;;; 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 <larsi@gnus.org>
: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."
(defcustom gnus-article-x-face-command
(if (featurep 'xemacs)
(if (or (gnus-image-type-available-p 'xface)
- (gnus-image-type-available-p 'xpm))
- 'gnus-xmas-article-display-xface
+ (gnus-image-type-available-p 'pbm))
+ 'gnus-display-x-face-in-from
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
- (if (gnus-image-type-available-p 'xbm)
- 'gnus-article-display-xface
- (if gnus-article-compface-xbm
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
-display -")))
+ (if (gnus-image-type-available-p 'pbm)
+ 'gnus-display-x-face-in-from
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
+display -"))
"*String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
:type `(choice string
- (function-item
- ,(if (featurep 'xemacs)
- 'gnus-xmas-article-display-xface
- 'gnus-article-display-xface))
+ (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
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) (cadr 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:
(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
("\225" "*")
("\226" "-")
("\227" "--")
+ ("\230" "~")
("\231" "(TM)")
("\233" ">")
("\234" "oe")
(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))
"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
: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
("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
;;;
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)
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)
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)
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)
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
+ "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
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
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
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
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
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
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
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
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
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
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
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
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)
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)
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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)
(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)
`(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)
+
+(defcustom gnus-treat-display-grey-xface
+ (and (not noninteractive)
+ (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))
`(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-from-picon
- (if (gnus-image-type-available-p 'xpm)
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
'head nil)
"Display picons in the From header.
Valid values are nil, t, `head', `last', an integer or a predicate.
See 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 (gnus-image-type-available-p 'xpm)
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
'head nil)
"Display picons in To and Cc headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
See 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)
(defcustom gnus-treat-newsgroups-picon
- (if (gnus-image-type-available-p 'xpm)
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
'head nil)
"Display picons in the Newsgroups and Followup-To headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
See 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)
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
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
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
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
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
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
: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
(gnus-treat-fill-article gnus-article-fill-cited-article)
(gnus-treat-fill-long-lines gnus-article-fill-long-lines)
(gnus-treat-strip-cr gnus-article-remove-cr)
+ (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
(gnus-treat-date-ut gnus-article-date-ut)
(gnus-treat-date-local gnus-article-date-local)
(gnus-treat-date-english gnus-article-date-english)
(gnus-treat-date-original gnus-article-date-original)
(gnus-treat-date-user-defined gnus-article-date-user)
(gnus-treat-date-iso8601 gnus-article-date-iso8601)
+ (gnus-treat-display-xface gnus-article-display-x-face)
+ (gnus-treat-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-mail-picon gnus-treat-mail-picon)
(gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
(gnus-treat-highlight-headers gnus-article-highlight-headers)
- (gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
(gnus-treat-strip-trailing-blank-lines
gnus-article-remove-trailing-blank-lines)
(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-display-xface gnus-article-display-x-face)
+ (gnus-treat-hide-citation gnus-article-hide-citation)
+ (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
+ (gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-body-boundary gnus-article-treat-body-boundary)
(gnus-treat-play-sounds gnus-earcon-display)))
(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.")
(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."
(with-temp-buffer
(insert header)
(goto-char (point-min))
- (while (re-search-forward "[\t ]*\n[\t ]+" nil t)
+ (while (re-search-forward "\n[\t ]" nil t)
(replace-match " " t t)))
(setq length (- (point-max) (point-min) 1)))
(when (< length (window-width))
- (while (re-search-forward "[\t ]*\n[\t ]+" nil t)
+ (while (re-search-forward "\n[\t ]" nil t)
(replace-match " " t t)))
(goto-char (point-max)))))))
(goto-char (point-max))))))
(defun gnus-treat-smiley ()
- "Display textual emoticons (\"smileys\") as small graphical icons."
- (interactive "P")
+ "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
+ (interactive)
(gnus-with-article-buffer
(if (memq 'smiley gnus-article-wash-types)
(gnus-delete-images 'smiley)
(defun gnus-article-treat-body-boundary ()
"Place a boundary line at the end of the headers."
(interactive)
- (when (and gnus-body-boundary-delimiter
+ (when (and gnus-body-boundary-delimiter
(> (length gnus-body-boundary-delimiter) 0))
(gnus-with-article-headers
(goto-char (point-max))
(while (>= (1- (window-width)) (length str))
(setq str (concat str gnus-body-boundary-delimiter)))
(substring str 0 (1- (window-width))))
- "\n")))))
+ "\n")
+ (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
(defun article-fill-long-lines ()
"Fill lines that are wider than the window width."
(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)))))))
(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))
- (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
- (set-buffer gnus-original-article-buffer)
- (save-restriction
- (mail-narrow-to-head)
- (while (gnus-article-goto-header "x-face\\(-[0-9]+\\)?")
- (when (match-beginning 2)
- (setq grey t))
- (push (mail-header-field-value) x-faces))
- (setq from (message-fetch-field "from"))))
- (if grey
- (gnus-put-image
- (gnus-create-image
- (gnus-convert-gray-x-face-to-xpm x-faces) 'xpm t))
- ;; Sending multiple EOFs to xv doesn't work, so we only do a
- ;; single external face.
- (when (stringp gnus-article-x-face-command)
- (setq x-faces (list (car x-faces))))
- (while (and (setq face (pop x-faces))
- gnus-article-x-face-command
- (or force
- ;; Check whether this face is censored.
- (not gnus-article-x-face-too-ugly)
- (and gnus-article-x-face-too-ugly from
- (not (string-match gnus-article-x-face-too-ugly
- from)))))
- ;; We display the face.
- (if (symbolp gnus-article-x-face-command)
- ;; The command is a lisp function, so we call it.
- (if (gnus-functionp gnus-article-x-face-command)
- (funcall gnus-article-x-face-command face)
- (error "%s is not a function" gnus-article-x-face-command))
- ;; The command is a string, so we interpret the command
- ;; as a, well, command, and fork it off.
- (let ((process-connection-type nil))
- (process-kill-without-query
- (start-process
- "article-x-face" nil shell-file-name shell-command-switch
- gnus-article-x-face-command))
- (with-temp-buffer
- (insert face)
- (process-send-region "article-x-face"
- (point-min) (point-max)))
- (process-send-eof "article-x-face")))))))))
+ (let ((wash-face-p buffer-read-only)) ;; When type `W f'
+ (gnus-with-article-headers
+ ;; Delete the old process, if any.
+ (when (process-status "article-x-face")
+ (delete-process "article-x-face"))
+ (if (memq 'xface gnus-article-wash-types)
+ ;; We have already displayed X-Faces, so we remove them
+ ;; instead.
+ (gnus-delete-images 'xface)
+ ;; Display X-Faces.
+ (let (x-faces from face grey)
+ (save-excursion
+ (when (and wash-face-p
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward
+ "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t)))
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ ;; If type `W f', use gnus-original-article-buffer,
+ ;; otherwise use the current buffer because displaying
+ ;; RFC822 parts calls this function too.
+ (set-buffer gnus-original-article-buffer))
+ (save-restriction
+ (mail-narrow-to-head)
+ (if gnus-treat-display-grey-xface
+ (progn
+ (while (gnus-article-goto-header "X-Face\\(-[0-9]+\\)?")
+ (if (match-beginning 2)
+ (progn
+ (setq grey t)
+ (push (cons (- (string-to-number (match-string 2)))
+ (mail-header-field-value))
+ x-faces))
+ (push (cons 0 (mail-header-field-value)) x-faces)))
+ (dolist (x-face (prog1
+ (if grey
+ (sort x-faces 'car-less-than-car)
+ (nreverse x-faces))
+ (setq x-faces nil)))
+ (push (cdr x-face) x-faces)))
+ (while (gnus-article-goto-header "X-Face")
+ (push (mail-header-field-value) x-faces)))
+ (setq from (message-fetch-field "from"))))
+ (if grey
+ (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces))
+ image)
+ (when xpm
+ (setq image (gnus-create-image xpm 'xpm t))
+ (gnus-article-goto-header "from")
+ (when (bobp)
+ (insert "From: [no `from' set]\n")
+ (forward-char -17))
+ (gnus-add-wash-type 'xface)
+ (gnus-add-image 'xface image)
+ (gnus-put-image image)))
+ ;; Sending multiple EOFs to xv doesn't work, so we only do a
+ ;; single external face.
+ (when (stringp gnus-article-x-face-command)
+ (setq x-faces (list (car x-faces))))
+ (while (and (setq face (pop x-faces))
+ gnus-article-x-face-command
+ (or force
+ ;; Check whether this face is censored.
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly from
+ (not (string-match gnus-article-x-face-too-ugly
+ from)))))
+ ;; We display the face.
+ (if (symbolp gnus-article-x-face-command)
+ ;; The command is a lisp function, so we call it.
+ (if (gnus-functionp gnus-article-x-face-command)
+ (funcall gnus-article-x-face-command face)
+ (error "%s is not a function" gnus-article-x-face-command))
+ ;; The command is a string, so we interpret the command
+ ;; as a, well, command, and fork it off.
+ (let ((process-connection-type nil))
+ (process-kill-without-query
+ (start-process
+ "article-x-face" nil shell-file-name shell-command-switch
+ gnus-article-x-face-command))
+ (with-temp-buffer
+ (insert face)
+ (process-send-region "article-x-face"
+ (point-min) (point-max)))
+ (process-send-eof "article-x-face"))))))))))
(defun article-decode-mime-words ()
"Decode all MIME-encoded words in the article."
(let ((buffer-read-only nil))
(rfc1843-decode-region (point-min) (point-max)))))
+(defun article-unsplit-urls ()
+ "Remove the newlines that some other mailers insert into URLs."
+ (interactive)
+ (save-excursion
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
+ (replace-match "\\1\\3" t)))
+ (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)
(save-window-excursion
(save-restriction
(narrow-to-region (point) (point-max))
- (mm-setup-w3)
- (let ((w3-strict-width (window-width))
- (url-standalone-mode t)
- (w3-honor-stylesheets nil)
- (w3-delay-image-loads t))
- (condition-case var
- (w3-region (point-min) (point-max))
- (error))))))))
+ (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
+ (entry (assq func mm-text-html-washer-alist)))
+ (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.
(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
(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
(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.
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))))
(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."
(interactive (list t))
(article-date-ut 'iso8601 highlight))
-(defun article-show-all ()
- "Show all hidden text in the article buffer."
- (interactive)
- (save-excursion
- (let ((buffer-read-only nil))
- (gnus-article-unhide-text (point-min) (point-max)))))
+;; (defun article-show-all ()
+;; "Show all hidden text in the article buffer."
+;; (interactive)
+;; (save-excursion
+;; (let ((buffer-read-only nil))
+;; (gnus-article-unhide-text (point-min) (point-max)))))
(defun article-remove-leading-whitespace ()
"Remove excessive whitespace from all headers."
(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)
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
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
article-emphasize
article-treat-dumbquotes
article-normalize-headers
- (article-show-all . gnus-article-show-all-headers))))
+;; (article-show-all . gnus-article-show-all-headers)
+ )))
\f
;;;
;;; Gnus article mode
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
["Remove base64" gnus-article-de-base64-unreadable t]
["Treat html" gnus-article-wash-html t]
+ ["Remove newlines from within URLs" gnus-article-unsplit-urls t]
["Decode HZ" gnus-article-decode-HZ t]))
;; Note "Commands" menu is defined in gnus-sum.el for consistency
(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))
(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"))
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))))))
%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)
(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")))
(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)
(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))))
(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)
+(defun gnus-mime-print-part (&optional handle filename)
"Print the MIME part under point."
- (interactive)
+ (interactive (list nil (ps-print-preprint current-prefix-arg)))
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(contents (and handle (mm-get-part handle)))
- (file (make-temp-name (expand-file-name "mm." mm-tmp-directory)))
+ (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
(printer (mailcap-mime-info (mm-handle-type handle) "print")))
(when contents
(if printer
(delete-file file))
(with-temp-buffer
(insert contents)
- (gnus-print-buffer))))))
+ (gnus-print-buffer))
+ (ps-despool filename)))))
(defun gnus-mime-inline-part (&optional handle arg)
"Insert the MIME part under point into the current buffer."
(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)
(mm-remove-part handle)
(mm-display-part handle)))))
-(defun gnus-mime-internalize-part (&optional handle)
+(defun gnus-mime-view-part-internally (&optional handle)
"View the MIME part under point with an internal viewer.
If no internal viewer is available, use an external viewer."
(interactive)
(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."
(let ((window (selected-window))
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
+ (if (gnus-buffer-live-p gnus-summary-buffer)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)
+ nil)))
(save-excursion
(unwind-protect
(let ((win (gnus-get-buffer-window (current-buffer) t))
(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
;; 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))
',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)
',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)
(defun gnus-add-wash-type (type)
"Add a washing of TYPE to the current status."
- (push type gnus-article-wash-types))
+ (add-to-list 'gnus-article-wash-types type))
(defun gnus-delete-wash-type (type)
"Add a washing of TYPE to the current status."
(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
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)))
- (if (not mark-active)
- (gnus-summary-reply (list (list article)) wide)
- (gnus-summary-reply
- (list (list article (buffer-substring (point) (mark)))) wide))))
+ (let ((article (cdr gnus-article-current)) cont)
+ (if (not (mark t))
+ (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))
+ (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)))
- (if (not mark-active)
- (gnus-summary-followup (list (list article)))
- (gnus-summary-followup
- (list (list article (buffer-substring (point) (mark))))))))
+ (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.
(gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
+(eval-when-compile
+ (autoload 'nneething-get-file-name "nneething"))
+
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
(let (do-update-line sparse-header)
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))))))))
(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))
(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)
(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)))
(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))
+(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.
(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)
+ (mml-mode)
(setq buffer-read-only nil)
(buffer-enable-undo)
(widen))
(interactive "P")
(let ((func gnus-article-edit-done-function)
(buf (current-buffer))
- (start (window-start)))
- ;; 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))))
+ (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.
+ (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))))
(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.
;;; 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
+<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. 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\\(<?[a-z0-9][^<>\")!;:,{}\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
+ "^<?\\(slrn\\|Pine\\.\\)"
+ "\\|\\.fsf@\\|\\.fsf_-_@\\|\\.ln@"
+ "\\|@4ax\\.com\\|@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de"
+ "\\|^<?.*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*@")
+ "Regular expression that matches message IDs and not mail addresses."
+ ;; TODO: Incorporate more matches from
+ ;; <URL:http://piology.org/perl/id-or-mail.pl.html>. 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\\|<?[Ff]1>?\\)")
+
+(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)
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
t gnus-button-message-id 3)
("\\(<URL: *\\)mailto: *\\([^> \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\\|<?[Ff]1>?\\)[ \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\\|<?[Ff]1>?\\)[ \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\\|<?[Ff]1>?\\)[ \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...
- ("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1)
+ ("<URL: *\\([^<>]*\\)>" 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,
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")
(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.
(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))))
(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)))
(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))
(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
(if (not (string-match "=" cur))
nil ; Grace
(setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
- val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
+ val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
(if downcase
(setq key (downcase key)))
(setq cur (assoc key retval))
(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
-(defvar gnus-prev-page-map nil)
-(unless gnus-prev-page-map
- (setq gnus-prev-page-map (make-sparse-keymap))
- (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
- (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
+(defvar gnus-prev-page-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= emacs-major-version 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map gnus-article-mode-map))
+ (define-key map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key map "\r" 'gnus-button-prev-page)
+ map))
(defun gnus-insert-prev-page-button ()
- (let ((buffer-read-only nil))
+ (let ((b (point))
+ (buffer-read-only nil))
(gnus-eval-format
gnus-prev-page-line-format nil
- `(gnus-prev t local-map ,gnus-prev-page-map
- gnus-callback gnus-article-button-prev-page
- article-type annotation))))
-
-(defvar gnus-next-page-map nil)
-(unless gnus-next-page-map
- (setq gnus-next-page-map (make-keymap))
- (suppress-keymap gnus-prev-page-map)
- (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
- (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
-
-(defun gnus-button-next-page ()
+ `(,@(gnus-local-map-property gnus-prev-page-map)
+ gnus-prev t
+ gnus-callback gnus-article-button-prev-page
+ article-type annotation))
+ (widget-convert-button
+ 'link b (point)
+ :action 'gnus-button-prev-page
+ :button-keymap gnus-prev-page-map)))
+
+(defvar gnus-prev-page-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= emacs-major-version 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map gnus-article-mode-map))
+ (define-key map gnus-mouse-2 'gnus-button-prev-page)
+ (define-key map "\r" 'gnus-button-prev-page)
+ map))
+
+(defvar gnus-next-page-map
+ (let ((map (make-sparse-keymap)))
+ (unless (>= emacs-major-version 21)
+ ;; XEmacs doesn't care.
+ (set-keymap-parent map gnus-article-mode-map))
+ (define-key map gnus-mouse-2 'gnus-button-next-page)
+ (define-key map "\r" 'gnus-button-next-page)
+ map))
+
+(defun gnus-button-next-page (&optional args more-args)
"Go to the next page."
(interactive)
(let ((win (selected-window)))
(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 win)))
(defun gnus-insert-next-page-button ()
- (let ((buffer-read-only nil))
+ (let ((b (point))
+ (buffer-read-only nil))
(gnus-eval-format gnus-next-page-line-format nil
- `(gnus-next
- t local-map ,gnus-next-page-map
- gnus-callback gnus-article-button-next-page
- article-type annotation))))
+ `(,@(gnus-local-map-property gnus-next-page-map)
+ gnus-next t
+ gnus-callback gnus-article-button-next-page
+ article-type annotation))
+ (widget-convert-button
+ 'link b (point)
+ :action 'gnus-button-next-page
+ :button-keymap gnus-next-page-map)))
(defun gnus-article-button-next-page (arg)
"Go to the next page."
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))
")
(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)
(cond
((null val)
nil)
+ (condition
+ (eq condition val))
((and (listp val)
(stringp (car val)))
(apply 'gnus-or (mapcar `(lambda (s)
(equal (car val) type))
(t
(error "%S is not a valid predicate" pred)))))
- (condition
- (eq condition val))
((eq val t)
t)
((eq val 'head)
(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)
(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