X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=7c455a212504b420d81e76e4d6094b6030429571;hb=053a77cf613ef3dc005d482c5c159b5707fb7dea;hp=ea875ccf7eee5e2557451369858c11817a8c3f37;hpb=c75c79131c7e2ce7b935b1bc10afdc24cf045c39;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index ea875cc..7c455a2 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,8 +1,8 @@ ;;; gnus-art.el --- article mode commands for Semi-gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen -;; MORIOKA Tomohiko +;; Author: Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko ;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -94,11 +94,26 @@ :group 'gnus-article) (defcustom gnus-ignored-headers - '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:" - "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:" - "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:" - "^Approved:" "^Sender:" "^Received:" "^Mail-from:") - "All headers that start with this regexp will be hidden. + '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:" + "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" + "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:" + "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:" + "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:" + "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:" + "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:" + "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:" + "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:" + "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:" + "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:" + "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" + "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:" + "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" + "^Old-Received:" "^X-Pgp-Fingerprint:" "^X-Pgp-Key-Id:" + "^X-Pgp-Public-Key-Url:" "^X-Auth:" "^X-From-Line:" + "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" + "^X-Mailing-List:" "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:" + "^Status:") + "*All headers that start with this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." :type '(choice :custom-show nil @@ -107,8 +122,8 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored." :group 'gnus-article-hiding) (defcustom gnus-visible-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:" - "All headers that do not match this regexp will be hidden. + "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:" + "*All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. If this variable is non-nil, `gnus-ignored-headers' will be ignored." :type '(repeat :value-to-internal (lambda (widget value) @@ -122,7 +137,7 @@ If this variable is non-nil, `gnus-ignored-headers' will be ignored." (defcustom gnus-sorted-header-list '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:") - "This variable is a list of regular expressions. + "*This variable is a list of regular expressions. If it is non-nil, headers that match the regular expressions will be placed first in the article buffer in the sequence specified by this list." @@ -171,7 +186,7 @@ regexp. If it matches, the text in question is not a signature." (defcustom gnus-article-x-face-command "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" - "String or function to be executed to display an X-Face header. + "*String or function to be executed to display an X-Face header. If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command." :type 'string ;Leave function case to Lisp. @@ -199,9 +214,9 @@ asynchronously. The compressed face will be piped to this command." (lambda (spec) (list (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (caddr spec))))) + 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) types))) - "Alist that says how to fontify certain phrases. + "*Alist that says how to fontify certain phrases. Each item looks like this: (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline) @@ -250,8 +265,12 @@ Esample: (_/*word*/_)." (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" "Format for display of Date headers in article bodies. -See `format-time-string' for the possible values." - :type 'string +See `format-time-string' for the possible values. + +The variable can also be function, which should return a complete Date +header. The function is called with one argument, the time, which can +be fed to `format-time-string'." + :type '(choice string symbol) :link '(custom-manual "(gnus)Article Date") :group 'gnus-article-washing) @@ -335,7 +354,7 @@ LAST-FILE." (defcustom gnus-split-methods '((gnus-article-archive-name) (gnus-article-nndoc-name)) - "Variable used to suggest where articles are to be saved. + "*Variable used to suggest where articles are to be saved. For instance, if you would like to save articles related to Gnus in the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", you could set this variable to something like: @@ -360,18 +379,27 @@ be used as possible file names." (sexp :value nil)))) (defcustom gnus-strict-mime t - "*If nil, MIME-decode even if there is no Mime-Version header." + "*If nil, MIME-decode even if there is no MIME-Version header." :group 'gnus-article-mime :type 'boolean) -(defcustom gnus-show-mime-method 'gnus-article-preview-mime-message - "Function to process a MIME message. +(defcustom gnus-article-display-method-for-mime + 'gnus-article-display-mime-message + "Function to display a MIME message. +The function is called from the article buffer." + :group 'gnus-article-mime + :type 'function) + +(defcustom gnus-article-display-method-for-encoded-word + 'gnus-article-display-message-with-encoded-word + "*Function to display a message with MIME encoded-words. The function is called from the article buffer." :group 'gnus-article-mime :type 'function) -(defcustom gnus-decode-encoded-word-method 'gnus-article-decode-encoded-word - "*Function to decode MIME encoded words. +(defcustom gnus-article-display-method-for-traditional + 'gnus-article-display-traditional-message + "*Function to display a traditional message. The function is called from the article buffer." :group 'gnus-article-mime :type 'function) @@ -443,12 +471,12 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (defface gnus-header-from-face '((((class color) (background dark)) - (:foreground "spring green" :bold t)) + (:foreground "spring green")) (((class color) (background light)) - (:foreground "red3" :bold t)) + (:foreground "red3")) (t - (:bold t :italic t))) + (:italic t))) "Face used for displaying from headers." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -456,10 +484,10 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (defface gnus-header-subject-face '((((class color) (background dark)) - (:foreground "SeaGreen3" :bold t)) + (:foreground "SeaGreen3")) (((class color) (background light)) - (:foreground "red4" :bold t)) + (:foreground "red4")) (t (:bold t :italic t))) "Face used for displaying subject headers." @@ -469,12 +497,12 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (defface gnus-header-newsgroups-face '((((class color) (background dark)) - (:foreground "yellow" :bold t :italic t)) + (:foreground "yellow" :italic t)) (((class color) (background light)) - (:foreground "MidnightBlue" :bold t :italic t)) + (:foreground "MidnightBlue" :italic t)) (t - (:bold t :italic t))) + (:italic t))) "Face used for displaying newsgroups headers." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -509,7 +537,7 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." ("Subject" nil gnus-header-subject-face) ("Newsgroups:.*," nil gnus-header-newsgroups-face) ("" gnus-header-name-face gnus-header-content-face)) - "Controls highlighting of article header. + "*Controls highlighting of article header. An alist of the form (HEADER NAME CONTENT). @@ -533,6 +561,7 @@ displayed by the first non-nil matching CONTENT face." ;;; Internal variables (defvar article-lapsed-timer nil) +(defvar gnus-article-current-summary nil) (defvar gnus-article-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) @@ -546,8 +575,8 @@ Initialized from `text-mode-syntax-table.") (defvar gnus-save-article-buffer nil) (defvar gnus-article-mode-line-format-alist - (nconc '((?w (gnus-article-wash-status) ?s)) - gnus-summary-mode-line-format-alist)) + (nconc '((?w (gnus-article-wash-status) ?s)) + gnus-summary-mode-line-format-alist)) (defvar gnus-number-of-articles-to-be-saved nil) @@ -574,7 +603,7 @@ Initialized from `text-mode-syntax-table.") b e (cons 'article-type (cons type gnus-hidden-properties)))) (defun gnus-article-unhide-text-type (b e type) - "Hide text of TYPE between B and E." + "Unhide text of TYPE between B and E." (remove-text-properties b e (cons 'article-type (cons type gnus-hidden-properties))) (when (memq 'intangible gnus-hidden-properties) @@ -636,6 +665,7 @@ always hide." (save-excursion (save-restriction (let ((buffer-read-only nil) + (case-fold-search t) (props (nconc (list 'article-type 'headers) gnus-hidden-properties)) (max (1+ (length gnus-sorted-header-list))) @@ -652,7 +682,7 @@ always hide." (listp gnus-visible-headers)) (mapconcat 'identity gnus-visible-headers "\\|")))) (inhibit-point-motion-hooks t) - want-list beg) + beg) ;; First we narrow to just the headers. (widen) (goto-char (point-min)) @@ -745,8 +775,8 @@ always hide." from reply-to (ignore-errors (equal - (nth 1 (mail-extract-address-components from)) - (nth 1 (mail-extract-address-components reply-to))))) + (nth 1 (funcall gnus-extract-address-components from)) + (nth 1 (funcall gnus-extract-address-components reply-to))))) (gnus-article-hide-header "reply-to")))) ((eq elem 'date) (let ((date (message-fetch-field "date"))) @@ -887,12 +917,13 @@ characters to translate to." (delete-process "article-x-face")) (let ((inhibit-point-motion-hooks t) (case-fold-search t) - from) + from last) (save-restriction (nnheader-narrow-to-headers) (setq from (message-fetch-field "from")) (goto-char (point-min)) (while (and gnus-article-x-face-command + (not last) (or force ;; Check whether this face is censored. (not gnus-article-x-face-too-ugly) @@ -901,6 +932,12 @@ characters to translate to." from)))) ;; Has to be present. (re-search-forward "^X-Face: " nil t)) + ;; This used to try to do multiple faces (`while' instead of + ;; `when' above), but (a) sending multiple EOFs to xv doesn't + ;; work (b) it can crash some versions of Emacs (c) are + ;; multiple faces really something to encourage? + (when (stringp gnus-article-x-face-command) + (setq last t)) ;; We now have the area of the buffer where the X-Face is stored. (save-excursion (let ((beg (point)) @@ -924,8 +961,11 @@ characters to translate to." (defun gnus-article-decode-rfc1522 () "Decode MIME encoded-words in header fields." (let (buffer-read-only) - (eword-decode-header) - )) + (let ((charset (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset))) + (eword-decode-header charset) + ))) (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. @@ -940,29 +980,27 @@ always hide." (goto-char (point-min)) ;; Hide the "header". (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (gnus-article-hide-text-type (1+ (match-beginning 0)) - (match-end 0) 'pgp) + (delete-region (1+ (match-beginning 0)) (match-end 0)) (setq beg (point)) ;; Hide the actual signature. (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type + (delete-region end (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) (match-end 0) ;; Perhaps we shouldn't hide to the end of the buffer ;; if there is no end to the signature? - (point-max)) - 'pgp)) + (point-max)))) ;; Hide "- " PGP quotation markers. (when (and beg end) (narrow-to-region beg end) (goto-char (point-min)) (while (re-search-forward "^- " nil t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pgp)) + (delete-region + (match-beginning 0) (match-end 0))) (widen)) - (run-hooks 'gnus-article-hide-pgp-hook)))))) + (gnus-run-hooks 'gnus-article-hide-pgp-hook)))))) (defun article-hide-pem (&optional arg) "Toggle hiding of any PEM headers and signatures in the current article. @@ -1052,42 +1090,43 @@ always hide." (article-remove-trailing-blank-lines) (article-strip-multiple-blank-lines)) -(defvar mime::preview/content-list) -(defvar mime::preview-content-info/point-min) +(defun article-strip-all-blank-lines () + "Strip all blank lines." + (interactive) + (save-excursion + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (while (re-search-forward "^[ \t]*\n" nil t) + (replace-match "" t t))))) + (defun gnus-article-narrow-to-signature () "Narrow to the signature; return t if a signature is found, else nil." (widen) - (when (and (boundp 'mime::preview/content-list) - mime::preview/content-list) - ;; We have a MIMEish article, so we use the MIME data to narrow. - (let ((pcinfo (car (last mime::preview/content-list)))) - (ignore-errors - (narrow-to-region - (funcall (intern "mime::preview-content-info/point-min") pcinfo) - (point-max))))) - - (when (gnus-article-search-signature) - (forward-line 1) - ;; Check whether we have some limits to what we consider - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (gnus-functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t)))) + (let ((inhibit-point-motion-hooks t)) + (when (gnus-article-search-signature) + (forward-line 1) + ;; Check whether we have some limits to what we consider + ;; to be a signature. + (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit + (list gnus-signature-limit))) + limit limited) + (while (setq limit (pop limits)) + (if (or (and (integerp limit) + (< (- (point-max) (point)) limit)) + (and (floatp limit) + (< (count-lines (point) (point-max)) limit)) + (and (gnus-functionp limit) + (funcall limit)) + (and (stringp limit) + (not (re-search-forward limit nil t)))) + () ; This limit did not succeed. + (setq limited t + limits nil))) + (unless limited + (narrow-to-region (point) (point-max)) + t))))) (defun gnus-article-search-signature () "Search the current buffer for the signature separator. @@ -1164,8 +1203,7 @@ means show, 0 means toggle." (defun gnus-article-hidden-text-p (type) "Say whether the current buffer contains hidden text of type TYPE." - (let ((start (point-min)) - (pos (text-property-any (point-min) (point-max) 'article-type type))) + (let ((pos (text-property-any (point-min) (point-max) 'article-type type))) (while (and pos (not (get-text-property pos 'invisible))) (setq pos @@ -1266,9 +1304,25 @@ how much time has lapsed since DATE." (concat "Date: " date)) ;; Let the user define the format. ((eq type 'user) + (if (gnus-functionp gnus-article-time-format) + (funcall + gnus-article-time-format + (ignore-errors + (gnus-encode-date + (timezone-make-date-arpa-standard + date nil "UT")))) + (concat + "Date: " + (format-time-string gnus-article-time-format + (ignore-errors + (gnus-encode-date + (timezone-make-date-arpa-standard + date nil "UT"))))))) + ;; ISO 8601. + ((eq type 'iso8601) (concat "Date: " - (format-time-string gnus-article-time-format + (format-time-string "%Y%M%DT%h%m%s" (ignore-errors (gnus-encode-date (timezone-make-date-arpa-standard @@ -1347,13 +1401,14 @@ function and want to see what the date was before converting." (defun article-update-date-lapsed () "Function to be run from a timer to update the lapsed time line." - (save-excursion - (ignore-errors - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (when (re-search-forward "^X-Sent:" nil t) - (article-date-lapsed t)))))) + (let (deactivate-mark) + (save-excursion + (ignore-errors + (when (gnus-buffer-live-p gnus-article-buffer) + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (when (re-search-forward "^X-Sent:" nil t) + (article-date-lapsed t))))))) (defun gnus-start-date-timer (&optional n) "Start a timer to update the X-Sent header in the article buffers. @@ -1363,7 +1418,7 @@ is to run." (unless n (setq n 1)) (gnus-stop-date-timer) - (setq article-lapsed-timer + (setq article-lapsed-timer (nnheader-run-at-time 1 n 'article-update-date-lapsed))) (defun gnus-stop-date-timer () @@ -1379,6 +1434,11 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (list t)) (article-date-ut 'user highlight)) +(defun article-date-iso8601 (&optional highlight) + "Convert the current article date to ISO8601." + (interactive (list t)) + (article-date-ut 'iso8601 highlight)) + (defun article-show-all () "Show all hidden text in the article buffer." (interactive) @@ -1446,7 +1506,7 @@ This format is defined by the `gnus-article-time-format' variable." (gnus-number-of-articles-to-be-saved (when (eq gnus-prompt-before-saving t) num))) ; Magic - (set-buffer gnus-summary-buffer) + (set-buffer gnus-article-current-summary) (funcall gnus-default-article-saver filename))))) (defun gnus-read-save-file-name (prompt &optional filename @@ -1543,7 +1603,6 @@ This format is defined by the `gnus-article-time-format' variable." "Append this article to Rmail file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory'." - (interactive) (setq filename (gnus-read-save-file-name "Save %s in rmail file:" filename gnus-rmail-save-name gnus-newsgroup-name @@ -1559,7 +1618,6 @@ Directory to save to is default to `gnus-article-save-directory'." "Append this article to Unix mail file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory'." - (interactive) (setq filename (gnus-read-save-file-name "Save %s in Unix mail file:" filename gnus-mail-save-name gnus-newsgroup-name @@ -1578,7 +1636,6 @@ Directory to save to is default to `gnus-article-save-directory'." "Append this article to file. Optional argument FILENAME specifies file name. Directory to save to is default to `gnus-article-save-directory'." - (interactive) (setq filename (gnus-read-save-file-name "Save %s in file:" filename gnus-file-save-name gnus-newsgroup-name @@ -1597,14 +1654,12 @@ Directory to save to is default to `gnus-article-save-directory'." "Write this article to a file. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." - (interactive) (gnus-summary-save-in-file nil t)) (defun gnus-summary-save-body-in-file (&optional filename) "Append this article body to a file. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." - (interactive) (setq filename (gnus-read-save-file-name "Save %s body in file:" filename gnus-file-save-name gnus-newsgroup-name @@ -1621,7 +1676,6 @@ The directory to save in defaults to `gnus-article-save-directory'." (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." - (interactive) (setq command (cond ((eq command 'default) gnus-last-shell-command) @@ -1735,8 +1789,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is (article-fill . gnus-article-word-wrap) article-remove-cr article-display-x-face - article-de-quoted-unreadable - article-mime-decode-quoted-printable article-hide-pgp article-hide-pem article-hide-signature @@ -1745,7 +1797,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-strip-multiple-blank-lines article-strip-leading-space article-strip-blank-lines + article-strip-all-blank-lines article-date-local + article-date-iso8601 article-date-original article-date-ut article-date-user @@ -1798,7 +1852,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Scroll backwards" gnus-article-goto-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] - ["Mail to address at point" gnus-article-mail t])) + ["Mail to address at point" gnus-article-mail t] + ["Send a bug report" gnus-bug t])) (easy-menu-define gnus-article-treatment-menu gnus-article-mode-map "" @@ -1808,18 +1863,15 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Hide citation" gnus-article-hide-citation t] ["Treat overstrike" gnus-article-treat-overstrike t] ["Remove carriage return" gnus-article-remove-cr t] - ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t])) + )) - (when nil - (when (boundp 'gnus-summary-article-menu) - (define-key gnus-article-mode-map [menu-bar commands] - (cons "Commands" gnus-summary-article-menu)))) + ;; Note "Commands" menu is defined in gnus-sum.el for consistency (when (boundp 'gnus-summary-post-menu) (define-key gnus-article-mode-map [menu-bar post] (cons "Post" gnus-summary-post-menu))) - (run-hooks 'gnus-article-menu-hook))) + (gnus-run-hooks 'gnus-article-menu-hook))) (defun gnus-article-mode () "Major mode for displaying an article. @@ -1839,7 +1891,6 @@ commands: (interactive) (when (gnus-visual-p 'article-menu 'menu) (gnus-article-make-menu-bar)) - (kill-all-local-variables) (gnus-simplify-mode-line) (setq mode-name "Article") (setq major-mode 'gnus-article-mode) @@ -1849,13 +1900,14 @@ commands: (use-local-map gnus-article-mode-map) (gnus-update-format-specifications nil 'article-mode) (set (make-local-variable 'page-delimiter) gnus-page-delimiter) - (set (make-local-variable 'gnus-page-broken) nil) - (set (make-local-variable 'gnus-button-marker-list) nil) + (make-local-variable 'gnus-page-broken) + (make-local-variable 'gnus-button-marker-list) + (make-local-variable 'gnus-article-current-summary) (gnus-set-default-directory) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) (set-syntax-table gnus-article-mode-syntax-table) - (run-hooks 'gnus-article-mode-hook)) + (gnus-run-hooks 'gnus-article-mode-hook)) (defun gnus-article-setup-buffer () "Initialize the article buffer." @@ -1876,23 +1928,20 @@ commands: (gnus-set-global-variables))) ;; Init original article buffer. (save-excursion - (set-buffer (get-buffer-create gnus-original-article-buffer)) + (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) (buffer-disable-undo (current-buffer)) (setq major-mode 'gnus-original-article-mode) - (gnus-add-current-to-buffer-list) (make-local-variable 'gnus-original-article)) (if (get-buffer name) (save-excursion (set-buffer name) (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (current-buffer)) (save-excursion - (set-buffer (get-buffer-create name)) - (gnus-add-current-to-buffer-list) + (set-buffer (gnus-get-buffer-create name)) (gnus-article-mode) (make-local-variable 'gnus-summary-buffer) (current-buffer))))) @@ -1914,49 +1963,41 @@ commands: ;;; @@ article filters ;;; -(defun gnus-article-preview-mime-message () + +(defun gnus-article-display-mime-message () + "Article display method for MIME message." + ;; called from `gnus-original-article-buffer'. + (let ((default-mime-charset (save-excursion + (set-buffer gnus-summary-buffer) + default-mime-charset))) + (mime-display-message mime-message-structure + gnus-article-buffer nil gnus-article-mode-map)) + ;; `mime-display-message' changes current buffer to `gnus-article-buffer'. (make-local-variable 'mime-button-mother-dispatcher) (setq mime-button-mother-dispatcher (function gnus-article-push-button)) - (let ((default-mime-charset - (save-excursion - (set-buffer gnus-summary-buffer) - default-mime-charset)) - ) - (save-excursion - (mime-view-mode nil nil nil gnus-original-article-buffer - gnus-article-buffer - gnus-article-mode-map) - )) - (run-hooks 'gnus-mime-article-prepare-hook) - ) + (run-hooks 'gnus-mime-article-prepare-hook)) -(defun gnus-article-decode-encoded-word () - "Header filter for gnus-article-mode. -It is registered to variable `mime-view-content-header-filter-alist'." - (goto-char (point-min)) +(defun gnus-article-display-traditional-message () + "Article display method for traditional message." + (set-buffer gnus-article-buffer) + (let (buffer-read-only) + (erase-buffer) + (insert-buffer-substring gnus-original-article-buffer))) + +(defun gnus-article-display-message-with-encoded-word () + "Article display method for message with encoded-words." (let ((charset (save-excursion (set-buffer gnus-summary-buffer) default-mime-charset))) - (save-restriction - (std11-narrow-to-header) + (gnus-article-display-traditional-message) + (let (buffer-read-only) + (eword-decode-header charset) (goto-char (point-min)) - (while (re-search-forward "^[^ \t:]+:" nil t) - (let ((start (match-beginning 0)) - (end (std11-field-end)) - ) - (save-restriction - (narrow-to-region start end) - (decode-mime-charset-region start end charset) - (goto-char (point-max)) - ))) - (eword-decode-header) - ) - (decode-mime-charset-region (point) (point-max) charset) - (mime-maybe-hide-echo-buffer) - ) - (run-hooks 'gnus-mime-article-prepare-hook) - ) + (if (search-forward "\n\n" nil t) + (decode-mime-charset-region (match-end 0) (point-max) charset))) + (mime-maybe-hide-echo-buffer)) + (gnus-run-hooks 'gnus-mime-article-prepare-hook)) (defun gnus-article-prepare (article &optional all-headers header) "Prepare ARTICLE in article mode buffer. @@ -1968,19 +2009,14 @@ If ALL-HEADERS is non-nil, no headers are hidden." (unless (eq major-mode 'gnus-summary-mode) (set-buffer gnus-summary-buffer)) (setq gnus-summary-buffer (current-buffer)) - ;; Make sure the connection to the server is alive. - (unless (gnus-server-opened - (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-request-group gnus-newsgroup-name t)) (let* ((gnus-article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) - (internal-hook gnus-article-internal-prepare-hook) + (gnus-tmp-internal-hook gnus-article-internal-prepare-hook) (group gnus-newsgroup-name) result) (save-excursion (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) + (set-buffer gnus-original-article-buffer) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) @@ -1996,11 +2032,16 @@ If ALL-HEADERS is non-nil, no headers are hidden." (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) - (gnus-summary-mark-article article gnus-canceled-mark)) - (unless (memq article gnus-newsgroup-sparse) - (gnus-error - 1 "No such article (may have expired or been canceled)"))) - (if (or (eq result 'pseudo) (eq result 'nneething)) + (if (eq (gnus-article-mark article) gnus-undownloaded-mark) + (progn + (gnus-summary-set-agent-mark article) + (message "Message marked for downloading")) + (gnus-summary-mark-article article gnus-canceled-mark) + (unless (memq article gnus-newsgroup-sparse) + (gnus-error 1 + "No such article (may have expired or been canceled)"))))) + (if (or (eq result 'pseudo) + (eq result 'nneething)) (progn (save-excursion (set-buffer summary-buffer) @@ -2033,40 +2074,43 @@ If ALL-HEADERS is non-nil, no headers are hidden." (unless (vectorp gnus-current-headers) (setq gnus-current-headers nil)) (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-show-thread) - (run-hooks 'gnus-mark-article-hook) + (when (gnus-summary-show-thread) + ;; If the summary buffer really was folded, the + ;; previous goto may not actually have gone to + ;; the right article, but the thread root instead. + ;; So we go again. + (gnus-summary-goto-subject gnus-current-article)) + (gnus-run-hooks 'gnus-mark-article-hook) (gnus-set-mode-line 'summary) (when (gnus-visual-p 'article-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook)) + (gnus-run-hooks 'gnus-visual-mark-article-hook)) ;; Set the global newsgroup variables here. ;; Suggested by Jim Sisolak ;; . (gnus-set-global-variables) (setq gnus-have-all-headers - (or all-headers gnus-show-all-headers)) - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (gnus-cache-possibly-enter-article - group article - (gnus-summary-article-header article) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))))) + (or all-headers gnus-show-all-headers)))) (when (or (numberp article) (stringp article)) ;; Hooks for getting information from the article. ;; This hook must be called before being narrowed. - (let (buffer-read-only) - (run-hooks 'internal-hook) - (run-hooks 'gnus-article-prepare-hook) - ;; Decode MIME message. - (when gnus-show-mime - (if (or (not gnus-strict-mime) - (gnus-fetch-field "Mime-Version")) - (funcall gnus-show-mime-method) - (funcall gnus-decode-encoded-word-method))) + (let ((method + (if gnus-show-mime + (progn + (mime-parse-buffer) + (if (or (not gnus-strict-mime) + (mime-fetch-field "MIME-Version")) + gnus-article-display-method-for-mime + gnus-article-display-method-for-encoded-word)) + gnus-article-display-method-for-traditional))) + (gnus-run-hooks 'gnus-tmp-internal-hook) + (gnus-run-hooks 'gnus-article-prepare-hook) + ;; Display message. + (funcall method) + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary summary-buffer) ;; Perform the article display hooks. - (run-hooks 'gnus-article-display-hook)) + (gnus-run-hooks 'gnus-article-display-hook)) ;; Do page break. (goto-char (point-min)) (setq gnus-page-broken @@ -2076,6 +2120,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-set-mode-line 'article) (gnus-configure-windows 'article) (goto-char (point-min)) + (search-forward "\n\n" nil t) + (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) (defun gnus-article-wash-status () @@ -2100,7 +2146,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (if mime ?m ? ) (if emphasis ?e ? ))))) -(defun gnus-article-hide-headers-if-wanted () +(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) + +(defun gnus-article-maybe-hide-headers () "Hide unwanted headers if `gnus-have-all-headers' is nil. Provided for backwards compatibility." (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) @@ -2240,7 +2288,8 @@ Argument LINES specifies lines to be scrolled down." (error "There is no summary buffer for this article buffer") (gnus-article-set-globals) (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article))) + (gnus-summary-goto-subject gnus-current-article) + (gnus-summary-position-point))) (defun gnus-article-describe-briefly () "Describe article mode commands briefly." @@ -2254,7 +2303,7 @@ Argument LINES specifies lines to be scrolled down." (let ((obuf (current-buffer)) (owin (current-window-configuration)) func) - (switch-to-buffer gnus-summary-buffer 'norecord) + (switch-to-buffer gnus-article-current-summary 'norecord) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func) (set-buffer obuf) @@ -2265,7 +2314,7 @@ Argument LINES specifies lines to be scrolled down." "Execute the last keystroke in the summary buffer." (interactive) (let (func) - (pop-to-buffer gnus-summary-buffer 'norecord) + (pop-to-buffer gnus-article-current-summary 'norecord) (setq func (lookup-key (current-local-map) (this-command-keys))) (call-interactively func))) @@ -2273,85 +2322,101 @@ Argument LINES specifies lines to be scrolled down." "Read a summary buffer key sequence and execute it from the article buffer." (interactive "P") (let ((nosaves - '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" - "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" - "=" "^" "\M-^" "|")) - (nosave-but-article - '("A\r")) - (nosave-in-article - '("\C-d")) - keys) + '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" + "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" + "=" "^" "\M-^" "|")) + (nosave-but-article + '("A\r")) + (nosave-in-article + '("\C-d")) + (up-to-top + '("n" "Gn" "p" "Gp")) + keys new-sum-point) (save-excursion - (set-buffer gnus-summary-buffer) + (set-buffer gnus-article-current-summary) (let (gnus-pick-mode) - (push (or key last-command-event) unread-command-events) - (setq keys (read-key-sequence nil)))) + (push (or key last-command-event) unread-command-events) + (setq keys (read-key-sequence nil)))) (message "") (if (or (member keys nosaves) - (member keys nosave-but-article) - (member keys nosave-in-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-summary-buffer 'norecord) - ;; We disable the pick minor mode commands. - (let (gnus-pick-mode) - (setq func (lookup-key (current-local-map) keys)))) - (if (not func) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-summary-buffer)) - (call-interactively func)) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer 'norecord))) + (member keys nosave-but-article) + (member keys nosave-in-article)) + (let (func) + (save-window-excursion + (pop-to-buffer gnus-article-current-summary 'norecord) + ;; We disable the pick minor mode commands. + (let (gnus-pick-mode) + (setq func (lookup-key (current-local-map) keys)))) + (if (not func) + (ding) + (unless (member keys nosave-in-article) + (set-buffer gnus-article-current-summary)) + (call-interactively func) + (setq new-sum-point (point))) + (when (member keys nosave-but-article) + (pop-to-buffer gnus-article-buffer 'norecord))) ;; These commands should restore window configuration. (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - (opoint (point)) - func in-buffer) - (if not-restore-window - (pop-to-buffer gnus-summary-buffer 'norecord) - (switch-to-buffer gnus-summary-buffer 'norecord)) - (setq in-buffer (current-buffer)) - ;; We disable the pick minor mode commands. - (if (setq func (let (gnus-pick-mode) - (lookup-key (current-local-map) keys))) - (call-interactively func) - (ding)) - (when (eq in-buffer (current-buffer)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (set-window-point (get-buffer-window (current-buffer)) opoint)))))) + (owin (current-window-configuration)) + (opoint (point)) + (summary gnus-article-current-summary) + func in-buffer selected) + (if not-restore-window + (pop-to-buffer summary 'norecord) + (switch-to-buffer summary 'norecord)) + (setq in-buffer (current-buffer)) + ;; We disable the pick minor mode commands. + (if (setq func (let (gnus-pick-mode) + (lookup-key (current-local-map) keys))) + (progn + (call-interactively func) + (setq new-sum-point (point))) + (ding)) + (when (eq in-buffer (current-buffer)) + (setq selected (gnus-summary-select-article)) + (set-buffer obuf) + (unless not-restore-window + (set-window-configuration owin)) + (unless (or (not (eq selected 'old)) (member keys up-to-top)) + (set-window-point (get-buffer-window (current-buffer)) + opoint)) + (let ((win (get-buffer-window gnus-article-current-summary))) + (when win + (set-window-point win new-sum-point)))))))) (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. This means that PGP stuff, signatures, cited text and (some) headers will be hidden. If given a prefix, show the hidden text instead." - (interactive (list current-prefix-arg 'force)) + (interactive (append (gnus-article-hidden-arg) (list 'force))) (gnus-article-hide-headers arg) (gnus-article-hide-pgp arg) (gnus-article-hide-citation-maybe arg force) (gnus-article-hide-signature arg)) (defun gnus-article-maybe-highlight () - "Do some article highlighting if `article-visual' is non-nil." + "Do some article highlighting if article highlighting is requested." (when (gnus-visual-p 'article-highlight 'highlight) (gnus-article-highlight-some))) +(defun gnus-check-group-server () + ;; Make sure the connection to the server is alive. + (unless (gnus-server-opened + (gnus-find-method-for-group gnus-newsgroup-name)) + (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) + (gnus-request-group gnus-newsgroup-name t))) + (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." - (let (do-update-line) + (let (do-update-line sparse-header) (prog1 (save-excursion (erase-buffer) (gnus-kill-all-overlays) (setq group (or group gnus-newsgroup-name)) - ;; Open server if it has closed. - (gnus-check-server (gnus-find-method-for-group group)) - ;; Using `gnus-request-article' directly will insert the article into ;; `nntp-server-buffer' - so we'll save some time by not having to ;; copy it from the server buffer into the article buffer. @@ -2368,7 +2433,7 @@ If given a prefix, show the hidden text instead." (when (and (numberp article) gnus-summary-buffer (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) + (gnus-buffer-exists-p gnus-summary-buffer)) (save-excursion (set-buffer gnus-summary-buffer) (let ((header (gnus-summary-article-header article))) @@ -2379,7 +2444,7 @@ If given a prefix, show the hidden text instead." (setq do-update-line article) (setq article (mail-header-id header)) (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article)) + (setq sparse-header (gnus-read-header article))) (setq gnus-newsgroup-sparse (delq article gnus-newsgroup-sparse))) ((vectorp header) @@ -2392,10 +2457,13 @@ If given a prefix, show the hidden text instead." (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) - (if (not (eq (car method) 'nneething)) - () - (let ((dir (concat (file-name-as-directory (nth 1 method)) - (mail-header-subject header)))) + (when (and (eq (car method) 'nneething) + (vectorp header)) + (let ((dir (concat + (file-name-as-directory + (or (cadr (assq 'nneething-address method)) + (nth 1 method))) + (mail-header-subject header)))) (when (file-directory-p dir) (setq article 'nneething) (gnus-group-enter-directory dir)))))))) @@ -2405,21 +2473,12 @@ If given a prefix, show the hidden text instead." ((and (numberp article) gnus-summary-buffer (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer)) + (gnus-buffer-exists-p gnus-summary-buffer) (eq (cdr (save-excursion (set-buffer gnus-summary-buffer) (assq article gnus-newsgroup-reads))) gnus-canceled-mark)) nil) - ;; We first check `gnus-original-article-buffer'. - ((and (get-buffer gnus-original-article-buffer) - (numberp article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (and (equal (car gnus-original-article) group) - (eq (cdr gnus-original-article) article)))) - (insert-buffer-substring gnus-original-article-buffer) - 'article) ;; Check the backlog. ((and gnus-keep-backlog (gnus-backlog-request-article group article (current-buffer))) @@ -2427,6 +2486,8 @@ If given a prefix, show the hidden text instead." ;; Check asynchronous pre-fetch. ((gnus-async-request-fetched-article group article (current-buffer)) (gnus-async-prefetch-next group article gnus-summary-buffer) + (when (and (numberp article) gnus-keep-backlog) + (gnus-backlog-enter-article group article (current-buffer))) 'article) ;; Check the cache. ((and gnus-use-cache @@ -2440,6 +2501,7 @@ If given a prefix, show the hidden text instead." (buffer-read-only nil)) (erase-buffer) (gnus-kill-all-overlays) + (gnus-check-group-server) (when (gnus-request-article article group (current-buffer)) (when (numberp article) (gnus-async-prefetch-next group article gnus-summary-buffer) @@ -2450,20 +2512,21 @@ If given a prefix, show the hidden text instead." ;; It was a pseudo. (t article))) + ;; Associate this article with the current summary buffer. + (setq gnus-article-current-summary gnus-summary-buffer) + ;; Take the article from the original article buffer ;; and place it in the buffer it's supposed to be in. (when (and (get-buffer gnus-article-buffer) - ;;(numberp article) (equal (buffer-name (current-buffer)) (buffer-name (get-buffer gnus-article-buffer)))) (save-excursion (if (get-buffer gnus-original-article-buffer) - (set-buffer (get-buffer gnus-original-article-buffer)) - (set-buffer (get-buffer-create gnus-original-article-buffer)) + (set-buffer gnus-original-article-buffer) + (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) (buffer-disable-undo (current-buffer)) (setq major-mode 'gnus-original-article-mode) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list)) + (setq buffer-read-only t)) (let (buffer-read-only) (erase-buffer) (insert-buffer-substring gnus-article-buffer)) @@ -2475,7 +2538,7 @@ If given a prefix, show the hidden text instead." (stringp article))) (let ((buf (current-buffer))) (set-buffer gnus-summary-buffer) - (gnus-summary-update-article do-update-line) + (gnus-summary-update-article do-update-line sparse-header) (gnus-summary-goto-subject do-update-line nil t) (set-window-point (get-buffer-window (current-buffer) t) (point)) @@ -2511,7 +2574,6 @@ This is an extended text-mode. \\{gnus-article-edit-mode-map}" (interactive) - (kill-all-local-variables) (setq major-mode 'gnus-article-edit-mode) (setq mode-name "Article Edit") (use-local-map gnus-article-edit-mode-map) @@ -2520,7 +2582,7 @@ This is an extended text-mode. (setq buffer-read-only nil) (buffer-enable-undo) (widen) - (run-hooks 'text-mode 'gnus-article-edit-mode-hook)) + (gnus-run-hooks 'text-mode-hook 'gnus-article-edit-mode-hook)) (defun gnus-article-edit (&optional force) "Edit the current article. @@ -2531,6 +2593,7 @@ groups." (when (and (not force) (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing")) + (gnus-article-date-original) (gnus-article-edit-article `(lambda (no-highlight) (gnus-summary-edit-article-done @@ -2542,6 +2605,7 @@ groups." (let ((winconf (current-window-configuration))) (set-buffer gnus-article-buffer) (gnus-article-edit-mode) + (gnus-article-delete-text-of-type 'annotation) (gnus-set-text-properties (point-min) (point-max) nil) (gnus-configure-windows 'edit-article) (setq gnus-article-edit-done-function exit-func) @@ -2640,21 +2704,23 @@ groups." :type 'regexp) (defcustom gnus-button-alist - `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t + `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t gnus-button-message-id 2) ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1) - ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t + ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" + 1 t gnus-button-fetch-group 4) ("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2) ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) + ("mailto:\\([a-zA-Z.-@_+0-9%]+\\)" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) ;; This is how URLs _should_ be embedded in text... ("]*\\)>" 0 t gnus-button-embedded-url 1) ;; Raw URLs. (,gnus-button-url-regexp 0 t gnus-button-url 0)) - "Alist of regexps matching buttons in article bodies. + "*Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where REGEXP: is the string matching text around the button, @@ -2686,7 +2752,7 @@ variable it the real callback function." ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t gnus-button-message-id 3)) - "Alist of headers and regexps to match buttons in article heads. + "*Alist of headers and regexps to match buttons in article heads. This alist is very similar to `gnus-button-alist', except that each alist has an additional HEADER element first in each entry: @@ -2724,6 +2790,7 @@ call it with the value of the `gnus-data' text property." (let* ((pos (posn-point (event-start event))) (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) + (goto-char pos) (when fun (funcall fun data)))) @@ -3028,14 +3095,6 @@ specified by `gnus-button-alist'." (match-string 3 address) "nntp"))))))) -(defun gnus-split-string (string pattern) - "Return a list of substrings of STRING which are separated by PATTERN." - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)))) - (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) (setq pairs (gnus-split-string query "&")) @@ -3090,7 +3149,7 @@ forbidden in URL encoding." ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) (setq url (substring url (match-beginning 1) nil))) - (let (to args source-url subject func) + (let (to args subject func) (if (string-match (regexp-quote "?") url) (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) args (gnus-url-parse-query-string @@ -3098,34 +3157,43 @@ forbidden in URL encoding." (setq to (gnus-url-unhex-string url))) (setq args (cons (list "to" to) args) subject (cdr-safe (assoc "subject" args))) - (message-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (mapconcat 'identity (cdar args) ", ")) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject)))) + (gnus-setup-message 'reply + (message-mail) + (while args + (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) + (if (fboundp func) + (funcall func) + (message-position-on-field (caar args))) + (insert (mapconcat 'identity (cdar args) ", ")) + (setq args (cdr args))) + (if subject + (message-goto-body) + (message-goto-subject))))) (defun gnus-button-mailto (address) ;; Mail to ADDRESS. (set-buffer (gnus-copy-article-buffer)) - (message-reply address)) + (gnus-setup-message 'reply + (message-reply address))) (defun gnus-button-reply (address) ;; Reply to ADDRESS. - (message-reply address)) + (gnus-setup-message 'reply + (message-reply address))) (defun gnus-button-url (address) "Browse ADDRESS." - (funcall browse-url-browser-function address)) + ;; In Emacs 20, `browse-url-browser-function' may be an alist. + (if (listp browse-url-browser-function) + (browse-url address) + (funcall browse-url-browser-function address))) (defun gnus-button-embedded-url (address) "Browse ADDRESS." - (funcall browse-url-browser-function (gnus-strip-whitespace address))) + ;; In Emacs 20, `browse-url-browser-function' may be an alist. + (if (listp browse-url-browser-function) + (browse-url (gnus-strip-whitespace address)) + (funcall browse-url-browser-function (gnus-strip-whitespace address)))) ;;; Next/prev buttons in the article buffer. @@ -3143,7 +3211,8 @@ forbidden in URL encoding." (gnus-eval-format gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map - gnus-callback gnus-article-button-prev-page)))) + gnus-callback gnus-article-button-prev-page + gnus-type annotation)))) (defvar gnus-next-page-map nil) (unless gnus-next-page-map @@ -3171,9 +3240,10 @@ forbidden in URL encoding." (defun gnus-insert-next-page-button () (let ((buffer-read-only nil)) (gnus-eval-format gnus-next-page-line-format nil - `(gnus-next t local-map ,gnus-next-page-map - gnus-callback - gnus-article-button-next-page)))) + `(gnus-next + t local-map ,gnus-next-page-map + gnus-callback gnus-article-button-next-page + gnus-type annotation)))) (defun gnus-article-button-next-page (arg) "Go to the next page." @@ -3195,47 +3265,36 @@ forbidden in URL encoding." ;;; @ for mime-view ;;; -(defun gnus-content-header-filter () - "Header filter for mime-view. -It is registered to variable `mime-view-content-header-filter-alist'." - (goto-char (point-min)) - (while (re-search-forward "^[^ \t:]+:" nil t) - (let ((start (match-beginning 0)) - (end (std11-field-end)) - ) - (save-restriction - (narrow-to-region start end) - (decode-mime-charset-region start end default-mime-charset) - (goto-char (point-max)) - ))) - (eword-decode-header) +(defun gnus-article-header-presentation-method (entity situation) + (mime-insert-decoded-header entity) ) -(defun mime-view-quitting-method-for-gnus () - (if (not gnus-show-mime) - (mime-view-kill-buffer)) - (delete-other-windows) - (gnus-article-show-summary) - (if (or (not gnus-show-mime) - (null gnus-have-all-headers)) - (gnus-summary-select-article nil t) - )) - -(set-alist 'mime-view-content-header-filter-alist +(set-alist 'mime-header-presentation-method-alist 'gnus-original-article-mode - (function gnus-content-header-filter)) + #'gnus-article-header-presentation-method) + +(defun gnus-mime-preview-quitting-method () + (if gnus-show-mime + (gnus-article-show-summary) + (mime-preview-kill-buffer) + (delete-other-windows) + (gnus-article-show-summary) + (gnus-summary-select-article nil t) + )) -(set-alist 'mime-text-decoder-alist - 'gnus-original-article-mode - (function mime-text-decode-buffer)) +(set-alist 'mime-preview-quitting-method-alist + 'gnus-original-article-mode #'gnus-mime-preview-quitting-method) -(set-alist 'mime-view-quitting-method-alist - 'gnus-original-article-mode - (function mime-view-quitting-method-for-gnus)) +(defun gnus-following-method (buf) + (set-buffer buf) + (message-followup) + (message-yank-original) + (kill-buffer buf) + (goto-char (point-min)) + ) -(set-alist 'mime-view-show-summary-method - 'gnus-original-article-mode - (function mime-view-quitting-method-for-gnus)) +(set-alist 'mime-preview-following-method-alist + 'gnus-original-article-mode #'gnus-following-method) ;;; @ end