X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=4e60965856e60eed216930600f5cce3a3feed6b0;hb=16e3a2ac89706e52a7624a9955133b6b2c2927e1;hp=3b71b8bcb94640fe9082e160004a065a896b52dc;hpb=f816e633c6befcf4c6fcdd0eb165ee88e378ddb4;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 3b71b8bcb..4e6096585 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,7 +1,7 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -33,6 +33,12 @@ (require 'gnus-spec) (require 'gnus-int) (require 'browse-url) +(require 'mm-bodies) +(require 'mail-parse) +(require 'mm-decode) +(require 'mm-view) +(require 'wid-edit) +(require 'mm-uu) (defgroup gnus-article nil "Article display." @@ -91,11 +97,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 @@ -104,8 +125,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:\\|^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. 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) @@ -119,7 +140,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." @@ -168,7 +189,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. @@ -196,9 +217,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) @@ -247,14 +268,16 @@ 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) (eval-and-compile - (autoload 'hexl-hex-string-to-integer "hexl") - (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'mail-extract-address-components "mail-extr")) (defcustom gnus-save-all-headers t @@ -332,7 +355,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: @@ -356,23 +379,6 @@ be used as possible file names." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-strict-mime t - "*If nil, MIME-decode even if there is no Mime-Version header." - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-show-mime-method 'metamail-buffer - "Function to process a MIME message. -The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - -(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable - "*Function to decode MIME encoded words. -The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - (defcustom gnus-page-delimiter "^\^L" "*Regexp describing what to use as article page delimiters. The default value is \"^\^L\", which is a form linefeed at the @@ -380,9 +386,14 @@ beginning of a line." :type 'regexp :group 'gnus-article-various) -(defcustom gnus-article-mode-line-format "Gnus: %%b %S" +(defcustom gnus-article-mode-line-format "Gnus: %g %S%m" "*The format specification for the article mode line. -See `gnus-summary-mode-line-format' for a closer description." +See `gnus-summary-mode-line-format' for a closer description. + +The following additional specs are available: + +%w The article washing status. +%m The number of MIME parts in the article." :type 'string :group 'gnus-article-various) @@ -440,12 +451,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) @@ -453,10 +464,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." @@ -466,12 +477,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) @@ -506,7 +517,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). @@ -527,9 +538,75 @@ displayed by the first non-nil matching CONTENT face." (item :tag "skip" nil) (face :value default))))) +(defcustom gnus-article-decode-hook + '(article-decode-charset article-decode-encoded-words) + "*Hook run to decode charsets in articles." + :group 'gnus-article-headers + :type 'hook) + +(defcustom gnus-display-mime-function 'gnus-display-mime + "Function to display MIME articles." + :group 'gnus-article-mime + :type 'function) + +(defvar gnus-decode-header-function 'mail-decode-encoded-word-region + "Function used to decode headers.") + +(defvar gnus-article-dumbquotes-map + '(("\202" ",") + ("\203" "f") + ("\204" ",,") + ("\205" "...") + ("\213" "<") + ("\214" "OE") + ("\205" "...") + ("\221" "`") + ("\222" "'") + ("\223" "``") + ("\224" "''") + ("\225" "*") + ("\226" "-") + ("\227" "-") + ("\231" "(TM)") + ("\233" ">") + ("\234" "oe") + ("\264" "'")) + "Table for MS-to-Latin1 translation.") + +(defcustom gnus-ignored-mime-types nil + "List of MIME types that should be ignored by Gnus." + :group 'gnus-article-mime + :type '(repeat regexp)) + +(defcustom gnus-unbuttonized-mime-types '(".*/.*") + "List of MIME types that should not be given buttons when rendered." + :group 'gnus-article-mime + :type '(repeat regexp)) + +(defcustom gnus-treat-body-highlight-signature t + "Highlight the signature." + :group 'gnus-article + :type '(choice (const :tag "Off" nil) + (const :tag "On" t) + (const :tag "Last" last) + (integer :tag "Less") + (sexp :tag "Predicate"))) + +(defcustom gnus-article-mime-part-function nil + "Function called with a MIME handle as the argument." + :group 'gnus-article-mime + :type 'function) + ;;; Internal variables +(defvar gnus-article-mime-handle-alist-1 nil) +(defvar gnus-treatment-function-alist + '((gnus-treat-body-highlight-signature gnus-article-highlight-signature nil) + )) + +(defvar gnus-article-mime-handle-alist nil) (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))) @@ -543,8 +620,9 @@ 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) + (?m (gnus-article-mime-part-status) ?s)) + gnus-summary-mode-line-format-alist)) (defvar gnus-number-of-articles-to-be-saved nil) @@ -558,6 +636,33 @@ Initialized from `text-mode-syntax-table.") (max (1- b) (point-min)) b 'intangible (cddr (memq 'intangible props))))) +(defmacro gnus-with-article (article &rest forms) + "Select ARTICLE and perform FORMS in the original article buffer. +Then replace the article with the result." + `(progn + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil ,article)) + (set-buffer gnus-original-article-buffer) + ,@forms + (if (not (gnus-check-backend-function + 'request-replace-article (car gnus-article-current))) + (gnus-message 5 "Read-only group; not replacing") + (unless (gnus-request-replace-article + ,article (car gnus-article-current) + (current-buffer) t) + (error "Couldn't replace article"))) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))))) + +(put 'gnus-with-article 'lisp-indent-function 1) +(put 'gnus-with-article 'edebug-form-spec '(form body)) + (defsubst gnus-article-unhide-text (b e) "Remove hidden text properties from region between B and E." (remove-text-properties b e gnus-hidden-properties) @@ -571,7 +676,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) @@ -633,6 +738,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))) @@ -649,7 +755,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)) @@ -748,7 +854,7 @@ always hide." ((eq elem 'date) (let ((date (message-fetch-field "date"))) (when (and date - (< (gnus-days-between (current-time-string) date) + (< (days-between (current-time-string) date) 4)) (gnus-article-hide-header "date")))) ((eq elem 'long-to) @@ -783,18 +889,50 @@ always hide." (point-max))) 'boring-headers)))) +(defvar gnus-article-normalized-header-length 40 + "Length of normalized headers.") + +(defun article-normalize-headers () + "Make all header lines 40 characters long." + (interactive) + (let ((buffer-read-only nil) + column) + (save-excursion + (save-restriction + (message-narrow-to-head) + (while (not (eobp)) + (cond + ((< (setq column (- (gnus-point-at-eol) (point))) + gnus-article-normalized-header-length) + (end-of-line) + (insert (make-string + (- gnus-article-normalized-header-length column) + ? ))) + ((> column gnus-article-normalized-header-length) + (gnus-put-text-property + (progn + (forward-char gnus-article-normalized-header-length) + (point)) + (gnus-point-at-eol) + 'invisible t)) + (t + ;; Do nothing. + )) + (forward-line 1)))))) + (defun article-treat-dumbquotes () - "Translate M******** sm*rtq**t*s into proper text." + "Translate M******** sm*rtq**t*s into proper text. +Note that this function guesses whether a character is a sm*rtq**t* or +not, so it should only be used interactively." (interactive) - (article-translate-characters "\221\222\223\223" "`'\"\"")) + (article-translate-strings gnus-article-dumbquotes-map)) (defun article-translate-characters (from to) "Translate all characters in the body of the article according to FROM and TO. FROM is a string of characters to translate from; to is a string of characters to translate to." (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) + (when (article-goto-body) (let ((buffer-read-only nil) (x (make-string 225 ?x)) (i -1)) @@ -806,15 +944,26 @@ characters to translate to." (incf i)) (translate-region (point) (point-max) x))))) +(defun article-translate-strings (map) + "Translate all string in the body of the article according to MAP. +MAP is an alist where the elements are on the form (\"from\" \"to\")." + (save-excursion + (when (article-goto-body) + (let ((buffer-read-only nil) + elem) + (while (setq elem (pop map)) + (save-excursion + (while (search-forward (car elem) nil t) + (replace-match (cadr elem))))))))) + (defun article-treat-overstrike () "Translate overstrikes into bold text." (interactive) (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) + (when (article-goto-body) (let ((buffer-read-only nil)) (while (search-forward "\b" nil t) - (let ((next (following-char)) + (let ((next (char-after)) (previous (char-after (- (point) 2)))) ;; We do the boldification/underlining by hiding the ;; overstrikes and putting the proper text property @@ -839,8 +988,7 @@ characters to translate to." (save-excursion (let ((buffer-read-only nil)) (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (end-of-line 1) (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") @@ -852,13 +1000,16 @@ characters to translate 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." @@ -870,7 +1021,9 @@ characters to translate to." (point) (progn (while (and (not (bobp)) - (looking-at "^[ \t]*$")) + (looking-at "^[ \t]*$") + (not (gnus-annotation-in-region-p + (point) (gnus-point-at-eol)))) (forward-line -1)) (forward-line 1) (point)))))) @@ -884,12 +1037,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) @@ -898,6 +1052,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)) @@ -918,84 +1078,79 @@ characters to translate to." (process-send-region "article-x-face" beg end) (process-send-eof "article-x-face")))))))))) -(defun gnus-hack-decode-rfc1522 () - "Emergency hack function for avoiding problems when decoding." - (let ((buffer-read-only nil)) - (goto-char (point-min)) - ;; Remove encoded TABs. - (while (search-forward "=09" nil t) - (replace-match " " t t)) - ;; Remove encoded newlines. - (goto-char (point-min)) - (while (search-forward "=10" nil t) - (replace-match " " t t)))) - -(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) -(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) -(defun article-decode-rfc1522 () - "Hack to remove QP encoding from headers." - (let ((case-fold-search t) - (inhibit-point-motion-hooks t) - (buffer-read-only nil) - string) +(defun article-decode-mime-words () + "Decode all MIME-encoded words in the article." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((inhibit-point-motion-hooks t) + buffer-read-only + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (mail-decode-encoded-word-region (point-min) (point-max))))) + +(defun article-decode-charset (&optional prompt) + "Decode charset-encoded text in the article. +If PROMPT (the prefix), prompt for a coding system to use." + (interactive "P") + (save-excursion (save-restriction - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - (while (re-search-forward - "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) - (setq string (match-string 1)) - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (delete-region (point-min) (point-max)) - (insert string) - (article-mime-decode-quoted-printable - (goto-char (point-min)) (point-max)) - (subst-char-in-region (point-min) (point-max) ?_ ? ) - (goto-char (point-max))) - (goto-char (point-min)))))) + (message-narrow-to-head) + (let* ((inhibit-point-motion-hooks t) + (case-fold-search t) + (ct (message-fetch-field "Content-Type" t)) + (cte (message-fetch-field "Content-Transfer-Encoding" t)) + (ctl (and ct (condition-case () + (mail-header-parse-content-type ct) + (error nil)))) + (charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ctl + (mail-content-type-get ctl 'charset)))) + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced) + buffer-read-only) + (goto-char (point-max)) + (widen) + (forward-line 1) + (narrow-to-region (point) (point-max)) + (when (and (or (not ctl) + (equal (car ctl) "text/plain")) + (not (mm-uu-test))) + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))) + (car ctl))))))) + +(defun article-decode-encoded-words () + "Remove encoded-word encoding from headers." + (let ((inhibit-point-motion-hooks t) + (rfc2047-default-charset gnus-newsgroup-default-charset) + buffer-read-only) + (save-restriction + (message-narrow-to-head) + (funcall gnus-decode-header-function (point-min) (point-max))))) (defun article-de-quoted-unreadable (&optional force) - "Do a naive translation of a quoted-printable-encoded article. -This is in no way, shape or form meant as a replacement for real MIME -processing, but is simply a stop-gap measure until MIME support is -written. + "Translate a quoted-printable-encoded article. If FORCE, decode the article whether it is marked as quoted-printable or not." (interactive (list 'force)) (save-excursion - (let ((case-fold-search t) - (buffer-read-only nil) - (type (gnus-fetch-field "content-transfer-encoding"))) - (gnus-article-decode-rfc1522) + (let ((buffer-read-only nil) + (type (gnus-fetch-field "content-transfer-encoding")) + (charset + (or gnus-newsgroup-default-charset mm-default-coding-system)) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (when (or force (and type (string-match "quoted-printable" (downcase type)))) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (article-mime-decode-quoted-printable (point) (point-max)))))) - -(defun article-mime-decode-quoted-printable-buffer () - "Decode Quoted-Printable in the current buffer." - (article-mime-decode-quoted-printable (point-min) (point-max))) - -(defun article-mime-decode-quoted-printable (from to) - "Decode Quoted-Printable in the region between FROM and TO." - (interactive "r") - (goto-char from) - (while (search-forward "=" to t) - (cond ((eq (following-char) ?\n) - (delete-char -1) - (delete-char 1)) - ((looking-at "[0-9A-F][0-9A-F]") - (subst-char-in-region - (1- (point)) (point) ?= - (hexl-hex-string-to-integer - (buffer-substring (point) (+ 2 (point))))) - (delete-char 2)) - ((looking-at "=") - (delete-char 1)) - ((gnus-message 3 "Malformed MIME quoted-printable message"))))) + (article-goto-body) + (save-restriction + (narrow-to-region (point) (point-max)) + (quoted-printable-decode-region (point-min) (point-max)) + (when charset + (mm-decode-body charset))))))) (defun article-hide-pgp (&optional arg) "Toggle hiding of any PGP headers and signatures in the current article. @@ -1010,29 +1165,30 @@ 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)) + ;; PGP 5 and GNU PG add a `Hash: <>' comment, hide that too + (when (looking-at "Hash:.*$") + (delete-region (point) (1+ (gnus-point-at-eol)))) (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. @@ -1081,12 +1237,19 @@ always hide." (save-excursion (let ((inhibit-point-motion-hooks t) buffer-read-only) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) + (when (article-goto-body) (while (and (not (eobp)) (looking-at "[ \t]*$")) (gnus-delete-line)))))) +(defun article-goto-body () + "Place point at the start of the body." + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + t + (goto-char (point-max)) + nil)) + (defun article-strip-multiple-blank-lines () "Replace consecutive blank lines with one empty line." (interactive) @@ -1094,15 +1257,17 @@ always hide." (let ((inhibit-point-motion-hooks t) buffer-read-only) ;; First make all blank lines empty. - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (while (re-search-forward "^[ \t]+$" nil t) - (replace-match "" nil t)) + (unless (gnus-annotation-in-region-p + (match-beginning 0) (match-end 0)) + (replace-match "" nil t))) ;; Then replace multiple empty lines with a single empty line. - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (while (re-search-forward "\n\n\n+" nil t) - (replace-match "\n\n" t t))))) + (unless (gnus-annotation-in-region-p + (match-beginning 0) (match-end 0)) + (replace-match "\n\n" t t)))))) (defun article-strip-leading-space () "Remove all white space from the beginning of the lines in the article." @@ -1110,11 +1275,20 @@ always hide." (save-excursion (let ((inhibit-point-motion-hooks t) buffer-read-only) - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (while (re-search-forward "^[ \t]+" nil t) (replace-match "" t t))))) +(defun article-strip-trailing-space () + "Remove all white space from the end of the lines in the article." + (interactive) + (save-excursion + (let ((inhibit-point-motion-hooks t) + buffer-read-only) + (article-goto-body) + (while (re-search-forward "[ \t]+$" nil t) + (replace-match "" t t))))) + (defun article-strip-blank-lines () "Strip leading, trailing and multiple blank lines." (interactive) @@ -1128,47 +1302,36 @@ always hide." (save-excursion (let ((inhibit-point-motion-hooks t) buffer-read-only) - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (while (re-search-forward "^[ \t]*\n" nil t) (replace-match "" t t))))) -(defvar mime::preview/content-list) -(defvar mime::preview-content-info/point-min) (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. @@ -1204,7 +1367,7 @@ Put point at the beginning of the signature separator." (setq b (point)) (point-max)) (setq e (point-max))) - (nnheader-temp-write nil + (with-temp-buffer (insert-buffer-substring gnus-article-buffer b e) (require 'url) (save-window-excursion @@ -1245,15 +1408,14 @@ 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 (text-property-any (1+ pos) (point-max) 'article-type type))) (if pos 'hidden - 'shown))) + nil))) (defun gnus-article-show-hidden-text (type &optional hide) "Show all hidden text of type TYPE. @@ -1327,87 +1489,92 @@ how much time has lapsed since DATE." (defun article-make-date-line (date type) "Return a DATE line of TYPE." - (cond - ;; Convert to the local timezone. We have to slap a - ;; `condition-case' round the calls to the timezone - ;; functions since they aren't particularly resistant to - ;; buggy dates. - ((eq type 'local) - (concat "Date: " (condition-case () - (timezone-make-date-arpa-standard date) - (error date)))) - ;; Convert to Universal Time. - ((eq type 'ut) - (concat "Date: " - (condition-case () - (timezone-make-date-arpa-standard date nil "UT") - (error date)))) - ;; Get the original date from the article. - ((eq type 'original) - (concat "Date: " date)) - ;; Let the user define the format. - ((eq type 'user) - (concat - "Date: " - (format-time-string gnus-article-time-format - (ignore-errors - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT")))))) - ;; Do an X-Sent lapsed format. - ((eq type 'lapsed) - ;; If the date is seriously mangled, the timezone functions are - ;; liable to bug out, so we ignore all errors. - (let* ((now (current-time)) - (real-time - (ignore-errors - (gnus-time-minus - (gnus-encode-date - (timezone-make-date-arpa-standard - (current-time-string now) - (current-time-zone now) "UT")) - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT"))))) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) - num prev) - (cond - ((null real-time) - "X-Sent: Unknown") - ((zerop sec) - "X-Sent: Now") - (t + (let ((time (condition-case () + (date-to-time date) + (error '(0 0))))) + (cond + ;; Convert to the local timezone. We have to slap a + ;; `condition-case' round the calls to the timezone + ;; functions since they aren't particularly resistant to + ;; buggy dates. + ((eq type 'local) + (let ((tz (car (current-time-zone)))) + (format "Date: %s %s%04d" (current-time-string time) + (if (> tz 0) "+" "-") (abs (/ tz 36))))) + ;; Convert to Universal Time. + ((eq type 'ut) + (concat "Date: " + (current-time-string + (let* ((e (parse-time-string date)) + (tm (apply 'encode-time e)) + (ms (car tm)) + (ls (- (cadr tm) (car (current-time-zone))))) + (cond ((< ls 0) (list (1- ms) (+ ls 65536))) + ((> ls 65535) (list (1+ ms) (- ls 65536))) + (t (list ms ls))))) + " UT")) + ;; Get the original date from the article. + ((eq type 'original) + (concat "Date: " (if (string-match "\n+$" date) + (substring date 0 (match-beginning 0)) + date))) + ;; Let the user define the format. + ((eq type 'user) + (if (gnus-functionp gnus-article-time-format) + (funcall gnus-article-time-format time) (concat - "X-Sent: " - ;; This is a bit convoluted, but basically we go - ;; through the time units for years, weeks, etc, - ;; and divide things to see whether that results - ;; in positive answers. - (mapconcat - (lambda (unit) - (if (zerop (setq num (ffloor (/ sec (cdr unit))))) - ;; The (remaining) seconds are too few to - ;; be divided into this time unit. - "" - ;; It's big enough, so we output it. - (setq sec (- sec (* num (cdr unit)))) - (prog1 - (concat (if prev ", " "") (int-to-string - (floor num)) - " " (symbol-name (car unit)) - (if (> num 1) "s" "")) - (setq prev t)))) - article-time-units "") - ;; If dates are odd, then it might appear like the - ;; article was sent in the future. - (if (> real-sec 0) - " ago" - " in the future")))))) - (t - (error "Unknown conversion type: %s" type)))) + "Date: " + (format-time-string gnus-article-time-format time)))) + ;; ISO 8601. + ((eq type 'iso8601) + (concat + "Date: " + (format-time-string "%Y%M%DT%h%m%s" time))) + ;; Do an X-Sent lapsed format. + ((eq type 'lapsed) + ;; If the date is seriously mangled, the timezone functions are + ;; liable to bug out, so we ignore all errors. + (let* ((now (current-time)) + (real-time (subtract-time now time)) + (real-sec (and real-time + (+ (* (float (car real-time)) 65536) + (cadr real-time)))) + (sec (and real-time (abs real-sec))) + num prev) + (cond + ((null real-time) + "X-Sent: Unknown") + ((zerop sec) + "X-Sent: Now") + (t + (concat + "X-Sent: " + ;; This is a bit convoluted, but basically we go + ;; through the time units for years, weeks, etc, + ;; and divide things to see whether that results + ;; in positive answers. + (mapconcat + (lambda (unit) + (if (zerop (setq num (ffloor (/ sec (cdr unit))))) + ;; The (remaining) seconds are too few to + ;; be divided into this time unit. + "" + ;; It's big enough, so we output it. + (setq sec (- sec (* num (cdr unit)))) + (prog1 + (concat (if prev ", " "") (int-to-string + (floor num)) + " " (symbol-name (car unit)) + (if (> num 1) "s" "")) + (setq prev t)))) + article-time-units "") + ;; If dates are odd, then it might appear like the + ;; article was sent in the future. + (if (> real-sec 0) + " ago" + " in the future")))))) + (t + (error "Unknown conversion type: %s" type))))) (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." @@ -1428,13 +1595,16 @@ 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 + (walk-windows + (lambda (w) + (set-buffer (window-buffer w)) + (when (eq major-mode 'gnus-article-mode) + (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. @@ -1444,7 +1614,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 () @@ -1460,6 +1630,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) @@ -1477,8 +1652,7 @@ This format is defined by the `gnus-article-time-format' variable." (props (append '(article-type emphasis) gnus-hidden-properties)) regexp elem beg invisible visible face) - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (setq beg (point)) (while (setq elem (pop alist)) (goto-char beg) @@ -1515,7 +1689,7 @@ This format is defined by the `gnus-article-time-format' variable." (if (not gnus-default-article-saver) (error "No default saver is defined") ;; !!! Magic! The saving functions all save - ;; `gnus-original-article-buffer' (or so they think), but we + ;; `gnus-save-article-buffer' (or so they think), but we ;; bind that variable to our save-buffer. (set-buffer gnus-article-buffer) (let* ((gnus-save-article-buffer save-buffer) @@ -1527,7 +1701,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 @@ -1624,7 +1798,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 @@ -1640,7 +1813,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 @@ -1651,7 +1823,7 @@ Directory to save to is default to `gnus-article-save-directory'." (widen) (if (and (file-readable-p filename) (mail-file-babyl-p filename)) - (gnus-output-to-rmail filename t) + (rmail-output-to-rmail-file filename t) (gnus-output-to-mail filename))))) filename) @@ -1659,7 +1831,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 @@ -1678,14 +1849,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 @@ -1694,17 +1863,16 @@ The directory to save in defaults to `gnus-article-save-directory'." (save-excursion (save-restriction (widen) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) + (when (article-goto-body) (narrow-to-region (point) (point-max))) (gnus-output-to-file filename)))) filename) (defun gnus-summary-save-in-pipe (&optional command) "Pipe this article to subprocess." - (interactive) (setq command - (cond ((eq command 'default) + (cond ((and (eq command 'default) + gnus-last-shell-command) gnus-last-shell-command) (command command) (t (read-string @@ -1825,15 +1993,21 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-strip-leading-blank-lines article-strip-multiple-blank-lines article-strip-leading-space + article-strip-trailing-space article-strip-blank-lines article-strip-all-blank-lines article-date-local + article-date-iso8601 article-date-original article-date-ut + article-decode-mime-words + article-decode-charset + article-decode-encoded-words article-date-user article-date-lapsed article-emphasize article-treat-dumbquotes + article-normalize-headers (article-show-all . gnus-article-show-all-headers)))) ;;; @@ -1842,6 +2016,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (put 'gnus-article-mode 'mode-class 'special) +(set-keymap-parent gnus-article-mode-map widget-keymap) + (gnus-define-keys gnus-article-mode-map " " gnus-article-goto-next-page "\177" gnus-article-goto-prev-page @@ -1851,10 +2027,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is "s" gnus-article-show-summary "\C-c\C-m" gnus-article-mail "?" gnus-article-describe-briefly - gnus-mouse-2 gnus-article-push-button - "\r" gnus-article-press-button - "\t" gnus-article-next-button - "\M-\t" gnus-article-prev-button "e" gnus-article-edit "<" beginning-of-buffer ">" end-of-buffer @@ -1880,7 +2052,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 "" @@ -1892,16 +2065,13 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["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. @@ -1921,23 +2091,25 @@ 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) (make-local-variable 'minor-mode-alist) - (unless (assq 'gnus-show-mime minor-mode-alist) - (push (list 'gnus-show-mime " MIME") minor-mode-alist)) (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) + (make-local-variable 'gnus-article-mime-handles) + (make-local-variable 'gnus-article-decoded-p) + (make-local-variable 'gnus-article-mime-handle-alist) (gnus-set-default-directory) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (setq buffer-read-only t) (set-syntax-table gnus-article-mode-syntax-table) - (run-hooks 'gnus-article-mode-hook)) + (mm-enable-multibyte) + (gnus-run-hooks 'gnus-article-mode-hook)) (defun gnus-article-setup-buffer () "Initialize the article buffer." @@ -1949,6 +2121,7 @@ commands: (substring name (match-end 0)))))) (setq gnus-article-buffer name) (setq gnus-original-article-buffer original) + (setq gnus-article-mime-handle-alist nil) ;; This might be a variable local to the summary buffer. (unless gnus-single-article-buffer (save-excursion @@ -1958,25 +2131,23 @@ commands: (gnus-set-global-variables))) ;; Init original article buffer. (save-excursion - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo (current-buffer)) + (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) + (mm-enable-multibyte) (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)) + (buffer-disable-undo) (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) + (gnus-summary-set-local-parameters gnus-newsgroup-name) (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines @@ -2004,14 +2175,9 @@ 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 @@ -2032,11 +2198,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) @@ -2049,7 +2220,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-configure-windows 'summary) (gnus-configure-windows 'article)) (gnus-set-global-variables)) - (gnus-set-mode-line 'article)) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article))) ;; The result from the `request' was an actual article - ;; or at least some text that is now displayed in the ;; article buffer. @@ -2069,53 +2242,568 @@ 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")) - (let ((coding-system-for-write 'binary) - (coding-system-for-read 'binary)) - (funcall gnus-show-mime-method)) - (funcall gnus-decode-encoded-word-method))) - ;; Perform the article display hooks. - (run-hooks 'gnus-article-display-hook)) + (gnus-article-prepare-display) ;; Do page break. (goto-char (point-min)) (setq gnus-page-broken (when gnus-break-pages (gnus-narrow-to-page) t))) - (gnus-set-mode-line 'article) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)) (gnus-configure-windows 'article) - (goto-char (point-min)) + (article-goto-body) + (set-window-point (get-buffer-window (current-buffer)) (point)) t)))))) +(defun gnus-article-prepare-display () + "Make the current buffer look like a nice article." + ;; Hooks for getting information from the article. + ;; This hook must be called before being narrowed. + (let ((gnus-article-buffer (current-buffer)) + buffer-read-only) + (unless (eq major-mode 'gnus-article-mode) + (gnus-article-mode)) + (setq buffer-read-only nil) + (gnus-run-hooks 'gnus-tmp-internal-hook) + (gnus-run-hooks 'gnus-article-prepare-hook) + (when gnus-display-mime-function + (mm-setup-w3) + (let ((url-standalone-mode (not gnus-plugged))) + (funcall gnus-display-mime-function))) + ;; Perform the article display hooks. + (gnus-run-hooks 'gnus-article-display-hook))) + +;;; +;;; Gnus MIME viewing functions +;;; + +(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" + "The following specs can be used: +%t The MIME type +%T MIME type, along with additional info +%n The `name' parameter +%d The description, if any +%l The length of the encoded part +%p The part identifier number +%e Dots if the part isn't displayed") + +(defvar gnus-mime-button-line-format-alist + '((?t gnus-tmp-type ?s) + (?T gnus-tmp-type-long ?s) + (?n gnus-tmp-name ?s) + (?d gnus-tmp-description ?s) + (?p gnus-tmp-id ?s) + (?l gnus-tmp-length ?d) + (?e gnus-tmp-dots ?s))) + +(defvar gnus-mime-button-commands + '((gnus-article-press-button "\r" "Toggle Display") + (gnus-mime-view-part "v" "View Interactively...") + (gnus-mime-save-part "o" "Save...") + (gnus-mime-copy-part "c" "View As Text, In Other Buffer") + (gnus-mime-inline-part "i" "View As Text, In This Buffer") + (gnus-mime-internalize-part "E" "View Internally") + (gnus-mime-externalize-part "e" "View Externally") + (gnus-mime-pipe-part "|" "Pipe To Command..."))) + +(defun gnus-article-mime-part-status () + (if gnus-article-mime-handle-alist-1 + (format " (%d parts)" (length gnus-article-mime-handle-alist-1)) + "")) + +(defvar gnus-mime-button-map nil) +(unless gnus-mime-button-map + (setq gnus-mime-button-map (make-sparse-keymap)) + (set-keymap-parent gnus-mime-button-map gnus-article-mode-map) + (define-key gnus-mime-button-map gnus-mouse-2 'gnus-article-push-button) + (define-key gnus-mime-button-map gnus-mouse-3 'gnus-mime-button-menu) + (mapcar (lambda (c) + (define-key gnus-mime-button-map (cadr c) (car c))) + gnus-mime-button-commands)) + +(defun gnus-mime-button-menu (event) + "Construct a context-sensitive menu of MIME commands." + (interactive "e") + (gnus-article-check-buffer) + (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 (&optional handles) + "View all the MIME parts." + (interactive) + (save-current-buffer + (set-buffer gnus-article-buffer) + (let ((handles (or handles gnus-article-mime-handles)) + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (if (stringp (car handles)) + (gnus-mime-view-all-parts (cdr handles)) + (mapcar 'mm-display-part handles))))) + +(defun gnus-mime-save-part () + "Save the MIME part under point." + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-save-part data))) + +(defun gnus-mime-pipe-part () + "Pipe the MIME part under point to a process." + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-data))) + (mm-pipe-part data))) + +(defun gnus-mime-view-part () + "Interactively choose a view method for the MIME part under point." + (interactive) + (gnus-article-check-buffer) + (mm-setup-w3) + (let ((data (get-text-property (point) 'gnus-data)) + (url-standalone-mode (not gnus-plugged))) + (mm-interactively-view-part data))) + +(defun gnus-mime-copy-part (&optional handle) + "Put the the MIME part under point into a new buffer." + (interactive) + (gnus-article-check-buffer) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + (contents (mm-get-part handle))| + (base (file-name-nondirectory + (or + (mail-content-type-get (mm-handle-type handle) 'name) + (mail-content-type-get (mm-handle-type handle) + 'filename) + "*decoded*"))) + (buffer (generate-new-buffer base))) + (switch-to-buffer buffer) + (insert contents) + ;; We do it this way to make `normal-mode' set the appropriate mode. + (unwind-protect + (progn + (setq buffer-file-name (expand-file-name base)) + (normal-mode)) + (setq buffer-file-name nil)) + (goto-char (point-min)))) + +(defun gnus-mime-inline-part (&optional charset) + "Insert the MIME part under point into the current buffer." + (interactive "P") ; For compatibility reasons we are not using "z". + (gnus-article-check-buffer) + (mm-setup-w3) + (let* ((data (get-text-property (point) 'gnus-data)) + contents + (url-standalone-mode (not gnus-plugged)) + (b (point)) + buffer-read-only) + (if (mm-handle-undisplayer data) + (mm-remove-part data) + (setq contents (mm-get-part data)) + (forward-line 2) + (when charset + (unless (symbolp charset) + (setq charset (mm-read-coding-system "Charset: "))) + (setq contents (mm-decode-coding-string contents charset))) + (mm-insert-inline data contents) + (goto-char b)))) + +(defun gnus-mime-externalize-part (&optional handle) + "View the MIME part under point with an external viewer." + (interactive) + (gnus-article-check-buffer) + (mm-setup-w3) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + (url-standalone-mode (not gnus-plugged)) + (mm-user-display-methods nil) + (mm-all-images-fit t) + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (if (mm-handle-undisplayer handle) + (mm-remove-part handle) + (mm-display-part handle)))) + +(defun gnus-mime-internalize-part (&optional handle) + "View the MIME part under point with an internal viewer." + (interactive) + (gnus-article-check-buffer) + (mm-setup-w3) + (let* ((handle (or handle (get-text-property (point) 'gnus-data))) + (url-standalone-mode (not gnus-plugged)) + (mm-user-display-methods '((".*" . inline))) + (mm-all-images-fit t) + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (if (mm-handle-undisplayer handle) + (mm-remove-part handle) + (mm-display-part handle)))) + +(defun gnus-article-part-wrapper (n function) + (save-current-buffer + (set-buffer gnus-article-buffer) + (when (> n (length gnus-article-mime-handle-alist)) + (error "No such part")) + (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) + (funcall function handle)))) + +(defun gnus-article-pipe-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'mm-pipe-part)) + +(defun gnus-article-save-part (n) + "Save MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'mm-save-part)) + +(defun gnus-article-interactively-view-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'mm-interactively-view-part)) + +(defun gnus-article-copy-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'gnus-mime-copy-part)) + +(defun gnus-article-externalize-part (n) + "Pipe MIME part N, which is the numerical prefix." + (interactive "p") + (gnus-article-part-wrapper n 'gnus-mime-externalize-part)) + +(defun gnus-article-view-part (n) + "View MIME part N, which is the numerical prefix." + (interactive "p") + (save-current-buffer + (set-buffer gnus-article-buffer) + (when (> n (length gnus-article-mime-handle-alist)) + (error "No such part")) + (let ((handle (cdr (assq n gnus-article-mime-handle-alist)))) + (when (gnus-article-goto-part n) + (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." + (let ((id (get-text-property (point) 'gnus-part)) + (point (point)) + buffer-read-only) + (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) + (gnus-insert-mime-button + handle id (list (not (mm-handle-displayed-p handle)))) + (prog1 + (let ((window (selected-window)) + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (save-excursion + (unwind-protect + (let ((win (get-buffer-window (current-buffer) t))) + (if win + (select-window win)) + (goto-char point) + (forward-line) + (mm-display-part handle)) + (select-window window)))) + (goto-char point)))) + +(defun gnus-article-goto-part (n) + "Go to MIME part N." + (let ((point (text-property-any (point-min) (point-max) 'gnus-part n))) + (when point + (goto-char point)))) + +(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) + (let ((gnus-tmp-name + (or (mail-content-type-get (mm-handle-type handle) + 'name) + (mail-content-type-get (mm-handle-disposition handle) + 'filename) + "")) + (gnus-tmp-type (car (mm-handle-type handle))) + (gnus-tmp-description (or (mm-handle-description handle) + "")) + (gnus-tmp-dots + (if (if displayed (car displayed) + (mm-handle-displayed-p handle)) + "" "...")) + (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle) + (buffer-size))) + gnus-tmp-type-long b e) + (when (string-match ".*/" gnus-tmp-name) + (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name))) + (setq gnus-tmp-type-long (concat gnus-tmp-type + (and (not (equal gnus-tmp-name "")) + (concat "; " gnus-tmp-name)))) + (or (equal gnus-tmp-description "") + (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) + (unless (bolp) + (insert "\n")) + (setq b (point)) + (gnus-eval-format + gnus-mime-button-line-format gnus-mime-button-line-format-alist + `(local-map ,gnus-mime-button-map + keymap ,gnus-mime-button-map + gnus-callback gnus-mm-display-part + gnus-part ,gnus-tmp-id + article-type annotation + gnus-data ,handle)) + (setq e (point)) + (widget-convert-button 'link b e + :mime-handle handle + :action 'gnus-widget-press-button + :button-keymap gnus-mime-button-map + :help-echo + (lambda (widget) + ;; Needed to properly clear the message + ;; due to a bug in wid-edit + (setq help-echo-owns-message t) + (format + "Click to %s the MIME part; %s for more options" + (if (mm-handle-displayed-p + (widget-get widget :mime-handle)) + "hide" "show") + (if gnus-xemacs "button3" "mouse-3")))))) + +(defun gnus-widget-press-button (elems el) + (goto-char (widget-get elems :from)) + (mm-setup-w3) + (let ((url-standalone-mode (not gnus-plugged))) + (gnus-article-press-button))) + +(defun gnus-display-mime (&optional ihandles) + "Insert MIME buttons in the buffer." + (save-excursion + (save-selected-window + (let ((window (get-buffer-window gnus-article-buffer)) + (point (point))) + (when window + (select-window window) + ;; We have to do this since selecting the window + ;; may change the point. So we set the window point. + (set-window-point window point))) + (let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) + handle name type b e display) + (unless ihandles + ;; Top-level call; we clean up. + (mm-destroy-parts gnus-article-mime-handles) + (setq gnus-article-mime-handles handles + gnus-article-mime-handle-alist nil) + ;; We allow users to glean info from the handles. + (when gnus-article-mime-part-function + (gnus-mime-part-function handles))) + (when (and handles + (or (not (stringp (car handles))) + (cdr handles))) + (unless ihandles + ;; Clean up for mime parts. + (article-goto-body) + (delete-region (point) (point-max))) + (gnus-mime-display-part handles)))))) + +(defun gnus-mime-display-part (handle) + (cond + ;; Single part. + ((not (stringp (car handle))) + (gnus-mime-display-single handle)) + ;; multipart/alternative + ((equal (car handle) "multipart/alternative") + (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))) + ;; multipart/related + ((equal (car handle) "multipart/related") + ;;;!!!We should find the start part, but we just default + ;;;!!!to the first part. + (gnus-mime-display-part (cadr handle))) + ;; Other multiparts are handled like multipart/mixed. + (t + (gnus-mime-display-mixed (cdr handle))))) + +(defun gnus-mime-part-function (handles) + (if (stringp (car handles)) + (mapcar 'gnus-mime-part-function (cdr handles)) + (funcall gnus-article-mime-part-function handles))) + +(defun gnus-mime-display-mixed (handles) + (mapcar 'gnus-mime-display-part handles)) + +(defun gnus-mime-display-single (handle) + (let ((type (car (mm-handle-type handle))) + (ignored gnus-ignored-mime-types) + (not-attachment t) + (move nil) + display text) + (catch 'ignored + (progn + (while ignored + (when (string-match (pop ignored) type) + (throw 'ignored nil))) + (if (and (setq not-attachment + (or (not (mm-handle-disposition handle)) + (equal (car (mm-handle-disposition handle)) + "inline"))) + (mm-automatic-display-p type) + (or (mm-inlinable-part-p type) + (mm-automatic-external-display-p type))) + (setq display t) + (when (equal (car (split-string type "/")) + "text") + (setq text t))) + (let ((id (1+ (length gnus-article-mime-handle-alist)))) + (push (cons id handle) gnus-article-mime-handle-alist) + (when (or (not display) + (not (gnus-unbuttonized-mime-type-p type))) + (gnus-article-insert-newline) + (gnus-insert-mime-button + handle id (list (or display + (and not-attachment text)))) + (gnus-article-insert-newline) + (gnus-article-insert-newline) + (setq move t))) + (cond + (display + (when move + (forward-line -2)) + (let ((rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced + gnus-newsgroup-iso-8859-1-forced)) + (mm-display-part handle t)) + (goto-char (point-max))) + ((and text not-attachment) + (when move + (forward-line -2)) + (gnus-article-insert-newline) + (mm-insert-inline handle (mm-get-part handle)) + (goto-char (point-max)))))))) + +(defun gnus-unbuttonized-mime-type-p (type) + "Say whether TYPE is to be unbuttonized." + (unless gnus-inhibit-mime-unbuttonizing + (catch 'found + (let ((types gnus-unbuttonized-mime-types)) + (while types + (when (string-match (pop types) type) + (throw 'found t))))))) + +(defun gnus-article-insert-newline () + "Insert a newline, but mark it as undeletable." + (gnus-put-text-property + (point) (progn (insert "\n") (point)) 'gnus-undeletable t)) + +(defun gnus-mime-display-alternative (handles &optional preferred ibegend id) + (let* ((preferred (or preferred (mm-preferred-alternative handles))) + (ihandles handles) + (point (point)) + handle buffer-read-only from props begend not-pref) + (save-window-excursion + (save-restriction + (when ibegend + (narrow-to-region (car ibegend) + (or (cdr ibegend) + (progn + (goto-char (car ibegend)) + (forward-line 2) + (point)))) + (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))) + (when (or ibegend + (not (gnus-unbuttonized-mime-type-p + "multipart/alternative"))) + (gnus-add-text-properties + (setq from (point)) + (progn + (insert (format "%d. " id)) + (point)) + `(gnus-callback + (lambda (handles) + (unless ,(not ibegend) + (setq gnus-article-mime-handle-alist + ',gnus-article-mime-handle-alist)) + (gnus-mime-display-alternative + ',ihandles ',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)) + (progn + (insert (format "(%c) %-18s" + (if (equal handle preferred) ?* ? ) + (if (stringp (car handle)) + (car handle) + (car (mm-handle-type handle))))) + (point)) + `(gnus-callback + (lambda (handles) + (unless ,(not ibegend) + (setq gnus-article-mime-handle-alist + ',gnus-article-mime-handle-alist)) + (gnus-mime-display-alternative + ',ihandles ',handle ',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) + (insert " ")) + (insert "\n\n")) + (when preferred + (if (stringp (car preferred)) + (gnus-display-mime preferred) + (let ((rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced + gnus-newsgroup-iso-8859-1-forced)) + (mm-display-part preferred))) + (goto-char (point-max)) + (setcdr begend (point-marker))))) + (when ibegend + (goto-char point)))) + (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion @@ -2127,18 +2815,18 @@ If ALL-HEADERS is non-nil, no headers are hidden." (pem (gnus-article-hidden-text-p 'pem)) (signature (gnus-article-hidden-text-p 'signature)) (overstrike (gnus-article-hidden-text-p 'overstrike)) - (emphasis (gnus-article-hidden-text-p 'emphasis)) - (mime gnus-show-mime)) - (format "%c%c%c%c%c%c%c" + (emphasis (gnus-article-hidden-text-p 'emphasis))) + (format "%c%c%c%c%c%c" (if cite ?c ? ) (if (or headers boring) ?h ? ) (if (or pgp pem) ?p ? ) (if signature ?s ? ) (if overstrike ?o ? ) - (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) @@ -2150,7 +2838,7 @@ Provided for backwards compatibility." (defun gnus-output-to-file (file-name) "Append the current article to a file named FILE-NAME." (let ((artbuf (current-buffer))) - (nnheader-temp-write nil + (with-temp-buffer (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then ;; save it to file. @@ -2278,7 +2966,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." @@ -2292,7 +2981,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) @@ -2303,93 +2992,115 @@ 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))) +(defun gnus-article-check-buffer () + "Beep if not in an article buffer." + (unless (equal major-mode 'gnus-article-mode) + (error "Command invoked outside of a Gnus article buffer"))) + (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) "Read a summary buffer key sequence and execute it from the article buffer." (interactive "P") + (gnus-article-check-buffer) (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. @@ -2406,7 +3117,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))) @@ -2417,7 +3128,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) @@ -2430,10 +3141,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)))))))) @@ -2443,7 +3157,7 @@ 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))) @@ -2480,6 +3194,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) @@ -2490,24 +3205,30 @@ 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)) - (buffer-disable-undo (current-buffer)) + (set-buffer gnus-original-article-buffer) + (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) + (buffer-disable-undo) (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)) - (setq gnus-original-article (cons group article)))) + (setq gnus-original-article (cons group article))) + + ;; Decode charsets. + (run-hooks 'gnus-article-decode-hook) + ;; Mark article as decoded or not. + (setq gnus-article-decoded-p gnus-article-decode-hook)) ;; Update sparse articles. (when (and do-update-line @@ -2515,7 +3236,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)) @@ -2534,8 +3255,10 @@ If given a prefix, show the hidden text instead." (defvar gnus-article-edit-mode-map nil) +;; Should we be using derived.el for this? (unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) + (setq gnus-article-edit-mode-map (make-sparse-keymap)) + (set-keymap-parent gnus-article-edit-mode-map text-mode-map) (gnus-define-keys gnus-article-edit-mode-map "\C-c\C-c" gnus-article-edit-done @@ -2551,7 +3274,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) @@ -2560,7 +3282,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. @@ -2571,6 +3293,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 @@ -2582,6 +3305,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) @@ -2594,8 +3318,7 @@ groups." (save-excursion (save-restriction (widen) - (goto-char (point-min)) - (when (search-forward "\n\n" nil 1) + (when (article-goto-body) (let ((lines (count-lines (point) (point-max))) (length (- (point-max) (point))) (case-fold-search t) @@ -2620,7 +3343,19 @@ groups." (save-excursion (set-buffer buf) (let ((buffer-read-only nil)) - (funcall func arg))) + (funcall func arg)) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + ;; Flush original article as well. + (save-excursion + (when (get-buffer gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq gnus-original-article nil))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current)))) (set-buffer buf) (set-window-start (get-buffer-window buf) start) (set-window-point (get-buffer-window buf) (point)))) @@ -2637,25 +3372,12 @@ groups." (insert buf) (let ((winconf gnus-prev-winconf)) (gnus-article-mode) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - ;; Flush original article as well. - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) (set-window-configuration winconf) ;; Tippy-toe some to make sure that point remains where it was. - (let ((buf (current-buffer))) + (save-current-buffer (set-buffer curbuf) (set-window-start (get-buffer-window (current-buffer)) window-start) - (goto-char p) - (set-buffer buf))))) + (goto-char p))))) (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." @@ -2680,21 +3402,23 @@ groups." :type 'regexp) (defcustom gnus-button-alist - `(("<\\(url: ?\\)?news:\\([^>\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 + `(("<\\(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:[>\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, @@ -2726,7 +3450,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: @@ -2764,6 +3488,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)))) @@ -2777,40 +3502,6 @@ call it with the value of the `gnus-data' text property." (when fun (funcall fun data)))) -(defun gnus-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (gnus-article-next-button (- n))) - -(defun gnus-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'gnus-callback) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'gnus-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'gnus-callback))) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - (defun gnus-article-highlight (&optional force) "Highlight current article. This function calls `gnus-article-highlight-headers', @@ -2920,9 +3611,7 @@ specified by `gnus-button-alist'." 'gnus-callback nil)) (set-marker marker nil))) ;; We skip the headers. - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) + (article-goto-body) (setq beg (point)) (while (setq entry (pop alist)) (setq regexp (car entry)) @@ -2993,7 +3682,9 @@ specified by `gnus-button-alist'." (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) + (and data (list 'gnus-data data)))) + (widget-convert-button 'link from to :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap)) ;;; Internal functions: @@ -3025,7 +3716,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) @@ -3068,17 +3758,9 @@ 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 "&")) + (setq pairs (split-string query "&")) (while pairs (setq cur (car pairs) pairs (cdr pairs)) @@ -3130,7 +3812,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 @@ -3161,11 +3843,17 @@ forbidden in URL encoding." (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. @@ -3183,7 +3871,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 + article-type annotation)))) (defvar gnus-next-page-map nil) (unless gnus-next-page-map @@ -3211,9 +3900,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 + article-type annotation)))) (defun gnus-article-button-next-page (arg) "Go to the next page." @@ -3231,6 +3921,49 @@ forbidden in URL encoding." (gnus-article-prev-page) (select-window win))) +(defvar gnus-decode-header-methods + '(gnus-decode-with-mail-decode-encoded-word-region) + "List of methods used to decode headers. + +This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is +FUNCTION, FUNCTION will be apply to all newsgroups. If item is a +(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +whose names match REGEXP. + +For example: +((\"chinese\" . gnus-decode-encoded-word-region-by-guess) + mail-decode-encoded-word-region + (\"chinese\" . rfc1843-decode-region)) +") + +(defvar gnus-decode-header-methods-cache nil) + +(defun gnus-decode-with-mail-decode-encoded-word-region (start end) + (let ((rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (mail-decode-encoded-word-region start end))) + +(defun gnus-multi-decode-header (start end) + "Apply the functions from `gnus-encoded-word-methods' that match." + (unless (and gnus-decode-header-methods-cache + (eq gnus-newsgroup-name + (car gnus-decode-header-methods-cache))) + (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name)) + (mapc '(lambda (x) + (if (symbolp x) + (nconc gnus-decode-header-methods-cache (list x)) + (if (and gnus-newsgroup-name + (string-match (car x) gnus-newsgroup-name)) + (nconc gnus-decode-header-methods-cache + (list (cdr x)))))) + gnus-decode-header-methods)) + (let ((xlist gnus-decode-header-methods-cache)) + (pop xlist) + (save-restriction + (narrow-to-region start end) + (while xlist + (funcall (pop xlist) (point-min) (point-max)))))) + (gnus-ems-redefine) (provide 'gnus-art)