X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=9176ba2d1b34d52c6d5d08347f60de6d846de62d;hb=cb8d31757c1492ebd0c4c9f9615b997a3f462054;hp=6825e9a8496bbc4288ddeba7c12864b7d5a9c1a7;hpb=846123b969d829cd20cde6f59926ee4c7267f90d;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 6825e9a..9176ba2 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Semi-gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -36,6 +36,7 @@ (require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) +(require 'gnus-win) (require 'alist) (require 'mime-view) (require 'wid-edit) @@ -46,8 +47,7 @@ (require 'mail-parse) (require 'mm-decode) (require 'mm-view) - (require 'mm-uu) - ) + (require 'mm-uu)) (autoload 'gnus-msg-mail "gnus-msg" nil t) (autoload 'gnus-button-mailto "gnus-msg") @@ -115,36 +115,47 @@ :group 'gnus-article) (defcustom gnus-ignored-headers - '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:" - "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" - "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:" - "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:" - "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:" - "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:" - "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:" - "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:" - "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:" - "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:" - "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:" - "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" - "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:" - "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" - "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:" - "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" - "^MBOX-Line" "^Priority:" "^X400-[-A-Za-z]+:" - "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:" - "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:" - "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:" - "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:" - "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:" - "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:" - "^List-[A-Za-z]+:" "^X-Listprocessor-Version:" - "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:" - "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:" - "^X-Received:" "^Content-length:" "X-precedence:" - "^X-Authenticated-User:" "^X-Comment" "^X-Report:" "^X-Abuse-Info:" - "^X-HTTP-Proxy:" "^X-Mydeja-Info:" "^X-Copyright" "^X-No-Markup:" - "^X-Abuse-Info:") + (mapcar + (lambda (header) + (concat "^" header ":")) + '("Path" "Expires" "Date-Received" "References" "Xref" "Lines" + "Relay-Version" "Message-ID" "Approved" "Sender" "Received" + "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To" + "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature" + "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop" + "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face" + "X-Attribution" "X-Originating-IP" "Delivered-To" + "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace" + "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*" + "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date" + "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache" + "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time" + "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List" + "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt" + "Old-Received" "X-Pgp" "X-Auth" "X-From-Line" + "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender" + "MBOX-Line" "Priority" "X400-[-A-Za-z]+" + "Status" "X-Gnus-Mail-Source" "Cancel-Lock" + "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance" + "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3" + "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT" + "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin" + "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender" + "List-[A-Za-z]+" "X-Listprocessor-Version" + "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks" + "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway" + "X-Received" "Content-length" "X-precedence" + "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info" + "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup" + "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" "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" "X-Hashcash" "Face" "X-DMCA-Notifications" + "X-Abuse-and-DMCA-Info" "X-Postfilter")) "*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." @@ -178,15 +189,23 @@ this list." (defcustom gnus-boring-article-headers '(empty followup-to reply-to) "Headers that are only to be displayed if they have interesting data. -Possible values in this list are `empty', `newsgroups', `followup-to', -`to-address', `reply-to', `date', `long-to', and `many-to'." +Possible values in this list are: + + 'empty Headers with no content. + 'newsgroups Newsgroup identical to Gnus group. + 'to-address To identical to To-address. + 'followup-to Followup-to identical to Newsgroups. + 'reply-to Reply-to identical to From. + 'date Date less than four days old. + 'long-to To and/or Cc longer than 1024 characters. + 'many-to Multiple To and/or Cc." :type '(set (const :tag "Headers with no content." empty) - (const :tag "Newsgroups with only one group." newsgroups) - (const :tag "To identical to to-address." to-address) - (const :tag "Followup-to identical to newsgroups." followup-to) - (const :tag "Reply-to identical to from." reply-to) + (const :tag "Newsgroups identical to Gnus group." newsgroups) + (const :tag "To identical to To-address." to-address) + (const :tag "Followup-to identical to Newsgroups." followup-to) + (const :tag "Reply-to identical to From." reply-to) (const :tag "Date less than four days old." date) - (const :tag "Very long To and/or Cc header." long-to) + (const :tag "To and/or Cc longer than 1024 characters." long-to) (const :tag "Multiple To and/or Cc headers." many-to)) :group 'gnus-article-hiding) @@ -219,35 +238,50 @@ 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 (cond + ((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 -")) ((and (fboundp 'image-type-available-p) (module-installed-p 'x-face-e21)) 'x-face-decode-message-header) - ((and (fboundp 'image-type-available-p) - (image-type-available-p 'xbm)) - 'gnus-article-display-xface) - ((and (not (featurep 'xemacs)) - window-system + ((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 -")) "*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 - :tag "x-face-decode-message-header (x-face-e21)" - x-face-decode-message-header) - (function-item gnus-article-display-xface) - (function-item x-face-mule-gnus-article-display-x-face) - function) + :type `(choice + ,@(let (x-face-e21 x-face-mule) + (if (featurep 'xemacs) + nil + (setq x-face-e21 (module-installed-p 'x-face-e21) + x-face-mule (module-installed-p 'x-face-mule))) + (delq nil + (list + 'string + (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 + :tag "x-face-decode-message-header (x-face-e21)" + x-face-decode-message-header)) + (if x-face-mule + '(function-item + 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 @@ -284,25 +318,47 @@ regular expression to match the banner in `gnus-article-banner-alist'. A string is used as a regular expression to match the banner directly.") +(defcustom gnus-article-address-banner-alist nil + "Alist of mail addresses and banners. +Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp +to match a mail address in the From: header, BANNER is one of a symbol +`signature', an item in `gnus-article-banner-alist', a regexp and nil. +If ADDRESS matches author's mail address, it will remove things like +advertisements. For example: + +\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\")) +" + :type '(repeat + (cons + (regexp :tag "Address") + (choice :tag "Banner" :value nil + (const :tag "Remove signature" signature) + (symbol :tag "Item in `gnus-article-banner-alist'" none) + regexp + (const :tag "None" nil)))) + :group 'gnus-article-washing) + (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-strikethru) + ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" + 2 3 gnus-emphasis-underline))) "*Alist that says how to fontify certain phrases. Each item looks like this: @@ -356,7 +412,11 @@ and the latter avoids underlining any whitespace at all." (defface gnus-emphasis-underline-bold-italic '((t (:bold t :italic t :underline t))) "Face used for displaying underlined bold italic emphasized text. -Esample: (_/*word*/_)." +Example: (_/*word*/_)." + :group 'gnus-article-emphasis) + +(defface gnus-emphasis-strikethru '((t (:strikethru t))) + "Face used for displaying strike-through text (-word-)." :group 'gnus-article-emphasis) (defface gnus-emphasis-highlight-words @@ -415,6 +475,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 @@ -422,6 +483,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))) @@ -626,7 +688,8 @@ Obsolete; use the face `gnus-signature-face' for customizations instead." (background light)) (:foreground "indianred4" :italic t)) (t - (:italic t))) "Face used for displaying header content." + (:italic t))) + "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -684,6 +747,7 @@ displayed by the first non-nil matching CONTENT face." ("\225" "*") ("\226" "-") ("\227" "--") + ("\230" "~") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -697,11 +761,57 @@ 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. +This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." + :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\")'. +This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." :version "21.1" :group 'gnus-article-mime :type '(repeat regexp)) +(defcustom gnus-inhibit-mime-unbuttonizing nil + "If non-nil, all MIME parts get buttons. +When nil (the default value), then some MIME parts do not get buttons, +as described by the variables `gnus-buttonized-mime-types' and +`gnus-unbuttonized-mime-types'." + :version "21.3" + :type 'boolean) + +(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 @@ -750,28 +860,13 @@ 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)) + ("view internally" . gnus-mime-view-part-internally) + ("view externally" . gnus-mime-view-part-externally)) "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)) - "An alist of actions that run on the MIME attachment." - :version "21.1" - :group 'gnus-article-mime - :type '(repeat (cons (string :tag "name") - (function)))) - ;;; ;;; The treatment variables ;;; @@ -802,24 +897,27 @@ 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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-highlight-signature 'highlight t) (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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-buttonize 'highlight t) (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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) @@ -830,229 +928,343 @@ 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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-emphasize 'highlight t) (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 + :link '(custom-manual "(gnus)Customizing Articles") + :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-strip-banner t "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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (put 'gnus-treat-highlight-headers 'highlight t) (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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (put 'gnus-treat-highlight-citation 'highlight t) (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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-head-custom) (defcustom gnus-treat-date-user-defined nil "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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") + :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 + :link '(custom-manual "(gnus)Customizing Articles") + :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 + :link '(custom-manual "(gnus)Customizing Articles") + :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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :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) (featurep 'xface)) + (and (featurep 'xemacs) + (featurep 'xface)) (eq 'x-face-mule-gnus-article-display-x-face gnus-article-x-face-command)) '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" + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)X-Face") + :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-face + (and (not noninteractive) + (or (and (fboundp 'image-type-available-p) + (image-type-available-p 'png)) + (and (featurep 'xemacs) + (featurep 'png))) + 'head) + "Display Face headers. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' and Info node +`(gnus)X-Face' for details." + :group 'gnus-article-treat + :version "21.1" + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)X-Face") :type gnus-article-treat-head-custom) (put 'gnus-treat-display-xface 'highlight t) +(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))) @@ -1060,41 +1272,105 @@ 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" + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Smileys") :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 + :group 'gnus-picon + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Picons") + :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 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 '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Picons") :type gnus-article-treat-head-custom) -(put 'gnus-treat-display-picons 'highlight t) +(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 Info node `(gnus)Customizing Articles' and Info node +`(gnus)Picons' for details." + :group 'gnus-article-treat + :group 'gnus-picon + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Picons") + :type gnus-article-treat-head-custom) +(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 + :link '(custom-manual "(gnus)Customizing Articles") + :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 + :link '(custom-manual "(gnus)Customizing Articles") + :type gnus-article-treat-custom) + +(defcustom gnus-treat-wash-html nil + "Format as HTML. +Valid values are nil, t, `head', `last', an integer or a predicate. +See Info node `(gnus)Customizing Articles' for details." + :group 'gnus-article-treat + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (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 + :link '(custom-manual "(gnus)Customizing Articles") :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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-decode-article-as-default-mime-charset nil @@ -1110,18 +1386,28 @@ 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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defcustom gnus-treat-x-pgp-sig nil "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 + :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) (defvar gnus-article-encrypt-protocol-alist @@ -1135,6 +1421,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 @@ -1144,19 +1433,21 @@ 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 - `((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-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) @@ -1164,18 +1455,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-face gnus-article-display-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-emphasize gnus-article-emphasize) - (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) @@ -1184,13 +1475,21 @@ 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) + ;; 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-display-picons gnus-article-display-picons) + (gnus-treat-wash-html gnus-article-wash-html) + (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) @@ -1201,8 +1500,11 @@ 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) + ;; make M-. in article buffers work for `foo' strings + (modify-syntax-entry ?' " " table) + (modify-syntax-entry ?` " " table) table) "Syntax table used in article mode buffers. Initialized from `text-mode-syntax-table.") @@ -1218,6 +1520,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) @@ -1235,14 +1565,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) @@ -1282,13 +1611,13 @@ Initialized from `text-mode-syntax-table.") (defsubst gnus-article-header-rank () "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." (let ((list gnus-sorted-header-list) - (i 0)) + (i 1)) (while list - (when (looking-at (car list)) - (setq list nil)) - (setq list (cdr list)) - (incf i)) - i)) + (if (looking-at (car list)) + (setq list nil) + (setq list (cdr list)) + (incf i))) + i)) (defun article-hide-headers (&optional arg delete) "Hide unwanted headers and possibly sort them as well." @@ -1300,66 +1629,65 @@ Initialized from `text-mode-syntax-table.") (gnus-article-show-hidden-text 'boring-headers) (when (eq 1 (point-min)) (set-window-start (get-buffer-window (current-buffer)) 1))) - (unless gnus-inhibit-hiding - (save-excursion - (save-restriction - (let ((inhibit-read-only t) - (case-fold-search t) - (max (1+ (length gnus-sorted-header-list))) - (ignored (when (not gnus-visible-headers) - (cond ((stringp gnus-ignored-headers) - gnus-ignored-headers) - ((listp gnus-ignored-headers) - (mapconcat 'identity gnus-ignored-headers - "\\|"))))) - (visible - (cond ((stringp gnus-visible-headers) - gnus-visible-headers) - ((and gnus-visible-headers - (listp gnus-visible-headers)) - (mapconcat 'identity gnus-visible-headers "\\|")))) - (inhibit-point-motion-hooks t) - beg) - ;; First we narrow to just the headers. - (article-narrow-to-head) - ;; Hide any "From " lines at the beginning of (mail) articles. - (while (looking-at "From ") - (forward-line 1)) - (unless (bobp) - (if delete - (delete-region (point-min) (point)) - (gnus-article-hide-text (point-min) (point) - (nconc (list 'article-type 'headers) - gnus-hidden-properties)))) - ;; Then treat the rest of the header lines. - ;; Then we use the two regular expressions - ;; `gnus-ignored-headers' and `gnus-visible-headers' to - ;; select which header lines is to remain visible in the - ;; article buffer. - (while (re-search-forward "^[^ \t]*:" nil t) - (beginning-of-line) - ;; Mark the rank of the header. - (put-text-property - (point) (1+ (point)) 'message-rank - (if (or (and visible (looking-at visible)) - (and ignored - (not (looking-at ignored)))) - (gnus-article-header-rank) - (+ 2 max))) - (forward-line 1)) - (message-sort-headers-1) - (when (setq beg (text-property-any - (point-min) (point-max) 'message-rank (+ 2 max))) - ;; We delete or make invisible the unwanted headers. - (push 'headers gnus-article-wash-types) - (if delete - (progn - (add-text-properties - (point-min) (+ 5 (point-min)) - '(article-type headers dummy-invisible t)) - (delete-region beg (point-max))) - (gnus-article-hide-text-type beg (point-max) 'headers)))))))) - ) + (unless gnus-inhibit-hiding + (save-excursion + (save-restriction + (let ((inhibit-read-only t) + (case-fold-search t) + (max (1+ (length gnus-sorted-header-list))) + (ignored (when (not gnus-visible-headers) + (cond ((stringp gnus-ignored-headers) + gnus-ignored-headers) + ((listp gnus-ignored-headers) + (mapconcat 'identity gnus-ignored-headers + "\\|"))))) + (visible + (cond ((stringp gnus-visible-headers) + gnus-visible-headers) + ((and gnus-visible-headers + (listp gnus-visible-headers)) + (mapconcat 'identity gnus-visible-headers "\\|")))) + (inhibit-point-motion-hooks t) + beg) + ;; First we narrow to just the headers. + (article-narrow-to-head) + ;; Hide any "From " lines at the beginning of (mail) articles. + (while (looking-at "From ") + (forward-line 1)) + (unless (bobp) + (if delete + (delete-region (point-min) (point)) + (gnus-article-hide-text (point-min) (point) + (nconc (list 'article-type 'headers) + gnus-hidden-properties)))) + ;; Then treat the rest of the header lines. + ;; Then we use the two regular expressions + ;; `gnus-ignored-headers' and `gnus-visible-headers' to + ;; select which header lines is to remain visible in the + ;; article buffer. + (while (re-search-forward "^[^ \t:]*:" nil t) + (beginning-of-line) + ;; Mark the rank of the header. + (put-text-property + (point) (1+ (point)) 'message-rank + (if (or (and visible (looking-at visible)) + (and ignored + (not (looking-at ignored)))) + (gnus-article-header-rank) + (+ 2 max))) + (forward-line 1)) + (message-sort-headers-1) + (when (setq beg (text-property-any + (point-min) (point-max) 'message-rank (+ 2 max))) + ;; We delete or make invisible the unwanted headers. + (gnus-add-wash-type 'headers) + (if delete + (progn + (add-text-properties + (point-min) (+ 5 (point-min)) + '(article-type headers dummy-invisible t)) + (delete-region beg (point-max))) + (gnus-article-hide-text-type beg (point-max) 'headers))))))))) (defun article-hide-boring-headers (&optional arg) "Toggle hiding of headers that aren't very interesting. @@ -1482,86 +1810,6 @@ always hide." (point-max))) 'boring-headers)))) -(defun article-toggle-headers (&optional arg) - "Toggle hiding of headers. If given a negative prefix, always show; -if given a positive prefix, always hide." - (interactive (gnus-article-hidden-arg)) - (let ((force (when (numberp arg) - (cond ((> arg 0) 'always-hide) - ((< arg 0) 'always-show)))) - (window (get-buffer-window gnus-article-buffer)) - (header-end (point-min)) - header-start field-end field-start - (inhibit-point-motion-hooks t) - (inhibit-read-only t)) - (save-restriction - (widen) - (while (and (setq header-start - (text-property-any header-end (point-max) - 'article-treated-header t)) - (setq header-end - (text-property-not-all header-start (point-max) - 'article-treated-header t))) - (setq field-end header-start) - (cond - (;; Hide exposed invisible fields. - (and (not (eq 'always-show force)) - (setq field-start - (text-property-any field-end header-end - 'exposed-invisible-field t))) - (while (and field-start - (setq field-end (text-property-not-all - field-start header-end - 'exposed-invisible-field t))) - (add-text-properties field-start field-end gnus-hidden-properties) - (setq field-start (text-property-any field-end header-end - 'exposed-invisible-field t))) - (put-text-property header-start header-end - 'exposed-invisible-field nil)) - (;; Expose invisible fields. - (and (not (eq 'always-hide force)) - (setq field-start - (text-property-any field-end header-end 'invisible t))) - (while (and field-start - (setq field-end (text-property-not-all - field-start header-end - '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 - ;; 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. - (when (or (not (or (eq header-start field-start) - (eq ?\n (char-before field-start)))) - (eq ?\n (char-before field-end))) - (remove-text-properties field-start field-end - gnus-hidden-properties) - (put-text-property field-start field-end - 'exposed-invisible-field t)) - (setq field-start (text-property-any field-end header-end - 'invisible t)))) - (;; Hide fields. - (not (eq 'always-show force)) - (narrow-to-region header-start header-end) - (article-hide-headers) - ;; Re-display X-Face image under XEmacs. - (when (and (featurep 'xemacs) - (gnus-functionp gnus-article-x-face-command)) - (let ((func (cadr (assq 'gnus-treat-display-xface - gnus-treatment-function-alist))) - (condition 'head)) - (when (and (not gnus-inhibit-treatment) - func - (gnus-treat-predicate gnus-treat-display-xface)) - (funcall func) - (put-text-property header-start header-end 'read-only nil)))) - (widen)) - )) - (goto-char (point-min)) - (when window - (set-window-start window (point-min)))))) - (defvar gnus-article-normalized-header-length 40 "Length of normalized headers.") @@ -1666,6 +1914,99 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (put-text-property (point) end '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) + (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 +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-put-text-property start (point) 'gnus-decoration 'header))))) + (defun article-fill-long-lines () "Fill lines that are wider than the window width." (interactive) @@ -1674,13 +2015,15 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (width (window-width (get-buffer-window (current-buffer))))) (save-restriction (article-goto-body) - (let ((adaptive-fill-mode nil)) + (let ((adaptive-fill-mode nil)) ;Why? -sm (while (not (eobp)) (end-of-line) (when (>= (current-column) (min fill-column width)) - (narrow-to-region (point) (gnus-point-at-bol)) - (fill-paragraph nil) - (goto-char (point-max)) + (narrow-to-region (min (1+ (point)) (point-max)) + (gnus-point-at-bol)) + (let ((goback (point-marker))) + (fill-paragraph nil) + (goto-char (marker-position goback))) (widen)) (forward-line 1))))))) @@ -1724,82 +2067,103 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (forward-line 1) (point)))))) +(defun article-display-face () + "Display any Face headers in the header." + (interactive) + (gnus-with-article-headers + (let ((face nil)) + (save-excursion + (when (gnus-buffer-live-p gnus-original-article-buffer) + (set-buffer gnus-original-article-buffer) + (setq face (message-fetch-field "face")))) + (when face + (let ((png (gnus-convert-face-to-png face)) + image) + (when png + (setq image (gnus-create-image png 'png t)) + (gnus-article-goto-header "from") + (when (bobp) + (insert "From: [no `from' set]\n") + (forward-char -17)) + (gnus-add-wash-type 'face) + (gnus-add-image 'face image) + (gnus-put-image image))))))) + (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) + (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 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. @@ -1808,7 +2172,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 () @@ -1837,38 +2204,38 @@ If PROMPT (the prefix), prompt for a coding system to use." (error)) gnus-newsgroup-ignored-charsets)) ct cte ctl charset format) - (save-excursion - (save-restriction - (article-narrow-to-head) - (setq ct (message-fetch-field "Content-Type" t) - cte (message-fetch-field "Content-Transfer-Encoding" t) - ctl (and ct (ignore-errors - (mail-header-parse-content-type ct))) - charset (cond - (prompt - (mm-read-coding-system "Charset to decode: ")) - (ctl - (mail-content-type-get ctl 'charset))) - format (and ctl (mail-content-type-get ctl 'format))) - (when cte - (setq cte (mail-header-strip cte))) - (if (and ctl (not (string-match "/" (car ctl)))) - (setq ctl nil)) - (goto-char (point-max))) - (forward-line 1) - (save-restriction - (narrow-to-region (point) (point-max)) - (when (and (eq mail-parse-charset 'gnus-decoded) - (eq (mm-body-7-or-8) '8bit)) - ;; The text code could have been decoded. - (setq charset mail-parse-charset)) - (when (and (or (not ctl) - (equal (car ctl) "text/plain")) - (not format)) ;; article with format will decode later. - (mm-decode-body - charset (and cte (intern (downcase - (gnus-strip-whitespace cte)))) - (car ctl))))))) + (save-excursion + (save-restriction + (article-narrow-to-head) + (setq ct (message-fetch-field "Content-Type" t) + cte (message-fetch-field "Content-Transfer-Encoding" t) + ctl (and ct (ignore-errors + (mail-header-parse-content-type ct))) + charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ctl + (mail-content-type-get ctl 'charset))) + format (and ctl (mail-content-type-get ctl 'format))) + (when cte + (setq cte (mail-header-strip cte))) + (if (and ctl (not (string-match "/" (car ctl)))) + (setq ctl nil)) + (goto-char (point-max))) + (forward-line 1) + (save-restriction + (narrow-to-region (point) (point-max)) + (when (and (eq mail-parse-charset 'gnus-decoded) + (eq (mm-body-7-or-8) '8bit)) + ;; The text code could have been decoded. + (setq charset mail-parse-charset)) + (when (and (or (not ctl) + (equal (car ctl) "text/plain")) + (not format)) ;; article with format will decode later. + (mm-decode-body + charset (and cte (intern (downcase + (gnus-strip-whitespace cte)))) + (car ctl))))))) (defun article-decode-encoded-words () "Remove encoded-word encoding from headers." @@ -1876,14 +2243,37 @@ If PROMPT (the prefix), prompt for a coding system to use." (let ((charset (save-excursion (set-buffer gnus-summary-buffer) default-mime-charset))) - (mime-decode-header-in-buffer charset) - ))) + (mime-decode-header-in-buffer charset)))) -(defun article-de-quoted-unreadable (&optional force) +(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 -or not." - (interactive (list 'force)) +or not. +If READ-CHARSET, ask for a coding system." + (interactive (list 'force current-prefix-arg)) (save-excursion (let ((buffer-read-only nil) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -1898,6 +2288,8 @@ or not." (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) + (if read-charset + (setq charset (mm-read-coding-system "Charset: " charset))) (unless charset (setq charset gnus-newsgroup-charset)) (when (or force @@ -1907,10 +2299,11 @@ or not." (quoted-printable-decode-region (point) (point-max) (mm-charset-to-coding-system charset)))))) -(defun article-de-base64-unreadable (&optional force) +(defun article-de-base64-unreadable (&optional force read-charset) "Translate a base64 article. -If FORCE, decode the article whether it is marked as base64 not." - (interactive (list 'force)) +If FORCE, decode the article whether it is marked as base64 not. +If READ-CHARSET, ask for a coding system." + (interactive (list 'force current-prefix-arg)) (save-excursion (let ((buffer-read-only nil) type charset) (if (gnus-buffer-live-p gnus-original-article-buffer) @@ -1925,6 +2318,8 @@ If FORCE, decode the article whether it is marked as base64 not." (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) + (if read-charset + (setq charset (mm-read-coding-system "Charset: " charset))) (unless charset (setq charset gnus-newsgroup-charset)) (when (or force @@ -1948,34 +2343,81 @@ If FORCE, decode the article whether it is marked as base64 not." (let ((buffer-read-only nil)) (rfc1843-decode-region (point-min) (point-max))))) -(defun article-wash-html () - "Format an html article." +(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))) + (when (and gnus-display-mime-function (interactive-p)) + (funcall gnus-display-mime-function)))) + + +(defun article-wash-html (&optional read-charset) + "Format an HTML article. +If READ-CHARSET, ask for a coding system." + (interactive "P") + (save-excursion (let ((buffer-read-only nil) charset) - (if (gnus-buffer-live-p gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct - (ignore-errors - (mail-header-parse-content-type ct))))) - (setq charset (and ctl - (mail-content-type-get ctl 'charset))) - (if (stringp charset) - (setq charset (intern (downcase charset))))))) + (when (gnus-buffer-live-p gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (let* ((ct (gnus-fetch-field "content-type")) + (ctl (and ct + (ignore-errors + (mail-header-parse-content-type ct))))) + (setq charset (and ctl + (mail-content-type-get ctl 'charset))) + (when (stringp charset) + (setq charset (intern (downcase charset))))))) + (when read-charset + (setq charset (mm-read-coding-system "Charset: " charset))) (unless charset (setq charset gnus-newsgroup-charset)) (article-goto-body) (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)))))))) + (let* ((func (or gnus-article-wash-function mm-text-html-renderer)) + (entry (assq func mm-text-html-washer-alist))) + (when 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) + (nconc (mm-w3m-local-map-property) + '(mm-inline-text-html-with-w3m t)))))) (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. @@ -2010,7 +2452,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) @@ -2050,7 +2492,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) @@ -2072,6 +2514,20 @@ always hide." (banner (gnus-parameter-banner gnus-newsgroup-name)) (gnus-signature-limit nil) buffer-read-only beg end) + (when (and gnus-article-address-banner-alist + (not banner)) + (setq banner + (let ((from (save-restriction + (widen) + (article-narrow-to-head) + (mail-fetch-field "from")))) + (when (and from + (setq from + (caar (mail-header-parse-addresses from)))) + (catch 'found + (dolist (pair gnus-article-address-banner-alist) + (when (string-match (car pair) from) + (throw 'found (cdr pair))))))))) (when banner (article-goto-body) (cond @@ -2099,11 +2555,11 @@ always hide." (start (point)) (end (point-max)) (orig (buffer-substring start end)) - (trans (babel-as-string orig))) + (trans (babel-as-string orig))) (save-restriction (narrow-to-region start end) (delete-region start end) - (insert trans)))))) + (insert trans)))))) (defun article-hide-signature (&optional arg) "Hide the signature in the current article. @@ -2131,7 +2587,8 @@ always hide." (1+ button) (next-single-property-change (1+ button) 'mime-view-entity nil (point-max)) - 'signature)))))))) + 'signature))))))) + (gnus-set-mode-line 'article)) (defun article-strip-headers-in-body () "Strip offensive headers from bodies." @@ -2191,10 +2648,10 @@ Point is left at the beginning of the narrowed-to region." (replace-match "" nil t))) ;; Then replace multiple empty lines with a single empty line. (article-goto-body) - (while (re-search-forward "\n\n\n+" nil t) + (while (re-search-forward "\n\n\\(\n+\\)" nil t) (unless (gnus-annotation-in-region-p (match-beginning 0) (match-end 0)) - (replace-match "\n\n" t t)))))) + (delete-region (match-beginning 1) (match-end 1))))))) (defun article-strip-leading-space () "Remove all white space from the beginning of the lines in the article." @@ -2283,7 +2740,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 @@ -2323,7 +2780,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)) @@ -2334,6 +2792,17 @@ Originally it is hide instead of DUMMY." (second . 1)) "Mapping from time units to seconds.") +(defun gnus-article-forward-header () + "Move point to the start of the next header. +If the current header is a continuation header, this can be several +lines forward." + (let ((ended nil)) + (while (not ended) + (forward-line 1) + (if (looking-at "[ \t]+[^ \t]") + (forward-line 1) + (setq ended t))))) + (defun article-date-ut (&optional type highlight header) "Convert DATE date to universal time in the current article. If TYPE is `local', convert to local time; if it is `lapsed', output @@ -2365,8 +2834,8 @@ should replace the \"Date:\" one, or should be added below it." (re-search-forward "^X-Sent:[ \t]" nil t)) (setq bface (get-text-property (gnus-point-at-bol) 'face) date (or (get-text-property (gnus-point-at-bol) - 'original-date) - date) + 'original-date) + date) eface (get-text-property (1- (gnus-point-at-eol)) 'face))) (let ((buffer-read-only nil)) @@ -2444,11 +2913,14 @@ should replace the \"Date:\" one, or should be added below it." date))) ;; Let the user define the format. ((eq type 'user) - (if (gnus-functionp gnus-article-time-format) - (funcall gnus-article-time-format time) - (concat - "Date: " - (format-time-string gnus-article-time-format time)))) + (let ((format (or (condition-case nil + (with-current-buffer gnus-summary-buffer + gnus-article-time-format) + (error nil)) + gnus-article-time-format))) + (if (gnus-functionp format) + (funcall format time) + (concat "Date: " (format-time-string format time))))) ;; ISO 8601. ((eq type 'iso8601) (let ((tz (car (current-time-zone time)))) @@ -2522,8 +2994,8 @@ should replace the \"Date:\" one, or should be added below it." (format "%02d" (nth 2 dtime)) ":" (format "%02d" (nth 1 dtime))))))) - (error - (format "Date: %s (from Oort)" date)))) + (error + (format "Date: %s (from T-gnus)" date)))) (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." @@ -2590,15 +3062,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." @@ -2645,15 +3117,15 @@ This format is defined by the `gnus-article-time-format' variable." visible (nth 2 elem) 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 - (match-beginning visible) (match-end visible) 'face face) - (goto-char (match-end invisible))))))))) + (when (and (match-beginning visible) (match-beginning invisible)) + (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-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) "Setup newsgroup emphasis alist." @@ -2780,7 +3252,7 @@ This format is defined by the `gnus-article-time-format' variable." (car (push result file-name-history))))))) ;; Create the directory. (gnus-make-directory (file-name-directory file)) - ;; If we have read a directory, we append the default file name. + ;; If we have read a directory, we append the default file name. (when (file-directory-p file) (setq file (expand-file-name (file-name-nondirectory default-name) @@ -2854,7 +3326,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)) @@ -2896,13 +3368,20 @@ The directory to save in defaults to `gnus-article-save-directory'." (when (string-equal command "") (if gnus-last-shell-command (setq command gnus-last-shell-command) - (error "A command is required."))) + (error "A command is required"))) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) (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) @@ -2955,7 +3434,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is (expand-file-name (if (gnus-use-long-file-name 'not-save) newsgroup - (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))) + (file-relative-name + (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)) + default-directory)) gnus-article-save-directory))) (defun gnus-sender-save-name (newsgroup headers &optional last-file) @@ -2978,7 +3459,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) @@ -3040,6 +3521,27 @@ 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))) + +(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) @@ -3050,7 +3552,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)) @@ -3061,18 +3563,21 @@ 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-monafy article-hide-boring-headers - article-toggle-headers article-treat-overstrike article-fill-long-lines article-capitalize-sentences article-remove-cr article-remove-leading-whitespace article-display-x-face + article-display-face article-de-quoted-unreadable article-de-base64-unreadable article-decode-HZ article-wash-html + article-unsplit-urls article-hide-list-identifiers article-hide-pgp article-strip-banner @@ -3101,7 +3606,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 @@ -3124,6 +3630,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 @@ -3168,12 +3676,14 @@ If variable `gnus-use-long-file-name' is non-nil, it is gnus-article-treatment-menu gnus-article-mode-map "" ;; Fixme: this should use :active (and maybe :visible). '("Treatment" - ["Hide headers" gnus-article-toggle-headers t] + ["Hide headers" gnus-article-hide-headers t] ["Hide signature" gnus-article-hide-signature t] ["Hide citation" gnus-article-hide-citation t] ["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 @@ -3219,6 +3729,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) @@ -3249,12 +3760,18 @@ 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) (save-excursion (set-buffer name) + (when (and gnus-article-edit-mode + (buffer-modified-p) + (not + (y-or-n-p "Article mode edit in progress; discard? "))) + (error "Action aborted")) + (set (make-local-variable 'gnus-article-edit-mode) nil) (buffer-disable-undo) (setq buffer-read-only t) (unless (eq major-mode 'gnus-article-mode) @@ -3271,7 +3788,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)) @@ -3375,7 +3892,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) - (if (eq (gnus-article-mark article) gnus-undownloaded-mark) + (if (memq article gnus-newsgroup-undownloaded) (progn (gnus-summary-set-agent-mark article) (message "Message marked for downloading")) @@ -3447,6 +3964,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)))))) @@ -3527,7 +4046,8 @@ If ALL-HEADERS is non-nil, no headers are hidden." (gnus-article-mode)) (setq buffer-read-only nil gnus-button-marker-list nil - gnus-article-wash-types nil) + gnus-article-wash-types nil + gnus-article-image-alist nil) (save-restriction (widen) (static-if (featurep 'xemacs) @@ -3536,24 +4056,27 @@ If ALL-HEADERS is non-nil, no headers are hidden." (dolist (overlay (nconc (car lists) (cdr lists))) (delete-overlay overlay))))) (gnus-run-hooks 'gnus-tmp-internal-hook)) - (set-buffer gnus-original-article-buffer) - ;; Display message. - (setq mime-message-structure gnus-current-headers) - (mime-buffer-entity-set-buffer-internal mime-message-structure - gnus-original-article-buffer) - (mime-entity-set-representation-type-internal mime-message-structure - 'mime-buffer-entity) - (luna-send mime-message-structure 'initialize-instance - mime-message-structure) - (if gnus-show-mime - (let (mime-display-header-hook mime-display-text/plain-hook) - (funcall gnus-article-display-method-for-mime)) - (funcall gnus-article-display-method-for-traditional)) - ;; Call the treatment functions. - (let ((inhibit-read-only t)) + (let ((show-mime (unless (member gnus-newsgroup-name '("nndraft:delayed" + "nndraft:drafts")) + gnus-show-mime)) + (inhibit-read-only t)) + (set-buffer gnus-original-article-buffer) + ;; Display message. + (setq mime-message-structure gnus-current-headers) + (mime-buffer-entity-set-buffer-internal mime-message-structure + gnus-original-article-buffer) + (mime-entity-set-representation-type-internal mime-message-structure + 'mime-buffer-entity) + (luna-send mime-message-structure 'initialize-instance + mime-message-structure) + (if show-mime + (let (mime-display-header-hook mime-display-text/plain-hook) + (funcall gnus-article-display-method-for-mime)) + (funcall gnus-article-display-method-for-traditional)) + ;; Call the treatment functions. (save-restriction (widen) - (if gnus-show-mime + (if show-mime (gnus-article-prepare-mime-display) (narrow-to-region (goto-char (point-min)) (if (search-forward "\n\n" nil t) @@ -3571,7 +4094,9 @@ If ALL-HEADERS is non-nil, no headers are hidden." (defun gnus-article-decode-article-as-default-mime-charset () "Decode an article as `default-mime-charset'. It won't work if the value of the variable `gnus-show-mime' is non-nil." - (unless gnus-show-mime + (unless (or gnus-show-mime + (member gnus-newsgroup-name '("nndraft:delayed" + "nndraft:drafts"))) (set (make-local-variable 'default-mime-charset) (with-current-buffer gnus-summary-buffer default-mime-charset)) @@ -3583,14 +4108,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 Info node +`(gnus)Formatting Variables'.") (defvar gnus-mime-button-line-format-alist '((?t gnus-tmp-type ?s) @@ -3610,8 +4140,9 @@ 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"))) @@ -3669,17 +4200,18 @@ value of the variable `gnus-show-mime' is non-nil." (goto-char (point-min)) (or (search-forward "\n\n") (goto-char (point-max))) (let (buffer-read-only) - (delete-region (point) (point-max))) - (mm-display-parts handles))))) + (delete-region (point) (point-max)) + (mm-display-parts handles)))))) (defun gnus-mime-save-part-and-strip () "Save the MIME part under point then replace it with an external body." (interactive) (gnus-article-check-buffer) (let* ((data (get-text-property (point) 'gnus-data)) - file param) + file param + (handles gnus-article-mime-handles)) (if (mm-multiple-handles gnus-article-mime-handles) - (error "This function is not implemented.")) + (error "This function is not implemented")) (setq file (and data (mm-save-part data))) (when file (with-current-buffer (mm-handle-buffer data) @@ -3699,22 +4231,24 @@ value of the variable `gnus-show-mime' is non-nil." (set-buffer gnus-summary-buffer) (gnus-article-edit-article `(lambda () - (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset - ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets - (or gnus-article-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - (mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (insert-buffer gnus-original-article-buffer) - (mime-to-mml gnus-article-mime-handles) - (setq gnus-article-mime-handles nil) - (make-local-hook 'kill-buffer-hook) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) + (erase-buffer) + (let ((mail-parse-charset (or gnus-article-charset + ',gnus-newsgroup-charset)) + (mail-parse-ignored-charsets + (or gnus-article-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + (mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (insert-buffer gnus-original-article-buffer) + (mime-to-mml ',handles) + (setq gnus-article-mime-handles nil) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + ;; LOCAL argument of add-hook differs between GNU Emacs + ;; and XEmacs. make-local-hook makes sure they are local. + (make-local-hook 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) `(lambda (no-highlight) (let ((mail-parse-charset (or gnus-article-charset ',gnus-newsgroup-charset)) @@ -3723,11 +4257,11 @@ value of the variable `gnus-show-mime' is non-nil." (mail-parse-ignored-charsets (or gnus-article-ignored-charsets ',gnus-newsgroup-ignored-charsets))) - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list)) + (mml-to-mime) + (mml-destroy-buffers) + (remove-hook 'kill-buffer-hook + 'mml-destroy-buffers t) + (kill-local-variable 'mml-buffer-list)) (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") ,(gnus-group-read-only-p) @@ -3787,14 +4321,46 @@ value of the variable `gnus-show-mime' is non-nil." (mm-handle-undisplayer handle) (mm-handle-disposition handle) (mm-handle-description handle) - (mm-handle-cache handle) + nil (mm-handle-id handle))) (setq gnus-article-mime-handles (mm-merge-handles gnus-article-mime-handles handle)) (gnus-mm-display-part handle)))) +(eval-when-compile + (require 'jka-compr)) + +;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days +;; emacs can do that itself. +;; +(defun gnus-mime-jka-compr-maybe-uncompress () + "Uncompress the current buffer if `auto-compression-mode' is enabled. +The uncompress method used is derived from `buffer-file-name'." + (when (and (fboundp 'jka-compr-installed-p) + (jka-compr-installed-p)) + (let ((info (jka-compr-get-compression-info buffer-file-name))) + (when info + (let ((basename (file-name-nondirectory buffer-file-name)) + (args (jka-compr-info-uncompress-args info)) + (prog (jka-compr-info-uncompress-program info)) + (message (jka-compr-info-uncompress-message info)) + (err-file (jka-compr-make-temp-name))) + (if message + (message "%s %s..." message basename)) + (unwind-protect + (unless (memq (apply 'call-process-region + (point-min) (point-max) + prog + t (list t err-file) nil + args) + jka-compr-acceptable-retval-list) + (jka-compr-error prog args basename message err-file)) + (jka-compr-delete-temp-file err-file))))))) + (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. +If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 +are decompressed." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) @@ -3803,7 +4369,7 @@ value of the variable `gnus-show-mime' is non-nil." (file-name-nondirectory (or (mail-content-type-get (mm-handle-type handle) 'name) - (mail-content-type-get (mm-handle-type handle) + (mail-content-type-get (mm-handle-disposition handle) 'filename) "*decoded*")))) (buffer (and base (generate-new-buffer base)))) @@ -3814,10 +4380,36 @@ value of the variable `gnus-show-mime' is non-nil." (unwind-protect (progn (setq buffer-file-name (expand-file-name base)) + (gnus-mime-jka-compr-maybe-uncompress) (normal-mode)) (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 (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) + (printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) + (when contents + (if printer + (unwind-protect + (progn + (mm-save-part-to-file handle file) + (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)) @@ -3841,7 +4433,7 @@ value of the variable `gnus-show-mime' is non-nil." (setq charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (read-coding-system "Charset: "))))) + (mm-read-coding-system "Charset: "))))) (forward-line 2) (mm-insert-inline handle (if (and charset @@ -3853,7 +4445,8 @@ value of the variable `gnus-show-mime' is non-nil." (goto-char b))))) (defun gnus-mime-view-part-as-charset (&optional handle arg) - "Insert the MIME part under point into the current buffer." + "Insert the MIME part under point into the current buffer using the +specified charset." (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) @@ -3866,11 +4459,11 @@ value of the variable `gnus-show-mime' is non-nil." (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (read-coding-system "Charset: "))) - (gnus-newsgroup-ignored-charsets 'gnus-all)) + (mm-read-coding-system "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) @@ -3886,9 +4479,9 @@ value of the variable `gnus-show-mime' is non-nil." (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. -In no internal viewer is available, use an external viewer." +If no internal viewer is available, use an external viewer." (interactive) (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) @@ -3946,10 +4539,10 @@ In 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." @@ -4007,11 +4600,14 @@ In 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)) @@ -4021,7 +4617,8 @@ In no internal viewer is available, use an external viewer." ;; This will remove the part. (mm-display-part handle) (save-restriction - (narrow-to-region (point) (1+ (point))) + (narrow-to-region (point) + (if (eobp) (point) (1+ (point)))) (mm-display-part handle) ;; We narrow to the part itself and ;; then call the treatment functions. @@ -4032,7 +4629,8 @@ In no internal viewer is available, use an external viewer." nil id (gnus-article-mime-total-parts) (mm-handle-media-type handle))))) - (select-window window)))) + (if (window-live-p window) + (select-window window))))) (goto-char point) (delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) (gnus-insert-mime-button @@ -4047,12 +4645,9 @@ In no internal viewer is available, use an external viewer." (defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) (let ((gnus-tmp-name - (or (mail-content-type-get (mm-handle-type handle) - 'name) - (mail-content-type-get (mm-handle-disposition handle) - 'filename) - (mail-content-type-get (mm-handle-type handle) - 'url) + (or (mail-content-type-get (mm-handle-type handle) 'name) + (mail-content-type-get (mm-handle-disposition handle) 'filename) + (mail-content-type-get (mm-handle-type handle) 'url) "")) (gnus-tmp-type (mm-handle-media-type handle)) (gnus-tmp-description @@ -4070,21 +4665,18 @@ In no internal viewer is available, use an external viewer." (setq gnus-tmp-type-long (concat gnus-tmp-type (and (not (equal gnus-tmp-name "")) (concat "; " gnus-tmp-name)))) - (or (equal gnus-tmp-description "") - (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) + (unless (equal gnus-tmp-description "") + (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) (unless (bolp) (insert "\n")) (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist - `(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 @@ -4128,7 +4720,10 @@ In 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) + (and gnus-article-emulate-mime + (mm-uu-dissect)))) buffer-read-only handle name type b e display) (when (and (not ihandles) (not gnus-displaying-mime)) @@ -4198,12 +4793,10 @@ In 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 @@ -4235,7 +4828,9 @@ In no internal viewer is available, use an external viewer." "inline") (mm-attachment-override-p handle)))) (mm-automatic-display-p handle) - (or (mm-inlined-p handle) + (or (and + (mm-inlinable-p handle) + (mm-inlined-p handle)) (mm-automatic-external-display-p type))) (setq display t) (when (equal (mm-handle-media-supertype handle) "text") @@ -4285,11 +4880,16 @@ In 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." @@ -4332,12 +4932,9 @@ In 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) @@ -4359,12 +4956,9 @@ In 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) @@ -4393,6 +4987,41 @@ In 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") + (gnus-show-mime "m" "Mime processing is activated" + " " "Mime processing is not activated") + (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 @@ -4407,14 +5036,38 @@ In 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%c" - (if cite ?c ? ) - (if (or headers boring) ?h ? ) - (if (or pgp pem signed encrypted) ?p ? ) - (if signature ?s ? ) - (if overstrike ?o ? ) - (if gnus-show-mime ?m ? ) - (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 'gnus-show-mime gnus-show-mime) + (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) @@ -4438,7 +5091,9 @@ Provided for backwards compatibility." ;; save it to file. (goto-char (point-max)) (insert "\n") - (write-region-as-binary (point-min) (point-max) file-name 'append) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (write-region-as-binary (point-min) (point-max) file-name 'append)) t))) (defun gnus-narrow-to-page (&optional arg) @@ -4607,60 +5262,60 @@ 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" - "Zc" "ZC" "ZE" "ZJ" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" - "=" "^" "\M-^" "|")) - (nosave-but-article - '("A\r")) - (nosave-in-article - '("\C-d")) - (up-to-top - '("n" "Gn" "p" "Gp")) - keys new-sum-point) + '("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 + '("A\r")) + (nosave-in-article + '("\C-d")) + (up-to-top + '("n" "Gn" "p" "Gp")) + keys new-sum-point) (save-excursion (set-buffer gnus-article-current-summary) (let (gnus-pick-mode) - (push (or key last-command-event) unread-command-events) + (push (or key last-command-event) unread-command-events) (setq keys (static-if (featurep 'xemacs) (events-to-keys (read-key-sequence nil)) (read-key-sequence nil))))) (message "") (if (or (member keys nosaves) - (member keys nosave-but-article) - (member keys nosave-in-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-article-current-summary 'norecord) - ;; We disable the pick minor mode commands. - (let (gnus-pick-mode) - (setq func (lookup-key (current-local-map) keys)))) - (if (or (not func) + (member keys nosave-but-article) + (member keys nosave-in-article)) + (let (func) + (save-window-excursion + (pop-to-buffer gnus-article-current-summary 'norecord) + ;; We disable the pick minor mode commands. + (let (gnus-pick-mode) + (setq func (lookup-key (current-local-map) keys)))) + (if (or (not func) (numberp func)) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-article-current-summary)) - (call-interactively func) - (setq new-sum-point (point))) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer 'norecord))) + (ding) + (unless (member keys nosave-in-article) + (set-buffer gnus-article-current-summary)) + (call-interactively func) + (setq new-sum-point (point))) + (when (member keys nosave-but-article) + (pop-to-buffer gnus-article-buffer 'norecord))) ;; These commands should restore window configuration. (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - (opoint (point)) - (summary gnus-article-current-summary) - func in-buffer selected) - (if not-restore-window - (pop-to-buffer summary 'norecord) - (switch-to-buffer summary 'norecord)) - (setq in-buffer (current-buffer)) - ;; We disable the pick minor mode commands. - (if (and (setq func (let (gnus-pick-mode) + (owin (current-window-configuration)) + (opoint (point)) + (summary gnus-article-current-summary) + func in-buffer selected) + (if not-restore-window + (pop-to-buffer summary 'norecord) + (switch-to-buffer summary 'norecord)) + (setq in-buffer (current-buffer)) + ;; We disable the pick minor mode commands. + (if (and (setq func (let (gnus-pick-mode) (lookup-key (current-local-map) keys))) (functionp func)) - (progn - (call-interactively func) - (setq new-sum-point (point)) + (progn + (call-interactively func) + (setq new-sum-point (point)) (when (eq in-buffer (current-buffer)) (setq selected (gnus-summary-select-article)) (set-buffer obuf) @@ -4676,7 +5331,7 @@ Argument LINES specifies lines to be scrolled down." (when win (set-window-point win new-sum-point)))) ) (switch-to-buffer gnus-article-buffer) - (ding)))))) + (ding)))))) (defun gnus-article-describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string." @@ -4720,6 +5375,44 @@ 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)) + contents) + (if (not (gnus-mark-active-p)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply (list (list article)) wide)) + (setq contents (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply + (list (list article contents)) 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)) + contents) + (if (not (gnus-mark-active-p)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup (list (list article)))) + (setq contents (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup + (list (list article contents))))))) + (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) @@ -4744,11 +5437,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) @@ -4795,17 +5489,13 @@ 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)) - (set-buffer gnus-original-article-buffer) (cond ;; Refuse to select canceled articles. ((and (numberp article) @@ -4817,6 +5507,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))) @@ -4832,12 +5531,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)) @@ -4849,12 +5555,15 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (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)) (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) @@ -4862,10 +5571,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))) @@ -4873,10 +5585,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) - ;; Decode charsets. - (run-hooks 'gnus-article-decode-hook) - ;; Mark article as decoded or not. - (setq gnus-article-decoded-p gnus-article-decode-hook) + ;; 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)) ;; Update sparse articles. (when (and do-update-line @@ -4886,7 +5615,7 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (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)))))) @@ -4908,35 +5637,86 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'." (defvar gnus-article-edit-done-function nil) (defvar gnus-article-edit-mode-map nil) +(defvar gnus-article-edit-mode nil) ;; 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-generate-unsubscribed-mail-followup-to + "\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)) -(defun gnus-article-edit-mode () +(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. \\{gnus-article-edit-mode-map}" - (interactive) - (setq major-mode 'gnus-article-edit-mode) - (setq mode-name "Article Edit") - (use-local-map gnus-article-edit-mode-map) (make-local-variable 'gnus-article-edit-done-function) (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) "") + (set (make-local-variable 'gnus-article-edit-mode) t) + (easy-menu-add message-mode-field-menu message-mode-map) (setq buffer-read-only nil) (buffer-enable-undo) - (widen) - (gnus-run-hooks 'text-mode-hook 'gnus-article-edit-mode-hook)) + (widen)) (defun gnus-article-edit (&optional force) "Edit the current article. @@ -4975,39 +5755,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)))) @@ -5022,8 +5794,9 @@ 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)) + (kill-all-local-variables) (gnus-article-mode) (set-window-configuration winconf) ;; Tippy-toe some to make sure that point remains where it was. @@ -5092,19 +5865,23 @@ after replacing with the original article." 'gnus-article-mime-edit-exit gnus-article-edit-mode-map) (erase-buffer) - (insert-buffer 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) - (if (let ((content-type (car args))) - (and (eq 'message (mime-content-type-primary-type - content-type)) - (eq 'rfc822 (mime-content-type-subtype content-type)))) - (setcar (cdr args) 'not-decode-text)) - (apply ofn args))) - (unwind-protect - (mime-edit-again) - (fset 'mime-edit-decode-single-part-in-buffer ofn))) + (insert-buffer-substring gnus-original-article-buffer) + (unless (member (with-current-buffer gnus-summary-buffer + gnus-newsgroup-name) + '("nndraft:delayed" "nndraft:drafts")) + (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer))) + (fset 'mime-edit-decode-single-part-in-buffer + (lambda (&rest args) + (if (let ((content-type (car args))) + (and (eq 'message (mime-content-type-primary-type + content-type)) + (eq 'rfc822 (mime-content-type-subtype + content-type)))) + (setcar (cdr args) 'not-decode-text)) + (apply ofn args))) + (unwind-protect + (mime-edit-again) + (fset 'mime-edit-decode-single-part-in-buffer ofn)))) (when (featurep 'font-lock) (set (make-local-variable 'font-lock-defaults) '(message-font-lock-keywords t)) @@ -5121,7 +5898,8 @@ after replacing with the original article." (when (featurep 'font-lock) (setq font-lock-defaults nil) (font-lock-mode -1)) - (gnus-article-edit-done arg)) + (let ((inhibit-read-only t)) + (gnus-article-edit-done arg))) (defun gnus-article-mime-edit-exit () "Exit the article MIME editing without updating." @@ -5158,13 +5936,215 @@ after replacing with the original article." ;;; Internal Variables: -(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)" +(defcustom gnus-button-url-regexp + (if (string-match "[[:digit:]]" "1") ;; support POSIX? + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~`%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~`%&*+\\/[:word:]]\\)" + "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~`%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~`%&*+\\/]\\|\\w\\)\\)") "Regular expression that matches URLs." :group 'gnus-article-buttons :type 'regexp) +(defcustom gnus-button-valid-fqdn-regexp + (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain. + ;; valid TLDs: + "\\([a-z][a-z]" ;; two letter country TDLs + "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org" + "\\|aero\\|coop\\|info\\|name\\|museum" + "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style? + "\\)") + "Regular expression that matches a valid FQDN." + :group 'gnus-article-buttons + :type 'regexp) + +(defcustom gnus-button-man-handler 'manual-entry + "Function to use for displaying man pages. +The function must take at least one argument with a string naming the +man page." + :type '(choice (function-item :tag "Man" manual-entry) + (function-item :tag "Woman" woman) + (function :tag "Other")) + :group 'gnus-article-buttons) + +(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/" + "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive. +If the default site is too slow, try to find a CTAN mirror, see +. See also +the variable `gnus-button-handle-ctan'." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type '(choice (const "http://www.tex.ac.uk/tex-archive/") + (const "http://tug.ctan.org/tex-archive/") + (const "http://www.dante.de/CTAN/") + (string :tag "Other"))) + +(defcustom gnus-button-ctan-handler 'browse-url + "Function to use for displaying CTAN links. +The function must take one argument, the string naming the URL." + :type '(choice (function-item :tag "Browse Url" browse-url) + (function :tag "Other")) + :group 'gnus-article-buttons) + +(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" + "Bogus strings removed from CTAN URLs." + :group 'gnus-article-buttons + :type '(choice (const "^/?tex-archive/\\|/") + (regexp :tag "Other"))) + +(defcustom gnus-button-mid-or-mail-regexp + (concat "\\b\\(\")!;:,{}\n\t ]*@" + gnus-button-valid-fqdn-regexp + ">?\\)\\b") + "Regular expression that matches a message ID or a mail address." + :group 'gnus-article-buttons + :type 'regexp) + +(defcustom gnus-button-prefer-mid-or-mail 'guess + "What to do when the button on a string as \"foo123@bar.com\" is pushed. +Strings like this can be either a message ID or a mail address. If the +variable is set to the symbol `ask', query the user what do do. If it is the +symbol `guess', Gnus will do a guess and query the user what do do if it is +ambiguous. See the variable `gnus-button-guessed-mid-regexp' for details +concerning the guessing. If it is one of the sybols `mid' or `mail', Gnus +will always assume that the string is a message ID or a mail address, +respectivly." + ;; FIXME: doc-string could/should be improved. + :group 'gnus-article-buttons + :type '(choice (const ask) + (const guess) + (const mid) + (const mail))) + +(defcustom gnus-button-guessed-mid-regexp + (concat + "^. I.e. translate the + ;; Perl-REs to Elisp-REs. + :group 'gnus-article-buttons + :type 'regexp) + +(defun gnus-button-handle-mid-or-mail (mid-or-mail) + (let* ((pref gnus-button-prefer-mid-or-mail) + (url-mid (concat "news" ":" mid-or-mail)) + (url-mailto (concat "mailto" ":" mid-or-mail))) + (gnus-message 9 "mid-or-mail=%s" mid-or-mail) + ;; If it looks like a MID (well known readers or servers) use 'mid, + ;; otherwise 'ask the user. + (if (eq pref 'guess) + (if (string-match gnus-button-guessed-mid-regexp mid-or-mail) + (setq pref 'mid) + (setq pref 'ask))) + (if (eq pref 'ask) + (save-window-excursion + (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? ")) + (setq pref 'mail) + (setq pref 'mid)))) + (cond ((eq pref 'mid) + (gnus-message 9 "calling `gnus-button-handle-news' %s" url-mid) + (gnus-button-handle-news url-mid)) + ((eq pref 'mail) + (gnus-message 9 "calling `gnus-url-mailto' %s" url-mailto) + (gnus-url-mailto url-mailto))))) + +(defun gnus-button-handle-custom (url) + "Follow a Custom URL." + (customize-apropos (gnus-url-unhex-string url))) + +(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|?\\)") + +(defun gnus-button-handle-describe-function (url) + "Call describe-function when pushing the corresponding URL button." + (describe-function + (intern + (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + +(defun gnus-button-handle-describe-variable (url) + "Call describe-variable when pushing the corresponding URL button." + (describe-variable + (intern + (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) + +;; FIXME: Is is possible to implement this? Else it should be removed here +;; and in `gnus-button-alist'. +(defun gnus-button-handle-describe-key (url) + "Call describe-key when pushing the corresponding URL button." + (error "not implemented")) + +(defun gnus-button-handle-apropos (url) + "Call apropos when pushing the corresponding URL button." + (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-apropos-command (url) + "Call apropos when pushing the corresponding URL button." + (apropos-command + (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-apropos-variable (url) + "Call apropos when pushing the corresponding URL button." + (funcall + (if (fboundp 'apropos-variable) 'apropos-variable 'apropos) + (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-apropos-documentation (url) + "Call apropos when pushing the corresponding URL button." + (funcall + (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) + (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) + +(defun gnus-button-handle-ctan (url) + "Call `browse-url' when pushing a CTAN URL button." + (funcall + gnus-button-ctan-handler + (concat + gnus-ctan-url + (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp "")))) + +(defcustom gnus-button-tex-level 5 + "*Integer that says how many TeX-related buttons Gnus will show. +The higher the number, the more buttons will appear and the more false +positives are possible. Note that you can set this variable local to +specifific groups. Setting it higher in TeX groups is probably a good idea. +See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on +how to set variables in specific groups." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type 'integer) + +(defcustom gnus-button-man-level 5 + "*Integer that says how many man-related buttons Gnus will show. +The higher the number, the more buttons will appear and the more false +positives are possible. Note that you can set this variable local to +specifific groups. Setting it higher in Unix groups is probably a good idea. +See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on +how to set variables in specific groups." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type 'integer) + +(defcustom gnus-button-emacs-level 5 + "*Integer that says how many emacs-related buttons Gnus will show. +The higher the number, the more buttons will appear and the more false +positives are possible. Note that you can set this variable local to +specifific groups. Setting it higher in Emacs or Gnus related groups is +probably a good idea. See Info node `(gnus)Group Parameters' and the variable +`gnus-parameters' on how to set variables in specific groups." + :group 'gnus-article-buttons + :link '(custom-manual "(gnus)Group Parameters") + :type 'integer) + +(defcustom gnus-button-mail-level 5 + "*Integer that says how many buttons for message IDs or mail addresses will appear. +The higher the number, the more buttons will appear and the more false +positives are possible." + :group 'gnus-article-buttons + :type 'integer) + (defcustom gnus-button-alist - `(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" + '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t gnus-button-handle-news 3) ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-handle-news 2) @@ -5175,16 +6155,64 @@ after replacing with the original article." ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 2) - ("mailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) + ("mailto:\\([-a-z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) + ;; CTAN + ("\\bCTAN:[ \t\n]*\\([^>)!;:,\n\t ]*\\)" 0 (>= gnus-button-tex-level 1) + gnus-button-handle-ctan 1) + ;; This is info + ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 + (>= gnus-button-emacs-level 1) gnus-button-handle-info 2) + ;; This is custom + ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 + (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) + ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 + (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1) + ;; Emacs help commands + ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + ;; regexp doesn't match arguments containing ` '. + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1) + ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1) + ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1) + ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) + ("\\b\\(C-h\\|?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) + ("\\b\\(C-h\\|?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" + 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) + ("\\b\\(C-h\\|?\\)[ \t\n]+k[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+" 0 + ;; this regexp needs to be fixed! + (>= gnus-button-emacs-level 9) gnus-button-handle-describe-key 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) + ;; man pages + ("\\b\\([a-z][a-z]+\\)([1-9])\\W" 0 + (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) + gnus-button-handle-man 1) + ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) + ("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W" 0 + (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) + gnus-button-handle-man 1) + ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), + ;; SoWWWAnchor(3iv), XSelectInput(3X11) + ("\\b\\([a-z][-_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W" 0 + (>= gnus-button-man-level 5) gnus-button-handle-man 1) + ;; MID or mail: To avoid too many false positives we don't try to catch + ;; all kind of allowed MIDs or mail addresses. Domain part must contain + ;; at least one dot. TLD must contain two or three chars or be a know TLD + ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist' + ;; so that non-ambiguous entries (see above) match first. + (gnus-button-mid-or-mail-regexp + 0 (>= gnus-button-mail-level 5) gnus-button-handle-mid-or-mail 1)) "*Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where -REGEXP: is the string matching text around the button, +REGEXP: is the string (case insensitive) matching text around the button (can +also be lisp expression evaluating to a string), BUTTON: is the number of the regexp grouping actually matching the button, FORM: is a lisp expression which must eval to true for the button to be added, @@ -5194,7 +6222,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") @@ -5203,14 +6231,15 @@ variable it the real callback function." (integer :tag "Regexp group"))))) (defcustom gnus-header-button-alist - `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" + '(("^\\(References\\|Message-I[Dd]\\):" "<[^<>]+>" 0 t gnus-button-message-id 0) ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 0 t gnus-button-mailto 0) - ("^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) + ("^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-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. @@ -5249,7 +6278,7 @@ call it with the value of the `gnus-data' text property." (interactive "e") (set-buffer (window-buffer (posn-window (event-start event)))) (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'gnus-data)) + (data (get-text-property pos 'gnus-data)) (fun (get-text-property pos 'gnus-callback))) (goto-char pos) (when fun @@ -5421,7 +6450,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)))) @@ -5463,7 +6492,7 @@ specified by `gnus-button-alist'." (match-beginning 0)) (point-max))) (goto-char beg) - (while (re-search-forward (nth 1 entry) end t) + (while (re-search-forward (eval (nth 1 entry)) end t) ;; Each match within a header. (let* ((entry (cdr entry)) (start (match-beginning (nth 1 entry))) @@ -5510,14 +6539,19 @@ specified by `gnus-button-alist'." (limit (next-single-property-change end 'mime-view-entity nil (point-max)))) (if (text-property-any end limit 'article-type 'signature) - (gnus-remove-text-properties-when - 'article-type 'signature end limit - (cons 'article-type (cons 'signature - gnus-hidden-properties))) + (progn + (gnus-delete-wash-type 'signature) + (gnus-remove-text-properties-when + 'article-type 'signature end limit + (cons 'article-type (cons 'signature + gnus-hidden-properties)))) + (gnus-add-wash-type 'signature) (gnus-add-text-properties-when 'article-type nil end limit (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. @@ -5525,7 +6559,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)) @@ -5564,7 +6598,7 @@ specified by `gnus-button-alist'." (when (looking-at "//\\([^/]+\\)/") (setq server (match-string 1)) (goto-char (match-end 0))) - + (cond ((looking-at "\\(.*@.*\\)") (setq message-id (match-string 1))) @@ -5592,6 +6626,22 @@ specified by `gnus-button-alist'." (group (gnus-button-fetch-group url))))) +(defun gnus-button-handle-man (url) + "Fetch a man page." + (funcall gnus-button-man-handler url)) + +(defun gnus-button-handle-info (url) + "Fetch an info URL." + (if (string-match + "^\\([^:/]+\\)?/\\(.*\\)" + url) + (gnus-info-find-node + (concat "(" (or (gnus-url-unhex-string (match-string 1 url)) + "Gnus") + ")" + (gnus-url-unhex-string (match-string 2 url)))) + (error "Can't parse %s" url))) + (defun gnus-button-message-id (message-id) "Fetch MESSAGE-ID." (save-excursion @@ -5603,8 +6653,10 @@ 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 "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$" - address)) + (if (not + (string-match + "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?" + address)) (error "Can't parse %s" address) (gnus-group-read-ephemeral-group (match-string 4 address) @@ -5612,171 +6664,131 @@ specified by `gnus-button-alist'." (nntp-address ,(match-string 1 address)) (nntp-port-number ,(if (match-end 3) (match-string 3 address) - "nntp"))))))) + "nntp"))) + nil nil nil + (and (match-end 6) (list (string-to-int (match-string 6 address)))))))) (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) (setq pairs (split-string query "&")) (while pairs (setq cur (car pairs) - pairs (cdr pairs)) + pairs (cdr pairs)) (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))) - (if downcase - (setq key (downcase key))) - (setq cur (assoc key retval)) - (if cur - (setcdr cur (cons val (cdr cur))) - (setq retval (cons (list key val) retval))))) + 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) t)) + (if downcase + (setq key (downcase key))) + (setq cur (assoc key retval)) + (if cur + (setcdr cur (cons val (cdr cur))) + (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 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) (setq url (substring url (match-beginning 1) nil))) (let (to args subject func) (if (string-match (regexp-quote "?") url) - (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) - args (gnus-url-parse-query-string - (substring url (match-end 0) nil) t)) + (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) + args (gnus-url-parse-query-string + (substring url (match-end 0) nil) t)) (setq to (gnus-url-unhex-string url))) (setq args (cons (list "to" to) args) - subject (cdr-safe (assoc "subject" args))) + subject (cdr-safe (assoc "subject" args))) (gnus-msg-mail) (while args (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) + (funcall func) + (message-position-on-field (caar args))) (insert (mapconcat 'identity (cdar args) ", ")) (setq args (cdr args))) (if subject - (message-goto-body) + (message-goto-body) (message-goto-subject)))) (defun gnus-button-embedded-url (address) "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)))) - ) - -(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)) - -(defun gnus-button-next-page () +(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 + (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))) -(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." (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))) @@ -5784,7 +6796,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))) @@ -5794,11 +6806,11 @@ forbidden in URL encoding." 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)) ") @@ -5818,7 +6830,7 @@ For example: (string-match (car x) gnus-newsgroup-name)) (nconc gnus-decode-header-methods-cache (list (cdr x)))))) - gnus-decode-header-methods)) + gnus-decode-header-methods)) (let ((xlist gnus-decode-header-methods-cache)) (pop xlist) (save-restriction @@ -5848,11 +6860,11 @@ For example: val elem buttonized) (gnus-run-hooks 'gnus-part-display-hook) (unless gnus-inhibit-treatment - (while (setq elem (pop alist)) + (dolist (elem alist) (setq val (save-excursion - (if (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-summary-buffer)) + (when (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-summary-buffer)) (symbol-value (car elem)))) (when (and (or (consp val) treated-type) @@ -5931,10 +6943,11 @@ For example: (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) (unless func (error (format "Can't find the encrypt protocol %s" protocol))) - (if (equal gnus-newsgroup-name "nndraft:drafts") - (error "Can't encrypt the article in group nndraft:drafts.")) - (if (equal gnus-newsgroup-name "nndraft:queue") - (error "Don't encrypt the article in group nndraft:queue.")) + (if (member gnus-newsgroup-name '("nndraft:delayed" + "nndraft:drafts" + "nndraft:queue")) + (error "Can't encrypt the article in group %s" + gnus-newsgroup-name)) (gnus-summary-iterate n (save-excursion (set-buffer gnus-summary-buffer) @@ -5947,7 +6960,7 @@ For example: (error "The current newsgroup does not support article encrypt")) (gnus-summary-show-article t) (setq references - (or (mail-header-references gnus-current-headers) "")) + (or (mail-header-references gnus-current-headers) "")) (set-buffer gnus-article-buffer) (let* ((buffer-read-only nil) (headers @@ -6029,21 +7042,25 @@ For example: (defun gnus-mime-security-verify-or-decrypt (handle) (mm-remove-parts (cdr handle)) (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) - buffer-read-only) + point buffer-read-only) + (if region + (goto-char (car region))) + (save-restriction + (narrow-to-region (point) (point)) + (with-current-buffer (mm-handle-multipart-original-buffer handle) + (let* ((mm-verify-option 'known) + (mm-decrypt-option 'known) + (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) + (unless (eq nparts (cdr handle)) + (mm-destroy-parts (cdr handle)) + (setcdr handle nparts)))) + (setq point (point)) + (gnus-mime-display-security handle) + (goto-char (point-max))) (when region - (delete-region (car region) (cdr region)) + (delete-region (point) (cdr region)) (set-marker (car region) nil) - (set-marker (cdr region) nil))) - (with-current-buffer (mm-handle-multipart-original-buffer handle) - (let* ((mm-verify-option 'known) - (mm-decrypt-option 'known) - (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) - (unless (eq nparts (cdr handle)) - (mm-destroy-parts (cdr handle)) - (setcdr handle nparts)))) - (let ((point (point)) - buffer-read-only) - (gnus-mime-display-security handle) + (set-marker (cdr region) nil)) (goto-char point))) (defun gnus-mime-security-show-details (handle) @@ -6053,19 +7070,21 @@ For example: (let ((gnus-mime-security-button-pressed t) (gnus-mime-security-button-line-format (get-text-property (point) 'gnus-line-format)) - buffer-read-only) + buffer-read-only) (forward-char -1) (while (eq (get-text-property (point) 'gnus-line-format) gnus-mime-security-button-line-format) (forward-char -1)) (forward-char) + (save-restriction + (narrow-to-region (point) (point)) + (gnus-insert-mime-security-button handle)) (delete-region (point) (or (text-property-not-all (point) (point-max) - 'gnus-line-format - gnus-mime-security-button-line-format) - (point-max))) - (gnus-insert-mime-security-button handle)) + 'gnus-line-format + gnus-mime-security-button-line-format) + (point-max)))) (if (gnus-buffer-live-p gnus-mime-security-details-buffer) (with-current-buffer gnus-mime-security-details-buffer (erase-buffer) @@ -6111,14 +7130,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 @@ -6138,13 +7154,15 @@ For example: (defun gnus-mime-display-security (handle) (save-restriction (narrow-to-region (point) (point)) - (gnus-insert-mime-security-button handle) + (unless (gnus-unbuttonized-mime-type-p (car handle)) + (gnus-insert-mime-security-button handle)) (gnus-mime-display-mixed (cdr handle)) (unless (bolp) (insert "\n")) - (let ((gnus-mime-security-button-line-format - gnus-mime-security-button-end-line-format)) - (gnus-insert-mime-security-button handle)) + (unless (gnus-unbuttonized-mime-type-p (car handle)) + (let ((gnus-mime-security-button-line-format + gnus-mime-security-button-end-line-format)) + (gnus-insert-mime-security-button handle))) (mm-set-handle-multipart-parameter handle 'gnus-region (cons (set-marker (make-marker) (point-min)) @@ -6156,7 +7174,7 @@ For example: (defun gnus-article-header-presentation-method (entity situation) (mime-insert-header entity) - ) + (article-decode-group-name)) (set-alist 'mime-header-presentation-method-alist 'gnus-original-article-mode