X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=496d4b918489bf2c8a60c40daf620a4aa0ebc512;hb=5b258ce0d93a0e07c081f72b1338a5e86bd96754;hp=cdb8ab9e4fc49c5f5dfc46b31baaf9a603fed54c;hpb=fafd03137cfa5d2c6a65c94228160fb8193bfee5;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index cdb8ab9e4..496d4b918 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -32,6 +32,7 @@ (require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) +(require 'gnus-win) (require 'mm-bodies) (require 'mail-parse) (require 'mm-decode) @@ -110,7 +111,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.*:" @@ -137,7 +138,11 @@ "^X-Abuse-Info:" "^X-From_:" "^X-Accept-Language:" "^Errors-To:" "^X-BeenThere:" "^X-Mailman-Version:" "^List-Help:" "^List-Post:" "^List-Subscribe:" "^List-Id:" "^List-Unsubscribe:" "^List-Archive:" - "^X-Content-length:" "^X-Posting-Agent:") + "^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-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." @@ -220,20 +225,21 @@ regexp. If it matches, the text in question is not a signature." ;; Fixme: This isn't the right thing for mixed graphical and and ;; non-graphical frames in a session. -;; gnus-xmas.el overrides this for XEmacs. (defcustom gnus-article-x-face-command - (if (and (fboundp 'image-type-available-p) - (image-type-available-p 'xbm)) - 'gnus-article-display-xface - (if gnus-article-compface-xbm - "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -" + (if (featurep 'xemacs) + (if (or (gnus-image-type-available-p 'xface) + (gnus-image-type-available-p 'pbm)) + 'gnus-display-x-face-in-from + "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -") + (if (gnus-image-type-available-p 'pbm) + 'gnus-display-x-face-in-from "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ display -")) "*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 '(choice string - (function-item gnus-article-display-xface) + :type `(choice string + (function-item gnus-display-x-face-in-from) function) :version "21.1" :group 'gnus-article-washing) @@ -274,23 +280,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) (cadr 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: @@ -403,6 +409,7 @@ Gnus provides the following functions: * gnus-summary-save-in-mail (Unix mail format) * gnus-summary-save-in-folder (MH folder) * gnus-summary-save-in-file (article format) +* gnus-summary-save-body-in-file (article body) * gnus-summary-save-in-vm (use VM's folder format) * gnus-summary-write-to-file (article format -- overwrite)." :group 'gnus-article-saving @@ -410,6 +417,7 @@ Gnus provides the following functions: (function-item gnus-summary-save-in-mail) (function-item gnus-summary-save-in-folder) (function-item gnus-summary-save-in-file) + (function-item gnus-summary-save-body-in-file) (function-item gnus-summary-save-in-vm) (function-item gnus-summary-write-to-file))) @@ -631,7 +639,8 @@ displayed by the first non-nil matching CONTENT face." (face :value default))))) (defcustom gnus-article-decode-hook - '(article-decode-charset article-decode-encoded-words) + '(article-decode-charset article-decode-encoded-words + article-decode-group-name) "*Hook run to decode charsets in articles." :group 'gnus-article-headers :type 'hook) @@ -672,11 +681,44 @@ displayed by the first non-nil matching CONTENT face." :type '(repeat regexp)) (defcustom gnus-unbuttonized-mime-types '(".*/.*") - "List of MIME types that should not be given buttons when rendered inline." + "List of MIME types that should not be given buttons when rendered inline. +See also `gnus-buttonized-mime-types' which may override this variable." :version "21.1" :group 'gnus-article-mime :type '(repeat regexp)) +(defcustom gnus-buttonized-mime-types nil + "List of MIME types that should be given buttons when rendered inline. +If set, this variable overrides `gnus-unbuttonized-mime-types'. +To see e.g. security buttons you could set this to +`(\"multipart/signed\")'." + :version "21.1" + :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 'directory + :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 @@ -776,7 +818,7 @@ used." (defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard")) "Highlight 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'." :group 'gnus-article-treat :type gnus-article-treat-custom) (put 'gnus-treat-highlight-signature 'highlight t) @@ -784,7 +826,7 @@ See the manual for details." (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) @@ -792,7 +834,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) @@ -804,7 +846,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) @@ -812,70 +854,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." - :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) @@ -883,14 +925,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) @@ -898,14 +940,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) @@ -913,7 +955,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) @@ -921,42 +963,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) @@ -965,14 +1007,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) @@ -980,28 +1022,49 @@ 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 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 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) @@ -1010,16 +1073,28 @@ See the manual for details." (and (or (and (fboundp 'image-type-available-p) (image-type-available-p 'xbm) (string-match "^0x" (shell-command-to-string "uncompface"))) - (and (featurep 'xemacs) (featurep 'xface))) + (and (featurep 'xemacs) + (featurep 'xface))) '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-treat-display-grey-xface + (and (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)) @@ -1028,24 +1103,65 @@ See the manual for details." t 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-display-picons (if (featurep 'xemacs) 'head nil) - "Display picons. +(defcustom gnus-treat-from-picon + (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 Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." + :group 'gnus-article-treat + :type gnus-article-treat-head-custom) +(put 'gnus-treat-from-picon 'highlight t) + +(defcustom gnus-treat-mail-picon + (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 Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." + :group 'gnus-article-treat + :type gnus-article-treat-head-custom) +(put 'gnus-treat-mail-picon 'highlight t) + +(defcustom gnus-treat-newsgroups-picon + (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 :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-picons 'highlight t) +(put 'gnus-treat-newsgroups-picon 'highlight t) + +(defcustom gnus-treat-body-boundary + (if (or gnus-treat-newsgroups-picon + gnus-treat-mail-picon + gnus-treat-from-picon) + 'head nil) + "Draw a boundary at the end of the headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :version "21.1" + :group 'gnus-article-treat + :type gnus-article-treat-custom) (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) @@ -1053,14 +1169,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) @@ -1068,7 +1184,7 @@ See the manual for details." (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) @@ -1077,7 +1193,7 @@ 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) @@ -1093,6 +1209,16 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) +(defcustom gnus-article-wash-function + (cond ((locate-library "w3") + 'gnus-article-wash-html-with-w3) + ((locate-library "w3m") + 'gnus-article-wash-html-with-w3m)) + "Function used for converting HTML into text." + :type '(radio (function-item gnus-article-wash-html-with-w3) + (function-item gnus-article-wash-html-with-w3m)) + :group 'gnus-article) + ;;; Internal variables (defvar gnus-english-month-names @@ -1102,6 +1228,7 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar article-goto-body-goes-to-point-min-p nil) (defvar gnus-article-wash-types nil) (defvar gnus-article-emphasis-alist nil) +(defvar gnus-article-image-alist nil) (defvar gnus-article-mime-handle-alist-1 nil) (defvar gnus-treatment-function-alist @@ -1113,8 +1240,7 @@ It is a string, such as \"PGP\". If nil, ask user." (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-emphasize gnus-article-emphasize) - (gnus-treat-display-xface gnus-article-display-x-face) + (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) @@ -1122,17 +1248,18 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-date-original gnus-article-date-original) (gnus-treat-date-user-defined gnus-article-date-user) (gnus-treat-date-iso8601 gnus-article-date-iso8601) + (gnus-treat-display-xface gnus-article-display-x-face) (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) (gnus-treat-strip-pem gnus-article-hide-pem) + (gnus-treat-from-picon gnus-treat-from-picon) + (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) @@ -1141,10 +1268,17 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-strip-multiple-blank-lines 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) + (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) - (gnus-treat-display-smileys gnus-smiley-display) + (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) - (gnus-treat-display-picons gnus-article-display-picons) + (gnus-treat-emphasize gnus-article-emphasize) + (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))) (defvar gnus-article-mime-handle-alist nil) @@ -1172,6 +1306,34 @@ Initialized from `text-mode-syntax-table.") (defvar gnus-inhibit-hiding nil) +;;; Macros for dealing with the article buffer. + +(defmacro gnus-with-article-headers (&rest forms) + `(save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (let ((buffer-read-only nil) + (inhibit-point-motion-hooks t) + (case-fold-search t)) + (article-narrow-to-head) + ,@forms)))) + +(put 'gnus-with-article-headers 'lisp-indent-function 0) +(put 'gnus-with-article-headers 'edebug-form-spec '(body)) + +(defmacro gnus-with-article-buffer (&rest forms) + `(save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + ,@forms))) + +(put 'gnus-with-article-buffer 'lisp-indent-function 0) +(put 'gnus-with-article-buffer 'edebug-form-spec '(body)) + +(defun gnus-article-goto-header (header) + "Go to HEADER, which is a regular expression." + (re-search-forward (concat "^\\(" header "\\):") nil t)) + (defsubst gnus-article-hide-text (b e props) "Set text PROPS on the B to E region, extending `intangible' 1 past B." (gnus-add-text-properties-when 'article-type nil b e props) @@ -1189,14 +1351,13 @@ Initialized from `text-mode-syntax-table.") (defun gnus-article-hide-text-type (b e type) "Hide text of TYPE between B and E." - (push type gnus-article-wash-types) + (gnus-add-wash-type type) (gnus-article-hide-text b e (cons 'article-type (cons type gnus-hidden-properties)))) (defun gnus-article-unhide-text-type (b e type) "Unhide text of TYPE between B and E." - (setq gnus-article-wash-types - (delq type gnus-article-wash-types)) + (gnus-delete-wash-type type) (remove-text-properties b e (cons 'article-type (cons type gnus-hidden-properties))) (when (memq 'intangible gnus-hidden-properties) @@ -1295,7 +1456,7 @@ Initialized from `text-mode-syntax-table.") (when (setq beg (text-property-any (point-min) (point-max) 'message-rank (+ 2 max))) ;; We delete the unwanted headers. - (push 'headers gnus-article-wash-types) + (gnus-add-wash-type 'headers) (add-text-properties (point-min) (+ 5 (point-min)) '(article-type headers dummy-invisible t)) (delete-region beg (point-max)))))))) @@ -1519,6 +1680,89 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (put-text-property (point) (1+ (point)) 'face 'underline))))))))) +(defun gnus-article-treat-unfold-headers () + "Unfold folded message headers. +Only the headers that fit into the current window width will be +unfolded." + (interactive) + (gnus-with-article-headers + (let (length) + (while (not (eobp)) + (save-restriction + (mail-header-narrow-to-field) + (let ((header (buffer-substring (point-min) (point-max)))) + (with-temp-buffer + (insert header) + (goto-char (point-min)) + (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 "\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) + (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 +unfolded." + (interactive) + (gnus-with-article-headers + (while (gnus-article-goto-header "newsgroups\\|followup-to") + (save-restriction + (mail-header-narrow-to-field) + (while (re-search-forward ", *" nil t) + (replace-match ", " t t)) + (mail-header-fold-field) + (goto-char (point-max)))))) + +(defun gnus-article-treat-body-boundary () + "Place a boundary line at the end of the headers." + (interactive) + (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." (interactive) @@ -1580,79 +1824,68 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." (interactive (list 'force)) - (save-excursion - ;; Delete the old process, if any. - (when (process-status "article-x-face") - (delete-process "article-x-face")) - (let ((inhibit-point-motion-hooks t) - x-faces - (case-fold-search t) - from last) - (save-restriction - (article-narrow-to-head) - (when (and buffer-read-only ;; When type `W f' - (progn - (goto-char (point-min)) - (not (re-search-forward "^X-Face:[\t ]*" nil t))) - (gnus-buffer-live-p gnus-original-article-buffer)) - (with-current-buffer gnus-original-article-buffer - (save-restriction - (article-narrow-to-head) - (while (re-search-forward "^X-Face:" nil t) - (setq x-faces - (concat - (or x-faces "") - (buffer-substring - (match-beginning 0) - (1- (re-search-forward - "^\\($\\|[^ \t]\\)" nil t)))))))) - (if x-faces - (let (point start bface eface buffer-read-only) - (goto-char (point-max)) - (forward-line -1) - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) 'face)) - (goto-char (point-max)) - (setq point (point)) - (insert x-faces) - (goto-char point) - (while (looking-at "\\([^:]+\\): *") - (put-text-property (match-beginning 1) (1+ (match-end 1)) - 'face bface) - (setq start (match-end 0)) - (forward-line 1) - (while (looking-at "[\t ]") - (forward-line 1)) - (put-text-property start (point) - 'face eface))))) - (goto-char (point-min)) - (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) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from)))) - ;; Has to be present. - (re-search-forward "^X-Face:[\t ]*" 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. + (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 - (let ((beg (point)) - (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) + (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) + (let ((regexp + (if gnus-treat-display-grey-xface + "x-face\\(-[0-9]+\\)?" + "x-face"))) + (while (gnus-article-goto-header regexp) + (when (match-beginning 2) + (setq grey t)) + (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 beg end) + (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. @@ -1661,7 +1894,10 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (start-process "article-x-face" nil shell-file-name shell-command-switch gnus-article-x-face-command)) - (process-send-region "article-x-face" beg end) + (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 () @@ -1737,6 +1973,29 @@ If PROMPT (the prefix), prompt for a coding system to use." (article-narrow-to-head) (funcall gnus-decode-header-function (point-min) (point-max))))) +(defun article-decode-group-name () + "Decode group names in `Newsgroups:'." + (let ((inhibit-point-motion-hooks t) + buffer-read-only + (method (gnus-find-method-for-group gnus-newsgroup-name))) + (when (and (or gnus-group-name-charset-method-alist + gnus-group-name-charset-group-alist) + (gnus-buffer-live-p gnus-original-article-buffer)) + (when (nnmail-fetch-field "Newsgroups") + (nnheader-replace-header "Newsgroups" + (gnus-decode-newsgroups + (with-current-buffer + gnus-original-article-buffer + (nnmail-fetch-field "Newsgroups")) + gnus-newsgroup-name method))) + (when (nnmail-fetch-field "Followup-To") + (nnheader-replace-header "Followup-To" + (gnus-decode-newsgroups + (with-current-buffer + gnus-original-article-buffer + (nnmail-fetch-field "Followup-To")) + gnus-newsgroup-name method)))))) + (defun article-de-quoted-unreadable (&optional force read-charset) "Translate a quoted-printable-encoded article. If FORCE, decode the article whether it is marked as quoted-printable @@ -1812,6 +2071,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." @@ -1837,12 +2106,36 @@ 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)) - (condition-case var - (w3-region (point-min) (point-max)) - (error)))))))) + (funcall gnus-article-wash-function)))))) + +(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) + (w3-delay-image-loads t)) + (condition-case var + (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. @@ -1877,7 +2170,7 @@ The `gnus-list-identifiers' variable specifies what to do." (article-goto-body) ;; Hide the "header". (when (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (push 'pgp gnus-article-wash-types) + (gnus-add-wash-type 'pgp) (delete-region (match-beginning 0) (match-end 0)) ;; Remove armor headers (rfc2440 6.2) (delete-region (point) (or (re-search-forward "^[ \t]*\n" nil t) @@ -1917,7 +2210,7 @@ always hide." "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" nil t) (setq end (1+ (match-beginning 0)))) - (push 'pem gnus-article-wash-types) + (gnus-add-wash-type 'pem) (gnus-article-hide-text-type end (if (search-forward "\n\n" nil t) @@ -1983,7 +2276,8 @@ always hide." (let ((buffer-read-only nil)) (when (gnus-article-narrow-to-signature) (gnus-article-hide-text-type - (point-min) (point-max) 'signature))))))) + (point-min) (point-max) 'signature)))))) + (gnus-set-mode-line 'article)) (defun article-strip-headers-in-body () "Strip offensive headers from bodies." @@ -2135,7 +2429,7 @@ Put point at the beginning of the signature separator." (defun gnus-article-check-hidden-text (type arg) "Return nil if hiding is necessary. -Arg can be nil or a number. Nil and positive means hide, negative +Arg can be nil or a number. nil and positive means hide, negative means show, 0 means toggle." (save-excursion (save-restriction @@ -2175,7 +2469,8 @@ Originally it is hide instead of DUMMY." 'article-type type (point-min) (point-max) (cons 'article-type (cons type - gnus-hidden-properties))))) + gnus-hidden-properties))) + (gnus-delete-wash-type type))) (defconst article-time-units `((year . ,(* 365.25 24 60 60)) @@ -2426,12 +2721,12 @@ 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 - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max))))) +;; (defun article-show-all () +;; "Show all hidden text in the article buffer." +;; (interactive) +;; (save-excursion +;; (let ((buffer-read-only nil)) +;; (gnus-article-unhide-text (point-min) (point-max))))) (defun article-remove-leading-whitespace () "Remove excessive whitespace from all headers." @@ -2469,13 +2764,13 @@ This format is defined by the `gnus-article-time-format' variable." face (nth 3 elem)) (while (re-search-forward regexp nil t) (when (and (match-beginning visible) (match-beginning invisible)) - (push 'emphasis gnus-article-wash-types) (gnus-article-hide-text (match-beginning invisible) (match-end invisible) props) (gnus-article-unhide-text-type (match-beginning visible) (match-end visible) 'emphasis) - (gnus-put-text-property-excluding-newlines + (gnus-put-overlay-excluding-newlines (match-beginning visible) (match-end visible) 'face face) + (gnus-add-wash-type 'emphasis) (goto-char (match-end invisible))))))))) (defun gnus-article-setup-highlight-words (&optional highlight-words) @@ -2677,7 +2972,7 @@ Directory to save to is default to `gnus-article-save-directory'." filename) (defun gnus-summary-write-to-file (&optional filename) - "Write this article to a file. + "Write this article to a file, overwriting it if the file exists. Optional argument FILENAME specifies file name. The directory to save in defaults to `gnus-article-save-directory'." (gnus-summary-save-in-file nil t)) @@ -2726,6 +3021,13 @@ The directory to save in defaults to `gnus-article-save-directory'." (shell-command-on-region (point-min) (point-max) command nil))) (setq gnus-last-shell-command command)) +(defun gnus-summary-pipe-to-muttprint (&optional command) + "Pipe this article to muttprint." + (setq command (read-string + "Print using command: " gnus-summary-muttprint-program + nil gnus-summary-muttprint-program)) + (gnus-summary-save-in-pipe command)) + ;;; Article file names when saving. (defun gnus-capitalize-newsgroup (newsgroup) @@ -2865,6 +3167,12 @@ If variable `gnus-use-long-file-name' is non-nil, it is (put-text-property (match-end 0) (point-max) 'face eface))))))))) +(defun article-verify-cancel-lock () + "Verify Cancel-Lock header." + (interactive) + (if (gnus-buffer-live-p gnus-original-article-buffer) + (canlock-verify gnus-original-article-buffer))) + (eval-and-compile (mapcar (lambda (func) @@ -2875,7 +3183,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (setq afunc func gfunc (intern (format "gnus-%s" func)))) (defalias gfunc - (if (fboundp afunc) + (when (fboundp afunc) `(lambda (&optional interactive &rest args) ,(documentation afunc t) (interactive (list t)) @@ -2886,6 +3194,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (apply ',afunc args)))))))) '(article-hide-headers article-verify-x-pgp-sig + article-verify-cancel-lock article-hide-boring-headers article-treat-overstrike article-fill-long-lines @@ -2897,6 +3206,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 @@ -2925,7 +3235,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-emphasize article-treat-dumbquotes article-normalize-headers - (article-show-all . gnus-article-show-all-headers)))) +;; (article-show-all . gnus-article-show-all-headers) + ))) ;;; ;;; Gnus article mode @@ -2950,6 +3261,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 @@ -2990,6 +3303,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] ["Remove base64" gnus-article-de-base64-unreadable 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 @@ -3033,6 +3347,7 @@ commands: (make-local-variable 'gnus-article-decoded-p) (make-local-variable 'gnus-article-mime-handle-alist) (make-local-variable 'gnus-article-wash-types) + (make-local-variable 'gnus-article-image-alist) (make-local-variable 'gnus-article-charset) (make-local-variable 'gnus-article-ignored-charsets) (gnus-set-default-directory) @@ -3091,7 +3406,7 @@ commands: ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) (set-window-start - (get-buffer-window gnus-article-buffer t) + (gnus-get-buffer-window gnus-article-buffer t) (save-excursion (set-buffer gnus-article-buffer) (goto-char (point-min)) @@ -3221,7 +3536,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (unless (eq major-mode 'gnus-article-mode) (gnus-article-mode)) (setq buffer-read-only nil - gnus-article-wash-types nil) + gnus-article-wash-types nil + gnus-article-image-alist nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (when gnus-display-mime-function (funcall gnus-display-mime-function)) @@ -3232,14 +3548,19 @@ If ALL-HEADERS is non-nil, no headers are hidden." ;;; (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) @@ -3261,6 +3582,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (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-print-part "p" "Print") (gnus-mime-pipe-part "|" "Pipe To Command...") (gnus-mime-action-on-part "." "Take action on the part"))) @@ -3441,7 +3763,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-mm-display-part handle)))) (defun gnus-mime-copy-part (&optional handle) - "Put the the MIME part under point into a new buffer." + "Put the MIME part under point into a new buffer." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) @@ -3465,6 +3787,32 @@ If ALL-HEADERS is non-nil, no headers are hidden." (setq buffer-file-name nil)) (goto-char (point-min))))) +(defun gnus-mime-print-part (&optional handle filename) + "Print the MIME part under point." + (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))) + (printer (mailcap-mime-info (mm-handle-type handle) "print"))) + (when contents + (if printer + (unwind-protect + (progn + (with-temp-file file + (insert contents)) + (call-process shell-file-name nil + (generate-new-buffer " *mm*") + nil + shell-command-switch + (mm-mailcap-command + printer file (mm-handle-type handle)))) + (delete-file file)) + (with-temp-buffer + (insert contents) + (gnus-print-buffer)) + (ps-despool filename))))) + (defun gnus-mime-inline-part (&optional handle arg) "Insert the MIME part under point into the current buffer." (interactive (list nil current-prefix-arg)) @@ -3655,11 +4003,14 @@ 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 (get-buffer-window (current-buffer) t)) + (let ((win (gnus-get-buffer-window (current-buffer) t)) (beg (point))) (when win (select-window win)) @@ -3669,7 +4020,7 @@ If no internal viewer is available, use an external viewer." ;; This will remove the part. (mm-display-part handle) (save-restriction - (narrow-to-region (point) + (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) (mm-display-part handle) ;; We narrow to the part itself and @@ -3724,14 +4075,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 @@ -3775,7 +4123,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 + gnus-article-no-strict-mime) + (mm-uu-dissect))) buffer-read-only handle name type b e display) (when (and (not ihandles) (not gnus-displaying-mime)) @@ -3845,12 +4195,10 @@ If no internal viewer is available, use an external viewer." ;;;!!! No, w3 can display everything just fine. (gnus-mime-display-part (cadr handle))) ((equal (car handle) "multipart/signed") - (or (memq 'signed gnus-article-wash-types) - (push 'signed gnus-article-wash-types)) + (gnus-add-wash-type 'signed) (gnus-mime-display-security handle)) ((equal (car handle) "multipart/encrypted") - (or (memq 'encrypted gnus-article-wash-types) - (push 'encrypted gnus-article-wash-types)) + (gnus-add-wash-type 'encrypted) (gnus-mime-display-security handle)) ;; Other multiparts are handled like multipart/mixed. (t @@ -3934,11 +4282,16 @@ If no internal viewer is available, use an external viewer." (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))))))) + (when (catch 'found + (let ((types gnus-unbuttonized-mime-types)) + (while types + (when (string-match (pop types) type) + (throw 'found t))))) + (not (catch 'found + (let ((types gnus-buttonized-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." @@ -3981,12 +4334,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) @@ -4008,12 +4358,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) @@ -4042,6 +4389,39 @@ If no internal viewer is available, use an external viewer." (when ibegend (goto-char point)))) +(defconst gnus-article-wash-status-strings + (let ((alist '((cite "c" "Possible hidden citation text" + " " "All citation text visible") + (headers "h" "Hidden headers" + " " "All headers visible.") + (pgp "p" "Encrypted or signed message status hidden" + " " "No hidden encryption nor digital signature status") + (signature "s" "Signature has been hidden" + " " "Signature is visible") + (overstrike "o" "Overstrike (^H) characters applied" + " " "No overstrike characters applied") + (emphasis "e" "/*_Emphasis_*/ characters applied" + " " "No /*_emphasis_*/ characters applied"))) + result) + (dolist (entry alist result) + (let ((key (nth 0 entry)) + (on (copy-sequence (nth 1 entry))) + (on-help (nth 2 entry)) + (off (copy-sequence (nth 3 entry))) + (off-help (nth 4 entry))) + (put-text-property 0 1 'help-echo on-help on) + (put-text-property 0 1 'help-echo off-help off) + (push (list key on off) result)))) + "Alist of strings describing wash status in the mode line. +Each entry has the form (KEY ON OF), where the KEY is a symbol +representing the particular washing function, ON is the string to use +in the article mode line when the washing function is active, and OFF +is the string to use when it is inactive.") + +(defun gnus-article-wash-status-entry (key value) + (let ((entry (assoc key gnus-article-wash-status-strings))) + (if value (nth 1 entry) (nth 2 entry)))) + (defun gnus-article-wash-status () "Return a string which display status of article washing." (save-excursion @@ -4056,13 +4436,37 @@ If no internal viewer is available, use an external viewer." (signature (memq 'signature gnus-article-wash-types)) (overstrike (memq 'overstrike gnus-article-wash-types)) (emphasis (memq 'emphasis gnus-article-wash-types))) - (format "%c%c%c%c%c%c" - (if cite ?c ? ) - (if (or headers boring) ?h ? ) - (if (or pgp pem signed encrypted) ?p ? ) - (if signature ?s ? ) - (if overstrike ?o ? ) - (if emphasis ?e ? ))))) + (concat + (gnus-article-wash-status-entry 'cite cite) + (gnus-article-wash-status-entry 'headers (or headers boring)) + (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted)) + (gnus-article-wash-status-entry 'signature signature) + (gnus-article-wash-status-entry 'overstrike overstrike) + (gnus-article-wash-status-entry 'emphasis emphasis))))) + +(defun gnus-add-wash-type (type) + "Add a washing of TYPE to the current status." + (add-to-list 'gnus-article-wash-types type)) + +(defun gnus-delete-wash-type (type) + "Add a washing of TYPE to the current status." + (setq gnus-article-wash-types (delq type gnus-article-wash-types))) + +(defun gnus-add-image (category image) + "Add IMAGE of CATEGORY to the list of displayed images." + (let ((entry (assq category gnus-article-image-alist))) + (unless entry + (setq entry (list category)) + (push entry gnus-article-image-alist)) + (nconc entry (list image)))) + +(defun gnus-delete-images (category) + "Delete all images in CATEGORY." + (let ((entry (assq category gnus-article-image-alist))) + (dolist (image (cdr entry)) + (gnus-remove-image image)) + (setq gnus-article-image-alist (delq entry gnus-article-image-alist)) + (gnus-delete-wash-type category))) (defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) @@ -4248,7 +4652,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" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" "=" "^" "\M-^" "|")) (nosave-but-article @@ -4362,6 +4766,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) @@ -4386,6 +4823,9 @@ 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." (let (do-update-line sparse-header) @@ -4435,12 +4875,10 @@ If given a prefix, show the hidden text instead." 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)))))))) @@ -4479,6 +4917,11 @@ If given a prefix, show the hidden text instead." (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)) @@ -4496,7 +4939,9 @@ If given a prefix, show the hidden text instead." (setq gnus-override-method (pop methods))) (while (not result) (when (eq gnus-override-method 'current) - (setq gnus-override-method gnus-current-select-method)) + (setq gnus-override-method + (with-current-buffer gnus-summary-buffer + gnus-current-select-method))) (erase-buffer) (gnus-kill-all-overlays) (let ((gnus-newsgroup-name group)) @@ -4550,7 +4995,7 @@ If given a prefix, show the hidden text instead." (set-buffer gnus-summary-buffer) (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) + (set-window-point (gnus-get-buffer-window (current-buffer) t) (point)) (set-buffer buf)))))) @@ -4723,7 +5168,7 @@ groups." ("\\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)) "*Alist of regexps matching buttons in article bodies. @@ -4756,6 +5201,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. @@ -5010,14 +5456,19 @@ specified by `gnus-button-alist'." (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) (if (text-property-any end (point-max) 'article-type 'signature) - (gnus-remove-text-properties-when - 'article-type 'signature end (point-max) - (cons 'article-type (cons 'signature - gnus-hidden-properties))) + (progn + (gnus-delete-wash-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end (point-max) + (cons 'article-type (cons 'signature + gnus-hidden-properties)))) + (gnus-add-wash-type 'signature) (gnus-add-text-properties-when 'article-type nil end (point-max) (cons 'article-type (cons 'signature - gnus-hidden-properties))))))) + gnus-hidden-properties))))) + (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)))) (defun gnus-button-entry () ;; Return the first entry in `gnus-button-alist' matching this place. @@ -5094,13 +5545,13 @@ specified by `gnus-button-alist'." (defun gnus-button-handle-info (url) "Fetch an info URL." - (if (string-match + (if (string-match "^\\([^:/]+\\)?/\\(.*\\)" url) (gnus-info-find-node (concat "(" (or (gnus-url-unhex-string (match-string 1 url)) - "Gnus") - ")" + "Gnus") + ")" (gnus-url-unhex-string (match-string 2 url)))) (error "Can't parse %s" url))) @@ -5115,8 +5566,8 @@ specified by `gnus-button-alist'." (if (not (string-match "[:/]" address)) ;; This is just a simple group url. (gnus-group-read-ephemeral-group address gnus-select-method) - (if (not - (string-match + (if (not + (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?" address)) (error "Can't parse %s" address) @@ -5139,7 +5590,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)) @@ -5148,38 +5599,6 @@ specified by `gnus-button-alist'." (setq retval (cons (list key val) retval))))) retval)) -(defun gnus-url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun gnus-url-unhex-string (str &optional allow-newlines) - "Remove %XXX embedded spaces, etc in a url. -If optional second argument ALLOW-NEWLINES is non-nil, then allow the -decoding of carriage returns and line feeds in the string, which is normally -forbidden in URL encoding." - (setq str (or (mm-subst-char-in-string ?+ ? str) "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "%[0-9a-f][0-9a-f]" str) - (let* ((start (match-beginning 0)) - (ch1 (gnus-url-unhex (elt str (+ start 1)))) - (code (+ (* 16 ch1) - (gnus-url-unhex (elt str (+ start 2)))))) - (setq tmp (concat - tmp (substring str 0 start) - (cond - (allow-newlines - (char-to-string code)) - ((or (= code ?\n) (= code ?\r)) - " ") - (t (char-to-string code)))) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - (defun gnus-url-mailto (url) ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) @@ -5213,56 +5632,81 @@ forbidden in URL encoding." (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)) (defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil)) + (let ((b (point)) + (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)))) - -(defvar gnus-next-page-map nil) -(unless gnus-next-page-map - (setq gnus-next-page-map (make-keymap)) - (suppress-keymap gnus-prev-page-map) - (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) - (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) - -(defun gnus-button-next-page () + `(,@(gnus-local-map-property gnus-prev-page-map) + gnus-prev t + gnus-callback gnus-article-button-prev-page + article-type annotation)) + (widget-convert-button + 'link b (point) + :action 'gnus-button-prev-page + :button-keymap gnus-prev-page-map))) + +(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)) + +(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 (&optional args more-args) "Go to the next page." (interactive) (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (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))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) (select-window win))) (defun gnus-insert-next-page-button () - (let ((buffer-read-only nil)) + (let ((b (point)) + (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)))) + `(,@(gnus-local-map-property gnus-next-page-map) + gnus-next t + gnus-callback gnus-article-button-next-page + article-type annotation)) + (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." (interactive "P") (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-next-page) (select-window win))) @@ -5270,7 +5714,7 @@ forbidden in URL encoding." "Go to the prev page." (interactive "P") (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) + (select-window (gnus-get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) (select-window win))) @@ -5585,14 +6029,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