;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
"^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
"^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
"^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
- "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:"
+ "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face"
"^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
"^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
"^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
"^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:"g)
+ "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:"
+ "^X-Virus-Scanned:" "^X-Delivery-Agent:" "^Posted-Date:" "^X-Gateway:"
+ "^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:"
+ "^X-Received-Date:")
"*All headers that start with this regexp will be hidden.
This variable can also be a list of regexps of headers to be ignored.
If `gnus-visible-headers' is non-nil, this variable will be ignored."
;; non-graphical frames in a session.
(defcustom gnus-article-x-face-command
(if (featurep 'xemacs)
- (if (or (featurep 'xface)
- (featurep 'xpm))
- 'gnus-xmas-article-display-xface
+ (if (or (gnus-image-type-available-p 'xface)
+ (gnus-image-type-available-p 'pbm))
+ 'gnus-display-x-face-in-from
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
- (if (and (fboundp 'image-type-available-p)
- (image-type-available-p 'xbm))
- 'gnus-article-display-xface
- (if gnus-article-compface-xbm
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
- "{ 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" "-") ; This might not be correct.
("\231" "(TM)")
("\233" ">")
("\234" "oe")
:group 'gnus-article-mime
:type '(repeat regexp))
+(defcustom gnus-body-boundary-delimiter "_"
+ "String used to delimit header and body.
+This variable is used by `gnus-article-treat-body-boundary' which can
+be controlled by `gnus-treat-body-boundary'."
+ :group 'gnus-article-various
+ :type '(choice (item :tag "None" :value nil)
+ string))
+
+(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
+ "Defines the location of the faces database.
+For information on obtaining this database of pretty pictures, please
+see http://www.cs.indiana.edu/picons/ftp/index.html"
+ :type '(repeat directory)
+ :link '(url-link :tag "download"
+ "http://www.cs.indiana.edu/picons/ftp/index.html")
+ :link '(custom-manual "(gnus)Picons")
+ :group 'gnus-picon)
+
+(defun gnus-picons-installed-p ()
+ "Say whether picons are installed on your machine."
+ (let ((installed nil))
+ (dolist (database gnus-picon-databases)
+ (when (file-exists-p database)
+ (setq installed t)))
+ installed))
+
(defcustom gnus-article-mime-part-function nil
"Function called with a MIME handle as the argument.
This is meant for people who want to do something automatic based
("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
;;;
(defcustom gnus-treat-buttonize 100000
"Add buttons.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles'."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(put 'gnus-treat-buttonize 'highlight t)
(defcustom gnus-treat-buttonize-head 'head
"Add buttons to the head.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(put 'gnus-treat-buttonize-head 'highlight t)
50000)
"Emphasize text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(put 'gnus-treat-emphasize 'highlight t)
(defcustom gnus-treat-strip-cr nil
"Remove carriage returns.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-unsplit-urls nil
+ "Remove newlines from within URLs.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-leading-whitespace nil
"Remove leading whitespace in headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-headers 'head
"Hide headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-hide-boring-headers nil
"Hide boring headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-hide-signature nil
"Hide the signature.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-fill-article nil
"Fill the article.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-citation nil
"Hide cited text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-hide-citation-maybe nil
"Hide cited text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-list-identifiers 'head
"Strip list identifiers from `gnus-list-identifiers`.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-pgp t
"Strip PGP signatures.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-pem nil
"Strip PEM signatures.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
"Strip banners from articles.
The banner to be stripped is specified in the `banner' group parameter.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-highlight-headers 'head
"Highlight the headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(put 'gnus-treat-highlight-headers 'highlight t)
(defcustom gnus-treat-highlight-citation t
"Highlight cited text.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-citation 'highlight t)
(defcustom gnus-treat-date-ut nil
"Display the Date in UT (GMT).
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-local nil
"Display the Date in the local timezone.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-english nil
"Display the Date in a format that can be read aloud in English.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-lapsed nil
"Display the Date header in a way that says how much time has elapsed.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-original nil
"Display the date in the original timezone.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-date-iso8601 nil
"Display the date in the ISO8601 format.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
"Display the date in a user-defined format.
The format is defined by the `gnus-article-time-format' variable.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-head-custom)
(defcustom gnus-treat-strip-headers-in-body t
"Strip the X-No-Archive header line from the beginning of the body.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-trailing-blank-lines nil
"Strip trailing blank lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-leading-blank-lines nil
"Strip leading blank lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-strip-multiple-blank-lines nil
"Strip multiple blank lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-unfold-headers 'head
+ "Unfold folded header lines.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-fold-headers nil
+ "Fold headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-fold-newsgroups 'head
+ "Fold the Newsgroups and Followup-To headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-overstrike t
"Treat overstrike highlighting.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(put 'gnus-treat-overstrike 'highlight t)
(defcustom gnus-treat-display-xface
- (and (or (and (fboundp 'image-type-available-p)
+ (and (not noninteractive)
+ (or (and (fboundp 'image-type-available-p)
(image-type-available-p 'xbm)
(string-match "^0x" (shell-command-to-string "uncompface")))
- (and (featurep 'xemacs) (featurep 'xface)))
+ (and (featurep 'xemacs)
+ (featurep 'xface)))
'head)
"Display X-Face headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)X-Face' for details."
:group 'gnus-article-treat
:version "21.1"
:type gnus-article-treat-head-custom)
(put 'gnus-treat-display-xface 'highlight t)
+(defcustom gnus-treat-display-grey-xface
+ (and (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))
t nil)
"Display smileys.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Smileys' for details."
:group 'gnus-article-treat
:version "21.1"
:type gnus-article-treat-custom)
(put 'gnus-treat-display-smileys 'highlight t)
-(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil)
- "Display picons.
+(defcustom gnus-treat-from-picon
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
+ 'head nil)
+ "Display picons in the From header.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Picons' for details."
+ :group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
+ :type gnus-article-treat-head-custom)
+(put 'gnus-treat-from-picon 'highlight t)
+
+(defcustom gnus-treat-mail-picon
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
+ 'head nil)
+ "Display picons in To and Cc headers.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Picons' for details."
:group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
:type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-picons 'highlight t)
+(put 'gnus-treat-mail-picon 'highlight t)
+
+(defcustom gnus-treat-newsgroups-picon
+ (if (and (gnus-image-type-available-p 'xpm)
+ (gnus-picons-installed-p))
+ 'head nil)
+ "Display picons in the Newsgroups and Followup-To headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' and Info node
+`(gnus)Picons' for details."
+ :group 'gnus-article-treat
+ :group 'gnus-picon
+ :link '(info-link "(gnus)Customizing Articles")
+ :link '(info-link "(gnus)Picons")
+ :type gnus-article-treat-head-custom)
+(put 'gnus-treat-newsgroups-picon 'highlight t)
+
+(defcustom gnus-treat-body-boundary
+ (if (or gnus-treat-newsgroups-picon
+ gnus-treat-mail-picon
+ gnus-treat-from-picon)
+ 'head nil)
+ "Draw a boundary at the end of the headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' for details."
+ :version "21.1"
+ :group 'gnus-article-treat
+ :type gnus-article-treat-custom)
(defcustom gnus-treat-capitalize-sentences nil
"Capitalize sentence-starting words.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-fill-long-lines nil
"Fill long lines.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-play-sounds nil
"Play sounds.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
(defcustom gnus-treat-translate nil
"Translate articles from one language to another.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:version "21.1"
:group 'gnus-article-treat
:type gnus-article-treat-custom)
"Verify X-PGP-Sig.
To automatically treat X-PGP-Sig, set it to head.
Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
:group 'gnus-article-treat
:group 'mime-security
:type gnus-article-treat-custom)
: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
(defvar article-goto-body-goes-to-point-min-p nil)
(defvar gnus-article-wash-types nil)
(defvar gnus-article-emphasis-alist nil)
+(defvar gnus-article-image-alist nil)
(defvar gnus-article-mime-handle-alist-1 nil)
(defvar gnus-treatment-function-alist
(gnus-treat-fill-article gnus-article-fill-cited-article)
(gnus-treat-fill-long-lines gnus-article-fill-long-lines)
(gnus-treat-strip-cr gnus-article-remove-cr)
- (gnus-treat-display-xface gnus-article-display-x-face)
+ (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
(gnus-treat-date-ut gnus-article-date-ut)
(gnus-treat-date-local gnus-article-date-local)
(gnus-treat-date-english gnus-article-date-english)
(gnus-treat-date-original gnus-article-date-original)
(gnus-treat-date-user-defined gnus-article-date-user)
(gnus-treat-date-iso8601 gnus-article-date-iso8601)
+ (gnus-treat-display-xface gnus-article-display-x-face)
(gnus-treat-hide-headers gnus-article-maybe-hide-headers)
(gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
(gnus-treat-hide-signature gnus-article-hide-signature)
- (gnus-treat-hide-citation gnus-article-hide-citation)
- (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
(gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
(gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
(gnus-treat-strip-pgp gnus-article-hide-pgp)
(gnus-treat-strip-pem gnus-article-hide-pem)
+ (gnus-treat-from-picon gnus-treat-from-picon)
+ (gnus-treat-mail-picon gnus-treat-mail-picon)
+ (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
(gnus-treat-highlight-headers gnus-article-highlight-headers)
- (gnus-treat-highlight-citation gnus-article-highlight-citation)
(gnus-treat-highlight-signature gnus-article-highlight-signature)
(gnus-treat-strip-trailing-blank-lines
gnus-article-remove-trailing-blank-lines)
(gnus-treat-strip-multiple-blank-lines
gnus-article-strip-multiple-blank-lines)
(gnus-treat-overstrike gnus-article-treat-overstrike)
+ (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
+ (gnus-treat-fold-headers gnus-article-treat-fold-headers)
+ (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
- (gnus-treat-display-smileys gnus-smiley-display)
+ (gnus-treat-display-smileys gnus-treat-smiley)
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
- (gnus-treat-display-picons gnus-article-display-picons)
(gnus-treat-emphasize gnus-article-emphasize)
+ (gnus-treat-hide-citation gnus-article-hide-citation)
+ (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
+ (gnus-treat-highlight-citation gnus-article-highlight-citation)
+ (gnus-treat-body-boundary gnus-article-treat-body-boundary)
(gnus-treat-play-sounds gnus-earcon-display)))
(defvar gnus-article-mime-handle-alist nil)
(let ((table (copy-syntax-table text-mode-syntax-table)))
;; This causes the citation match run O(2^n).
;; (modify-syntax-entry ?- "w" table)
- (modify-syntax-entry ?> ")" table)
- (modify-syntax-entry ?< "(" table)
+ (modify-syntax-entry ?> ")<" table)
+ (modify-syntax-entry ?< "(>" table)
table)
"Syntax table used in article mode buffers.
Initialized from `text-mode-syntax-table.")
(defvar gnus-inhibit-hiding nil)
+;;; Macros for dealing with the article buffer.
+
+(defmacro gnus-with-article-headers (&rest forms)
+ `(save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (let ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ (case-fold-search t))
+ (article-narrow-to-head)
+ ,@forms))))
+
+(put 'gnus-with-article-headers 'lisp-indent-function 0)
+(put 'gnus-with-article-headers 'edebug-form-spec '(body))
+
+(defmacro gnus-with-article-buffer (&rest forms)
+ `(save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil))
+ ,@forms)))
+
+(put 'gnus-with-article-buffer 'lisp-indent-function 0)
+(put 'gnus-with-article-buffer 'edebug-form-spec '(body))
+
+(defun gnus-article-goto-header (header)
+ "Go to HEADER, which is a regular expression."
+ (re-search-forward (concat "^\\(" header "\\):") nil t))
+
(defsubst gnus-article-hide-text (b e props)
"Set text PROPS on the B to E region, extending `intangible' 1 past B."
(gnus-add-text-properties-when 'article-type nil b e props)
(defun gnus-article-hide-text-type (b e type)
"Hide text of TYPE between B and E."
- (push type gnus-article-wash-types)
+ (gnus-add-wash-type type)
(gnus-article-hide-text
b e (cons 'article-type (cons type gnus-hidden-properties))))
(defun gnus-article-unhide-text-type (b e type)
"Unhide text of TYPE between B and E."
- (setq gnus-article-wash-types
- (delq type gnus-article-wash-types))
+ (gnus-delete-wash-type type)
(remove-text-properties
b e (cons 'article-type (cons type gnus-hidden-properties)))
(when (memq 'intangible gnus-hidden-properties)
(when (setq beg (text-property-any
(point-min) (point-max) 'message-rank (+ 2 max)))
;; We delete the unwanted headers.
- (push 'headers gnus-article-wash-types)
+ (gnus-add-wash-type 'headers)
(add-text-properties (point-min) (+ 5 (point-min))
'(article-type headers dummy-invisible t))
(delete-region beg (point-max))))))))
(put-text-property
(point) (1+ (point)) 'face 'underline)))))))))
+(defun gnus-article-treat-unfold-headers ()
+ "Unfold folded message headers.
+Only the headers that fit into the current window width will be
+unfolded."
+ (interactive)
+ (gnus-with-article-headers
+ (let (length)
+ (while (not (eobp))
+ (save-restriction
+ (mail-header-narrow-to-field)
+ (let ((header (buffer-substring (point-min) (point-max))))
+ (with-temp-buffer
+ (insert header)
+ (goto-char (point-min))
+ (while (re-search-forward "\n[\t ]" nil t)
+ (replace-match " " t t)))
+ (setq length (- (point-max) (point-min) 1)))
+ (when (< length (window-width))
+ (while (re-search-forward "\n[\t ]" nil t)
+ (replace-match " " t t)))
+ (goto-char (point-max)))))))
+
+(defun gnus-article-treat-fold-headers ()
+ "Fold message headers."
+ (interactive)
+ (gnus-with-article-headers
+ (while (not (eobp))
+ (save-restriction
+ (mail-header-narrow-to-field)
+ (mail-header-fold-field)
+ (goto-char (point-max))))))
+
+(defun gnus-treat-smiley ()
+ "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
+ (interactive)
+ (gnus-with-article-buffer
+ (if (memq 'smiley gnus-article-wash-types)
+ (gnus-delete-images 'smiley)
+ (article-goto-body)
+ (let ((images (smiley-region (point) (point-max))))
+ (when images
+ (gnus-add-wash-type 'smiley)
+ (dolist (image images)
+ (gnus-add-image 'smiley image)))))))
+
+(defun gnus-article-remove-images ()
+ "Remove all images from the article buffer."
+ (interactive)
+ (gnus-with-article-buffer
+ (dolist (elem gnus-article-image-alist)
+ (gnus-delete-images (car elem)))))
+
+(defun gnus-article-treat-fold-newsgroups ()
+ "Unfold folded message headers.
+Only the headers that fit into the current window width will be
+unfolded."
+ (interactive)
+ (gnus-with-article-headers
+ (while (gnus-article-goto-header "newsgroups\\|followup-to")
+ (save-restriction
+ (mail-header-narrow-to-field)
+ (while (re-search-forward ", *" nil t)
+ (replace-match ", " t t))
+ (mail-header-fold-field)
+ (goto-char (point-max))))))
+
+(defun gnus-article-treat-body-boundary ()
+ "Place a boundary line at the end of the headers."
+ (interactive)
+ (when (and gnus-body-boundary-delimiter
+ (> (length gnus-body-boundary-delimiter) 0))
+ (gnus-with-article-headers
+ (goto-char (point-max))
+ (let ((start (point)))
+ (insert "X-Boundary: ")
+ (gnus-add-text-properties start (point) '(invisible t intangible t))
+ (insert (let (str)
+ (while (>= (1- (window-width)) (length str))
+ (setq str (concat str gnus-body-boundary-delimiter)))
+ (substring str 0 (1- (window-width))))
+ "\n")
+ (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
+
(defun article-fill-long-lines ()
"Fill lines that are wider than the window width."
(interactive)
(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)))))))
(defun article-display-x-face (&optional force)
"Look for an X-Face header and display it if present."
(interactive (list 'force))
- (save-excursion
- ;; Delete the old process, if any.
- (when (process-status "article-x-face")
- (delete-process "article-x-face"))
- (let ((inhibit-point-motion-hooks t)
- x-faces
- (case-fold-search t)
- from last)
- (save-restriction
- (article-narrow-to-head)
- (when (and buffer-read-only ;; When type `W f'
- (progn
- (goto-char (point-min))
- (not (re-search-forward "^X-Face:[\t ]*" nil t)))
- (gnus-buffer-live-p gnus-original-article-buffer))
- (with-current-buffer gnus-original-article-buffer
- (save-restriction
- (article-narrow-to-head)
- (while (re-search-forward "^X-Face:" nil t)
- (setq x-faces
- (concat
- (or x-faces "")
- (buffer-substring
- (match-beginning 0)
- (1- (re-search-forward
- "^\\($\\|[^ \t]\\)" nil t))))))))
- (if x-faces
- (let (point start bface eface buffer-read-only)
- (goto-char (point-max))
- (forward-line -1)
- (setq bface (get-text-property (gnus-point-at-bol) 'face)
- eface (get-text-property (1- (gnus-point-at-eol)) 'face))
- (goto-char (point-max))
- (setq point (point))
- (insert x-faces)
- (goto-char point)
- (while (looking-at "\\([^:]+\\): *")
- (put-text-property (match-beginning 1) (1+ (match-end 1))
- 'face bface)
- (setq start (match-end 0))
- (forward-line 1)
- (while (looking-at "[\t ]")
- (forward-line 1))
- (put-text-property start (point)
- 'face eface)))))
- (goto-char (point-min))
- (setq from (message-fetch-field "from"))
- (goto-char (point-min))
- (while (and gnus-article-x-face-command
- (not last)
- (or force
- ;; Check whether this face is censored.
- (not gnus-article-x-face-too-ugly)
- (and gnus-article-x-face-too-ugly from
- (not (string-match gnus-article-x-face-too-ugly
- from))))
- ;; Has to be present.
- (re-search-forward "^X-Face:[\t ]*" nil t))
- ;; This used to try to do multiple faces (`while' instead of
- ;; `when' above), but (a) sending multiple EOFs to xv doesn't
- ;; work (b) it can crash some versions of Emacs (c) are
- ;; multiple faces really something to encourage?
- (when (stringp gnus-article-x-face-command)
- (setq last t))
- ;; We now have the area of the buffer where the X-Face is stored.
+ (let ((wash-face-p buffer-read-only)) ;; When type `W f'
+ (gnus-with-article-headers
+ ;; Delete the old process, if any.
+ (when (process-status "article-x-face")
+ (delete-process "article-x-face"))
+ (if (memq 'xface gnus-article-wash-types)
+ ;; We have already displayed X-Faces, so we remove them
+ ;; instead.
+ (gnus-delete-images 'xface)
+ ;; Display X-Faces.
+ (let (x-faces from face grey)
(save-excursion
- (let ((beg (point))
- (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))
- buffer-read-only)
+ (when (and wash-face-p
+ (progn
+ (goto-char (point-min))
+ (not (re-search-forward
+ "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t)))
+ (gnus-buffer-live-p gnus-original-article-buffer))
+ ;; If type `W f', use gnus-original-article-buffer,
+ ;; otherwise use the current buffer because displaying
+ ;; RFC822 parts calls this function too.
+ (set-buffer gnus-original-article-buffer))
+ (save-restriction
+ (mail-narrow-to-head)
+ (if gnus-treat-display-grey-xface
+ (progn
+ (while (gnus-article-goto-header "X-Face\\(-[0-9]+\\)?")
+ (if (match-beginning 2)
+ (progn
+ (setq grey t)
+ (push (cons (- (string-to-number (match-string 2)))
+ (mail-header-field-value))
+ x-faces))
+ (push (cons 0 (mail-header-field-value)) x-faces)))
+ (dolist (x-face (prog1
+ (if grey
+ (sort x-faces 'car-less-than-car)
+ (nreverse x-faces))
+ (setq x-faces nil)))
+ (push (cdr x-face) x-faces)))
+ (while (gnus-article-goto-header "X-Face")
+ (push (mail-header-field-value) x-faces)))
+ (setq from (message-fetch-field "from"))))
+ (if grey
+ (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces))
+ image)
+ (when xpm
+ (setq image (gnus-create-image xpm 'xpm t))
+ (gnus-article-goto-header "from")
+ (when (bobp)
+ (insert "From: [no `from' set]\n")
+ (forward-char -17))
+ (gnus-add-wash-type 'xface)
+ (gnus-add-image 'xface image)
+ (gnus-put-image image)))
+ ;; Sending multiple EOFs to xv doesn't work, so we only do a
+ ;; single external face.
+ (when (stringp gnus-article-x-face-command)
+ (setq x-faces (list (car x-faces))))
+ (while (and (setq face (pop x-faces))
+ gnus-article-x-face-command
+ (or force
+ ;; Check whether this face is censored.
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly from
+ (not (string-match gnus-article-x-face-too-ugly
+ from)))))
;; We display the face.
(if (symbolp gnus-article-x-face-command)
;; The command is a lisp function, so we call it.
(if (gnus-functionp gnus-article-x-face-command)
- (funcall gnus-article-x-face-command beg end)
+ (funcall gnus-article-x-face-command face)
(error "%s is not a function" gnus-article-x-face-command))
;; The command is a string, so we interpret the command
;; as a, well, command, and fork it off.
(start-process
"article-x-face" nil shell-file-name shell-command-switch
gnus-article-x-face-command))
- (process-send-region "article-x-face" beg end)
+ (with-temp-buffer
+ (insert face)
+ (process-send-region "article-x-face"
+ (point-min) (point-max)))
(process-send-eof "article-x-face"))))))))))
(defun article-decode-mime-words ()
(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.
If READ-CHARSET, ask for a coding system."
(save-window-excursion
(save-restriction
(narrow-to-region (point) (point-max))
- (mm-setup-w3)
- (let ((w3-strict-width (window-width))
- (url-standalone-mode t)
- (w3-honor-stylesheets nil)
- (w3-delay-image-loads t))
- (condition-case var
- (w3-region (point-min) (point-max))
- (error))))))))
+ (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
+ (entry (assq func mm-text-html-washer-alist)))
+ (if entry
+ (setq func (cdr entry)))
+ (cond
+ ((gnus-functionp func)
+ (funcall func))
+ (t
+ (apply (car func) (cdr func))))))))))
+
+(defun gnus-article-wash-html-with-w3 ()
+ "Wash the current buffer with w3."
+ (mm-setup-w3)
+ (let ((w3-strict-width (window-width))
+ (url-standalone-mode t)
+ (url-gateway-unplugged t)
+ (w3-honor-stylesheets nil))
+ (condition-case ()
+ (w3-region (point-min) (point-max))
+ (error))))
+
+(defun gnus-article-wash-html-with-w3m ()
+ "Wash the current buffer with emacs-w3m."
+ (mm-setup-w3m)
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images
+ nil
+ "\\`cid:"))
+ (w3m-display-inline-images mm-inline-text-html-with-images)
+ w3m-force-redisplay)
+ (w3m-region (point-min) (point-max)))
+ (when mm-inline-text-html-with-w3m-keymap
+ (add-text-properties
+ (point-min) (point-max)
+ (append '(mm-inline-text-html-with-w3m t)
+ (gnus-local-map-property mm-w3m-mode-map))))))
(defun article-hide-list-identifiers ()
"Remove list identifies from the Subject header.
(article-goto-body)
;; Hide the "header".
(when (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
- (push 'pgp gnus-article-wash-types)
+ (gnus-add-wash-type 'pgp)
(delete-region (match-beginning 0) (match-end 0))
;; Remove armor headers (rfc2440 6.2)
(delete-region (point) (or (re-search-forward "^[ \t]*\n" nil t)
"\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
nil t)
(setq end (1+ (match-beginning 0))))
- (push 'pem gnus-article-wash-types)
+ (gnus-add-wash-type 'pem)
(gnus-article-hide-text-type
end
(if (search-forward "\n\n" nil t)
(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)
+ (caar (mail-header-parse-addresses
+ (mail-fetch-field "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
(point-min) (point-max)
(cons 'article-type (cons type
gnus-hidden-properties)))
- (setq gnus-article-wash-types (delq type gnus-article-wash-types))))
+ (gnus-delete-wash-type type)))
(defconst article-time-units
`((year . ,(* 365.25 24 60 60))
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 1 dtime)))))))
(error
- (format "Date: %s (from Oort)" date))))
+ (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."
(match-beginning visible) (match-end visible) 'emphasis)
(gnus-put-overlay-excluding-newlines
(match-beginning visible) (match-end visible) 'face face)
- (push 'emphasis gnus-article-wash-types)
+ (gnus-add-wash-type 'emphasis)
(goto-char (match-end invisible)))))))))
(defun gnus-article-setup-highlight-words (&optional highlight-words)
(setq afunc func
gfunc (intern (format "gnus-%s" func))))
(defalias gfunc
- (if (fboundp afunc)
+ (when (fboundp afunc)
`(lambda (&optional interactive &rest args)
,(documentation afunc t)
(interactive (list t))
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
">" end-of-buffer
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug
+ "R" gnus-article-reply-with-original
+ "F" gnus-article-followup-with-original
"\C-hk" gnus-article-describe-key
"\C-hc" gnus-article-describe-key-briefly
["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
(make-local-variable 'gnus-article-decoded-p)
(make-local-variable 'gnus-article-mime-handle-alist)
(make-local-variable 'gnus-article-wash-types)
+ (make-local-variable 'gnus-article-image-alist)
(make-local-variable 'gnus-article-charset)
(make-local-variable 'gnus-article-ignored-charsets)
(gnus-set-default-directory)
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))))))
(unless (eq major-mode 'gnus-article-mode)
(gnus-article-mode))
(setq buffer-read-only nil
- gnus-article-wash-types nil)
+ gnus-article-wash-types nil
+ gnus-article-image-alist nil)
(gnus-run-hooks 'gnus-tmp-internal-hook)
(when gnus-display-mime-function
(funcall gnus-display-mime-function))
;;;
(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
- "The following specs can be used:
+ "Format of the MIME buttons.
+
+Valid specifiers include:
%t The MIME type
%T MIME type, along with additional info
%n The `name' parameter
%d The description, if any
%l The length of the encoded part
%p The part identifier number
-%e Dots if the part isn't displayed")
+%e Dots if the part isn't displayed
+
+General format specifiers can also be used. See
+(gnus)Formatting Variables.")
(defvar gnus-mime-button-line-format-alist
'((?t gnus-tmp-type ?s)
(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")))
(gnus-mm-display-part handle))))
(defun gnus-mime-copy-part (&optional handle)
- "Put the the MIME part under point into a new buffer."
+ "Put the MIME part under point into a new buffer."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(setq buffer-file-name nil))
(goto-char (point-min)))))
+(defun gnus-mime-print-part (&optional handle filename)
+ "Print the MIME part under point."
+ (interactive (list nil (ps-print-preprint current-prefix-arg)))
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ (contents (and handle (mm-get-part handle)))
+ (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
+ (printer (mailcap-mime-info (mm-handle-type handle) "print")))
+ (when contents
+ (if printer
+ (unwind-protect
+ (progn
+ (with-temp-file file
+ (insert contents))
+ (call-process shell-file-name nil
+ (generate-new-buffer " *mm*")
+ nil
+ shell-command-switch
+ (mm-mailcap-command
+ printer file (mm-handle-type handle))))
+ (delete-file file))
+ (with-temp-buffer
+ (insert contents)
+ (gnus-print-buffer))
+ (ps-despool filename)))))
+
(defun gnus-mime-inline-part (&optional handle arg)
"Insert the MIME part under point into the current buffer."
(interactive (list nil current-prefix-arg))
(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)
+ (mm-uu-dissect)))
buffer-read-only handle name type b e display)
(when (and (not ihandles)
(not gnus-displaying-mime))
;;;!!! No, w3 can display everything just fine.
(gnus-mime-display-part (cadr handle)))
((equal (car handle) "multipart/signed")
- (or (memq 'signed gnus-article-wash-types)
- (push 'signed gnus-article-wash-types))
+ (gnus-add-wash-type 'signed)
(gnus-mime-display-security handle))
((equal (car handle) "multipart/encrypted")
- (or (memq 'encrypted gnus-article-wash-types)
- (push 'encrypted gnus-article-wash-types))
+ (gnus-add-wash-type 'encrypted)
(gnus-mime-display-security handle))
;; Other multiparts are handled like multipart/mixed.
(t
',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)
in the article mode line when the washing function is active, and OFF
is the string to use when it is inactive.")
-(defun gnus-gnus-article-wash-status-entry (key value)
+(defun gnus-article-wash-status-entry (key value)
(let ((entry (assoc key gnus-article-wash-status-strings)))
(if value (nth 1 entry) (nth 2 entry))))
(signature (memq 'signature gnus-article-wash-types))
(overstrike (memq 'overstrike gnus-article-wash-types))
(emphasis (memq 'emphasis gnus-article-wash-types)))
- (concat (gnus-gnus-article-wash-status-entry 'cite cite)
- (gnus-gnus-article-wash-status-entry 'headers
- (or headers boring))
- (gnus-gnus-article-wash-status-entry
- 'pgp (or pgp pem signed encrypted))
- (gnus-gnus-article-wash-status-entry 'signature signature)
- (gnus-gnus-article-wash-status-entry 'overstrike overstrike)
- (gnus-gnus-article-wash-status-entry 'emphasis emphasis)))))
+ (concat
+ (gnus-article-wash-status-entry 'cite cite)
+ (gnus-article-wash-status-entry 'headers (or headers boring))
+ (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted))
+ (gnus-article-wash-status-entry 'signature signature)
+ (gnus-article-wash-status-entry 'o
projects / gnus / blobdiff