From: ichikawa Date: Sun, 8 Nov 1998 15:42:41 +0000 (+0000) Subject: Importing pgnus-0.41 X-Git-Tag: pgnus-0_41~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5c85eb9dd8a85edecf9b9da5bfeb5ca5d754aa1b;p=elisp%2Fgnus.git- Importing pgnus-0.41 --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 71bb150..c9c5441 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,160 @@ +Sun Nov 8 01:00:16 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.41 is released. + +1998-11-08 00:52:38 Hrvoje Niksic + + * mm-decode.el (mm-dissect-multipart): Quote regexp. + +1998-10-29 Sudish Joseph + + * gnus.el (gnus-short-group-name): When shortening foreign select + methods, do not scan for plusses beyond the first colon. + +1998-11-07 Mike McEwan + + * gnus-agent.el (gnus-agent-save-group-info): Cater for group info + lines where `group' is the last thing on the line. + +1998-11-08 00:35:09 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Do alternative. + (gnus-mime-display-alternative): Insert marker. + +1998-11-07 14:33:46 Lars Magne Ingebrigtsen + + * mm-decode.el (mm-dissect-multipart): Quote regexp. + + * nnmail.el (nnmail-expired-article-p): Protect against bogus + dates. + + * gnus-cus.el (gnus-topic): Required. + + * nnheader.el (nnheader-parse-nov): Parse extra. + (nnheader-nov-parse-extra): New macro. + +1998-10-31 12:33:22 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-article-view-part): Internal move. + +1998-10-28 Per Abrahamsen + + * gnus-cus-new.el (gnus-custom-topic): New free variable. + (gnus-group-customize): Support editing topic parameters. + +1998-10-29 12:09:20 Karl Kleinpaste + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add + indicators. + +1998-10-29 11:31:11 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-mm-display-part): Return. + (gnus-article-view-part): Only go if external. + (gnus-article-dumbquotes-map): Do 205. + + * mm-decode.el (mm-display-part): Return what was done. + + * message.el (message-buffer-naming-style): New variable. + (message-generate-new-buffers): Extended. + (message-buffer-naming-style): Removed. + (message-buffer-name): Use it. + (message-do-send-housekeeping): Rename new styling. + + * gnus-sum.el (gnus-summary-recenter): Allow + gnus-auto-center-summary to be a number. + +Wed Nov 4 02:24:39 1998 Shenghuo ZHU + + * pop3.el (pop3-open-server): Use "binary" instead of + "no-conversion". + +Sun Nov 1 01:26:42 1998 Shenghuo ZHU + + * gnus-srvr.el (gnus-browse-foreign-server): Set + gnus-browse-current-method to the result of gnus-server-to-method. + +Thu Oct 29 01:47:44 1998 Shenghuo ZHU + + * gnus-util.el (gnus-pull): Another optional argument. + * nnweb.el (nnweb-request-delete-group): Delete from + nnweb-group-alist and update active file. + +Thu Oct 29 01:05:08 1998 Shenghuo ZHU + + * gnus-group.el (gnus-group-make-group): Accept group of new + method. + +Wed Oct 28 02:19:16 1998 Shenghuo ZHU + + * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble. + +Tue Oct 27 11:59:31 1998 Shenghuo ZHU + + * mm-view.el (mm-inline-text): Postion of html portion. + +1998-10-29 10:26:54 Lars Magne Ingebrigtsen + + * nntp.el (nntp-list-active-group): Waited for short strings. + (nntp-send-mode-reader): Ditto. + (nntp-open-connection): Ditto. + + * gnus-int.el (gnus-request-group-articles): New function. + + * nntp.el (nntp-request-listgroup): New function. + (nntp-request-group-articles): Renamed. + +1998-10-27 10:37:52 Karl Kleinpaste + + * nnheader.el (nnheader-parse-nov): Supply extra. + +1998-10-26 23:03:48 Lars Magne Ingebrigtsen + + * gnus-art.el (gnus-button-push): Don't go to + gnus-article-buffer. + + * mm-view.el (mm-inline-image): Add a newline. + + * gnus-start.el (gnus-check-first-time-used): Check more. + +1998-10-26 23:03:29 Francois Felix Ingrand + + * gnus-start.el (gnus-check-first-time-used): Check current. + +1998-10-26 22:07:52 Lars Magne Ingebrigtsen + + * mm-util.el (mm-find-charset-region): New function. + + * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header. + + * gnus-art.el (gnus-mime-button-menu): Fix. + +1998-10-26 22:07:43 Michael Welsh Duggan + + * gnus-art.el (gnus-mime-button-menu): New definition. + +1998-10-26 01:46:11 Lars Magne Ingebrigtsen + + * gnus-art.el (article-decode-charset): Downcase charset. + (article-decode-charset): Pass on type. + (article-decode-charset): Check nil charsets. + (article-remove-cr): Translate CR to LF. + (gnus-ignored-mime-types): Default to nil. + + * nnheader.el (nnheader-insert-nov): Work when not Xref. + + * gnus-sum.el (gnus-ignored-from-addresses): Default to + user-mail-address. + (gnus-nov-parse-extra): Didn't return right thing. + +1998-10-25 23:25:27 Lars Magne Ingebrigtsen + + * gnus-xmas.el: Use compiled-function-p. + +Mon Oct 26 14:37:19 1998 Shenghuo ZHU + + * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header. + Sun Oct 25 23:11:44 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.40 is released. @@ -460,7 +617,7 @@ Sun Oct 18 13:59:07 1998 Kurt Swanson * gnus-draft.el (gnus-draft-send): Allow mail. -1998-10-10 SL Baur +1998-10-10 -SL Baur * message.el (message-check): Move message-check macro above where it is first used. @@ -994,7 +1151,7 @@ Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.27 is released. -1998-09-11 12:42:07 Lars Magne Ingebrigtsen +1998-09-11 12:42:07 Lars Magne Ingebrigtsen- * mm-decode.el (mm-alternative-precedence): New variable. (mm-preferred-alternative): New function. diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 4fc0d64..eef0400 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -558,7 +558,7 @@ the actual number of articles toggled is returned." (gnus-delete-line)) (insert group " " (number-to-string (cdr active)) " " (number-to-string (car active)) " y\n")) - (when (re-search-forward (concat (regexp-quote group) " ") nil t) + (when (re-search-forward (concat (regexp-quote group) "\\($\\| \\)") nil t) (gnus-delete-line)) (insert-buffer-substring nntp-server-buffer)))))) @@ -982,7 +982,11 @@ the actual number of articles toggled is returned." (gnus-agent-fetch-articles group (gnus-uncompress-range (cdr arts))) (setq marks (delq arts (gnus-info-marks info))) - (gnus-info-set-marks info marks)))) + (gnus-info-set-marks info marks) + (gnus-dribble-enter + (concat "(gnus-group-set-info '" + (gnus-prin1-to-string info) + ")"))))) ;;; ;;; Agent Category Mode diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 5909c54..8cc86cf 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -551,6 +551,7 @@ displayed by the first non-nil matching CONTENT face." '(("\202" ",") ("\203" "f") ("\204" ",,") + ("\205" "...") ("\213" "<") ("\214" "OE") ("\205" "...") @@ -567,7 +568,7 @@ displayed by the first non-nil matching CONTENT face." ("\264" "'")) "Table for MS-to-Latin1 translation.") -(defcustom gnus-ignored-mime-types '("text/x-vcard") +(defcustom gnus-ignored-mime-types nil "List of MIME types that should be ignored by Gnus." :group 'gnus-mime :type '(repeat regexp)) @@ -578,7 +579,8 @@ displayed by the first non-nil matching CONTENT face." :type '(choice (const :tag "Off" nil) (const :tag "On" t) (const :tag "Last" last) - (integer :tag "Less"))) + (integer :tag "Less") + (sexp :tag "Predicate"))) ;;; Internal variables @@ -925,13 +927,16 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (end-of-line 2)))))) (defun article-remove-cr () - "Remove carriage returns from an article." + "Translate CRLF pairs into LF, and then CR into LF.." (interactive) (save-excursion (let ((buffer-read-only nil)) (goto-char (point-min)) + (while (search-forward "\r$" nil t) + (replace-match "" t t)) + (goto-char (point-min)) (while (search-forward "\r" nil t) - (replace-match "" t t))))) + (replace-match "\n" t t))))) (defun article-remove-trailing-blank-lines () "Remove all trailing blank lines from the article." @@ -1032,6 +1037,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (gnus-group-find-parameter gnus-newsgroup-name 'charset)))) buffer-read-only) + (when charset + (setq charset (downcase charset))) (goto-char (point-max)) (widen) (forward-line 1) @@ -1040,7 +1047,8 @@ If PROMPT (the prefix), prompt for a coding system to use." (equal (car ctl) "text/plain")) (mm-decode-body charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))))))))) + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -2235,7 +2243,16 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-mime-button-menu (event) "Construct a context-sensitive menu of MIME commands." (interactive "e") - ) + (let ((response (x-popup-menu + t `("MIME Part" + ("" ,@(mapcar (lambda (c) + (cons (caddr c) (car c))) + gnus-mime-button-commands))))) + (pos (event-start event))) + (when response + (set-buffer (window-buffer (posn-window pos))) + (goto-char (posn-point pos)) + (funcall response)))) (defun gnus-mime-view-all-parts () "View all the MIME parts." @@ -2303,8 +2320,10 @@ If ALL-HEADERS is non-nil, no headers are hidden." (error "No such part")) (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) (gnus-article-goto-part n) - (gnus-set-window-start) - (gnus-mm-display-part handle)))) + (if (equal (car handle) "multipart/alternative") + (gnus-article-press-button) + (when (eq (gnus-mm-display-part handle) 'internal) + (gnus-set-window-start)))))) (defun gnus-mm-display-part (handle) "Display HANDLE and fix MIME button." @@ -2314,8 +2333,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) (gnus-insert-mime-button handle id (list (not (mm-handle-displayed-p handle)))) - (mm-display-part handle) - (goto-char point))) + (prog1 + (mm-display-part handle) + (goto-char point)))) (defun gnus-article-goto-part (n) "Go to MIME part N." @@ -2383,7 +2403,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (while (setq handle (pop handles)) (if (stringp (car handle)) (if (equal (car handle) "multipart/alternative") - (gnus-mime-display-alternative (cdr handle)) + (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (push (cons id handle) gnus-article-mime-handle-alist) + (gnus-mime-display-alternative (cdr handle) nil nil id)) (gnus-mime-display-mixed (cdr handle))) (gnus-mime-display-single handle))))) @@ -2420,17 +2442,42 @@ If ALL-HEADERS is non-nil, no headers are hidden." (mm-insert-inline handle (mm-get-part handle)) (goto-char (point-max)))))))) -(defun gnus-mime-display-alternative (handles &optional preferred ibegend) +(defun gnus-mime-display-alternative (handles &optional preferred ibegend id) (let* ((preferred (mm-preferred-alternative handles preferred)) (ihandles handles) (point (point)) - handle buffer-read-only from props begend) + handle buffer-read-only from props begend not-pref) (save-restriction (when ibegend (narrow-to-region (car ibegend) (cdr ibegend)) (delete-region (point-min) (point-max)) (mm-remove-parts handles)) (setq begend (list (point-marker))) + ;; Do the toggle. + (unless (setq not-pref (cadr (member preferred ihandles))) + (setq not-pref (car ihandles))) + (gnus-add-text-properties + (setq from (point)) + (progn + (insert (format "%d. " id)) + (point)) + `(gnus-callback + (lambda (handles) + (gnus-mime-display-alternative + ',ihandles ,(if (stringp (car not-pref)) + (car not-pref) + (car (mm-handle-type not-pref))) + ',begend ,id)) + local-map ,gnus-mime-button-map + ,gnus-mouse-face-prop ,gnus-article-mouse-face + face ,gnus-article-button-face + keymap ,gnus-mime-button-map + gnus-part ,id + gnus-data ,handle)) + (widget-convert-button 'link from (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap) + ;; Do the handles (while (setq handle (pop handles)) (gnus-add-text-properties (setq from (point)) @@ -2447,11 +2494,12 @@ If ALL-HEADERS is non-nil, no headers are hidden." ',ihandles ,(if (stringp (car handle)) (car handle) (car (mm-handle-type handle))) - ',begend)) + ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face face ,gnus-article-button-face keymap ,gnus-mime-button-map + gnus-part ,id gnus-data ,handle)) (widget-convert-button 'link from (point) :action 'gnus-widget-press-button @@ -3376,7 +3424,6 @@ specified by `gnus-button-alist'." (defun gnus-button-push (marker) ;; Push button starting at MARKER. (save-excursion - (set-buffer gnus-article-buffer) (goto-char marker) (let* ((entry (gnus-button-entry)) (inhibit-point-motion-hooks t) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index 501d27d..7474f37 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -28,6 +28,7 @@ (require 'wid-edit) (require 'gnus-score) +(require 'gnus-topic) ;;; Widgets: @@ -173,10 +174,11 @@ DOC is a documentation string for the parameter.") (defvar gnus-custom-params) (defvar gnus-custom-method) (defvar gnus-custom-group) +(defvar gnus-custom-topic) -(defun gnus-group-customize (group) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) +(defun gnus-group-customize (group topic) + "Edit the group or topicon the current line." + (interactive (list (gnus-group-group-name) (gnus-group-topic-name))) (let (info (types (mapcar (lambda (entry) `(cons :format "%v%h\n" @@ -184,9 +186,11 @@ DOC is a documentation string for the parameter.") (const :format "" ,(nth 0 entry)) ,(nth 1 entry))) gnus-group-parameters))) - (unless group + (unless (or group topic) (error "No group on current line")) - (unless (setq info (gnus-get-info group)) + (when (and group topic) + (error "Both a group an topic on current line")) + (unless (or topic (setq info (gnus-get-info group))) (error "Killed group; can't be edited")) ;; Ready. (kill-buffer (gnus-get-buffer-create "*Gnus Customize*")) @@ -194,13 +198,20 @@ DOC is a documentation string for the parameter.") (gnus-custom-mode) (make-local-variable 'gnus-custom-group) (setq gnus-custom-group group) + (make-local-variable 'gnus-custom-topic) + (setq gnus-custom-topic topic) (widget-insert "Customize the ") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "group parameters" - "(gnus)Group Parameters") + (if group + (widget-create 'info-link + :help-echo "Push me to learn more." + :tag "group parameters" + "(gnus)Group Parameters") + (widget-create 'info-link + :help-echo "Push me to learn more." + :tag "topic parameters" + "(gnus)Topic Parameters")) (widget-insert " for <") - (widget-insert group) + (widget-insert (or group topic)) (widget-insert "> and press ") (widget-create 'push-button :tag "done" @@ -210,15 +221,17 @@ DOC is a documentation string for the parameter.") (make-local-variable 'gnus-custom-params) (setq gnus-custom-params (widget-create 'group - :value (gnus-info-params info) + :value (if group + (gnus-info-params info) + (gnus-topic-parameters topic)) `(set :inline t :greedy t :tag "Parameters" :format "%t:\n%h%v" :doc "\ These special paramerters are recognized by Gnus. -Check the [ ] for the parameters you want to apply to this group, then -edit the value to suit your taste." +Check the [ ] for the parameters you want to apply to this group or +to the groups in this topic, then edit the value to suit your taste." ,@types) '(repeat :inline t :tag "Variables" @@ -244,26 +257,30 @@ form, but who cares?" '(repeat :inline t :tag "Unknown entries" sexp))) - (widget-insert "\n\nYou can also edit the ") - (widget-create 'info-link - :tag "select method" - :help-echo "Push me to learn more about select methods." - "(gnus)Select Methods") - (widget-insert " for the group.\n") - (setq gnus-custom-method - (widget-create 'sexp - :tag "Method" - :value (gnus-info-method info))) + (when group + (widget-insert "\n\nYou can also edit the ") + (widget-create 'info-link + :tag "select method" + :help-echo "Push me to learn more about select methods." + "(gnus)Select Methods") + (widget-insert " for the group.\n") + (setq gnus-custom-method + (widget-create 'sexp + :tag "Method" + :value (gnus-info-method info)))) (use-local-map widget-keymap) (widget-setup))) (defun gnus-group-customize-done (&rest ignore) "Apply changes and bury the buffer." (interactive) - (gnus-group-edit-group-done 'params gnus-custom-group - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'method gnus-custom-group - (widget-value gnus-custom-method)) + (if gnus-custom-topic + (gnus-topic-set-parameters gnus-custom-topic + (widget-value gnus-custom-params)) + (gnus-group-edit-group-done 'params gnus-custom-group + (widget-value gnus-custom-params)) + (gnus-group-edit-group-done 'method gnus-custom-group + (widget-value gnus-custom-method))) (bury-buffer)) ;;; Score Customization: diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 6c6bb82..fcbcea5 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1815,7 +1815,7 @@ ADDRESS." (gnus-read-method "From method: "))) (when (stringp method) - (setq method (gnus-server-to-method method))) + (setq method (or (gnus-server-to-method method) method))) (let* ((meth (when (and method (not (gnus-server-equal method gnus-select-method))) (if address (list (intern method) address) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index d72d966..4ba7f40 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -269,6 +269,14 @@ this group uses will be queried." (funcall (gnus-get-function gnus-command-method func) (gnus-group-real-name group) (nth 1 gnus-command-method))))) +(defun gnus-request-group-articles (group) + "Request a list of existing articles in GROUP." + (let ((gnus-command-method (gnus-find-method-for-group group)) + (func 'request-group-articles)) + (when (gnus-check-backend-function func group) + (funcall (gnus-get-function gnus-command-method func) + (gnus-group-real-name group) (nth 1 gnus-command-method))))) + (defun gnus-close-group (group) "Request the GROUP be closed." (let ((gnus-command-method (inline (gnus-find-method-for-group group)))) diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el new file mode 100644 index 0000000..6e85b13 --- /dev/null +++ b/lisp/gnus-mailcap.el @@ -0,0 +1,851 @@ +;;; mailcap.el --- Functions for displaying MIME parts +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: William M. Perry +;; Lars Magne Ingebrigtsen +;; Keywords: news, mail + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-and-compile + (require 'cl)) +(require 'mail-parse) + +(defvar mailcap-parse-args-syntax-table + (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) + (modify-syntax-entry ?' "\"" table) + (modify-syntax-entry ?` "\"" table) + (modify-syntax-entry ?{ "(" table) + (modify-syntax-entry ?} ")" table) + table) + "A syntax table for parsing sgml attributes.") + +(defvar mailcap-mime-data + '(("application" + ("x-x509-ca-cert" + (viewer . ssl-view-site-cert) + (test . (fboundp 'ssl-view-site-cert)) + (type . "application/x-x509-ca-cert")) + ("x-x509-user-cert" + (viewer . ssl-view-user-cert) + (test . (fboundp 'ssl-view-user-cert)) + (type . "application/x-x509-user-cert")) + ("octet-stream" + (viewer . mailcap-save-binary-file) + (type ."application/octet-stream")) + ("dvi" + (viewer . "open %s") + (type . "application/dvi") + (test . (eq (mm-device-type) 'ns))) + ("dvi" + (viewer . "xdvi %s") + (test . (eq (mm-device-type) 'x)) + ("needsx11") + (type . "application/dvi")) + ("dvi" + (viewer . "dvitty %s") + (test . (not (getenv "DISPLAY"))) + (type . "application/dvi")) + ("emacs-lisp" + (viewer . mailcap-maybe-eval) + (type . "application/emacs-lisp")) + ("x-tar" + (viewer . mailcap-save-binary-file) + (type . "application/x-tar")) + ("x-latex" + (viewer . tex-mode) + (test . (fboundp 'tex-mode)) + (type . "application/x-latex")) + ("x-tex" + (viewer . tex-mode) + (test . (fboundp 'tex-mode)) + (type . "application/x-tex")) + ("latex" + (viewer . tex-mode) + (test . (fboundp 'tex-mode)) + (type . "application/latex")) + ("tex" + (viewer . tex-mode) + (test . (fboundp 'tex-mode)) + (type . "application/tex")) + ("texinfo" + (viewer . texinfo-mode) + (test . (fboundp 'texinfo-mode)) + (type . "application/tex")) + ("zip" + (viewer . mailcap-save-binary-file) + (type . "application/zip") + ("copiousoutput")) + ("pdf" + (viewer . "acroread %s") + (type . "application/pdf")) + ("postscript" + (viewer . "open %s") + (type . "application/postscript") + (test . (eq (mm-device-type) 'ns))) + ("postscript" + (viewer . "ghostview %s") + (type . "application/postscript") + (test . (eq (mm-device-type) 'x)) + ("needsx11")) + ("postscript" + (viewer . "ps2ascii %s") + (type . "application/postscript") + (test . (not (getenv "DISPLAY"))) + ("copiousoutput"))) + ("audio" + ("x-mpeg" + (viewer . "maplay %s") + (type . "audio/x-mpeg")) + (".*" + (viewer . mailcap-save-binary-file) + (test . (or (featurep 'nas-sound) + (featurep 'native-sound))) + (type . "audio/*")) + (".*" + (viewer . "showaudio") + (type . "audio/*"))) + ("message" + ("rfc-*822" + (viewer . gnus-article-prepare-display) + (test . (and (featurep 'gnus) + (gnus-alive-p))) + (type . "message/rfc-822")) + ("rfc-*822" + (viewer . vm-mode) + (test . (fboundp 'vm-mode)) + (type . "message/rfc-822")) + ("rfc-*822" + (viewer . w3-mode) + (test . (fboundp 'w3-mode)) + (type . "message/rfc-822")) + ("rfc-*822" + (viewer . view-mode) + (test . (fboundp 'view-mode)) + (type . "message/rfc-822")) + ("rfc-*822" + (viewer . fundamental-mode) + (type . "message/rfc-822"))) + ("image" + ("x-xwd" + (viewer . "xwud -in %s") + (type . "image/x-xwd") + ("compose" . "xwd -frame > %s") + (test . (eq (mm-device-type) 'x)) + ("needsx11")) + ("x11-dump" + (viewer . "xwud -in %s") + (type . "image/x-xwd") + ("compose" . "xwd -frame > %s") + (test . (eq (mm-device-type) 'x)) + ("needsx11")) + ("windowdump" + (viewer . "xwud -in %s") + (type . "image/x-xwd") + ("compose" . "xwd -frame > %s") + (test . (eq (mm-device-type) 'x)) + ("needsx11")) + (".*" + (viewer . "aopen %s") + (type . "image/*") + (test . (eq (mm-device-type) 'ns))) + (".*" + (viewer . "xv -perfect %s") + (type . "image/*") + (test . (eq (mm-device-type) 'x)) + ("needsx11"))) + ("text" + ("plain" + (viewer . w3-mode) + (test . (fboundp 'w3-mode)) + (type . "text/plain")) + ("plain" + (viewer . view-mode) + (test . (fboundp 'view-mode)) + (type . "text/plain")) + ("plain" + (viewer . fundamental-mode) + (type . "text/plain")) + ("enriched" + (viewer . enriched-decode-region) + (test . (fboundp 'enriched-decode)) + (type . "text/enriched")) + ("html" + (viewer . mm-w3-prepare-buffer) + (test . (fboundp 'w3-prepare-buffer)) + (type . "text/html"))) + ("video" + ("mpeg" + (viewer . "mpeg_play %s") + (type . "video/mpeg") + (test . (eq (mm-device-type) 'x)) + ("needsx11"))) + ("x-world" + ("x-vrml" + (viewer . "webspace -remote %s -URL %u") + (type . "x-world/x-vrml") + ("description" + "VRML document"))) + ("archive" + ("tar" + (viewer . tar-mode) + (type . "archive/tar") + (test . (fboundp 'tar-mode))))) + "*The mailcap structure is an assoc list of assoc lists. +1st assoc list is keyed on the major content-type +2nd assoc list is keyed on the minor content-type (which can be a regexp) + +Which looks like: +----------------- + ((\"application\" + (\"postscript\" . )) + (\"text\" + (\"plain\" . ))) + +Where is another assoc list of the various information +related to the mailcap RFC. This is keyed on the lowercase +attribute name (viewer, test, etc). This looks like: + ((viewer . viewerinfo) + (test . testinfo) + (xxxx . \"string\")) + +Where viewerinfo specifies how the content-type is viewed. Can be +a string, in which case it is run through a shell, with +appropriate parameters, or a symbol, in which case the symbol is +funcall'd, with the buffer as an argument. + +testinfo is a list of strings, or nil. If nil, it means the +viewer specified is always valid. If it is a list of strings, +these are used to determine whether a viewer passes the 'test' or +not.") + +(defvar mailcap-download-directory nil + "*Where downloaded files should go by default.") + +(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp") + "*Where temporary files go.") + +;;; +;;; Utility functions +;;; + +(defun mailcap-generate-unique-filename (&optional fmt) + "Generate a unique filename in mailcap-temporary-directory" + (if (not fmt) + (let ((base (format "mailcap-tmp.%d" (user-real-uid))) + (fname "") + (x 0)) + (setq fname (format "%s%d" base x)) + (while (file-exists-p + (expand-file-name fname mailcap-temporary-directory)) + (setq x (1+ x) + fname (concat base (int-to-string x)))) + (expand-file-name fname mailcap-temporary-directory)) + (let ((base (concat "mm" (int-to-string (user-real-uid)))) + (fname "") + (x 0)) + (setq fname (format fmt (concat base (int-to-string x)))) + (while (file-exists-p + (expand-file-name fname mailcap-temporary-directory)) + (setq x (1+ x) + fname (format fmt (concat base (int-to-string x))))) + (expand-file-name fname mailcap-temporary-directory)))) + +(defun mailcap-save-binary-file () + (goto-char (point-min)) + (unwind-protect + (let ((file (read-file-name + "Filename to save as: " + (or mailcap-download-directory "~/"))) + (require-final-newline nil)) + (write-region (point-min) (point-max) file)) + (kill-buffer (current-buffer)))) + +(defun mailcap-maybe-eval () + "Maybe evaluate a buffer of emacs lisp code" + (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ") + (eval-buffer (current-buffer)) + (emacs-lisp-mode))) + +;;; +;;; The mailcap parser +;;; + +(defun mailcap-replace-regexp (regexp to-string) + ;; Quiet replace-regexp. + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (replace-match to-string t nil))) + +(defvar mailcap-parsed-p nil) + +(defun mailcap-parse-mailcaps (&optional path force) + "Parse out all the mailcaps specified in a unix-style path string PATH. +If FORCE, re-parse even if already parsed." + (interactive (list nil t)) + (when (or (not mailcap-parsed-p) + force) + (cond + (path nil) + ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) + ((memq system-type '(ms-dos ms-windows windows-nt)) + (setq path (mapconcat 'expand-file-name '("~/mail.cap" "~/etc/mail.cap") + ";"))) + (t (setq path (mapconcat 'expand-file-name + '("~/.mailcap" + "/etc/mailcap:/usr/etc/mailcap" + "/usr/local/etc/mailcap") ":")))) + (let ((fnames (reverse + (split-string + path (if (memq system-type + '(ms-dos ms-windows windows-nt)) + ";" + ":")))) + fname) + (while fnames + (setq fname (car fnames)) + (if (and (file-exists-p fname) (file-readable-p fname) + (file-regular-p fname)) + (mailcap-parse-mailcap (car fnames))) + (setq fnames (cdr fnames)))) + (setq mailcap-parsed-p t))) + +(defun mailcap-parse-mailcap (fname) + ;; Parse out the mailcap file specified by FNAME + (let (major ; The major mime type (image/audio/etc) + minor ; The minor mime type (gif, basic, etc) + save-pos ; Misc saved positions used in parsing + viewer ; How to view this mime type + info ; Misc info about this mime type + ) + (with-temp-buffer + (insert-file-contents fname) + (set-syntax-table mailcap-parse-args-syntax-table) + (mailcap-replace-regexp "#.*" "") ; Remove all comments + (mailcap-replace-regexp "\n+" "\n") ; And blank lines + (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces + (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "") + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n") + (setq save-pos (point) + info nil) + (skip-chars-forward "^/;") + (downcase-region save-pos (point)) + (setq major (buffer-substring save-pos (point))) + (skip-chars-forward "/ \t\n") + (setq save-pos (point)) + (skip-chars-forward "^;") + (downcase-region save-pos (point)) + (setq minor + (cond + ((eq ?* (or (char-after save-pos) 0)) ".*") + ((= (point) save-pos) ".*") + (t (buffer-substring save-pos (point))))) + (skip-chars-forward "; \t\n") + ;;; Got the major/minor chunks, now for the viewers/etc + ;;; The first item _must_ be a viewer, according to the + ;;; RFC for mailcap files (#1343) + (skip-chars-forward "; \t\n") + (setq save-pos (point)) + (skip-chars-forward "^;\n") + (if (eq (or (char-after save-pos) 0) ?') + (setq viewer (progn + (narrow-to-region (1+ save-pos) (point)) + (goto-char (point-min)) + (prog1 + (read (current-buffer)) + (goto-char (point-max)) + (widen)))) + (setq viewer (buffer-substring save-pos (point)))) + (setq save-pos (point)) + (end-of-line) + (setq info (nconc (list (cons 'viewer viewer) + (cons 'type (concat major "/" + (if (string= minor ".*") + "*" minor)))) + (mailcap-parse-mailcap-extras save-pos (point)))) + (mailcap-mailcap-entry-passes-test info) + (mailcap-add-mailcap-entry major minor info))))) + +(defun mailcap-parse-mailcap-extras (st nd) + ;; Grab all the extra stuff from a mailcap entry + (let ( + name ; From name= + value ; its value + results ; Assoc list of results + name-pos ; Start of XXXX= position + val-pos ; Start of value position + done ; Found end of \'d ;s? + ) + (save-restriction + (narrow-to-region st nd) + (goto-char (point-min)) + (skip-chars-forward " \n\t;") + (while (not (eobp)) + (setq done nil) + (skip-chars-forward " \";\n\t") + (setq name-pos (point)) + (skip-chars-forward "^ \n\t=") + (downcase-region name-pos (point)) + (setq name (buffer-substring name-pos (point))) + (skip-chars-forward " \t\n") + (if (not (eq (or (char-after (point)) 0) ?=)) ; There is no value + (setq value nil) + (skip-chars-forward " \t\n=") + (setq val-pos (point)) + (if (memq (char-after val-pos) '(?\" ?')) + (progn + (setq val-pos (1+ val-pos)) + (condition-case nil + (progn + (forward-sexp 1) + (backward-char 1)) + (error (goto-char (point-max))))) + (while (not done) + (skip-chars-forward "^;") + (if (eq (or (char-after (1- (point))) 0) ?\\ ) + (progn + (subst-char-in-region (1- (point)) (point) ?\\ ? ) + (skip-chars-forward ";")) + (setq done t)))) + (setq value (buffer-substring val-pos (point)))) + (setq results (cons (cons name value) results))) + results))) + +(defun mailcap-mailcap-entry-passes-test (info) + ;; Return t iff a mailcap entry passes its test clause or no test + ;; clause is present. + (let (status ; Call-process-regions return value + (test (assq 'test info)) ; The test clause + ) + (setq status (and test (split-string (cdr test) " "))) + (if (and (or (assoc "needsterm" info) + (assoc "needsx11" info)) + (not (getenv "DISPLAY"))) + (setq status nil) + (cond + ((and (equal (nth 0 status) "test") + (equal (nth 1 status) "-n") + (or (equal (nth 2 status) "$DISPLAY") + (equal (nth 2 status) "\"$DISPLAY\""))) + (setq status (if (getenv "DISPLAY") t nil))) + ((and (equal (nth 0 status) "test") + (equal (nth 1 status) "-z") + (or (equal (nth 2 status) "$DISPLAY") + (equal (nth 2 status) "\"$DISPLAY\""))) + (setq status (if (getenv "DISPLAY") nil t))) + (test nil) + (t nil))) + (and test (listp test) (setcdr test status)))) + +;;; +;;; The action routines. +;;; + +(defun mailcap-possible-viewers (major minor) + ;; Return a list of possible viewers from MAJOR for minor type MINOR + (let ((exact '()) + (wildcard '())) + (while major + (cond + ((equal (car (car major)) minor) + (setq exact (cons (cdr (car major)) exact))) + ((and minor (string-match (car (car major)) minor)) + (setq wildcard (cons (cdr (car major)) wildcard)))) + (setq major (cdr major))) + (nconc (nreverse exact) (nreverse wildcard)))) + +(defun mailcap-unescape-mime-test (test type-info) + (let (save-pos save-chr subst) + (cond + ((symbolp test) test) + ((and (listp test) (symbolp (car test))) test) + ((or (stringp test) + (and (listp test) (stringp (car test)) + (setq test (mapconcat 'identity test " ")))) + (with-temp-buffer + (insert test) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward "^%") + (if (/= (- (point) + (progn (skip-chars-backward "\\\\") + (point))) + 0) ; It is an escaped % + (progn + (delete-char 1) + (skip-chars-forward "%.")) + (setq save-pos (point)) + (skip-chars-forward "%") + (setq save-chr (char-after (point))) + (cond + ((null save-chr) nil) + ((= save-chr ?t) + (delete-region save-pos (progn (forward-char 1) (point))) + (insert (or (cdr (assq 'type type-info)) "\"\""))) + ((= save-chr ?M) + (delete-region save-pos (progn (forward-char 1) (point))) + (insert "\"\"")) + ((= save-chr ?n) + (delete-region save-pos (progn (forward-char 1) (point))) + (insert "\"\"")) + ((= save-chr ?F) + (delete-region save-pos (progn (forward-char 1) (point))) + (insert "\"\"")) + ((= save-chr ?{) + (forward-char 1) + (skip-chars-forward "^}") + (downcase-region (+ 2 save-pos) (point)) + (setq subst (buffer-substring (+ 2 save-pos) (point))) + (delete-region save-pos (1+ (point))) + (insert (or (cdr (assoc subst type-info)) "\"\""))) + (t nil)))) + (buffer-string))) + (t (error "Bad value to mailcap-unescape-mime-test. %s" test))))) + +(defvar mailcap-viewer-test-cache nil) + +(defun mailcap-viewer-passes-test (viewer-info type-info) + ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its + ;; test clause (if any). + (let* ((test-info (assq 'test viewer-info)) + (test (cdr test-info)) + (otest test) + (viewer (cdr (assoc 'viewer viewer-info))) + (default-directory (expand-file-name "~/")) + status parsed-test cache result) + (if (setq cache (assoc test mailcap-viewer-test-cache)) + (cadr cache) + (setq + result + (cond + ((not test-info) t) ; No test clause + ((not test) nil) ; Already failed test + ((eq test t) t) ; Already passed test + ((and (symbolp test) ; Lisp function as test + (fboundp test)) + (funcall test type-info)) + ((and (symbolp test) ; Lisp variable as test + (boundp test)) + (symbol-value test)) + ((and (listp test) ; List to be eval'd + (symbolp (car test))) + (eval test)) + (t + (setq test (mailcap-unescape-mime-test test type-info) + test (list shell-file-name nil nil nil + shell-command-switch test) + status (apply 'call-process test)) + (= 0 status)))) + (push (list otest result) mailcap-viewer-test-cache) + result))) + +(defun mailcap-add-mailcap-entry (major minor info) + (let ((old-major (assoc major mailcap-mime-data))) + (if (null old-major) ; New major area + (setq mailcap-mime-data + (cons (cons major (list (cons minor info))) + mailcap-mime-data)) + (let ((cur-minor (assoc minor old-major))) + (cond + ((or (null cur-minor) ; New minor area, or + (assq 'test info)) ; Has a test, insert at beginning + (setcdr old-major (cons (cons minor info) (cdr old-major)))) + ((and (not (assq 'test info)) ; No test info, replace completely + (not (assq 'test cur-minor))) + (setcdr cur-minor info)) + (t + (setcdr old-major (cons (cons minor info) (cdr old-major))))))))) + +;;; +;;; The main whabbo +;;; + +(defun mailcap-viewer-lessp (x y) + ;; Return t iff viewer X is more desirable than viewer Y + (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) ""))) + (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) ""))) + (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) "")))) + (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) ""))))) + (cond + ((and x-lisp (not y-lisp)) + t) + ((and (not y-lisp) x-wild (not y-wild)) + t) + ((and (not x-wild) y-wild) + t) + (t nil)))) + +(defun mailcap-mime-info (string &optional request) + "Get the MIME viewer command for STRING, return nil if none found. +Expects a complete content-type header line as its argument. + +Second argument REQUEST specifies what information to return. If it is +nil or the empty string, the viewer (second field of the mailcap +entry) will be returned. If it is a string, then the mailcap field +corresponding to that string will be returned (print, description, +whatever). If a number, then all the information for this specific +viewer is returned. If `all', then all possible viewers for +this type is returned." + (let ( + major ; Major encoding (text, etc) + minor ; Minor encoding (html, etc) + info ; Other info + save-pos ; Misc. position during parse + major-info ; (assoc major mailcap-mime-data) + minor-info ; (assoc minor major-info) + test ; current test proc. + viewers ; Possible viewers + passed ; Viewers that passed the test + viewer ; The one and only viewer + ctl) + (save-excursion + (setq ctl (mail-header-parse-content-type (or string "text/plain"))) + (setq major (split-string (car ctl) "/")) + (setq minor (cadr major) + major (car major)) + (when (setq major-info (cdr (assoc major mailcap-mime-data))) + (when (setq viewers (mailcap-possible-viewers major-info minor)) + (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) + (cdr a))) + (cdr ctl))) + (while viewers + (if (mailcap-viewer-passes-test (car viewers) info) + (setq passed (cons (car viewers) passed))) + (setq viewers (cdr viewers))) + (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) + (setq viewer (car passed)))) + (when (and (stringp (cdr (assq 'viewer viewer))) + passed) + (setq viewer (car passed))) + (cond + ((and (null viewer) (not (equal major "default")) request) + (mailcap-mime-info "default" request)) + ((or (null request) (equal request "")) + (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) + ((stringp request) + (if (or (eq request 'test) (eq request 'viewer)) + (mailcap-unescape-mime-test + (cdr-safe (assoc request viewer)) info))) + ((eq request 'all) + passed) + (t + ;; MUST make a copy *sigh*, else we modify mailcap-mime-data + (setq viewer (copy-tree viewer)) + (let ((view (assq 'viewer viewer)) + (test (assq 'test viewer))) + (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info))) + (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info)))) + viewer))))) + +;;; +;;; Experimental MIME-types parsing +;;; + +(defvar mailcap-mime-extensions + '(("" . "text/plain") + (".abs" . "audio/x-mpeg") + (".aif" . "audio/aiff") + (".aifc" . "audio/aiff") + (".aiff" . "audio/aiff") + (".ano" . "application/x-annotator") + (".au" . "audio/ulaw") + (".avi" . "video/x-msvideo") + (".bcpio" . "application/x-bcpio") + (".bin" . "application/octet-stream") + (".cdf" . "application/x-netcdr") + (".cpio" . "application/x-cpio") + (".csh" . "application/x-csh") + (".dvi" . "application/x-dvi") + (".el" . "application/emacs-lisp") + (".eps" . "application/postscript") + (".etx" . "text/x-setext") + (".exe" . "application/octet-stream") + (".fax" . "image/x-fax") + (".gif" . "image/gif") + (".hdf" . "application/x-hdf") + (".hqx" . "application/mac-binhex40") + (".htm" . "text/html") + (".html" . "text/html") + (".icon" . "image/x-icon") + (".ief" . "image/ief") + (".jpg" . "image/jpeg") + (".macp" . "image/x-macpaint") + (".man" . "application/x-troff-man") + (".me" . "application/x-troff-me") + (".mif" . "application/mif") + (".mov" . "video/quicktime") + (".movie" . "video/x-sgi-movie") + (".mp2" . "audio/x-mpeg") + (".mp3" . "audio/x-mpeg") + (".mp2a" . "audio/x-mpeg2") + (".mpa" . "audio/x-mpeg") + (".mpa2" . "audio/x-mpeg2") + (".mpe" . "video/mpeg") + (".mpeg" . "video/mpeg") + (".mpega" . "audio/x-mpeg") + (".mpegv" . "video/mpeg") + (".mpg" . "video/mpeg") + (".mpv" . "video/mpeg") + (".ms" . "application/x-troff-ms") + (".nc" . "application/x-netcdf") + (".nc" . "application/x-netcdf") + (".oda" . "application/oda") + (".pbm" . "image/x-portable-bitmap") + (".pdf" . "application/pdf") + (".pgm" . "image/portable-graymap") + (".pict" . "image/pict") + (".png" . "image/png") + (".pnm" . "image/x-portable-anymap") + (".ppm" . "image/portable-pixmap") + (".ps" . "application/postscript") + (".qt" . "video/quicktime") + (".ras" . "image/x-raster") + (".rgb" . "image/x-rgb") + (".rtf" . "application/rtf") + (".rtx" . "text/richtext") + (".sh" . "application/x-sh") + (".sit" . "application/x-stuffit") + (".snd" . "audio/basic") + (".src" . "application/x-wais-source") + (".tar" . "archive/tar") + (".tcl" . "application/x-tcl") + (".tcl" . "application/x-tcl") + (".tex" . "application/x-tex") + (".texi" . "application/texinfo") + (".tga" . "image/x-targa") + (".tif" . "image/tiff") + (".tiff" . "image/tiff") + (".tr" . "application/x-troff") + (".troff" . "application/x-troff") + (".tsv" . "text/tab-separated-values") + (".txt" . "text/plain") + (".vbs" . "video/mpeg") + (".vox" . "audio/basic") + (".vrml" . "x-world/x-vrml") + (".wav" . "audio/x-wav") + (".wrl" . "x-world/x-vrml") + (".xbm" . "image/xbm") + (".xpm" . "image/x-pixmap") + (".xwd" . "image/windowdump") + (".zip" . "application/zip") + (".ai" . "application/postscript") + (".jpe" . "image/jpeg") + (".jpeg" . "image/jpeg")) + "*An assoc list of file extensions and the MIME content-types they +correspond to.") + +(defun mailcap-parse-mimetypes (&optional path) + ;; Parse out all the mimetypes specified in a unix-style path string PATH + (cond + (path nil) + ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) + ((memq system-type '(ms-dos ms-windows windows-nt)) + (setq path (mapconcat 'expand-file-name + '("~/mime.typ" "~/etc/mime.typ") ";"))) + (t (setq path (mapconcat 'expand-file-name + '("~/.mime-types" + "/etc/mime-types:/usr/etc/mime-types" + "/usr/local/etc/mime-types" + "/usr/local/www/conf/mime-types") ":")))) + (let ((fnames (reverse + (split-string path + (if (memq system-type + '(ms-dos ms-windows windows-nt)) + ";" ":")))) + fname) + (while fnames + (setq fname (car fnames)) + (if (and (file-exists-p fname) (file-readable-p fname)) + (mailcap-parse-mimetype-file (car fnames))) + (setq fnames (cdr fnames))))) + +(defun mailcap-parse-mimetype-file (fname) + ;; Parse out a mime-types file + (let (type ; The MIME type for this line + extns ; The extensions for this line + save-pos ; Misc. saved buffer positions + ) + (with-temp-buffer + (insert-file-contents fname) + (mailcap-replace-regexp "#.*" "") + (mailcap-replace-regexp "\n+" "\n") + (mailcap-replace-regexp "[ \t]+$" "") + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n") + (setq save-pos (point)) + (skip-chars-forward "^ \t") + (downcase-region save-pos (point)) + (setq type (buffer-substring save-pos (point))) + (while (not (eolp)) + (skip-chars-forward " \t") + (setq save-pos (point)) + (skip-chars-forward "^ \t\n") + (setq extns (cons (buffer-substring save-pos (point)) extns))) + (while extns + (setq mailcap-mime-extensions + (cons + (cons (if (= (string-to-char (car extns)) ?.) + (car extns) + (concat "." (car extns))) type) + mailcap-mime-extensions) + extns (cdr extns))))))) + +(defun mailcap-extension-to-mime (extn) + "Return the MIME content type of the file extensions EXTN." + (if (and (stringp extn) + (not (eq (string-to-char extn) ?.))) + (setq extn (concat "." extn))) + (cdr (assoc (downcase extn) mailcap-mime-extensions))) + +(defvar mailcap-binary-suffixes + (if (memq system-type '(ms-dos windows-nt)) + '(".exe" ".com" ".bat" ".cmd" ".btm" "") + '(""))) + +(defun mailcap-command-p (command) + "Say whether COMMAND is in the exec path. +The path of COMMAND will be returned iff COMMAND is a command." + (let ((path (if (file-name-absolute-p command) '(nil) exec-path)) + file dir) + (catch 'found + (while (setq dir (pop path)) + (let ((suffixes mailcap-binary-suffixes)) + (while suffixes + (when (and (file-executable-p + (setq file (expand-file-name + (concat command (pop suffixes)) + dir))) + (not (file-directory-p file))) + (throw 'found file)))))))) + +(provide 'mailcap) + +;;; mailcap.el ends here diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 560c0e9..0f492e8 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -550,9 +550,9 @@ The following commands are available: (defun gnus-browse-foreign-server (server &optional return-buffer) "Browse the server SERVER." - (setq gnus-browse-current-method server) + (setq gnus-browse-current-method (gnus-server-to-method server)) (setq gnus-browse-return-buffer return-buffer) - (let* ((method (gnus-server-to-method server)) + (let* ((method gnus-browse-current-method) (gnus-select-method method) groups group) (gnus-message 5 "Connecting to %s..." (nth 1 method)) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 8b19bee..c7f1f8e 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1103,10 +1103,16 @@ for new groups, and subscribe the new groups as zombies." got-new)) (defun gnus-check-first-time-used () - (if (or (file-exists-p gnus-startup-file) - (file-exists-p (concat gnus-startup-file ".el")) - (file-exists-p (concat gnus-startup-file ".eld"))) - nil + (catch 'ended + (let ((files (list gnus-current-startup-file + (concat gnus-current-startup-file ".el") + (concat gnus-current-startup-file ".eld") + gnus-startup-file + (concat gnus-startup-file ".el") + (concat gnus-startup-file ".eld")))) + (while files + (when (file-exists-p (pop files)) + (throw 'ended nil)))) (gnus-message 6 "First time user; subscribing you to default groups") (unless (gnus-read-active-file-p) (let ((gnus-read-active-file t)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 72314d9..2fba73e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -310,6 +310,7 @@ and non-`vertical', do both horizontal and vertical recentering." :group 'gnus-summary-maneuvering :type '(choice (const :tag "none" nil) (const vertical) + (integer :tag "height") (sexp :menu-tag "both" t))) (defcustom gnus-show-all-headers nil @@ -777,7 +778,7 @@ which it may alter in any way.") :group 'gnus-summary :type '(repeat symbol)) -(defcustom gnus-ignored-from-addresses nil +(defcustom gnus-ignored-from-addresses (regexp-quote user-mail-address) "*Regexp of From headers that may be suppressed in favor of To headers." :group 'gnus-summary :type 'regexp) @@ -2450,14 +2451,16 @@ marks of articles." gnus-ignored-from-addresses (string-match gnus-ignored-from-addresses (mail-header-from header))) - (or (car (funcall gnus-extract-address-components - (funcall gnus-decode-encoded-word-function to))) - (funcall gnus-decode-encoded-word-function to))) + (concat "-> " + (or (car (funcall gnus-extract-address-components + (funcall + gnus-decode-encoded-word-function to))) + (funcall gnus-decode-encoded-word-function to)))) ((and newsgroups gnus-ignored-from-addresses (string-match gnus-ignored-from-addresses (mail-header-from header))) - newsgroups) + (concat "=> " newsgroups)) (t (or (car (funcall gnus-extract-address-components (mail-header-from header))) @@ -3128,8 +3131,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." '(let (out string) (while (not (memq (char-after) '(?\n nil))) (setq string (gnus-nov-field)) - (when (string-match "^\\([^ :]\\): " string) - (push (cons (intern (match-string 1)) + (when (string-match "^\\([^ :]+\\): " string) + (push (cons (intern (match-string 1 string)) (substring string (match-end 0))) out))) out)) @@ -4945,7 +4948,9 @@ displayed, no centering will be performed." ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) - (t 2))) + (t (if (numberp gnus-auto-center-summary) + gnus-auto-center-summary + 2)))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 30b2cde..678aba1 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -896,11 +896,12 @@ ARG is passed to the first function." (setq alist (delq entry alist))) alist)) -(defmacro gnus-pull (key alist) +(defmacro gnus-pull (key alist &optional assoc-p) "Modify ALIST to be without KEY." (unless (symbolp alist) (error "Not a symbol: %s" alist)) - `(setq ,alist (delq (assq ,key ,alist) ,alist))) + (let ((fun (if assoc-p 'assoc 'assq))) + `(setq ,alist (delq (,fun ,key ,alist) ,alist)))) (defun gnus-globalify-regexp (re) "Returns a regexp that matches a whole line, iff RE matches a part of it." diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index 6f99327..b323db1 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -434,7 +434,7 @@ call it with the value of the `gnus-data' text property." (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (indirect-function func))) - (if (byte-code-function-p fval) + (if (compiled-function-p fval) (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 12b9d61..4a1e51b 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -254,7 +254,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.40" +(defconst gnus-version-number "0.41" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -2585,22 +2585,18 @@ just the host name." ;; separate foreign select method from group name and collapse. ;; if method contains a server, collapse to non-domain server name, ;; otherwise collapse to select method - (when (string-match ":" group) - (cond ((string-match "+" group) - (let* ((plus (string-match "+" group)) - (colon (string-match ":" group (or plus 0))) - (dot (string-match "\\." group))) - (setq foreign (concat - (substring group (+ 1 plus) - (cond ((null dot) colon) - ((< colon dot) colon) - ((< dot colon) dot))) - ":") - group (substring group (+ 1 colon))))) - (t - (let* ((colon (string-match ":" group))) - (setq foreign (concat (substring group 0 (+ 1 colon))) - group (substring group (+ 1 colon))))))) + (let* ((colon (string-match ":" group)) + (server (and colon (substring group 0 colon))) + (plus (and server (string-match "+" server)))) + (when server + (cond (plus + (setq foreign (substring server (+ 1 plus) + (string-match "\\." server)) + group (substring group (+ 1 colon)))) + (t + (setq foreign server + group (substring group (+ 1 colon))))) + (setq foreign (concat foreign ":")))) ;; collapse group name leaving LEVELS uncollapsed elements (while group (if (and (string-match "\\." group) (> levels 0)) diff --git a/lisp/ietf-drums.el b/lisp/ietf-drums.el index 713b14a..865ddff 100644 --- a/lisp/ietf-drums.el +++ b/lisp/ietf-drums.el @@ -226,7 +226,7 @@ "Narrow to the header section in the current buffer." (narrow-to-region (goto-char (point-min)) - (if (search-forward "\n\n" nil 1) + (if (re-search-forward "^\n" nil 1) (1- (point)) (point-max))) (goto-char (point-min))) diff --git a/lisp/message.el b/lisp/message.el index 9eadf92..86b5a9c 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -242,14 +242,15 @@ nil means let mailer mail back a message to report errors." :group 'message-mail :type 'boolean) -(defcustom message-generate-new-buffers t +(defcustom message-generate-new-buffers 'unique "*Non-nil means that a new message buffer will be created whenever `message-setup' is called. If this is a function, call that function with three parameters: The type, the to address and the group name. (Any of these may be nil.) The function should return the new buffer name." :group 'message-buffers :type '(choice (const :tag "off" nil) - (const :tag "on" t) + (const :tag "unique" unique) + (const :tag "unsuniqueent" unsent) (function fun))) (defcustom message-kill-buffer-on-exit nil @@ -653,6 +654,13 @@ If nil, Message won't auto-save." :group 'message-buffers :type 'directory) +(defcustom message-buffer-naming-style 'unique + "*The way new message buffers are named. +Valid valued are `unique' and `unsent'." + :group 'message-buffers + :type '(choice (const :tag "unique" unique) + (const :tag "unsent" unsent))) + ;;; Internal variables. ;;; Well, not really internal. @@ -3140,7 +3148,7 @@ Headers already prepared in the buffer are not modified." ((message-functionp message-generate-new-buffers) (funcall message-generate-new-buffers type to group)) ;; Generate a new buffer name The Message Way. - (message-generate-new-buffers + ((eq message-generate-new-buffers 'unique) (generate-new-buffer-name (concat "*" type (if to @@ -3150,6 +3158,16 @@ Headers already prepared in the buffer are not modified." "") (if (and group (not (string= group ""))) (concat " on " group) "") "*"))) + ((eq message-generate-new-buffers 'unsent) + (generate-new-buffer-name + (concat "*unsent " type + (if to + (concat " to " + (or (car (mail-extract-address-components to)) + to) "") + "") + (if (and group (not (string= group ""))) (concat " on " group) "") + "*"))) ;; Use standard name. (t (format "*%s message*" type)))) @@ -3185,7 +3203,7 @@ Headers already prepared in the buffer are not modified." ;; Rename the buffer. (if message-send-rename-function (funcall message-send-rename-function) - (when (string-match "\\`\\*" (buffer-name)) + (when (string-match "\\`\\*\\(unsent \\)?" (buffer-name)) (rename-buffer (concat "*sent " (substring (buffer-name) (match-end 0))) t))) ;; Push the current buffer onto the list. diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index b7611c3..d4e05f0 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -43,7 +43,7 @@ If no encoding was done, nil is returned." (save-excursion (goto-char (point-min)) (let ((charsets - (delq 'ascii (find-charset-region (point-min) (point-max)))) + (delq 'ascii (mm-find-charset-region (point-min) (point-max)))) charset) (cond ;; No encoding. @@ -121,16 +121,15 @@ If no encoding was done, nil is returned." (funcall encoding (point-min) (point-max)) (error nil))) (t - (message "Unknown encoding %s; defaulting to 8bit" encoding) - ))) + (message "Unknown encoding %s; defaulting to 8bit" encoding)))) -(defun mm-decode-body (charset &optional encoding) +(defun mm-decode-body (charset &optional encoding type) "Decode the current article that has been encoded with ENCODING. The characters in CHARSET should then be decoded." (setq charset (or charset rfc2047-default-charset)) (save-excursion (when encoding - (mm-decode-content-transfer-encoding encoding)) + (mm-decode-content-transfer-encoding encoding type)) (when (featurep 'mule) (let (mule-charset) (when (and charset diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 6344209..ab07f8d 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -145,7 +145,7 @@ (defun mm-dissect-multipart (ctl) (goto-char (point-min)) (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary))) - (close-delimiter (concat boundary "--[ \t]*$")) + (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$")) start parts (end (save-excursion (goto-char (point-max)) @@ -174,7 +174,7 @@ (let ((obuf (current-buffer)) beg) (goto-char (point-min)) - (search-forward "\n\n" nil t) + (search-forward-regexp "^\n" nil t) (setq beg (point)) (set-buffer (generate-new-buffer " *mm*")) (insert-buffer-substring obuf beg) @@ -185,7 +185,9 @@ (eq (mm-user-method type) 'inline)) (defun mm-display-part (handle &optional no-default) - "Display the MIME part represented by HANDLE." + "Display the MIME part represented by HANDLE. +Returns nil if the part is removed; inline if displayed inline; +external if displayed external." (save-excursion (mailcap-parse-mailcaps) (if (mm-handle-displayed-p handle) @@ -203,10 +205,13 @@ (if (and (not user-method) (not method) (equal "text" (car (split-string type)))) - (mm-insert-inline handle (mm-get-part handle)) + (progn + (mm-insert-inline handle (mm-get-part handle)) + 'inline) (mm-display-external handle (or user-method method - 'mailcap-save-binary-file))))))))) + 'mailcap-save-binary-file)) + 'external))))))) (defun mm-display-external (handle method) "Display HANDLE using METHOD." diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 79454d0..eeff82f 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -222,6 +222,21 @@ See also `with-temp-file' and `with-output-to-string'." (put 'mm-with-unibyte-buffer 'lisp-indent-function 0) (put 'mm-with-unibyte-buffer 'edebug-form-spec '(body)) +(defun mm-find-charset-region (b e) + "Return a list of charsets in the region." + (if enable-multibyte-characters + (find-charset-region b e) + ;; We are in a unibyte buffer, so we futz around a bit. + (save-excursion + (save-restriction + (narrow-to-region b e) + (goto-char (point-min)) + (let ((entry (assoc current-language-environment language-info-alist))) + (skip-chars-forward "\0-\177") + (if (eobp) + '(ascii) + (list 'ascii (car (last (assq 'charset entry)))))))))) + (provide 'mm-util) ;;; mm-util.el ends here diff --git a/lisp/mm-view.el b/lisp/mm-view.el index 2d2a1d6..0335cdb 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -46,7 +46,7 @@ (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t) (mm-handle-set-undisplayer handle annot)) - (insert " "))) + (insert " \n"))) (defun mm-inline-text (handle) (let ((type (cadr (split-string (car (mm-handle-type handle)) "/"))) @@ -85,8 +85,8 @@ (require 'url) (save-window-excursion (w3-region (point-min) (point-max)) - (setq text (buffer-string)))) - (mm-insert-inline handle text))) + (setq text (buffer-string))))) + (mm-insert-inline handle text)) ((or (equal type "enriched") (equal type "richtext")) (save-excursion diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 9d64793..5f685a3 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -298,6 +298,16 @@ on your system, you could say something like: (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) +(defmacro nnheader-nov-parse-extra () + '(let (out string) + (while (not (memq (char-after) '(?\n nil))) + (setq string (nnheader-nov-field)) + (when (string-match "^\\([^ :]+\\): " string) + (push (cons (intern (match-string 1 string)) + (substring string (match-end 0))) + out))) + out)) + (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) (vector @@ -313,7 +323,7 @@ on your system, you could say something like: (if (eq (char-after) ?\n) nil (nnheader-nov-field)) ; misc - ))) + (nnheader-nov-parse-extra)))) ; extra (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) @@ -330,9 +340,11 @@ on your system, you could say something like: (insert "\t") (princ (or (mail-header-lines header) 0) (current-buffer)) (insert "\t") + (when (mail-header-xref header) + (insert "Xref: " (mail-header-xref header))) (when (or (mail-header-xref header) (mail-header-extra header)) - (insert "Xref: " (mail-header-xref header) "\t")) + (insert "\t")) (when (mail-header-extra header) (let ((extra (mail-header-extra header))) (while extra diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 5f43048..c852ad8 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -1642,7 +1642,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ((numberp days) (setq days (days-to-time days)) ;; Compare the time with the current time. - (time-less-p days (time-since time))))))) + (condition-case () + (time-less-p days (time-since time)) + (error nil))))))) (defvar nnmail-read-passwd nil) (defun nnmail-read-passwd (prompt &rest args) @@ -1774,7 +1776,11 @@ If ARGS, PROMPT is used as an argument to `format'." (defun nnmail-pop3-movemail (inbox crashbox) "Function to move mail from INBOX on a pop3 server to file CRASHBOX." (let ((pop3-maildrop - (substring inbox (match-end (string-match "^po:" inbox))))) + (substring inbox (match-end (string-match "^po:" inbox)))) + (pop3-password + (or nnmail-pop-password + (nnmail-read-passwd + (format "Password for %s: " inbox))))) (pop3-movemail crashbox))) (defun nnmail-within-headers-p () diff --git a/lisp/nntp.el b/lisp/nntp.el index 354dc72..16a262a 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -1,5 +1,5 @@ ;;; nntp.el --- nntp access for Gnus -;;; Copyright (C) 1987-90,92-97 Free Software Foundation, Inc. +;;; Copyright (C) 1987-90,92-98 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -270,9 +270,9 @@ If this variable is nil, which is the default, no timers are set.") (nntp-decode-text (not decode)) (unless discard (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) + (set-buffer buffer) + (goto-char (point-max)) + (insert-buffer-substring (process-buffer process)) ;; Nix out "nntp reading...." message. (when nntp-have-messaged (setq nntp-have-messaged nil) @@ -614,9 +614,14 @@ If this variable is nil, which is the default, no timers are set.") (setq nntp-server-list-active-group t))))) (deffoo nntp-list-active-group (group &optional server) - "Return the active info on GROUP (which can be a regexp." + "Return the active info on GROUP (which can be a regexp)." (nntp-possibly-change-group nil server) - (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) + (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)) + +(deffoo nntp-request-group-articles (group &optional server) + "Return the list of existing articles in GROUP." + (nntp-possibly-change-group nil server) + (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)) (deffoo nntp-request-article (article &optional group server buffer command) (nntp-possibly-change-group group server) @@ -745,7 +750,7 @@ If this variable is nil, which is the default, no timers are set.") This function is supposed to be called from `nntp-server-opened-hook'. It will make innd servers spawn an nnrpd process to allow actual article reading." - (nntp-send-command "^.*\r?\n" "MODE READER")) + (nntp-send-command "^\\.*\r?\n" "MODE READER")) (defun nntp-send-authinfo (&optional send-if-force) "Send the AUTHINFO to the nntp server. @@ -853,7 +858,7 @@ password contained in '~/.nntp-authinfo'." (when (and (buffer-name pbuffer) process) (process-kill-without-query process) - (nntp-wait-for process "^.*\n" buffer nil t) + (nntp-wait-for process "^\\.*\n" buffer nil t) (if (memq (process-status process) '(open run)) (prog1 (caar (push (list process buffer nil) nntp-connection-alist)) @@ -1111,7 +1116,6 @@ password contained in '~/.nntp-authinfo'." (delete-char -1)) (goto-char (point-min)) (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ") - ;;(copy-to-buffer nntp-server-buffer (point-min) (point-max)) t)))) nntp-server-xover) diff --git a/lisp/nnweb.el b/lisp/nnweb.el index 4ab9ec4..42dc338 100644 --- a/lisp/nnweb.el +++ b/lisp/nnweb.el @@ -214,7 +214,8 @@ and `altavista'.") (deffoo nnweb-request-delete-group (group &optional force server) (nnweb-possibly-change-server group server) - (gnus-pull group nnweb-group-alist) + (gnus-pull group nnweb-group-alist t) + (nnweb-write-active) (gnus-delete-file (nnweb-overview-file group)) t) diff --git a/lisp/pop3.el b/lisp/pop3.el index b90cd03..3d5cdf5 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -112,8 +112,8 @@ Returns the process associated with the connection." (let ((process-buffer (get-buffer-create (format "trace of POP session to %s" mailhost))) (process) - (coding-system-for-read 'no-conversion) ;; because FSF Emacs 20 - (coding-system-for-write 'no-conversion) ;; is st00pid + (coding-system-for-read 'binary) ;; because FSF Emacs 20 and + (coding-system-for-write 'binary) ;; XEmacs 20/1 are st00pid ) (save-excursion (set-buffer process-buffer) diff --git a/make.bat b/make.bat index 4a6b8a0..d183af9 100755 --- a/make.bat +++ b/make.bat @@ -1,57 +1,57 @@ -@echo off - -rem Written by David Charlap - -rem There are two catches, however. The emacs.bat batch file may not exist -rem in all distributions. It is part of the Voelker build of Emacs 19.34 -rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user -rem installs Gnus with some other build, he may have to replace calls to -rem %1\emacs.bat with something else. -rem -rem Also, the emacs.bat file that Voelker ships does not accept more than 9 -rem parameters, so the attempts to compile the .texi files will fail. To -rem fix that (at least on NT. I don't know about Win95), the following -rem change should be made to emacs.bat: -rem -rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 -rem -rem should become -rem -rem %emacs_dir%\bin\emacs.exe %* -rem -rem which will allow the batch file to accept an unlimited number of -rem parameters. - -if "%1" == "" goto usage - -cd lisp -call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile -if not "%2" == "copy" goto info -copy *.el* %1\lisp - -:info -cd ..\texi -call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -if not "%2" == "copy" goto done -copy gnus %1\info -copy gnus-?? %1\info -copy message %1\info - -:etc -cd ..\etc -copy gnus-tut.txt %1\etc - -:done -cd .. -goto end - -:usage -echo Usage: make ^ [copy] -echo. -echo where: ^ is the directory you installed emacs in -echo eg. d:\emacs\19.34 -echo copy indicates that the compiled files should be copied to your -echo emacs lisp, info, and etc directories - -:end +@echo off + +rem Written by David Charlap + +rem There are two catches, however. The emacs.bat batch file may not exist +rem in all distributions. It is part of the Voelker build of Emacs 19.34 +rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user +rem installs Gnus with some other build, he may have to replace calls to +rem %1\emacs.bat with something else. +rem +rem Also, the emacs.bat file that Voelker ships does not accept more than 9 +rem parameters, so the attempts to compile the .texi files will fail. To +rem fix that (at least on NT. I don't know about Win95), the following +rem change should be made to emacs.bat: +rem +rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 +rem +rem should become +rem +rem %emacs_dir%\bin\emacs.exe %* +rem +rem which will allow the batch file to accept an unlimited number of +rem parameters. + +if "%1" == "" goto usage + +cd lisp +call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile +if not "%2" == "copy" goto info +copy *.el* %1\lisp + +:info +cd ..\texi +call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +if not "%2" == "copy" goto done +copy gnus %1\info +copy gnus-?? %1\info +copy message %1\info + +:etc +cd ..\etc +copy gnus-tut.txt %1\etc + +:done +cd .. +goto end + +:usage +echo Usage: make ^ [copy] +echo. +echo where: ^ is the directory you installed emacs in +echo eg. d:\emacs\19.34 +echo copy indicates that the compiled files should be copied to your +echo emacs lisp, info, and etc directories + +:end diff --git a/texi/ChangeLog b/texi/ChangeLog index 51be9d0..ac7acc7 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,12 @@ +1998-11-07 17:18:07 Lars Magne Ingebrigtsen + + * gnus.texi (Gnus Reference Guide): Renamed. + +1998-10-26 22:03:08 Lars Magne Ingebrigtsen + + * gnus.texi (Article Washing): Fix. + (MIME Commands): Change. + 1998-10-25 01:51:56 Lars Magne Ingebrigtsen * gnus.texi (Headers): Addition. diff --git a/texi/gnus.texi b/texi/gnus.texi index 5f78162..6b8d098 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.40 Manual +@settitle Pterodactyl Gnus 0.41 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.40 Manual +@title Pterodactyl Gnus 0.41 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. -This manual corresponds to Pterodactyl Gnus 0.40. +This manual corresponds to Pterodactyl Gnus 0.41. @end ifinfo @@ -3447,7 +3447,7 @@ headers are used instead. @vindex nnmail-extra-headers A related variable is @code{nnmail-extra-headers}, which controls when -to include extra headers when generating active files. +to include extra headers when generating overview (@sc{nov}) files. In summary, you'd typically do something like the following: @@ -3640,6 +3640,9 @@ action. This will also inhibit horizontal re-centering of the summary buffer, which might make it more inconvenient to read extremely long threads. +This variable can also be a number. In that case, center the window at +the given number of lines from the top. + @end table @@ -3901,7 +3904,7 @@ goes out to all people listed in the @code{To}, @code{From} (or @kindex S W (Summary) @findex gnus-summary-wide-reply-with-original Mail a wide reply to the current article and include the original -message (@code{gnus-summary-reply-with-original}). This command uses +message (@code{gnus-summary-wide-reply-with-original}). This command uses the process/prefix convention. @item S o m @@ -6569,7 +6572,9 @@ when filling. @item W c @kindex W c (Summary) @findex gnus-article-remove-cr -Remove CR (i. e., @samp{^M}s on the end of the lines) +Translate CRLF pairs (i. e., @samp{^M}s on the end of the lines) into LF +(this takes care of DOS line endings), and then translate any remaining +CRs into LF (this takes care of Mac line endings) (@code{gnus-article-remove-cr}). @item W q @@ -6917,7 +6922,14 @@ Relevant variables: @vindex gnus-ignored-mime-types This is a list of regexps. @sc{mime} types that match a regexp from this list will be completely ignored by Gnus. The default value is -@code{("text/x-vcard")}. +@code{nil}. + +To have all Vcards be ignored, you'd say something like this: + +@lisp +(setq gnus-ignored-mime-types + '("text/x-vcard")) +@end lisp @end table @@ -14401,6 +14413,15 @@ and so on. Create as many faces as you wish. The same goes for the @code{mouse-face} specs---you can say @samp{%3(hello%)} to have @samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}. +Text inside the @samp{%<} and @samp{%>} specifiers will get the special +@code{balloon-help} property set to @code{gnus-balloon-face-0}. If you say +@samp{%1<}, you'll get @code{gnus-balloon-face-1} and so on. The +@code{gnus-balloon-face-*} variables should be either strings or +symbols naming functions that return a string. Under @code{balloon-help-mode}, +when the mouse passes over text with this property set, a balloon window +will appear and display the string. Please refer to the doc string of +@code{balloon-help-mode} for more information on this. + Here's an alternative recipe for the group buffer: @lisp @@ -15882,7 +15903,7 @@ but at the common table.@* * Terminology:: We use really difficult, like, words here. * Customization:: Tailoring Gnus to your needs. * Troubleshooting:: What you might try if things do not work. -* A Programmers Guide to Gnus:: Rilly, rilly technical stuff. +* Gnus Reference Guide:: Rilly, rilly technical stuff. * Emacs for Heathens:: A short introduction to Emacsian terms. * Frequently Asked Questions:: A question-and-answer session. @end menu @@ -18303,6 +18324,11 @@ The documentation should mention pop3.el, fetchmail, smtpmail and why po:username often fails. @item +Fetch by Message-ID from dejanews. + + + +@item Solve the halting problem. @c TODO @@ -18769,8 +18795,8 @@ Write to @samp{ding-request@@gnus.org} to subscribe. @page -@node A Programmers Guide to Gnus -@section A Programmer@'s Guide to Gnus +@node Gnus Reference Guide +@section Gnus Reference Guide It is my hope that other people will figure out smart stuff that Gnus can do, and that other people will write those smart things as well. To diff --git a/texi/message.texi b/texi/message.texi index bb26941..5c30392 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.40 Manual +@settitle Pterodactyl Message 0.41 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.40 Manual +@title Pterodactyl Message 0.41 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * Key Index:: List of Message mode keys. @end menu -This manual corresponds to Pterodactyl Message 0.40. Message is +This manual corresponds to Pterodactyl Message 0.41. Message is distributed with the Gnus distribution bearing the same version number as this manual.