X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=9c53e8b6a7fe4fb6c19866b6c2a4330db0534bcd;hp=162f7e88eda6a640df6c70c640937c55c06eb5f4;hb=d9bb27af5078e8ec7dbca6f750b55031b0578968;hpb=e589cbb5c55b587cd375e9f1fad84f63936c15b3 diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 162f7e88e..9c53e8b6a 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -106,43 +106,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:" "^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:") + (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." @@ -242,6 +246,7 @@ asynchronously. The compressed face will be piped to this command." (function-item gnus-display-x-face-in-from) function) :version "21.1" + :group 'gnus-picon :group 'gnus-article-washing) (defcustom gnus-article-x-face-too-ugly nil @@ -278,6 +283,26 @@ 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-\\)") @@ -295,6 +320,8 @@ directly.") (format format (car spec) (cadr spec)) 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) 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. @@ -350,7 +377,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 @@ -668,6 +699,7 @@ displayed by the first non-nil matching CONTENT face." ("\225" "*") ("\226" "-") ("\227" "--") + ("\230" "~") ("\231" "(TM)") ("\233" ">") ("\234" "oe") @@ -682,7 +714,8 @@ displayed by the first non-nil matching CONTENT face." (defcustom gnus-unbuttonized-mime-types '(".*/.*") "List of MIME types that should not be given buttons when rendered inline. -See also `gnus-buttonized-mime-types' which may override this variable." +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)) @@ -691,11 +724,20 @@ See also `gnus-buttonized-mime-types' which may override this variable." "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\")'." +`(\"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 @@ -705,10 +747,13 @@ be controlled by `gnus-treat-body-boundary'." string)) (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") - "*Defines the location of the faces database. + "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" - :type 'directory + :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 () @@ -805,6 +850,7 @@ used." Valid values are nil, t, `head', `last', an integer or a predicate. 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) @@ -813,6 +859,7 @@ See Info node `(gnus)Customizing Articles'." Valid values are nil, t, `head', `last', an integer or a predicate. 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) @@ -821,6 +868,7 @@ See Info node `(gnus)Customizing Articles'." 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-head-custom) (put 'gnus-treat-buttonize-head 'highlight t) @@ -833,6 +881,7 @@ See Info node `(gnus)Customizing Articles' for details." 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) (put 'gnus-treat-emphasize 'highlight t) @@ -841,6 +890,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-unsplit-urls nil @@ -848,6 +898,7 @@ See Info node `(gnus)Customizing Articles' for details." 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 @@ -855,6 +906,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-hide-headers 'head @@ -862,6 +914,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (defcustom gnus-treat-hide-boring-headers nil @@ -869,6 +922,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (defcustom gnus-treat-hide-signature nil @@ -876,6 +930,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-article nil @@ -883,6 +938,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-hide-citation nil @@ -890,6 +946,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-hide-citation-maybe nil @@ -897,6 +954,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-strip-list-identifiers 'head @@ -905,6 +963,7 @@ 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-strip-pgp t @@ -912,6 +971,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-strip-pem nil @@ -919,6 +979,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-strip-banner t @@ -927,6 +988,7 @@ 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 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 @@ -934,6 +996,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (put 'gnus-treat-highlight-headers 'highlight t) @@ -942,6 +1005,7 @@ See Info node `(gnus)Customizing Articles' for details." 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) (put 'gnus-treat-highlight-citation 'highlight t) @@ -950,6 +1014,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (defcustom gnus-treat-date-local nil @@ -957,6 +1022,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (defcustom gnus-treat-date-english nil @@ -964,6 +1030,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (defcustom gnus-treat-date-lapsed nil @@ -971,6 +1038,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (defcustom gnus-treat-date-original nil @@ -978,6 +1046,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-head-custom) (defcustom gnus-treat-date-iso8601 nil @@ -986,6 +1055,7 @@ 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-head-custom) (defcustom gnus-treat-date-user-defined nil @@ -994,6 +1064,7 @@ The format is defined by the `gnus-article-time-format' variable. 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-head-custom) (defcustom gnus-treat-strip-headers-in-body t @@ -1002,6 +1073,7 @@ 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-strip-trailing-blank-lines nil @@ -1009,6 +1081,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-strip-leading-blank-lines nil @@ -1016,6 +1089,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-strip-multiple-blank-lines nil @@ -1023,6 +1097,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-unfold-headers 'head @@ -1030,6 +1105,7 @@ See Info node `(gnus)Customizing Articles' for details." 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 @@ -1037,6 +1113,7 @@ See Info node `(gnus)Customizing Articles' for details." 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 @@ -1044,6 +1121,7 @@ See Info node `(gnus)Customizing Articles' for details." 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 @@ -1051,6 +1129,7 @@ See Info node `(gnus)Customizing Articles' for details." 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) (put 'gnus-treat-overstrike 'highlight t) @@ -1068,6 +1147,26 @@ 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-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) @@ -1094,6 +1193,8 @@ 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) @@ -1106,6 +1207,9 @@ 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) @@ -1118,6 +1222,9 @@ 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-mail-picon 'highlight t) @@ -1130,6 +1237,9 @@ 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) @@ -1143,6 +1253,7 @@ 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 @@ -1151,6 +1262,15 @@ 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-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 @@ -1158,6 +1278,7 @@ See Info node `(gnus)Customizing Articles' for details." 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-play-sounds nil @@ -1166,6 +1287,7 @@ 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-translate nil @@ -1174,6 +1296,7 @@ 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-x-pgp-sig nil @@ -1183,6 +1306,7 @@ 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 @@ -1229,6 +1353,7 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-date-user-defined gnus-article-date-user) (gnus-treat-date-iso8601 gnus-article-date-iso8601) (gnus-treat-display-xface gnus-article-display-x-face) + (gnus-treat-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) @@ -1254,6 +1379,7 @@ It is a string, such as \"PGP\". If nil, ask user." (gnus-treat-buttonize-head gnus-article-add-buttons-to-head) (gnus-treat-display-smileys gnus-treat-smiley) (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) + (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) @@ -1269,8 +1395,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.") @@ -1377,13 +1506,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." @@ -1741,7 +1870,7 @@ unfolded." (setq str (concat str gnus-body-boundary-delimiter))) (substring str 0 (1- (window-width)))) "\n") - (gnus-add-text-properties start (point) '(gnus-decoration 'header)))))) + (gnus-put-text-property start (point) 'gnus-decoration 'header))))) (defun article-fill-long-lines () "Fill lines that are wider than the window width." @@ -1755,9 +1884,10 @@ unfolded." (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))))))) @@ -1801,6 +1931,28 @@ unfolded." (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)) @@ -2068,28 +2220,31 @@ If READ-CHARSET, ask for a coding system." (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))))) + "^\\(\\(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. + "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))))))) - (if read-charset - (setq charset (mm-read-coding-system "Charset: " 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) @@ -2098,8 +2253,8 @@ If READ-CHARSET, ask for a coding system." (narrow-to-region (point) (point-max)) (let* ((func (or gnus-article-wash-function mm-text-html-renderer)) (entry (assq func mm-text-html-washer-alist))) - (if entry - (setq func (cdr entry))) + (when entry + (setq func (cdr entry))) (cond ((gnus-functionp func) (funcall func)) @@ -2111,9 +2266,9 @@ If READ-CHARSET, ask for a coding system." (mm-setup-w3) (let ((w3-strict-width (window-width)) (url-standalone-mode t) - (url-gateway-unplugged t) + (url-gateway-unplugged t) (w3-honor-stylesheets nil)) - (condition-case var + (condition-case () (w3-region (point-min) (point-max)) (error)))) @@ -2131,8 +2286,8 @@ If READ-CHARSET, ask for a coding system." (when mm-inline-text-html-with-w3m-keymap (add-text-properties (point-min) (point-max) - (append '(mm-inline-text-html-with-w3m t) - (gnus-local-map-property mm-w3m-mode-map)))))) + (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. @@ -2229,6 +2384,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 @@ -2478,6 +2647,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 @@ -2519,15 +2699,20 @@ should replace the \"Date:\" one, or should be added below it." (while (re-search-forward date-regexp nil t) (if pos (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) + (progn (gnus-article-forward-header) + (point))) (delete-region (progn (beginning-of-line) (point)) - (progn (end-of-line) (point))) + (progn (gnus-article-forward-header) + (forward-char -1) + (point))) (setq pos (point)))) - (when (and (not pos) (re-search-forward tdate-regexp nil t)) + (when (and (not pos) + (re-search-forward tdate-regexp nil t)) (forward-line 1)) - (if pos (goto-char pos)) + (when pos + (goto-char pos)) (insert (article-make-date-line date (or type 'ut))) - (when (not pos) + (unless pos (insert "\n") (forward-line -1)) ;; Do highlighting. @@ -2572,11 +2757,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)))) @@ -2650,8 +2838,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 Gnus)" date)))) (defun article-date-local (&optional highlight) "Convert the current article date to the local timezone." @@ -2895,7 +3083,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) @@ -3199,6 +3387,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is 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 @@ -3218,7 +3407,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is article-strip-trailing-space article-strip-blank-lines article-strip-all-blank-lines - article-replace-with-quoted-text article-date-local article-date-english article-date-iso8601 @@ -3382,6 +3570,12 @@ commands: (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) (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) (setq gnus-article-mime-handles nil)) @@ -3447,7 +3641,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")) @@ -3519,6 +3713,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)))))) @@ -3556,8 +3752,8 @@ Valid specifiers include: %p The part identifier number %e Dots if the part isn't displayed -General format specifiers can also be used. See -(gnus)Formatting Variables.") +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) @@ -3759,6 +3955,36 @@ General format specifiers can also be used. See (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 MIME part under point into a new buffer." (interactive) @@ -3769,7 +3995,7 @@ General format specifiers can also be used. See (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)))) @@ -3780,6 +4006,7 @@ General format specifiers can also be used. See (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))))) @@ -3790,7 +4017,7 @@ General format specifiers can also be used. See (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (file (make-temp-name (expand-file-name "mm." mm-tmp-directory))) + (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) (printer (mailcap-mime-info (mm-handle-type handle) "print"))) (when contents (if printer @@ -4120,9 +4347,10 @@ If no internal viewer is available, use an external viewer." ;; We have to do this since selecting the window ;; may change the point. So we set the window point. (set-window-point window point))) - (let* ((handles (or ihandles (mm-dissect-buffer - nil gnus-article-loose-mime) - (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)) @@ -4551,7 +4779,7 @@ Argument LINES specifies lines to be scrolled up." (if (save-excursion (end-of-line) (and (pos-visible-in-window-p) ;Not continuation line. - (eobp))) + (>= (1+ (point)) (point-max)))) ;Allow for trailing newline. ;; Nothing in this page. (if (or (not gnus-page-broken) (save-excursion @@ -4770,31 +4998,34 @@ the entire article will be yanked." (interactive "P") (let ((article (cdr gnus-article-current)) cont) (if (not (mark t)) - (gnus-summary-reply (list (list article)) wide) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply (list (list article)) wide)) (setq cont (buffer-substring (point) (mark t))) ;; Deactivate active regions. (when (and (boundp 'transient-mark-mode) transient-mark-mode) (setq mark-active nil)) - (gnus-summary-reply - (list (list article cont)) wide)))) + (with-current-buffer gnus-summary-buffer + (gnus-summary-reply + (list (list article cont)) wide))))) (defun gnus-article-followup-with-original () "Compose a followup to the current article. The text in the region will be yanked. If the region isn't active, the entire article will be yanked." (interactive) - (let ((article (cdr gnus-article-current)) - cont) - (if (not (mark t)) - (gnus-summary-followup (list (list article))) - (setq cont (buffer-substring (point) (mark t))) - ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active nil)) - (gnus-summary-followup - (list (list article cont)))))) + (let ((article (cdr gnus-article-current)) cont) + (if (not (mark t)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup (list (list article)))) + (setq cont (buffer-substring (point) (mark t))) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) + (with-current-buffer gnus-summary-buffer + (gnus-summary-followup + (list (list article cont))))))) (defun gnus-article-hide (&optional arg force) "Hide all the gruft in the current article. @@ -4925,6 +5156,8 @@ If given a prefix, show the hidden text instead." (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)) @@ -4943,7 +5176,8 @@ If given a prefix, show the hidden text instead." (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) @@ -4951,10 +5185,13 @@ If given a prefix, show the hidden text instead." (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))) @@ -5008,13 +5245,13 @@ If given a prefix, show the hidden text instead." (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-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 @@ -5033,7 +5270,7 @@ If given a prefix, show the hidden text instead." "\C-c\C-f\C-k" message-goto-keywords "\C-c\C-f\C-u" message-goto-summary "\C-c\C-f\C-i" message-insert-or-toggle-importance - "\C-c\C-f\C-a" message-gen-unsubscribed-mft + "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to "\C-c\C-b" message-goto-body "\C-c\C-i" message-goto-signature @@ -5083,6 +5320,7 @@ This is an extended text-mode. (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) (mml-mode) (setq buffer-read-only nil) @@ -5127,6 +5365,7 @@ groups." (start (window-start)) (p (point)) (winconf gnus-prev-winconf)) + (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. @@ -5162,6 +5401,7 @@ groups." (if (gnus-buffer-live-p gnus-original-article-buffer) (insert-buffer 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. @@ -5187,13 +5427,215 @@ groups." ;;; Internal Variables: -(defcustom gnus-button-url-regexp "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-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) @@ -5204,19 +5646,64 @@ groups." ("\\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 t - gnus-button-handle-info 2) + ("\\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... ("]*\\)>" 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, @@ -5226,7 +5713,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") @@ -5235,15 +5722,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) - ("^[^:]+:" "\\bmailto:\\([-a-zA-Z.@_+0-9%=?]+\\)" 0 t gnus-url-mailto 1) + ("^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. @@ -5413,7 +5900,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)))) @@ -5455,7 +5942,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))) @@ -5518,7 +6005,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)) @@ -5585,6 +6072,10 @@ 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 @@ -5766,11 +6257,11 @@ specified by `gnus-button-alist'." This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a -(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups +\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups whose names match REGEXP. For example: -((\"chinese\" . gnus-decode-encoded-word-region-by-guess) +\((\"chinese\" . gnus-decode-encoded-word-region-by-guess) mail-decode-encoded-word-region (\"chinese\" . rfc1843-decode-region)) ") @@ -5816,11 +6307,11 @@ For example: (highlightp (gnus-visual-p 'article-highlight 'highlight)) val elem) (gnus-run-hooks 'gnus-part-display-hook) - (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) @@ -5842,6 +6333,8 @@ For example: (cond ((null val) nil) + (condition + (eq condition val)) ((and (listp val) (stringp (car val))) (apply 'gnus-or (mapcar `(lambda (s) @@ -5860,8 +6353,6 @@ For example: (equal (car val) type)) (t (error "%S is not a valid predicate" pred))))) - (condition - (eq condition val)) ((eq val t) t) ((eq val 'head) @@ -5885,10 +6376,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)