X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=94849bb4fc4f883945189c8934d44dfa499fd84c;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=60768c3f05356c0f278b9ebd201b6aad6f66cc7b;hpb=092c29dcb4682af91a1ad5616cceca540c15cd38;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 60768c3..94849bb 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -121,7 +121,7 @@ "^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-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.*:" @@ -151,7 +151,8 @@ "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:" "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:" "^X-Virus-Scanned:" "^X-Delivery-Agent:" "^Posted-Date:" "^X-Gateway:" - "^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:") + "^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:" + "^X-Received-Date:") "*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." @@ -238,19 +239,17 @@ regexp. If it matches, the text in question is not a signature." (cond ((featurep 'xemacs) (if (or (gnus-image-type-available-p 'xface) - (gnus-image-type-available-p 'xpm)) - 'gnus-xmas-article-display-xface + (gnus-image-type-available-p 'pbm)) + 'gnus-display-x-face-in-from "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")) ((and (fboundp 'image-type-available-p) (module-installed-p 'x-face-e21)) 'x-face-decode-message-header) - ((gnus-image-type-available-p 'xbm) - 'gnus-article-display-xface) + ((gnus-image-type-available-p 'pbm) + 'gnus-display-x-face-in-from) ((and window-system (module-installed-p 'x-face-mule)) 'x-face-mule-gnus-article-display-x-face) - (gnus-article-compface-xbm - "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -") (t "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ display -")) @@ -266,10 +265,9 @@ asynchronously. The compressed face will be piped to this command." (delq nil (list 'string - (if (and (featurep 'xemacs) - (or (featurep 'xface) - (featurep 'xpm))) - '(function-item gnus-xmas-article-display-xface)) + (if (or (gnus-image-type-available-p 'xface) + (gnus-image-type-available-p 'pbm)) + '(function-item gnus-display-x-face-in-from)) (if (and x-face-e21 (fboundp 'image-type-available-p)) '(function-item @@ -280,6 +278,7 @@ asynchronously. The compressed face will be piped to this command." x-face-mule-gnus-article-display-x-face)) 'function)))) ;;:version "21.1" + :group 'gnus-picon :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil @@ -318,23 +317,23 @@ directly.") (defcustom gnus-emphasis-alist (let ((format - "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)") + "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") (types - '(("_" "_" underline) + '(("\\*" "\\*" bold) + ("_" "_" underline) ("/" "/" italic) - ("\\*" "\\*" bold) ("_/" "/_" underline-italic) ("_\\*" "\\*_" underline-bold) ("\\*/" "/\\*" bold-italic) ("_\\*/" "/\\*_" underline-bold-italic)))) - `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline) - ,@(mapcar + `(,@(mapcar (lambda (spec) (list (format format (car spec) (car (cdr spec))) 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) - types))) + types) + ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline))) "*Alist that says how to fontify certain phrases. Each item looks like this: @@ -747,6 +746,32 @@ To see e.g. security buttons you could set this to :group 'gnus-article-mime :type '(repeat regexp)) +(defcustom gnus-body-boundary-delimiter "_" + "String used to delimit header and body. +This variable is used by `gnus-article-treat-body-boundary' which can +be controlled by `gnus-treat-body-boundary'." + :group 'gnus-article-various + :type '(choice (item :tag "None" :value nil) + string)) + +(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") + "Defines the location of the faces database. +For information on obtaining this database of pretty pictures, please +see http://www.cs.indiana.edu/picons/ftp/index.html" + :type '(repeat directory) + :link '(url-link :tag "download" + "http://www.cs.indiana.edu/picons/ftp/index.html") + :link '(custom-manual "(gnus)Picons") + :group 'gnus-picon) + +(defun gnus-picons-installed-p () + "Say whether picons are installed on your machine." + (let ((installed nil)) + (dolist (database gnus-picon-databases) + (when (file-exists-p database) + (setq installed t))) + installed)) + (defcustom gnus-article-mime-part-function nil "Function called with a MIME handle as the argument. This is meant for people who want to do something automatic based @@ -795,24 +820,9 @@ used." ("toggle display" . gnus-article-press-button) ("toggle display" . gnus-article-view-part-as-charset) ("view as type" . gnus-mime-view-part-as-type) - ("internalize type" . gnus-mime-internalize-part) - ("externalize type" . gnus-mime-externalize-part)) - "An alist of actions that run on the MIME attachment." - :group 'gnus-article-mime - :type '(repeat (cons (string :tag "name") - (function)))) - -(defcustom gnus-mime-action-alist - '(("save to file" . gnus-mime-save-part) - ("display as text" . gnus-mime-inline-part) - ("view the part" . gnus-mime-view-part) - ("pipe to command" . gnus-mime-pipe-part) - ("toggle display" . gnus-article-press-button) - ("view as type" . gnus-mime-view-part-as-type) - ("internalize type" . gnus-mime-internalize-part) - ("externalize type" . gnus-mime-externalize-part)) + ("view internally" . gnus-mime-view-part-internally) + ("view externally" . gnus-mime-view-part-externally)) "An alist of actions that run on the MIME attachment." - :version "21.1" :group 'gnus-article-mime :type '(repeat (cons (string :tag "name") (function)))) @@ -855,7 +865,7 @@ See Info node `(gnus)Customizing Articles'." (defcustom gnus-treat-buttonize 100000 "Add buttons. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles'." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-buttonize 'highlight t) @@ -863,7 +873,7 @@ See the manual for details." (defcustom gnus-treat-buttonize-head 'head "Add buttons to the head. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) @@ -875,7 +885,7 @@ See the manual for details." 50000) "Emphasize text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-emphasize 'highlight t) @@ -883,63 +893,70 @@ See the manual for details." (defcustom gnus-treat-strip-cr nil "Remove carriage returns. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-unsplit-urls nil + "Remove newlines from within URLs. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-leading-whitespace nil "Remove leading whitespace in headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-hide-headers 'head "Hide headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-boring-headers nil "Hide boring headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-hide-signature nil "Hide the signature. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-fill-article nil "Fill the article. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation nil "Hide cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-hide-citation-maybe nil "Hide cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-list-identifiers 'head "Strip list identifiers from `gnus-list-identifiers`. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -947,14 +964,14 @@ See the manual for details." (defcustom gnus-treat-strip-pgp t "Strip PGP signatures. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-pem nil "Strip PEM signatures. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -962,14 +979,14 @@ See the manual for details." "Strip banners from articles. The banner to be stripped is specified in the `banner' group parameter. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-highlight-headers 'head "Highlight the headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (put 'gnus-treat-highlight-headers 'highlight t) @@ -977,7 +994,7 @@ See the manual for details." (defcustom gnus-treat-highlight-citation t "Highlight cited text. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-highlight-citation 'highlight t) @@ -985,42 +1002,42 @@ See the manual for details." (defcustom gnus-treat-date-ut nil "Display the Date in UT (GMT). Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-local nil "Display the Date in the local timezone. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-english nil "Display the Date in a format that can be read aloud in English. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-lapsed nil "Display the Date header in a way that says how much time has elapsed. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-original nil "Display the date in the original timezone. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-iso8601 nil "Display the date in the ISO8601 format. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-head-custom) @@ -1029,14 +1046,14 @@ See the manual for details." "Display the date in a user-defined format. The format is defined by the `gnus-article-time-format' variable. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-head-custom) (defcustom gnus-treat-strip-headers-in-body t "Strip the X-No-Archive header line from the beginning of the body. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1044,48 +1061,56 @@ See the manual for details." (defcustom gnus-treat-strip-trailing-blank-lines nil "Strip trailing blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-leading-blank-lines nil "Strip leading blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-strip-multiple-blank-lines nil "Strip multiple blank lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-unfold-headers 'head "Unfold folded header lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :type gnus-article-treat-custom) + +(defcustom gnus-treat-fold-headers nil + "Fold headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-fold-newsgroups 'head "Fold the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-overstrike t "Treat overstrike highlighting. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-overstrike 'highlight t) (defcustom gnus-treat-display-xface - (and (or (and (fboundp 'image-type-available-p) + (and (not noninteractive) + (or (and (fboundp 'image-type-available-p) (image-type-available-p 'xbm) (string-match "^0x" (shell-command-to-string "uncompface"))) (and (featurep 'xemacs) @@ -1095,17 +1120,57 @@ See the manual for details." 'head) "Display X-Face headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)X-Face' for details." :group 'gnus-article-treat ;;:version "21.1" :type gnus-article-treat-head-custom) (put 'gnus-treat-display-xface 'highlight t) +(defcustom gnus-article-should-use-smiley-mule + (not (or (featurep 'xemacs) + (gnus-image-type-available-p 'xpm) + (gnus-image-type-available-p 'pbm))) + "If non-nil, gnus uses `smiley-mule' for displaying smileys rather than +`smiley'. It defaults to t when Emacs 20 or earlier is running. +`smiley-mule' is boundled in BITMAP-MULE package. You can set it to t +even if you are using Emacs 21+. It has no effect on XEmacs." + :group 'gnus-article-various + :type 'boolean + :get (lambda (symbol) + (and (default-value symbol) + (not (featurep 'xemacs)) + (module-installed-p 'smiley-mule) + t)) + :set (lambda (symbol value) + (set-default symbol (and value + (not (featurep 'xemacs)) + (module-installed-p 'smiley-mule) + t)))) + +(defvar gnus-article-smiley-mule-loaded-p nil + "Internal variable used to say whether `smiley-mule' is loaded (whether +smiley functions are not overridden by `smiley').") + +(defcustom gnus-treat-display-grey-xface + (and (not noninteractive) + (or (featurep 'xemacs) + (and (fboundp 'display-images-p) + (display-images-p))) + (string-match "^0x" (shell-command-to-string "uncompface")) + t) + "Display grey X-Face headers. +Valid values are nil, t." + :group 'gnus-article-treat + :version "21.3" + :type 'boolean) +(put 'gnus-treat-display-grey-xface 'highlight t) + (defcustom gnus-treat-display-smileys (if (or (and (featurep 'xemacs) (featurep 'xpm)) - (and (fboundp 'image-type-available-p) - (image-type-available-p 'pbm)) + (gnus-image-type-available-p 'xpm) + (gnus-image-type-available-p 'pbm) (and (not (featurep 'xemacs)) window-system (module-installed-p 'smiley-mule))) @@ -1113,39 +1178,55 @@ See the manual for details." nil) "Display smileys. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Smileys' for details." :group 'gnus-article-treat ;;:version "21.1" :type gnus-article-treat-custom) (put 'gnus-treat-display-smileys 'highlight t) (defcustom gnus-treat-from-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the From header. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." :group 'gnus-article-treat + :group 'gnus-picon + :link '(info-link "(gnus)Customizing Articles") + :link '(info-link "(gnus)Picons") :type gnus-article-treat-head-custom) (put 'gnus-treat-from-picon 'highlight t) (defcustom gnus-treat-mail-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in To and Cc headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." :group 'gnus-article-treat + :group 'gnus-picon + :link '(info-link "(gnus)Customizing Articles") + :link '(info-link "(gnus)Picons") :type gnus-article-treat-head-custom) (put 'gnus-treat-mail-picon 'highlight t) (defcustom gnus-treat-newsgroups-picon - (if (gnus-image-type-available-p 'xpm) + (if (and (gnus-image-type-available-p 'xpm) + (gnus-picons-installed-p)) 'head nil) "Display picons in the Newsgroups and Followup-To headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." :group 'gnus-article-treat + :group 'gnus-picon + :link '(info-link "(gnus)Customizing Articles") + :link '(info-link "(gnus)Picons") :type gnus-article-treat-head-custom) (put 'gnus-treat-newsgroups-picon 'highlight t) @@ -1156,7 +1237,7 @@ See the manual for details." 'head nil) "Draw a boundary at the end of the headers. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1164,7 +1245,7 @@ See the manual for details." (defcustom gnus-treat-capitalize-sentences nil "Capitalize sentence-starting words. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1172,14 +1253,14 @@ See the manual for details." (defcustom gnus-treat-fill-long-lines nil "Fill long lines. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :type gnus-article-treat-custom) (defcustom gnus-treat-play-sounds nil "Play sounds. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1197,7 +1278,7 @@ decode the body, '(or header t) for the whole article, etc." (defcustom gnus-treat-translate nil "Translate articles from one language to another. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." :version "21.1" :group 'gnus-article-treat :type gnus-article-treat-custom) @@ -1206,7 +1287,15 @@ See the manual for details." "Verify X-PGP-Sig. To automatically treat X-PGP-Sig, set it to head. Valid values are nil, t, `head', `last', an integer or a predicate. -See the manual for details." +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :group 'mime-security + :type gnus-article-treat-custom) + +(defcustom gnus-treat-monafy nil + "Display body part with mona font. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." :group 'gnus-article-treat :group 'mime-security :type gnus-article-treat-custom) @@ -1222,6 +1311,9 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) +(defvar gnus-article-wash-function nil + "Function used for converting HTML into text.") + ;;; Internal variables (defvar gnus-english-month-names @@ -1235,15 +1327,17 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist - `((gnus-treat-decode-article-as-default-mime-charset + '((gnus-treat-decode-article-as-default-mime-charset gnus-article-decode-article-as-default-mime-charset) (gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) + (gnus-treat-monafy gnus-article-monafy) (gnus-treat-strip-banner gnus-article-strip-banner) (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) (gnus-treat-buttonize gnus-article-add-buttons) (gnus-treat-fill-article gnus-article-fill-cited-article) (gnus-treat-fill-long-lines gnus-article-fill-long-lines) (gnus-treat-strip-cr gnus-article-remove-cr) + (gnus-treat-unsplit-urls gnus-article-unsplit-urls) (gnus-treat-date-ut gnus-article-date-ut) (gnus-treat-date-local gnus-article-date-local) (gnus-treat-date-english gnus-article-date-english) @@ -1254,8 +1348,6 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-hide-headers gnus-article-maybe-hide-headers) (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) (gnus-treat-hide-signature gnus-article-hide-signature) - (gnus-treat-hide-citation gnus-article-hide-citation) - (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers) (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace) (gnus-treat-strip-pgp gnus-article-hide-pgp) @@ -1264,7 +1356,6 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-mail-picon gnus-treat-mail-picon) (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) (gnus-treat-highlight-headers gnus-article-highlight-headers) - (gnus-treat-highlight-citation gnus-article-highlight-citation) (gnus-treat-highlight-signature gnus-article-highlight-signature) (gnus-treat-strip-trailing-blank-lines gnus-article-remove-trailing-blank-lines) @@ -1274,15 +1365,18 @@ It is a string, such as \"PGP\". If nil, ask user." gnus-article-strip-multiple-blank-lines) (gnus-treat-overstrike gnus-article-treat-overstrike) (gnus-treat-unfold-headers gnus-article-treat-unfold-headers) + (gnus-treat-fold-headers gnus-article-treat-fold-headers) + ;; Displaying X-Face should be done after unfolding headers + ;; to protect bitmap lines. + (gnus-treat-display-xface gnus-article-display-x-face) (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) - (gnus-treat-display-smileys ,(if (or (featurep 'xemacs) - (>= emacs-major-version 21)) - 'gnus-smiley-display - 'gnus-article-smiley-display)) + (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) (gnus-treat-emphasize gnus-article-emphasize) - (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-hide-citation gnus-article-hide-citation) + (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) + (gnus-treat-highlight-citation gnus-article-highlight-citation) (gnus-treat-body-boundary gnus-article-treat-body-boundary) (gnus-treat-play-sounds gnus-earcon-display))) @@ -1294,8 +1388,8 @@ It is a string, such as \"PGP\". If nil, ask user." (let ((table (copy-syntax-table text-mode-syntax-table))) ;; This causes the citation match run O(2^n). ;; (modify-syntax-entry ?- "w" table) - (modify-syntax-entry ?> ")" table) - (modify-syntax-entry ?< "(" table) + (modify-syntax-entry ?> ")<" table) + (modify-syntax-entry ?< "(>" table) table) "Syntax table used in article mode buffers. Initialized from `text-mode-syntax-table.") @@ -1647,13 +1741,18 @@ if given a positive prefix, always hide." 'invisible t))) ;; If the invisible text is not terminated with newline, we ;; won't expose it. Because it may be created by x-face-mule. - ;; BTW, XEmacs sometimes fail in putting a invisible text + ;; BTW, XEmacs sometimes fail in putting an invisible text ;; property with `gnus-article-hide-text' (really?). In that ;; case, the invisible text might be started from the middle of - ;; a line so we will expose the sort of thing. + ;; a line, so we will expose the sort of thing. (when (or (not (or (eq header-start field-start) (eq ?\n (char-before field-start)))) - (eq ?\n (char-before field-end))) + (eq ?\n (char-before field-end)) + ;; Expose a boundary line anyway. + (string-equal + "\nX-Boundary: " + (buffer-substring (max (- field-end 13) header-start) + field-end))) (remove-text-properties field-start field-end gnus-hidden-properties) (put-text-property field-start field-end @@ -1799,14 +1898,54 @@ unfolded." (with-temp-buffer (insert header) (goto-char (point-min)) - (while (re-search-forward "[\t ]*\n[\t ]+" nil t) + (while (re-search-forward "\n[\t ]" nil t) (replace-match " " t t))) (setq length (- (point-max) (point-min) 1))) (when (< length (window-width)) - (while (re-search-forward "[\t ]*\n[\t ]+" nil t) + (while (re-search-forward "\n[\t ]" nil t) (replace-match " " t t))) (goto-char (point-max))))))) +(defun gnus-article-treat-fold-headers () + "Fold message headers." + (interactive) + (gnus-with-article-headers + (while (not (eobp)) + (save-restriction + (mail-header-narrow-to-field) + (mail-header-fold-field) + (goto-char (point-max)))))) + +(defun gnus-treat-smiley () + "Toggle display of textual emoticons (\"smileys\") as small graphical icons." + (interactive) + (unless (featurep 'xemacs) + (when (and (>= emacs-major-version 21) + (not gnus-article-should-use-smiley-mule) + gnus-article-smiley-mule-loaded-p) + (load "smiley" nil t) + (setq gnus-article-smiley-mule-loaded-p nil)) + (when (and gnus-article-should-use-smiley-mule + (not gnus-article-smiley-mule-loaded-p)) + (load "smiley-mule" nil t) + (setq gnus-article-smiley-mule-loaded-p t))) + (gnus-with-article-buffer + (if (memq 'smiley gnus-article-wash-types) + (gnus-delete-images 'smiley) + (article-goto-body) + (let ((images (smiley-region (point) (point-max)))) + (when images + (gnus-add-wash-type 'smiley) + (dolist (image images) + (gnus-add-image 'smiley image))))))) + +(defun gnus-article-remove-images () + "Remove all images from the article buffer." + (interactive) + (gnus-with-article-buffer + (dolist (elem gnus-article-image-alist) + (gnus-delete-images (car elem))))) + (defun gnus-article-treat-fold-newsgroups () "Unfold folded message headers. Only the headers that fit into the current window width will be @@ -1816,7 +1955,7 @@ unfolded." (while (gnus-article-goto-header "newsgroups\\|followup-to") (save-restriction (mail-header-narrow-to-field) - (while (search-forward "," nil t) + (while (re-search-forward ", *" nil t) (replace-match ", " t t)) (mail-header-fold-field) (goto-char (point-max)))))) @@ -1824,13 +1963,19 @@ unfolded." (defun gnus-article-treat-body-boundary () "Place a boundary line at the end of the headers." (interactive) - (gnus-with-article-headers - (goto-char (point-max)) - (let ((start (point))) - (insert "X-Boundary: ") - (gnus-add-text-properties start (point) '(invisible t intangible t)) - (insert (make-string (1- (window-width)) ?-) - "\n")))) + (when (and gnus-body-boundary-delimiter + (> (length gnus-body-boundary-delimiter) 0)) + (gnus-with-article-headers + (goto-char (point-max)) + (let ((start (point))) + (insert "X-Boundary: ") + (gnus-add-text-properties start (point) '(invisible t intangible t)) + (insert (let (str) + (while (>= (1- (window-width)) (length str)) + (setq str (concat str gnus-body-boundary-delimiter))) + (substring str 0 (1- (window-width)))) + "\n") + (gnus-add-text-properties start (point) '(gnus-decoration 'header)))))) (defun article-fill-long-lines () "Fill lines that are wider than the window width." @@ -1893,52 +2038,91 @@ unfolded." (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." (interactive (list 'force)) - (gnus-with-article-headers - ;; Delete the old process, if any. - (when (process-status "article-x-face") - (delete-process "article-x-face")) - (if (memq 'xface gnus-article-wash-types) - ;; We have already displayed X-Faces, so we remove them - ;; instead. - (gnus-delete-images 'xface) - ;; Display X-Faces. - (let (x-faces from face) - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (mail-narrow-to-head) - (while (gnus-article-goto-header "x-face") - (push (mail-header-field-value) x-faces)) - (setq from (message-fetch-field "from")))) - ;; Sending multiple EOFs to xv doesn't work, so we only do a - ;; single external face. - (when (stringp gnus-article-x-face-command) - (setq x-faces (list (car x-faces)))) - (while (and (setq face (pop x-faces)) - gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from))))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command face) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (with-temp-buffer - (insert face) - (process-send-region "article-x-face" (point-min) (point-max))) - (process-send-eof "article-x-face")))))))) + (let ((wash-face-p buffer-read-only)) ;; When type `W f' + (gnus-with-article-headers + ;; Delete the old process, if any. + (when (process-status "article-x-face") + (delete-process "article-x-face")) + (if (memq 'xface gnus-article-wash-types) + ;; We have already displayed X-Faces, so we remove them + ;; instead. + (gnus-delete-images 'xface) + ;; Display X-Faces. + (let (x-faces from face grey) + (save-excursion + (when (and wash-face-p + (progn + (goto-char (point-min)) + (not (re-search-forward + "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t))) + (gnus-buffer-live-p gnus-original-article-buffer)) + ;; If type `W f', use gnus-original-article-buffer, + ;; otherwise use the current buffer because displaying + ;; RFC822 parts calls this function too. + (set-buffer gnus-original-article-buffer)) + (save-restriction + (mail-narrow-to-head) + (if gnus-treat-display-grey-xface + (progn + (while (gnus-article-goto-header "X-Face\\(-[0-9]+\\)?") + (if (match-beginning 2) + (progn + (setq grey t) + (push (cons (- (string-to-number (match-string 2))) + (mail-header-field-value)) + x-faces)) + (push (cons 0 (mail-header-field-value)) x-faces))) + (dolist (x-face (prog1 + (if grey + (sort x-faces 'car-less-than-car) + (nreverse x-faces)) + (setq x-faces nil))) + (push (cdr x-face) x-faces))) + (while (gnus-article-goto-header "X-Face") + (push (mail-header-field-value) x-faces))) + (setq from (message-fetch-field "from")))) + (if grey + (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces)) + image) + (when xpm + (setq image (gnus-create-image xpm 'xpm t)) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-wash-type 'xface) + (gnus-add-image 'xface image) + (gnus-put-image image))) + ;; Sending multiple EOFs to xv doesn't work, so we only do a + ;; single external face. + (when (stringp gnus-article-x-face-command) + (setq x-faces (list (car x-faces)))) + (while (and (setq face (pop x-faces)) + gnus-article-x-face-command + (or force + ;; Check whether this face is censored. + (not gnus-article-x-face-too-ugly) + (and gnus-article-x-face-too-ugly from + (not (string-match gnus-article-x-face-too-ugly + from))))) + ;; We display the face. + (if (symbolp gnus-article-x-face-command) + ;; The command is a lisp function, so we call it. + (if (gnus-functionp gnus-article-x-face-command) + (funcall gnus-article-x-face-command face) + (error "%s is not a function" gnus-article-x-face-command)) + ;; The command is a string, so we interpret the command + ;; as a, well, command, and fork it off. + (let ((process-connection-type nil)) + (process-kill-without-query + (start-process + "article-x-face" nil shell-file-name shell-command-switch + gnus-article-x-face-command)) + (with-temp-buffer + (insert face) + (process-send-region "article-x-face" + (point-min) (point-max))) + (process-send-eof "article-x-face")))))))))) (defun article-decode-mime-words () "Decode all MIME-encoded words in the article." @@ -2105,6 +2289,16 @@ If READ-CHARSET, ask for a coding system." (let ((buffer-read-only nil)) (rfc1843-decode-region (point-min) (point-max))))) +(defun article-unsplit-urls () + "Remove the newlines that some other mailers insert into URLs." + (interactive) + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (while (re-search-forward + "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) + (replace-match "\\1\\3" t))))) + (defun article-wash-html (&optional read-charset) "Format an html article. If READ-CHARSET, ask for a coding system." @@ -2130,14 +2324,43 @@ If READ-CHARSET, ask for a coding system." (save-window-excursion (save-restriction (narrow-to-region (point) (point-max)) - (mm-setup-w3) - (let ((w3-strict-width (window-width)) - (url-standalone-mode t) - (w3-honor-stylesheets nil) - (w3-delay-image-loads t)) - (condition-case var - (w3-region (point-min) (point-max)) - (error)))))))) + (let* ((func (or gnus-article-wash-function mm-text-html-renderer)) + (entry (assq func mm-text-html-washer-alist))) + (if entry + (setq func (cdr entry))) + (cond + ((gnus-functionp func) + (funcall func)) + (t + (apply (car func) (cdr func)))))))))) + +(defun gnus-article-wash-html-with-w3 () + "Wash the current buffer with w3." + (mm-setup-w3) + (let ((w3-strict-width (window-width)) + (url-standalone-mode t) + (url-gateway-unplugged t) + (w3-honor-stylesheets nil)) + (condition-case () + (w3-region (point-min) (point-max)) + (error)))) + +(defun gnus-article-wash-html-with-w3m () + "Wash the current buffer with emacs-w3m." + (mm-setup-w3m) + (save-restriction + (narrow-to-region (point) (point-max)) + (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images + nil + "\\`cid:")) + (w3m-display-inline-images mm-inline-text-html-with-images) + w3m-force-redisplay) + (w3m-region (point-min) (point-max))) + (when mm-inline-text-html-with-w3m-keymap + (add-text-properties + (point-min) (point-max) + (append '(mm-inline-text-html-with-w3m t) + (gnus-local-map-property mm-w3m-mode-map)))))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. @@ -2754,15 +2977,15 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (list t)) (article-date-ut 'iso8601 highlight)) -(defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (widen) - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next)))) +;; (defun article-show-all () +;; "Show all hidden text in the article buffer." +;; (interactive) +;; (save-excursion +;; (widen) +;; (let ((buffer-read-only nil)) +;; (gnus-article-unhide-text (point-min) (point-max)) +;; (gnus-remove-text-with-property 'gnus-prev) +;; (gnus-remove-text-with-property 'gnus-next)))) (defun article-show-all-headers () "Show all hidden headers in the article buffer." @@ -3151,7 +3374,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is mml2015-use (mml2015-clear-verify-function)) (with-temp-buffer - (insert-buffer gnus-original-article-buffer) + (insert-buffer-substring gnus-original-article-buffer) (setq items (split-string sig)) (message-narrow-to-head) (let ((inhibit-point-motion-hooks t) @@ -3219,6 +3442,21 @@ If variable `gnus-use-long-file-name' is non-nil, it is (if (gnus-buffer-live-p gnus-original-article-buffer) (canlock-verify gnus-original-article-buffer))) +(defun article-monafy () + "Display body part with mona font." + (interactive) + (unless (if (featurep 'xemacs) + (find-face 'gnus-mona-face) + (facep 'gnus-mona-face)) + (require 'navi2ch-mona) + (set-face-font (make-face 'gnus-mona-face) navi2ch-mona-font)) + (save-excursion + (let ((buffer-read-only nil)) + (article-goto-body) + (gnus-overlay-put + (gnus-make-overlay (point) (point-max)) + 'face 'gnus-mona-face)))) + (eval-and-compile (mapcar (lambda (func) @@ -3241,6 +3479,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is '(article-hide-headers article-verify-x-pgp-sig article-verify-cancel-lock + article-monafy article-hide-boring-headers article-toggle-headers article-treat-overstrike @@ -3253,6 +3492,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-de-base64-unreadable article-decode-HZ article-wash-html + article-unsplit-urls article-hide-list-identifiers article-hide-pgp article-strip-banner @@ -3281,7 +3521,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-treat-dumbquotes article-normalize-headers (article-show-all-headers . gnus-article-show-all-headers) - (article-show-all . gnus-article-show-all)))) +;; (article-show-all . gnus-article-show-all) + ))) ;;; ;;; Gnus article mode @@ -3304,6 +3545,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ">" end-of-buffer "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug + "R" gnus-article-reply-with-original + "F" gnus-article-followup-with-original "\C-hk" gnus-article-describe-key "\C-hc" gnus-article-describe-key-briefly @@ -3354,6 +3597,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Treat overstrike" gnus-article-treat-overstrike t] ["Remove carriage return" gnus-article-remove-cr t] ["Remove leading whitespace" gnus-article-remove-leading-whitespace t] + ["Treat html" gnus-article-wash-html t] + ["Remove newlines from within URLs" gnus-article-unsplit-urls t] ["Decode HZ" gnus-article-decode-HZ t])) ;; Note "Commands" menu is defined in gnus-sum.el for consistency @@ -3430,7 +3675,7 @@ commands: ;; Init original article buffer. (save-excursion (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) - (set-buffer-multibyte nil) + (set-buffer-multibyte t) (setq major-mode 'gnus-original-article-mode) (make-local-variable 'gnus-original-article)) (if (get-buffer name) @@ -3628,6 +3873,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." gnus-article-mime-handle-alist)) (gnus-set-mode-line 'article)) (article-goto-body) + (unless (bobp) + (forward-line -1)) (set-window-point (get-buffer-window (current-buffer)) (point)) (gnus-configure-windows 'article) t)))))) @@ -3765,14 +4012,19 @@ value of the variable `gnus-show-mime' is non-nil." ;;; (defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" - "The following specs can be used: + "Format of the MIME buttons. + +Valid specifiers include: %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") +%e Dots if the part isn't displayed + +General format specifiers can also be used. See +(gnus)Formatting Variables.") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) @@ -3792,8 +4044,8 @@ value of the variable `gnus-show-mime' is non-nil." (gnus-mime-save-part-and-strip "\C-o" "Save and Strip") (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-view-part-internally "E" "View Internally") + (gnus-mime-view-part-externally "e" "View Externally") (gnus-mime-print-part "p" "Print") (gnus-mime-pipe-part "|" "Pipe To Command...") (gnus-mime-action-on-part "." "Take action on the part"))) @@ -4004,13 +4256,13 @@ value of the variable `gnus-show-mime' is non-nil." (setq buffer-file-name nil)) (goto-char (point-min))))) -(defun gnus-mime-print-part (&optional handle) +(defun gnus-mime-print-part (&optional handle filename) "Print the MIME part under point." - (interactive) + (interactive (list nil (ps-print-preprint current-prefix-arg))) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (file (make-temp-name (expand-file-name "mm." mm-tmp-directory))) + (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) (printer (mailcap-mime-info (mm-handle-type handle) "print"))) (when contents (if printer @@ -4027,7 +4279,8 @@ value of the variable `gnus-show-mime' is non-nil." (delete-file file)) (with-temp-buffer (insert contents) - (gnus-print-buffer)))))) + (gnus-print-buffer)) + (ps-despool filename))))) (defun gnus-mime-inline-part (&optional handle arg) "Insert the MIME part under point into the current buffer." @@ -4082,7 +4335,7 @@ specified charset." (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-article-press-button))))) -(defun gnus-mime-externalize-part (&optional handle) +(defun gnus-mime-view-part-externally (&optional handle) "View the MIME part under point with an external viewer." (interactive) (gnus-article-check-buffer) @@ -4098,7 +4351,7 @@ specified charset." (mm-remove-part handle) (mm-display-part handle))))) -(defun gnus-mime-internalize-part (&optional handle) +(defun gnus-mime-view-part-internally (&optional handle) "View the MIME part under point with an internal viewer. If no internal viewer is available, use an external viewer." (interactive) @@ -4158,10 +4411,10 @@ If no internal viewer is available, use an external viewer." (interactive "p") (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) -(defun gnus-article-externalize-part (n) +(defun gnus-article-view-part-externally (n) "View MIME part N externally, which is the numerical prefix." (interactive "p") - (gnus-article-part-wrapper n 'gnus-mime-externalize-part)) + (gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) (defun gnus-article-inline-part (n) "Inline MIME part N, which is the numerical prefix." @@ -4219,8 +4472,11 @@ If no internal viewer is available, use an external viewer." (let ((window (selected-window)) (mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (if (gnus-buffer-live-p gnus-summary-buffer) + (save-excursion + (set-buffer gnus-summary-buffer) + gnus-newsgroup-ignored-charsets) + nil))) (save-excursion (unwind-protect (let ((win (gnus-get-buffer-window (current-buffer) t)) @@ -4288,14 +4544,11 @@ If no internal viewer is available, use an external viewer." (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist - `(keymap ,gnus-mime-button-map - ,@(if (>= (string-to-number emacs-version) 21) - nil - (list 'local-map gnus-mime-button-map)) - gnus-callback gnus-mm-display-part - gnus-part ,gnus-tmp-id - article-type annotation - gnus-data ,handle)) + `(,@(gnus-local-map-property 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 @@ -4339,7 +4592,9 @@ If no internal viewer is available, use an external viewer." ;; 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))) + (let* ((handles (or ihandles (mm-dissect-buffer + nil gnus-article-loose-mime) + (mm-uu-dissect))) buffer-read-only handle name type b e display) (when (and (not ihandles) (not gnus-displaying-mime)) @@ -4548,12 +4803,9 @@ If no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',not-pref ',begend ,id)) - ,@(if (>= (string-to-number emacs-version) 21) - nil ;; XEmacs doesn't care - (list 'local-map gnus-mime-button-map)) + ,@(gnus-local-map-property 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) @@ -4575,12 +4827,9 @@ If no internal viewer is available, use an external viewer." ',gnus-article-mime-handle-alist)) (gnus-mime-display-alternative ',ihandles ',handle ',begend ,id)) - ,@(if (>= (string-to-number emacs-version) 21) - nil ;; XEmacs doesn't care - (list 'local-map gnus-mime-button-map)) + ,@(gnus-local-map-property 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) @@ -4669,7 +4918,7 @@ is the string to use when it is inactive.") (defun gnus-add-wash-type (type) "Add a washing of TYPE to the current status." - (push type gnus-article-wash-types)) + (add-to-list 'gnus-article-wash-types type)) (defun gnus-delete-wash-type (type) "Add a washing of TYPE to the current status." @@ -4884,7 +5133,7 @@ Argument LINES specifies lines to be scrolled down." (interactive "P") (gnus-article-check-buffer) (let ((nosaves - '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" + '("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f" "Zc" "ZC" "ZE" "ZJ" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "^" "\M-^" "|")) (nosave-but-article @@ -4997,6 +5246,39 @@ Argument LINES specifies lines to be scrolled down." (describe-key-briefly key insert)) (describe-key-briefly key insert))) +(defun gnus-article-reply-with-original (&optional wide) + "Start composing a reply mail to the current message. +The text in the region will be yanked. If the region isn't active, +the entire article will be yanked." + (interactive "P") + (let ((article (cdr gnus-article-current)) cont) + (if (not (mark t)) + (gnus-summary-reply (list (list article)) wide) + (setq cont (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (gnus-summary-reply + (list (list article cont)) wide)))) + +(defun gnus-article-followup-with-original () + "Compose a followup to the current article. +The text in the region will be yanked. If the region isn't active, +the entire article will be yanked." + (interactive) + (let ((article (cdr gnus-article-current)) + cont) + (if (not (mark t)) + (gnus-summary-followup (list (list article))) + (setq cont (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (gnus-summary-followup + (list (list article cont)))))) + (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) @@ -5021,11 +5303,12 @@ If given a prefix, show the hidden text instead." (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (gnus-request-group gnus-newsgroup-name t))) +(eval-when-compile + (autoload 'nneething-get-file-name "nneething")) + (defun gnus-request-article-this-buffer (article group) - "Get an article and insert it into this buffer. -T-gnus change: Insert an article into `gnus-original-article-buffer'." + "Get an article and insert it into this buffer." (let (do-update-line sparse-header) - ;; The current buffer is `gnus-article-buffer'. (prog1 (save-excursion (erase-buffer) @@ -5072,24 +5355,12 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." gnus-newsgroup-name))) (when (and (eq (car method) 'nneething) (vectorp header)) - (let ((dir (expand-file-name - (mail-header-subject header) - (file-name-as-directory - (or (cadr (assq 'nneething-address method)) - (nth 1 method)))))) - (when (file-directory-p dir) + (let ((dir (nneething-get-file-name + (mail-header-id header)))) + (when (and (stringp dir) + (file-directory-p dir)) (setq article 'nneething) (gnus-group-enter-directory dir)))))))) - (setq gnus-original-article (cons group article)) - - ;; The current buffer is `gnus-original-article-buffer'. - (if (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (set-buffer (gnus-get-buffer-create gnus-original-article-buffer)) - (set-buffer-multibyte nil) - (buffer-disable-undo) - (setq major-mode 'gnus-original-article-mode) - (setq buffer-read-only nil)) (cond ;; Refuse to select canceled articles. @@ -5102,6 +5373,15 @@ T-gnus change: Insert an article into `gnus-original-article-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))) @@ -5117,12 +5397,19 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (numberp article) (gnus-cache-request-article article group)) 'article) + ;; Check the agent cache. + ((and gnus-agent gnus-agent-cache gnus-plugged + (numberp article) + (gnus-agent-request-article article group)) + 'article) ;; Get the article and put into the article buffer. ((or (stringp article) (numberp article)) (let ((gnus-override-method gnus-override-method) (methods (and (stringp article) gnus-refer-article-method)) + (backend (car (gnus-find-method-for-group + gnus-newsgroup-name))) result (buffer-read-only nil)) (if (or (not (listp methods)) @@ -5141,7 +5428,8 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (gnus-kill-all-overlays) (let ((gnus-newsgroup-name group)) (gnus-check-group-server)) - (when (gnus-request-article article group (current-buffer)) + (cond + ((gnus-request-article article group (current-buffer)) (when (numberp article) (gnus-async-prefetch-next group article gnus-summary-buffer) @@ -5149,10 +5437,13 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (gnus-backlog-enter-article group article (current-buffer)))) (setq result 'article)) - (if (not result) - (if methods - (setq gnus-override-method (pop methods)) - (setq result 'done)))) + (methods + (setq gnus-override-method (pop methods))) + ((not (string-match "^400 " + (nnheader-get-report backend))) + ;; If we get 400 server disconnect, reconnect and + ;; retry; otherwise, assume the article has expired. + (setq result 'done)))) (and (eq result 'article) 'article))) ;; It was a pseudo. (t article))) @@ -5160,15 +5451,27 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." ;; Associate this article with the current summary buffer. (setq gnus-article-current-summary gnus-summary-buffer) - ;; Copy the requested article from `gnus-original-article-buffer'. - (unless (equal (buffer-name (current-buffer)) - (buffer-name (get-buffer gnus-original-article-buffer))) - (insert-buffer gnus-original-article-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) + (equal (buffer-name (current-buffer)) + (buffer-name (get-buffer gnus-article-buffer)))) + (save-excursion + (if (get-buffer gnus-original-article-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)) + (let (buffer-read-only) + (erase-buffer) + (insert-buffer-substring gnus-article-buffer)) + (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) + ;; 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 @@ -5203,17 +5506,67 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." ;; Should we be using derived.el for this? (unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (make-sparse-keymap)) + (setq gnus-article-edit-mode-map (make-keymap)) (set-keymap-parent gnus-article-edit-mode-map text-mode-map) (gnus-define-keys gnus-article-edit-mode-map + "\C-c?" describe-mode "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit) + "\C-c\C-k" gnus-article-edit-exit + "\C-c\C-f\C-t" message-goto-to + "\C-c\C-f\C-o" message-goto-from + "\C-c\C-f\C-b" message-goto-bcc + ;;"\C-c\C-f\C-w" message-goto-fcc + "\C-c\C-f\C-c" message-goto-cc + "\C-c\C-f\C-s" message-goto-subject + "\C-c\C-f\C-r" message-goto-reply-to + "\C-c\C-f\C-n" message-goto-newsgroups + "\C-c\C-f\C-d" message-goto-distribution + "\C-c\C-f\C-f" message-goto-followup-to + "\C-c\C-f\C-m" message-goto-mail-followup-to + "\C-c\C-f\C-k" message-goto-keywords + "\C-c\C-f\C-u" message-goto-summary + "\C-c\C-f\C-i" message-insert-or-toggle-importance + "\C-c\C-f\C-a" message-gen-unsubscribed-mft + "\C-c\C-b" message-goto-body + "\C-c\C-i" message-goto-signature + + "\C-c\C-t" message-insert-to + "\C-c\C-n" message-insert-newsgroups + "\C-c\C-o" message-sort-headers + "\C-c\C-e" message-elide-region + "\C-c\C-v" message-delete-not-region + "\C-c\C-z" message-kill-to-signature + "\M-\r" message-newline-and-reformat + "\C-c\C-a" mml-attach-file + "\C-a" message-beginning-of-line + "\t" message-tab + "\M-;" comment-region) (gnus-define-keys (gnus-article-edit-wash-map "\C-c\C-w" gnus-article-edit-mode-map) "f" gnus-article-edit-full-stops)) +(easy-menu-define + gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" + '("Field" + ["Fetch To" message-insert-to t] + ["Fetch Newsgroups" message-insert-newsgroups t] + "----" + ["To" message-goto-to t] + ["From" message-goto-from t] + ["Subject" message-goto-subject t] + ["Cc" message-goto-cc t] + ["Reply-To" message-goto-reply-to t] + ["Summary" message-goto-summary t] + ["Keywords" message-goto-keywords t] + ["Newsgroups" message-goto-newsgroups t] + ["Followup-To" message-goto-followup-to t] + ["Mail-Followup-To" message-goto-mail-followup-to t] + ["Distribution" message-goto-distribution t] + ["Body" message-goto-body t] + ["Signature" message-goto-signature t])) + (define-derived-mode gnus-article-edit-mode text-mode "Article Edit" "Major mode for editing articles. This is an extended text-mode. @@ -5223,6 +5576,8 @@ This is an extended text-mode. (make-local-variable 'gnus-prev-winconf) (set (make-local-variable 'font-lock-defaults) '(message-font-lock-keywords t)) + (set (make-local-variable 'mail-header-separator) "") + (easy-menu-add message-mode-field-menu message-mode-map) (setq buffer-read-only nil) (buffer-enable-undo) (widen)) @@ -5264,39 +5619,31 @@ groups." (interactive "P") (let ((func gnus-article-edit-done-function) (buf (current-buffer)) - (start (window-start))) + (start (window-start)) + (p (point)) + (winconf gnus-prev-winconf)) (remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind) - ;; We remove all text props from the article buffer. - (let ((content - (buffer-substring-no-properties (point-min) (point-max))) - (p (point))) - (erase-buffer) - (insert content) - (let ((winconf gnus-prev-winconf)) - (gnus-article-mode) - (set-window-configuration winconf) - ;; Tippy-toe some to make sure that point remains where it was. - (save-current-buffer - (set-buffer buf) - (set-window-start (get-buffer-window (current-buffer)) start) - (goto-char p)))) + (widen) ;; Widen it in case that users narrowed the buffer. + (funcall func arg) + (set-buffer buf) + ;; 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 - (set-buffer buf) - (let ((buffer-read-only nil)) - (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)))) + (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))) + ;; We remove all text props from the article buffer. + (kill-all-local-variables) + (gnus-set-text-properties (point-min) (point-max) nil) + (gnus-article-mode) + (set-window-configuration winconf) (set-buffer buf) (set-window-start (get-buffer-window buf) start) (set-window-point (get-buffer-window buf) (point)))) @@ -5311,7 +5658,7 @@ groups." (window-start (window-start))) (erase-buffer) (if (gnus-buffer-live-p gnus-original-article-buffer) - (insert-buffer gnus-original-article-buffer)) + (insert-buffer-substring gnus-original-article-buffer)) (let ((winconf gnus-prev-winconf)) (gnus-article-mode) (set-window-configuration winconf) @@ -5381,7 +5728,7 @@ after replacing with the original article." 'gnus-article-mime-edit-exit gnus-article-edit-mode-map) (erase-buffer) - (insert-buffer gnus-original-article-buffer) + (insert-buffer-substring gnus-original-article-buffer) (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer))) (fset 'mime-edit-decode-single-part-in-buffer (lambda (&rest args) @@ -5470,9 +5817,9 @@ after replacing with the original article." ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-handle-info 2) ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 0 t gnus-button-embedded-url 1) + ("]*\\)>" 1 t gnus-button-embedded-url 1) ;; Raw URLs. - (,gnus-button-url-regexp 0 t browse-url 0)) + (gnus-button-url-regexp 0 t browse-url 0)) "*Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where @@ -5486,7 +5833,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function." :group 'gnus-article-buttons - :type '(repeat (list regexp + :type '(repeat (list (choice regexp variable) (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -5503,6 +5850,7 @@ variable it the real callback function." ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0) ("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0) ("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0) + ("^[^:]+:" "\\bmailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t gnus-button-message-id 3)) "*Alist of headers and regexps to match buttons in article heads. @@ -5713,7 +6061,7 @@ specified by `gnus-button-alist'." (article-goto-body) (setq beg (point)) (while (setq entry (pop alist)) - (setq regexp (car entry)) + (setq regexp (eval (car entry))) (goto-char beg) (while (re-search-forward regexp nil t) (let* ((start (and entry (match-beginning (nth 1 entry)))) @@ -5822,7 +6170,7 @@ specified by `gnus-button-alist'." (entry nil)) (while alist (setq entry (pop alist)) - (if (looking-at (car entry)) + (if (looking-at (eval (car entry))) (setq alist nil) (setq entry nil))) entry)) @@ -5936,7 +6284,7 @@ specified by `gnus-button-alist'." (if (not (string-match "=" cur)) nil ; Grace (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) - val (gnus-url-unhex-string (substring cur (match-end 0) nil))) + val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) (if downcase (setq key (downcase key))) (setq cur (assoc key retval)) @@ -5973,51 +6321,46 @@ specified by `gnus-button-alist'." "Activate ADDRESS with `browse-url'." (browse-url (gnus-strip-whitespace address))) -(eval-when-compile - ;; Silence the byte-compiler. - (autoload 'smiley-toggle-buffer "gnus-bitmap")) -(defun gnus-article-smiley-display () - "Display \"smileys\" as small graphical icons." - (smiley-toggle-buffer 1 (current-buffer) (point-min) (point-max))) - ;;; Next/prev buttons in the article buffer. (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") -(defvar gnus-prev-page-map nil) -(unless gnus-prev-page-map - (setq gnus-prev-page-map (make-sparse-keymap)) - (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) - (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) +(defvar gnus-prev-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-prev-page) + (define-key map "\r" 'gnus-button-prev-page) + map)) -(static-if (featurep 'xemacs) - (defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil)) - (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 - article-type annotation)))) - (defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil) - (situation (get-text-property (point-min) 'mime-view-situation))) - (set-keymap-parent gnus-prev-page-map (current-local-map)) - (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 - article-type annotation - mime-view-situation ,situation)))) - ) +(defun gnus-insert-prev-page-button () + (let ((b (point)) + (buffer-read-only nil) + (situation (get-text-property (point-min) 'mime-view-situation))) + (gnus-eval-format + gnus-prev-page-line-format nil + `(,@(gnus-local-map-property gnus-prev-page-map) + gnus-prev t + gnus-callback gnus-article-button-prev-page + article-type annotation + mime-view-situation ,situation)) + (widget-convert-button + 'link b (point) + :action 'gnus-button-prev-page + :button-keymap gnus-prev-page-map))) -(defvar gnus-next-page-map nil) -(unless gnus-next-page-map - (setq gnus-next-page-map (make-sparse-keymap)) - (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) - (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) +(defvar gnus-next-page-map + (let ((map (make-sparse-keymap))) + (unless (>= emacs-major-version 21) + ;; XEmacs doesn't care. + (set-keymap-parent map gnus-article-mode-map)) + (define-key map gnus-mouse-2 'gnus-button-next-page) + (define-key map "\r" 'gnus-button-next-page) + map)) -(defun gnus-button-next-page () +(defun gnus-button-next-page (&optional args more-args) "Go to the next page." (interactive) (let ((win (selected-window))) @@ -6025,7 +6368,7 @@ specified by `gnus-button-alist'." (gnus-article-next-page) (select-window win))) -(defun gnus-button-prev-page () +(defun gnus-button-prev-page (&optional args more-args) "Go to the prev page." (interactive) (let ((win (selected-window))) @@ -6033,25 +6376,20 @@ specified by `gnus-button-alist'." (gnus-article-prev-page) (select-window win))) -(static-if (featurep 'xemacs) - (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 - article-type annotation)))) - (defun gnus-insert-next-page-button () - (let ((buffer-read-only nil) - (situation (get-text-property (point-min) 'mime-view-situation))) - (set-keymap-parent gnus-next-page-map (current-local-map)) - (gnus-eval-format gnus-next-page-line-format nil - `(gnus-next - t local-map ,gnus-next-page-map +(defun gnus-insert-next-page-button () + (let ((b (point)) + (buffer-read-only nil) + (situation (get-text-property (point-min) 'mime-view-situation))) + (gnus-eval-format gnus-next-page-line-format nil + `(,@(gnus-local-map-property gnus-next-page-map) + gnus-next t gnus-callback gnus-article-button-next-page article-type annotation - mime-view-situation ,situation)))) - ) + mime-view-situation ,situation)) + (widget-convert-button + 'link b (point) + :action 'gnus-button-next-page + :button-keymap gnus-next-page-map))) (defun gnus-article-button-next-page (arg) "Go to the next page." @@ -6075,11 +6413,11 @@ specified by `gnus-button-alist'." 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 +\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups whose names match REGEXP. For example: -((\"chinese\" . gnus-decode-encoded-word-region-by-guess) +\((\"chinese\" . gnus-decode-encoded-word-region-by-guess) mail-decode-encoded-word-region (\"chinese\" . rfc1843-decode-region)) ") @@ -6398,14 +6736,11 @@ For example: (gnus-eval-format gnus-mime-security-button-line-format gnus-mime-security-button-line-format-alist - `(keymap ,gnus-mime-security-button-map - ,@(if (>= (string-to-number emacs-version) 21) - nil ;; XEmacs doesn't care - (list 'local-map gnus-mime-security-button-map)) - gnus-callback gnus-mime-security-press-button - gnus-line-format ,gnus-mime-security-button-line-format - article-type annotation - gnus-data ,handle)) + `(,@(gnus-local-map-property gnus-mime-security-button-map) + gnus-callback gnus-mime-security-press-button + gnus-line-format ,gnus-mime-security-button-line-format + article-type annotation + gnus-data ,handle)) (setq e (point)) (widget-convert-button 'link b e