1 ;;; gnus-art.el --- article mode commands for Gnus
2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 (eval-when-compile (require 'cl))
43 (autoload 'gnus-msg-mail "gnus-msg" nil t)
44 (autoload 'gnus-button-mailto "gnus-msg")
45 (autoload 'gnus-button-reply "gnus-msg" nil t)
47 (defgroup gnus-article nil
49 :link '(custom-manual "(gnus)The Article Buffer")
52 (defgroup gnus-article-treat nil
53 "Treating article parts."
54 :link '(custom-manual "(gnus)Article Hiding")
57 (defgroup gnus-article-hiding nil
58 "Hiding article parts."
59 :link '(custom-manual "(gnus)Article Hiding")
62 (defgroup gnus-article-highlight nil
63 "Article highlighting."
64 :link '(custom-manual "(gnus)Article Highlighting")
68 (defgroup gnus-article-signature nil
70 :link '(custom-manual "(gnus)Article Signature")
73 (defgroup gnus-article-headers nil
75 :link '(custom-manual "(gnus)Hiding Headers")
78 (defgroup gnus-article-washing nil
79 "Special commands on articles."
80 :link '(custom-manual "(gnus)Article Washing")
83 (defgroup gnus-article-emphasis nil
84 "Fontisizing articles."
85 :link '(custom-manual "(gnus)Article Fontisizing")
88 (defgroup gnus-article-saving nil
90 :link '(custom-manual "(gnus)Saving Articles")
93 (defgroup gnus-article-mime nil
94 "Worshiping the MIME wonder."
95 :link '(custom-manual "(gnus)Using MIME")
98 (defgroup gnus-article-buttons nil
99 "Pushable buttons in the article buffer."
100 :link '(custom-manual "(gnus)Article Buttons")
101 :group 'gnus-article)
103 (defgroup gnus-article-various nil
104 "Other article options."
105 :link '(custom-manual "(gnus)Misc Article")
106 :group 'gnus-article)
108 (defcustom gnus-ignored-headers
109 '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:"
110 "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
111 "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
112 "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
113 "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
114 "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face"
115 "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
116 "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
117 "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
118 "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:"
119 "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:"
120 "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:"
121 "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:"
122 "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:"
123 "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:"
124 "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
125 "^MBOX-Line" "^Priority:" "^X400-[-A-Za-z]+:"
126 "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:"
127 "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:"
128 "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:"
129 "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:"
130 "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:"
131 "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:"
132 "^List-[A-Za-z]+:" "^X-Listprocessor-Version:"
133 "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:"
134 "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:"
135 "^X-Received:" "^Content-length:" "X-precedence:"
136 "^X-Authenticated-User:" "^X-Comment" "^X-Report:" "^X-Abuse-Info:"
137 "^X-HTTP-Proxy:" "^X-Mydeja-Info:" "^X-Copyright" "^X-No-Markup:"
138 "^X-Abuse-Info:" "^X-From_:" "^X-Accept-Language:" "^Errors-To:"
139 "^X-BeenThere:" "^X-Mailman-Version:" "^List-Help:" "^List-Post:"
140 "^List-Subscribe:" "^List-Id:" "^List-Unsubscribe:" "^List-Archive:"
141 "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:"
142 "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:"
143 "^X-Virus-Scanned:" "^X-Delivery-Agent:" "^Posted-Date:" "^X-Gateway:"
144 "^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:"
146 "*All headers that start with this regexp will be hidden.
147 This variable can also be a list of regexps of headers to be ignored.
148 If `gnus-visible-headers' is non-nil, this variable will be ignored."
149 :type '(choice :custom-show nil
152 :group 'gnus-article-hiding)
154 (defcustom gnus-visible-headers
155 "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
156 "*All headers that do not match this regexp will be hidden.
157 This variable can also be a list of regexp of headers to remain visible.
158 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
159 :type '(repeat :value-to-internal (lambda (widget value)
160 (custom-split-regexp-maybe value))
161 :match (lambda (widget value)
163 (widget-editable-list-match widget value)))
165 :group 'gnus-article-hiding)
167 (defcustom gnus-sorted-header-list
168 '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
169 "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
170 "*This variable is a list of regular expressions.
171 If it is non-nil, headers that match the regular expressions will
172 be placed first in the article buffer in the sequence specified by
174 :type '(repeat regexp)
175 :group 'gnus-article-hiding)
177 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
178 "Headers that are only to be displayed if they have interesting data.
179 Possible values in this list are:
181 'empty Headers with no content.
182 'newsgroups Newsgroup identical to Gnus group.
183 'to-address To identical to To-address.
184 'followup-to Followup-to identical to Newsgroups.
185 'reply-to Reply-to identical to From.
186 'date Date less than four days old.
187 'long-to To and/or Cc longer than 1024 characters.
188 'many-to Multiple To and/or Cc."
189 :type '(set (const :tag "Headers with no content." empty)
190 (const :tag "Newsgroups identical to Gnus group." newsgroups)
191 (const :tag "To identical to To-address." to-address)
192 (const :tag "Followup-to identical to Newsgroups." followup-to)
193 (const :tag "Reply-to identical to From." reply-to)
194 (const :tag "Date less than four days old." date)
195 (const :tag "To and/or Cc longer than 1024 characters." long-to)
196 (const :tag "Multiple To and/or Cc headers." many-to))
197 :group 'gnus-article-hiding)
199 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
200 "Regexp matching signature separator.
201 This can also be a list of regexps. In that case, it will be checked
202 from head to tail looking for a separator. Searches will be done from
203 the end of the buffer."
204 :type '(repeat string)
205 :group 'gnus-article-signature)
207 (defcustom gnus-signature-limit nil
208 "Provide a limit to what is considered a signature.
209 If it is a number, no signature may not be longer (in characters) than
210 that number. If it is a floating point number, no signature may be
211 longer (in lines) than that number. If it is a function, the function
212 will be called without any parameters, and if it returns nil, there is
213 no signature in the buffer. If it is a string, it will be used as a
214 regexp. If it matches, the text in question is not a signature."
215 :type '(choice (integer :value 200)
217 (function :value fun)
218 (regexp :value ".*"))
219 :group 'gnus-article-signature)
221 (defcustom gnus-hidden-properties '(invisible t intangible t)
222 "Property list to use for hiding text."
224 :group 'gnus-article-hiding)
226 ;; Fixme: This isn't the right thing for mixed graphical and and
227 ;; non-graphical frames in a session.
228 (defcustom gnus-article-x-face-command
229 (if (featurep 'xemacs)
230 (if (or (gnus-image-type-available-p 'xface)
231 (gnus-image-type-available-p 'pbm))
232 'gnus-display-x-face-in-from
233 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
234 (if (gnus-image-type-available-p 'pbm)
235 'gnus-display-x-face-in-from
236 "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
238 "*String or function to be executed to display an X-Face header.
239 If it is a string, the command will be executed in a sub-shell
240 asynchronously. The compressed face will be piped to this command."
241 :type `(choice string
242 (function-item gnus-display-x-face-in-from)
246 :group 'gnus-article-washing)
248 (defcustom gnus-article-x-face-too-ugly nil
249 "Regexp matching posters whose face shouldn't be shown automatically."
250 :type '(choice regexp (const nil))
251 :group 'gnus-article-washing)
253 (defcustom gnus-article-banner-alist nil
254 "Banner alist for stripping.
256 ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
258 :type '(repeat (cons symbol regexp))
259 :group 'gnus-article-washing)
261 (gnus-define-group-parameter
264 "Alist of regexps (to match group names) and banner."
265 :variable-group gnus-article-washing
267 '(choice :tag "Banner"
269 (const :tag "Remove signature" signature)
270 (symbol :tag "Item in `gnus-article-banner-alist'" none)
272 (const :tag "None" nil))
274 "If non-nil, specify how to remove `banners' from articles.
276 Symbol `signature' means to remove signatures delimited by
277 `gnus-signature-separator'. Any other symbol is used to look up a
278 regular expression to match the banner in `gnus-article-banner-alist'.
279 A string is used as a regular expression to match the banner
282 (defcustom gnus-emphasis-alist
284 "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
289 ("_/" "/_" underline-italic)
290 ("_\\*" "\\*_" underline-bold)
291 ("\\*/" "/\\*" bold-italic)
292 ("_\\*/" "/\\*_" underline-bold-italic))))
296 (format format (car spec) (cadr spec))
297 2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
299 ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
300 2 3 gnus-emphasis-underline)))
301 "*Alist that says how to fontify certain phrases.
302 Each item looks like this:
304 (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
306 The first element is a regular expression to be matched. The second
307 is a number that says what regular expression grouping used to find
308 the entire emphasized word. The third is a number that says what
309 regexp grouping should be displayed and highlighted. The fourth
310 is the face used for highlighting."
311 :type '(repeat (list :value ("" 0 0 default)
313 (integer :tag "Match group")
314 (integer :tag "Emphasize group")
316 :group 'gnus-article-emphasis)
318 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
319 "A regexp to describe whitespace which should not be emphasized.
320 Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
321 The former avoids underlining of leading and trailing whitespace,
322 and the latter avoids underlining any whitespace at all."
324 :group 'gnus-article-emphasis
327 (defface gnus-emphasis-bold '((t (:bold t)))
328 "Face used for displaying strong emphasized text (*word*)."
329 :group 'gnus-article-emphasis)
331 (defface gnus-emphasis-italic '((t (:italic t)))
332 "Face used for displaying italic emphasized text (/word/)."
333 :group 'gnus-article-emphasis)
335 (defface gnus-emphasis-underline '((t (:underline t)))
336 "Face used for displaying underlined emphasized text (_word_)."
337 :group 'gnus-article-emphasis)
339 (defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
340 "Face used for displaying underlined bold emphasized text (_*word*_)."
341 :group 'gnus-article-emphasis)
343 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
344 "Face used for displaying underlined italic emphasized text (_/word/_)."
345 :group 'gnus-article-emphasis)
347 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
348 "Face used for displaying bold italic emphasized text (/*word*/)."
349 :group 'gnus-article-emphasis)
351 (defface gnus-emphasis-underline-bold-italic
352 '((t (:bold t :italic t :underline t)))
353 "Face used for displaying underlined bold italic emphasized text.
354 Esample: (_/*word*/_)."
355 :group 'gnus-article-emphasis)
357 (defface gnus-emphasis-highlight-words
358 '((t (:background "black" :foreground "yellow")))
359 "Face used for displaying highlighted words."
360 :group 'gnus-article-emphasis)
362 (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
363 "Format for display of Date headers in article bodies.
364 See `format-time-string' for the possible values.
366 The variable can also be function, which should return a complete Date
367 header. The function is called with one argument, the time, which can
368 be fed to `format-time-string'."
369 :type '(choice string symbol)
370 :link '(custom-manual "(gnus)Article Date")
371 :group 'gnus-article-washing)
374 (autoload 'mail-extract-address-components "mail-extr"))
376 (defcustom gnus-save-all-headers t
377 "*If non-nil, don't remove any headers before saving."
378 :group 'gnus-article-saving
381 (defcustom gnus-prompt-before-saving 'always
382 "*This variable says how much prompting is to be done when saving articles.
383 If it is nil, no prompting will be done, and the articles will be
384 saved to the default files. If this variable is `always', each and
385 every article that is saved will be preceded by a prompt, even when
386 saving large batches of articles. If this variable is neither nil not
387 `always', there the user will be prompted once for a file name for
388 each invocation of the saving commands."
389 :group 'gnus-article-saving
390 :type '(choice (item always)
391 (item :tag "never" nil)
392 (sexp :tag "once" :format "%t\n" :value t)))
394 (defcustom gnus-saved-headers gnus-visible-headers
395 "Headers to keep if `gnus-save-all-headers' is nil.
396 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
397 If that variable is nil, however, all headers that match this regexp
398 will be kept while the rest will be deleted before saving."
399 :group 'gnus-article-saving
402 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
403 "A function to save articles in your favourite format.
404 The function must be interactively callable (in other words, it must
405 be an Emacs command).
407 Gnus provides the following functions:
409 * gnus-summary-save-in-rmail (Rmail format)
410 * gnus-summary-save-in-mail (Unix mail format)
411 * gnus-summary-save-in-folder (MH folder)
412 * gnus-summary-save-in-file (article format)
413 * gnus-summary-save-body-in-file (article body)
414 * gnus-summary-save-in-vm (use VM's folder format)
415 * gnus-summary-write-to-file (article format -- overwrite)."
416 :group 'gnus-article-saving
417 :type '(radio (function-item gnus-summary-save-in-rmail)
418 (function-item gnus-summary-save-in-mail)
419 (function-item gnus-summary-save-in-folder)
420 (function-item gnus-summary-save-in-file)
421 (function-item gnus-summary-save-body-in-file)
422 (function-item gnus-summary-save-in-vm)
423 (function-item gnus-summary-write-to-file)))
425 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
426 "A function generating a file name to save articles in Rmail format.
427 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
428 :group 'gnus-article-saving
431 (defcustom gnus-mail-save-name 'gnus-plain-save-name
432 "A function generating a file name to save articles in Unix mail format.
433 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
434 :group 'gnus-article-saving
437 (defcustom gnus-folder-save-name 'gnus-folder-save-name
438 "A function generating a file name to save articles in MH folder.
439 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
440 :group 'gnus-article-saving
443 (defcustom gnus-file-save-name 'gnus-numeric-save-name
444 "A function generating a file name to save articles in article format.
445 The function is called with NEWSGROUP, HEADERS, and optional
447 :group 'gnus-article-saving
450 (defcustom gnus-split-methods
451 '((gnus-article-archive-name)
452 (gnus-article-nndoc-name))
453 "*Variable used to suggest where articles are to be saved.
454 For instance, if you would like to save articles related to Gnus in
455 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
456 you could set this variable to something like:
458 '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
459 (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
461 This variable is an alist where the where the key is the match and the
462 value is a list of possible files to save in if the match is non-nil.
464 If the match is a string, it is used as a regexp match on the
465 article. If the match is a symbol, that symbol will be funcalled
466 from the buffer of the article to be saved with the newsgroup as the
467 parameter. If it is a list, it will be evaled in the same buffer.
469 If this form or function returns a string, this string will be used as
470 a possible file name; and if it returns a non-nil list, that list will
471 be used as possible file names."
472 :group 'gnus-article-saving
473 :type '(repeat (choice (list :value (fun) function)
474 (cons :value ("" "") regexp (repeat string))
477 (defcustom gnus-page-delimiter "^\^L"
478 "*Regexp describing what to use as article page delimiters.
479 The default value is \"^\^L\", which is a form linefeed at the
480 beginning of a line."
482 :group 'gnus-article-various)
484 (defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
485 "*The format specification for the article mode line.
486 See `gnus-summary-mode-line-format' for a closer description.
488 The following additional specs are available:
490 %w The article washing status.
491 %m The number of MIME parts in the article."
493 :group 'gnus-article-various)
495 (defcustom gnus-article-mode-hook nil
496 "*A hook for Gnus article mode."
498 :group 'gnus-article-various)
500 (when (featurep 'xemacs)
501 ;; Extracted from gnus-xmas-define in order to preserve user settings
502 (when (fboundp 'turn-off-scroll-in-place)
503 (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
504 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
505 (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
507 (defcustom gnus-article-menu-hook nil
508 "*Hook run after the creation of the article mode menu."
510 :group 'gnus-article-various)
512 (defcustom gnus-article-prepare-hook nil
513 "*A hook called after an article has been prepared in the article buffer."
515 :group 'gnus-article-various)
517 (defcustom gnus-article-hide-pgp-hook nil
518 "*A hook called after successfully hiding a PGP signature."
520 :group 'gnus-article-various)
522 (defcustom gnus-article-button-face 'bold
523 "Face used for highlighting buttons in the article buffer.
525 An article button is a piece of text that you can activate by pressing
526 `RET' or `mouse-2' above it."
528 :group 'gnus-article-buttons)
530 (defcustom gnus-article-mouse-face 'highlight
531 "Face used for mouse highlighting in the article buffer.
533 Article buttons will be displayed in this face when the cursor is
536 :group 'gnus-article-buttons)
538 (defcustom gnus-signature-face 'gnus-signature-face
539 "Face used for highlighting a signature in the article buffer.
540 Obsolete; use the face `gnus-signature-face' for customizations instead."
542 :group 'gnus-article-highlight
543 :group 'gnus-article-signature)
545 (defface gnus-signature-face
548 "Face used for highlighting a signature in the article buffer."
549 :group 'gnus-article-highlight
550 :group 'gnus-article-signature)
552 (defface gnus-header-from-face
555 (:foreground "spring green"))
558 (:foreground "red3"))
561 "Face used for displaying from headers."
562 :group 'gnus-article-headers
563 :group 'gnus-article-highlight)
565 (defface gnus-header-subject-face
568 (:foreground "SeaGreen3"))
571 (:foreground "red4"))
573 (:bold t :italic t)))
574 "Face used for displaying subject headers."
575 :group 'gnus-article-headers
576 :group 'gnus-article-highlight)
578 (defface gnus-header-newsgroups-face
581 (:foreground "yellow" :italic t))
584 (:foreground "MidnightBlue" :italic t))
587 "Face used for displaying newsgroups headers."
588 :group 'gnus-article-headers
589 :group 'gnus-article-highlight)
591 (defface gnus-header-name-face
594 (:foreground "SeaGreen"))
597 (:foreground "maroon"))
600 "Face used for displaying header names."
601 :group 'gnus-article-headers
602 :group 'gnus-article-highlight)
604 (defface gnus-header-content-face
607 (:foreground "forest green" :italic t))
610 (:foreground "indianred4" :italic t))
612 (:italic t))) "Face used for displaying header content."
613 :group 'gnus-article-headers
614 :group 'gnus-article-highlight)
616 (defcustom gnus-header-face-alist
617 '(("From" nil gnus-header-from-face)
618 ("Subject" nil gnus-header-subject-face)
619 ("Newsgroups:.*," nil gnus-header-newsgroups-face)
620 ("" gnus-header-name-face gnus-header-content-face))
621 "*Controls highlighting of article header.
623 An alist of the form (HEADER NAME CONTENT).
625 HEADER is a regular expression which should match the name of an
626 header header and NAME and CONTENT are either face names or nil.
628 The name of each header field will be displayed using the face
629 specified by the first element in the list where HEADER match the
630 header name and NAME is non-nil. Similarly, the content will be
631 displayed by the first non-nil matching CONTENT face."
632 :group 'gnus-article-headers
633 :group 'gnus-article-highlight
634 :type '(repeat (list (regexp :tag "Header")
636 (item :tag "skip" nil)
637 (face :value default))
638 (choice :tag "Content"
639 (item :tag "skip" nil)
640 (face :value default)))))
642 (defcustom gnus-article-decode-hook
643 '(article-decode-charset article-decode-encoded-words
644 article-decode-group-name)
645 "*Hook run to decode charsets in articles."
646 :group 'gnus-article-headers
649 (defcustom gnus-display-mime-function 'gnus-display-mime
650 "Function to display MIME articles."
651 :group 'gnus-article-mime
654 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
655 "Function used to decode headers.")
657 (defvar gnus-article-dumbquotes-map
676 "Table for MS-to-Latin1 translation.")
678 (defcustom gnus-ignored-mime-types nil
679 "List of MIME types that should be ignored by Gnus."
681 :group 'gnus-article-mime
682 :type '(repeat regexp))
684 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
685 "List of MIME types that should not be given buttons when rendered inline.
686 See also `gnus-buttonized-mime-types' which may override this variable."
688 :group 'gnus-article-mime
689 :type '(repeat regexp))
691 (defcustom gnus-buttonized-mime-types nil
692 "List of MIME types that should be given buttons when rendered inline.
693 If set, this variable overrides `gnus-unbuttonized-mime-types'.
694 To see e.g. security buttons you could set this to
695 `(\"multipart/signed\")'."
697 :group 'gnus-article-mime
698 :type '(repeat regexp))
700 (defcustom gnus-body-boundary-delimiter "_"
701 "String used to delimit header and body.
702 This variable is used by `gnus-article-treat-body-boundary' which can
703 be controlled by `gnus-treat-body-boundary'."
704 :group 'gnus-article-various
705 :type '(choice (item :tag "None" :value nil)
708 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
709 "Defines the location of the faces database.
710 For information on obtaining this database of pretty pictures, please
711 see http://www.cs.indiana.edu/picons/ftp/index.html"
712 :type '(repeat directory)
713 :link '(url-link :tag "download"
714 "http://www.cs.indiana.edu/picons/ftp/index.html")
715 :link '(custom-manual "(gnus)Picons")
718 (defun gnus-picons-installed-p ()
719 "Say whether picons are installed on your machine."
720 (let ((installed nil))
721 (dolist (database gnus-picon-databases)
722 (when (file-exists-p database)
726 (defcustom gnus-article-mime-part-function nil
727 "Function called with a MIME handle as the argument.
728 This is meant for people who want to do something automatic based
729 on parts -- for instance, adding Vcard info to a database."
730 :group 'gnus-article-mime
733 (defcustom gnus-mime-multipart-functions nil
734 "An alist of MIME types to functions to display them."
736 :group 'gnus-article-mime
739 (defcustom gnus-article-date-lapsed-new-header nil
740 "Whether the X-Sent and Date headers can coexist.
741 When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
742 either replace the old \"Date:\" header (if this variable is nil), or
743 be added below it (otherwise)."
745 :group 'gnus-article-headers
748 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
749 "Function called with a MIME handle as the argument.
750 This is meant for people who want to view first matched part.
751 For `undisplayed-alternative' (default), the first undisplayed
752 part or alternative part is used. For `undisplayed', the first
753 undisplayed part is used. For a function, the first part which
754 the function return `t' is used. For `nil', the first part is
757 :group 'gnus-article-mime
759 (item :tag "first" :value nil)
760 (item :tag "undisplayed" :value undisplayed)
761 (item :tag "undisplayed or alternative"
762 :value undisplayed-alternative)
765 (defcustom gnus-mime-action-alist
766 '(("save to file" . gnus-mime-save-part)
767 ("save and strip" . gnus-mime-save-part-and-strip)
768 ("display as text" . gnus-mime-inline-part)
769 ("view the part" . gnus-mime-view-part)
770 ("pipe to command" . gnus-mime-pipe-part)
771 ("toggle display" . gnus-article-press-button)
772 ("toggle display" . gnus-article-view-part-as-charset)
773 ("view as type" . gnus-mime-view-part-as-type)
774 ("view internally" . gnus-mime-view-part-internally)
775 ("view externally" . gnus-mime-view-part-externally))
776 "An alist of actions that run on the MIME attachment."
777 :group 'gnus-article-mime
778 :type '(repeat (cons (string :tag "name")
782 ;;; The treatment variables
785 (defvar gnus-part-display-hook nil
786 "Hook called on parts that are to receive treatment.")
788 (defvar gnus-article-treat-custom
789 '(choice (const :tag "Off" nil)
791 (const :tag "Header" head)
792 (const :tag "Last" last)
793 (integer :tag "Less")
794 (repeat :tag "Groups" regexp)
795 (sexp :tag "Predicate")))
797 (defvar gnus-article-treat-head-custom
798 '(choice (const :tag "Off" nil)
799 (const :tag "Header" head)))
801 (defvar gnus-article-treat-types '("text/plain")
804 (defvar gnus-inhibit-treatment nil
805 "Whether to inhibit treatment.")
807 (defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
808 "Highlight the signature.
809 Valid values are nil, t, `head', `last', an integer or a predicate.
810 See Info node `(gnus)Customizing Articles'."
811 :group 'gnus-article-treat
812 :type gnus-article-treat-custom)
813 (put 'gnus-treat-highlight-signature 'highlight t)
815 (defcustom gnus-treat-buttonize 100000
817 Valid values are nil, t, `head', `last', an integer or a predicate.
818 See Info node `(gnus)Customizing Articles'."
819 :group 'gnus-article-treat
820 :type gnus-article-treat-custom)
821 (put 'gnus-treat-buttonize 'highlight t)
823 (defcustom gnus-treat-buttonize-head 'head
824 "Add buttons to the head.
825 Valid values are nil, t, `head', `last', an integer or a predicate.
826 See Info node `(gnus)Customizing Articles' for details."
827 :group 'gnus-article-treat
828 :type gnus-article-treat-head-custom)
829 (put 'gnus-treat-buttonize-head 'highlight t)
831 (defcustom gnus-treat-emphasize
832 (and (or window-system
834 (>= (string-to-number emacs-version) 21))
837 Valid values are nil, t, `head', `last', an integer or a predicate.
838 See Info node `(gnus)Customizing Articles' for details."
839 :group 'gnus-article-treat
840 :type gnus-article-treat-custom)
841 (put 'gnus-treat-emphasize 'highlight t)
843 (defcustom gnus-treat-strip-cr nil
844 "Remove carriage returns.
845 Valid values are nil, t, `head', `last', an integer or a predicate.
846 See Info node `(gnus)Customizing Articles' for details."
847 :group 'gnus-article-treat
848 :type gnus-article-treat-custom)
850 (defcustom gnus-treat-unsplit-urls nil
851 "Remove newlines from within URLs.
852 Valid values are nil, t, `head', `last', an integer or a predicate.
853 See Info node `(gnus)Customizing Articles' for details."
854 :group 'gnus-article-treat
855 :type gnus-article-treat-custom)
857 (defcustom gnus-treat-leading-whitespace nil
858 "Remove leading whitespace in headers.
859 Valid values are nil, t, `head', `last', an integer or a predicate.
860 See Info node `(gnus)Customizing Articles' for details."
861 :group 'gnus-article-treat
862 :type gnus-article-treat-custom)
864 (defcustom gnus-treat-hide-headers 'head
866 Valid values are nil, t, `head', `last', an integer or a predicate.
867 See Info node `(gnus)Customizing Articles' for details."
868 :group 'gnus-article-treat
869 :type gnus-article-treat-head-custom)
871 (defcustom gnus-treat-hide-boring-headers nil
872 "Hide boring headers.
873 Valid values are nil, t, `head', `last', an integer or a predicate.
874 See Info node `(gnus)Customizing Articles' for details."
875 :group 'gnus-article-treat
876 :type gnus-article-treat-head-custom)
878 (defcustom gnus-treat-hide-signature nil
880 Valid values are nil, t, `head', `last', an integer or a predicate.
881 See Info node `(gnus)Customizing Articles' for details."
882 :group 'gnus-article-treat
883 :type gnus-article-treat-custom)
885 (defcustom gnus-treat-fill-article nil
887 Valid values are nil, t, `head', `last', an integer or a predicate.
888 See Info node `(gnus)Customizing Articles' for details."
889 :group 'gnus-article-treat
890 :type gnus-article-treat-custom)
892 (defcustom gnus-treat-hide-citation nil
894 Valid values are nil, t, `head', `last', an integer or a predicate.
895 See Info node `(gnus)Customizing Articles' for details."
896 :group 'gnus-article-treat
897 :type gnus-article-treat-custom)
899 (defcustom gnus-treat-hide-citation-maybe nil
901 Valid values are nil, t, `head', `last', an integer or a predicate.
902 See Info node `(gnus)Customizing Articles' for details."
903 :group 'gnus-article-treat
904 :type gnus-article-treat-custom)
906 (defcustom gnus-treat-strip-list-identifiers 'head
907 "Strip list identifiers from `gnus-list-identifiers`.
908 Valid values are nil, t, `head', `last', an integer or a predicate.
909 See Info node `(gnus)Customizing Articles' for details."
911 :group 'gnus-article-treat
912 :type gnus-article-treat-custom)
914 (defcustom gnus-treat-strip-pgp t
915 "Strip PGP signatures.
916 Valid values are nil, t, `head', `last', an integer or a predicate.
917 See Info node `(gnus)Customizing Articles' for details."
918 :group 'gnus-article-treat
919 :type gnus-article-treat-custom)
921 (defcustom gnus-treat-strip-pem nil
922 "Strip PEM signatures.
923 Valid values are nil, t, `head', `last', an integer or a predicate.
924 See Info node `(gnus)Customizing Articles' for details."
925 :group 'gnus-article-treat
926 :type gnus-article-treat-custom)
928 (defcustom gnus-treat-strip-banner t
929 "Strip banners from articles.
930 The banner to be stripped is specified in the `banner' group parameter.
931 Valid values are nil, t, `head', `last', an integer or a predicate.
932 See Info node `(gnus)Customizing Articles' for details."
933 :group 'gnus-article-treat
934 :type gnus-article-treat-custom)
936 (defcustom gnus-treat-highlight-headers 'head
937 "Highlight the headers.
938 Valid values are nil, t, `head', `last', an integer or a predicate.
939 See Info node `(gnus)Customizing Articles' for details."
940 :group 'gnus-article-treat
941 :type gnus-article-treat-head-custom)
942 (put 'gnus-treat-highlight-headers 'highlight t)
944 (defcustom gnus-treat-highlight-citation t
945 "Highlight cited text.
946 Valid values are nil, t, `head', `last', an integer or a predicate.
947 See Info node `(gnus)Customizing Articles' for details."
948 :group 'gnus-article-treat
949 :type gnus-article-treat-custom)
950 (put 'gnus-treat-highlight-citation 'highlight t)
952 (defcustom gnus-treat-date-ut nil
953 "Display the Date in UT (GMT).
954 Valid values are nil, t, `head', `last', an integer or a predicate.
955 See Info node `(gnus)Customizing Articles' for details."
956 :group 'gnus-article-treat
957 :type gnus-article-treat-head-custom)
959 (defcustom gnus-treat-date-local nil
960 "Display the Date in the local timezone.
961 Valid values are nil, t, `head', `last', an integer or a predicate.
962 See Info node `(gnus)Customizing Articles' for details."
963 :group 'gnus-article-treat
964 :type gnus-article-treat-head-custom)
966 (defcustom gnus-treat-date-english nil
967 "Display the Date in a format that can be read aloud in English.
968 Valid values are nil, t, `head', `last', an integer or a predicate.
969 See Info node `(gnus)Customizing Articles' for details."
970 :group 'gnus-article-treat
971 :type gnus-article-treat-head-custom)
973 (defcustom gnus-treat-date-lapsed nil
974 "Display the Date header in a way that says how much time has elapsed.
975 Valid values are nil, t, `head', `last', an integer or a predicate.
976 See Info node `(gnus)Customizing Articles' for details."
977 :group 'gnus-article-treat
978 :type gnus-article-treat-head-custom)
980 (defcustom gnus-treat-date-original nil
981 "Display the date in the original timezone.
982 Valid values are nil, t, `head', `last', an integer or a predicate.
983 See Info node `(gnus)Customizing Articles' for details."
984 :group 'gnus-article-treat
985 :type gnus-article-treat-head-custom)
987 (defcustom gnus-treat-date-iso8601 nil
988 "Display the date in the ISO8601 format.
989 Valid values are nil, t, `head', `last', an integer or a predicate.
990 See Info node `(gnus)Customizing Articles' for details."
992 :group 'gnus-article-treat
993 :type gnus-article-treat-head-custom)
995 (defcustom gnus-treat-date-user-defined nil
996 "Display the date in a user-defined format.
997 The format is defined by the `gnus-article-time-format' variable.
998 Valid values are nil, t, `head', `last', an integer or a predicate.
999 See Info node `(gnus)Customizing Articles' for details."
1000 :group 'gnus-article-treat
1001 :type gnus-article-treat-head-custom)
1003 (defcustom gnus-treat-strip-headers-in-body t
1004 "Strip the X-No-Archive header line from the beginning of the body.
1005 Valid values are nil, t, `head', `last', an integer or a predicate.
1006 See Info node `(gnus)Customizing Articles' for details."
1008 :group 'gnus-article-treat
1009 :type gnus-article-treat-custom)
1011 (defcustom gnus-treat-strip-trailing-blank-lines nil
1012 "Strip trailing blank lines.
1013 Valid values are nil, t, `head', `last', an integer or a predicate.
1014 See Info node `(gnus)Customizing Articles' for details."
1015 :group 'gnus-article-treat
1016 :type gnus-article-treat-custom)
1018 (defcustom gnus-treat-strip-leading-blank-lines nil
1019 "Strip leading blank lines.
1020 Valid values are nil, t, `head', `last', an integer or a predicate.
1021 See Info node `(gnus)Customizing Articles' for details."
1022 :group 'gnus-article-treat
1023 :type gnus-article-treat-custom)
1025 (defcustom gnus-treat-strip-multiple-blank-lines nil
1026 "Strip multiple blank lines.
1027 Valid values are nil, t, `head', `last', an integer or a predicate.
1028 See Info node `(gnus)Customizing Articles' for details."
1029 :group 'gnus-article-treat
1030 :type gnus-article-treat-custom)
1032 (defcustom gnus-treat-unfold-headers 'head
1033 "Unfold folded header lines.
1034 Valid values are nil, t, `head', `last', an integer or a predicate.
1035 See Info node `(gnus)Customizing Articles' for details."
1036 :group 'gnus-article-treat
1037 :type gnus-article-treat-custom)
1039 (defcustom gnus-treat-fold-headers nil
1041 Valid values are nil, t, `head', `last', an integer or a predicate.
1042 See Info node `(gnus)Customizing Articles' for details."
1043 :group 'gnus-article-treat
1044 :type gnus-article-treat-custom)
1046 (defcustom gnus-treat-fold-newsgroups 'head
1047 "Fold the Newsgroups and Followup-To headers.
1048 Valid values are nil, t, `head', `last', an integer or a predicate.
1049 See Info node `(gnus)Customizing Articles' for details."
1050 :group 'gnus-article-treat
1051 :type gnus-article-treat-custom)
1053 (defcustom gnus-treat-overstrike t
1054 "Treat overstrike highlighting.
1055 Valid values are nil, t, `head', `last', an integer or a predicate.
1056 See Info node `(gnus)Customizing Articles' for details."
1057 :group 'gnus-article-treat
1058 :type gnus-article-treat-custom)
1059 (put 'gnus-treat-overstrike 'highlight t)
1061 (defcustom gnus-treat-display-xface
1062 (and (not noninteractive)
1063 (or (and (fboundp 'image-type-available-p)
1064 (image-type-available-p 'xbm)
1065 (string-match "^0x" (shell-command-to-string "uncompface")))
1066 (and (featurep 'xemacs)
1069 "Display X-Face headers.
1070 Valid values are nil, t, `head', `last', an integer or a predicate.
1071 See Info node `(gnus)Customizing Articles' and Info node
1072 `(gnus)X-Face' for details."
1073 :group 'gnus-article-treat
1075 :type gnus-article-treat-head-custom)
1076 (put 'gnus-treat-display-xface 'highlight t)
1078 (defcustom gnus-treat-display-grey-xface
1079 (and (not noninteractive)
1080 (string-match "^0x" (shell-command-to-string "uncompface"))
1082 "Display grey X-Face headers.
1083 Valid values are nil, t."
1084 :group 'gnus-article-treat
1087 (put 'gnus-treat-display-grey-xface 'highlight t)
1089 (defcustom gnus-treat-display-smileys
1090 (if (or (and (featurep 'xemacs)
1092 (and (fboundp 'image-type-available-p)
1093 (image-type-available-p 'pbm)))
1096 Valid values are nil, t, `head', `last', an integer or a predicate.
1097 See Info node `(gnus)Customizing Articles' and Info node
1098 `(gnus)Smileys' for details."
1099 :group 'gnus-article-treat
1101 :type gnus-article-treat-custom)
1102 (put 'gnus-treat-display-smileys 'highlight t)
1104 (defcustom gnus-treat-from-picon
1105 (if (and (gnus-image-type-available-p 'xpm)
1106 (gnus-picons-installed-p))
1108 "Display picons in the From header.
1109 Valid values are nil, t, `head', `last', an integer or a predicate.
1110 See Info node `(gnus)Customizing Articles' and Info node
1111 `(gnus)Picons' for details."
1112 :group 'gnus-article-treat
1114 :link '(info-link "(gnus)Customizing Articles")
1115 :link '(info-link "(gnus)Picons")
1116 :type gnus-article-treat-head-custom)
1117 (put 'gnus-treat-from-picon 'highlight t)
1119 (defcustom gnus-treat-mail-picon
1120 (if (and (gnus-image-type-available-p 'xpm)
1121 (gnus-picons-installed-p))
1123 "Display picons in To and Cc headers.
1124 Valid values are nil, t, `head', `last', an integer or a predicate.
1125 See Info node `(gnus)Customizing Articles' and Info node
1126 `(gnus)Picons' for details."
1127 :group 'gnus-article-treat
1129 :link '(info-link "(gnus)Customizing Articles")
1130 :link '(info-link "(gnus)Picons")
1131 :type gnus-article-treat-head-custom)
1132 (put 'gnus-treat-mail-picon 'highlight t)
1134 (defcustom gnus-treat-newsgroups-picon
1135 (if (and (gnus-image-type-available-p 'xpm)
1136 (gnus-picons-installed-p))
1138 "Display picons in the Newsgroups and Followup-To headers.
1139 Valid values are nil, t, `head', `last', an integer or a predicate.
1140 See Info node `(gnus)Customizing Articles' and Info node
1141 `(gnus)Picons' for details."
1142 :group 'gnus-article-treat
1144 :link '(info-link "(gnus)Customizing Articles")
1145 :link '(info-link "(gnus)Picons")
1146 :type gnus-article-treat-head-custom)
1147 (put 'gnus-treat-newsgroups-picon 'highlight t)
1149 (defcustom gnus-treat-body-boundary
1150 (if (or gnus-treat-newsgroups-picon
1151 gnus-treat-mail-picon
1152 gnus-treat-from-picon)
1154 "Draw a boundary at the end of the headers.
1155 Valid values are nil, t, `head', `last', an integer or a predicate.
1156 See Info node `(gnus)Customizing Articles' for details."
1158 :group 'gnus-article-treat
1159 :type gnus-article-treat-custom)
1161 (defcustom gnus-treat-capitalize-sentences nil
1162 "Capitalize sentence-starting words.
1163 Valid values are nil, t, `head', `last', an integer or a predicate.
1164 See Info node `(gnus)Customizing Articles' for details."
1166 :group 'gnus-article-treat
1167 :type gnus-article-treat-custom)
1169 (defcustom gnus-treat-fill-long-lines nil
1171 Valid values are nil, t, `head', `last', an integer or a predicate.
1172 See Info node `(gnus)Customizing Articles' for details."
1173 :group 'gnus-article-treat
1174 :type gnus-article-treat-custom)
1176 (defcustom gnus-treat-play-sounds nil
1178 Valid values are nil, t, `head', `last', an integer or a predicate.
1179 See Info node `(gnus)Customizing Articles' for details."
1181 :group 'gnus-article-treat
1182 :type gnus-article-treat-custom)
1184 (defcustom gnus-treat-translate nil
1185 "Translate articles from one language to another.
1186 Valid values are nil, t, `head', `last', an integer or a predicate.
1187 See Info node `(gnus)Customizing Articles' for details."
1189 :group 'gnus-article-treat
1190 :type gnus-article-treat-custom)
1192 (defcustom gnus-treat-x-pgp-sig nil
1194 To automatically treat X-PGP-Sig, set it to head.
1195 Valid values are nil, t, `head', `last', an integer or a predicate.
1196 See Info node `(gnus)Customizing Articles' for details."
1197 :group 'gnus-article-treat
1198 :group 'mime-security
1199 :type gnus-article-treat-custom)
1201 (defvar gnus-article-encrypt-protocol-alist
1202 '(("PGP" . mml2015-self-encrypt)))
1204 ;; Set to nil if more than one protocol added to
1205 ;; gnus-article-encrypt-protocol-alist.
1206 (defcustom gnus-article-encrypt-protocol "PGP"
1207 "The protocol used for encrypt articles.
1208 It is a string, such as \"PGP\". If nil, ask user."
1210 :group 'mime-security)
1212 (defvar gnus-article-wash-function nil
1213 "Function used for converting HTML into text.")
1215 ;;; Internal variables
1217 (defvar gnus-english-month-names
1218 '("January" "February" "March" "April" "May" "June" "July" "August"
1219 "September" "October" "November" "December"))
1221 (defvar article-goto-body-goes-to-point-min-p nil)
1222 (defvar gnus-article-wash-types nil)
1223 (defvar gnus-article-emphasis-alist nil)
1224 (defvar gnus-article-image-alist nil)
1226 (defvar gnus-article-mime-handle-alist-1 nil)
1227 (defvar gnus-treatment-function-alist
1228 '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
1229 (gnus-treat-strip-banner gnus-article-strip-banner)
1230 (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
1231 (gnus-treat-highlight-signature gnus-article-highlight-signature)
1232 (gnus-treat-buttonize gnus-article-add-buttons)
1233 (gnus-treat-fill-article gnus-article-fill-cited-article)
1234 (gnus-treat-fill-long-lines gnus-article-fill-long-lines)
1235 (gnus-treat-strip-cr gnus-article-remove-cr)
1236 (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1237 (gnus-treat-date-ut gnus-article-date-ut)
1238 (gnus-treat-date-local gnus-article-date-local)
1239 (gnus-treat-date-english gnus-article-date-english)
1240 (gnus-treat-date-lapsed gnus-article-date-lapsed)
1241 (gnus-treat-date-original gnus-article-date-original)
1242 (gnus-treat-date-user-defined gnus-article-date-user)
1243 (gnus-treat-date-iso8601 gnus-article-date-iso8601)
1244 (gnus-treat-display-xface gnus-article-display-x-face)
1245 (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
1246 (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
1247 (gnus-treat-hide-signature gnus-article-hide-signature)
1248 (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
1249 (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
1250 (gnus-treat-strip-pgp gnus-article-hide-pgp)
1251 (gnus-treat-strip-pem gnus-article-hide-pem)
1252 (gnus-treat-from-picon gnus-treat-from-picon)
1253 (gnus-treat-mail-picon gnus-treat-mail-picon)
1254 (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
1255 (gnus-treat-highlight-headers gnus-article-highlight-headers)
1256 (gnus-treat-highlight-signature gnus-article-highlight-signature)
1257 (gnus-treat-strip-trailing-blank-lines
1258 gnus-article-remove-trailing-blank-lines)
1259 (gnus-treat-strip-leading-blank-lines
1260 gnus-article-strip-leading-blank-lines)
1261 (gnus-treat-strip-multiple-blank-lines
1262 gnus-article-strip-multiple-blank-lines)
1263 (gnus-treat-overstrike gnus-article-treat-overstrike)
1264 (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
1265 (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1266 (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
1267 (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
1268 (gnus-treat-display-smileys gnus-treat-smiley)
1269 (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
1270 (gnus-treat-emphasize gnus-article-emphasize)
1271 (gnus-treat-hide-citation gnus-article-hide-citation)
1272 (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
1273 (gnus-treat-highlight-citation gnus-article-highlight-citation)
1274 (gnus-treat-body-boundary gnus-article-treat-body-boundary)
1275 (gnus-treat-play-sounds gnus-earcon-display)))
1277 (defvar gnus-article-mime-handle-alist nil)
1278 (defvar article-lapsed-timer nil)
1279 (defvar gnus-article-current-summary nil)
1281 (defvar gnus-article-mode-syntax-table
1282 (let ((table (copy-syntax-table text-mode-syntax-table)))
1283 ;; This causes the citation match run O(2^n).
1284 ;; (modify-syntax-entry ?- "w" table)
1285 (modify-syntax-entry ?> ")" table)
1286 (modify-syntax-entry ?< "(" table)
1288 "Syntax table used in article mode buffers.
1289 Initialized from `text-mode-syntax-table.")
1291 (defvar gnus-save-article-buffer nil)
1293 (defvar gnus-article-mode-line-format-alist
1294 (nconc '((?w (gnus-article-wash-status) ?s)
1295 (?m (gnus-article-mime-part-status) ?s))
1296 gnus-summary-mode-line-format-alist))
1298 (defvar gnus-number-of-articles-to-be-saved nil)
1300 (defvar gnus-inhibit-hiding nil)
1302 ;;; Macros for dealing with the article buffer.
1304 (defmacro gnus-with-article-headers (&rest forms)
1306 (set-buffer gnus-article-buffer)
1308 (let ((buffer-read-only nil)
1309 (inhibit-point-motion-hooks t)
1310 (case-fold-search t))
1311 (article-narrow-to-head)
1314 (put 'gnus-with-article-headers 'lisp-indent-function 0)
1315 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
1317 (defmacro gnus-with-article-buffer (&rest forms)
1319 (set-buffer gnus-article-buffer)
1320 (let ((buffer-read-only nil))
1323 (put 'gnus-with-article-buffer 'lisp-indent-function 0)
1324 (put 'gnus-with-article-buffer 'edebug-form-spec '(body))
1326 (defun gnus-article-goto-header (header)
1327 "Go to HEADER, which is a regular expression."
1328 (re-search-forward (concat "^\\(" header "\\):") nil t))
1330 (defsubst gnus-article-hide-text (b e props)
1331 "Set text PROPS on the B to E region, extending `intangible' 1 past B."
1332 (gnus-add-text-properties-when 'article-type nil b e props)
1333 (when (memq 'intangible props)
1335 (max (1- b) (point-min))
1336 b 'intangible (cddr (memq 'intangible props)))))
1338 (defsubst gnus-article-unhide-text (b e)
1339 "Remove hidden text properties from region between B and E."
1340 (remove-text-properties b e gnus-hidden-properties)
1341 (when (memq 'intangible gnus-hidden-properties)
1342 (put-text-property (max (1- b) (point-min))
1343 b 'intangible nil)))
1345 (defun gnus-article-hide-text-type (b e type)
1346 "Hide text of TYPE between B and E."
1347 (gnus-add-wash-type type)
1348 (gnus-article-hide-text
1349 b e (cons 'article-type (cons type gnus-hidden-properties))))
1351 (defun gnus-article-unhide-text-type (b e type)
1352 "Unhide text of TYPE between B and E."
1353 (gnus-delete-wash-type type)
1354 (remove-text-properties
1355 b e (cons 'article-type (cons type gnus-hidden-properties)))
1356 (when (memq 'intangible gnus-hidden-properties)
1357 (put-text-property (max (1- b) (point-min))
1358 b 'intangible nil)))
1360 (defun gnus-article-hide-text-of-type (type)
1361 "Hide text of TYPE in the current buffer."
1363 (let ((b (point-min))
1365 (while (setq b (text-property-any b e 'article-type type))
1366 (add-text-properties b (incf b) gnus-hidden-properties)))))
1368 (defun gnus-article-delete-text-of-type (type)
1369 "Delete text of TYPE in the current buffer."
1371 (let ((b (point-min)))
1372 (while (setq b (text-property-any b (point-max) 'article-type type))
1374 b (or (text-property-not-all b (point-max) 'article-type type)
1377 (defun gnus-article-delete-invisible-text ()
1378 "Delete all invisible text in the current buffer."
1380 (let ((b (point-min)))
1381 (while (setq b (text-property-any b (point-max) 'invisible t))
1383 b (or (text-property-not-all b (point-max) 'invisible t)
1386 (defun gnus-article-text-type-exists-p (type)
1387 "Say whether any text of type TYPE exists in the buffer."
1388 (text-property-any (point-min) (point-max) 'article-type type))
1390 (defsubst gnus-article-header-rank ()
1391 "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
1392 (let ((list gnus-sorted-header-list)
1395 (when (looking-at (car list))
1397 (setq list (cdr list))
1401 (defun article-hide-headers (&optional arg delete)
1402 "Hide unwanted headers and possibly sort them as well."
1404 ;; This function might be inhibited.
1405 (unless gnus-inhibit-hiding
1408 (let ((buffer-read-only nil)
1409 (case-fold-search t)
1410 (max (1+ (length gnus-sorted-header-list)))
1411 (ignored (when (not gnus-visible-headers)
1412 (cond ((stringp gnus-ignored-headers)
1413 gnus-ignored-headers)
1414 ((listp gnus-ignored-headers)
1415 (mapconcat 'identity gnus-ignored-headers
1418 (cond ((stringp gnus-visible-headers)
1419 gnus-visible-headers)
1420 ((and gnus-visible-headers
1421 (listp gnus-visible-headers))
1422 (mapconcat 'identity gnus-visible-headers "\\|"))))
1423 (inhibit-point-motion-hooks t)
1425 ;; First we narrow to just the headers.
1426 (article-narrow-to-head)
1427 ;; Hide any "From " lines at the beginning of (mail) articles.
1428 (while (looking-at "From ")
1431 (delete-region (point-min) (point)))
1432 ;; Then treat the rest of the header lines.
1433 ;; Then we use the two regular expressions
1434 ;; `gnus-ignored-headers' and `gnus-visible-headers' to
1435 ;; select which header lines is to remain visible in the
1437 (while (re-search-forward "^[^ \t:]*:" nil t)
1439 ;; Mark the rank of the header.
1441 (point) (1+ (point)) 'message-rank
1442 (if (or (and visible (looking-at visible))
1444 (not (looking-at ignored))))
1445 (gnus-article-header-rank)
1448 (message-sort-headers-1)
1449 (when (setq beg (text-property-any
1450 (point-min) (point-max) 'message-rank (+ 2 max)))
1451 ;; We delete the unwanted headers.
1452 (gnus-add-wash-type 'headers)
1453 (add-text-properties (point-min) (+ 5 (point-min))
1454 '(article-type headers dummy-invisible t))
1455 (delete-region beg (point-max))))))))
1457 (defun article-hide-boring-headers (&optional arg)
1458 "Toggle hiding of headers that aren't very interesting.
1459 If given a negative prefix, always show; if given a positive prefix,
1461 (interactive (gnus-article-hidden-arg))
1462 (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
1463 (not gnus-show-all-headers))
1466 (let ((buffer-read-only nil)
1467 (list gnus-boring-article-headers)
1468 (inhibit-point-motion-hooks t)
1470 (article-narrow-to-head)
1472 (setq elem (pop list))
1473 (goto-char (point-min))
1475 ;; Hide empty headers.
1477 (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
1479 (gnus-article-hide-text-type
1480 (progn (beginning-of-line) (point))
1483 (if (re-search-forward "^[^ \t]" nil t)
1487 ;; Hide boring Newsgroups header.
1488 ((eq elem 'newsgroups)
1489 (when (gnus-string-equal
1490 (gnus-fetch-field "newsgroups")
1491 (gnus-group-real-name
1492 (if (boundp 'gnus-newsgroup-name)
1495 (gnus-article-hide-header "newsgroups")))
1496 ((eq elem 'to-address)
1497 (let ((to (message-fetch-field "to"))
1499 (gnus-parameter-to-address
1500 (if (boundp 'gnus-newsgroup-name)
1501 gnus-newsgroup-name ""))))
1502 (when (and to to-address
1505 ;; only one address in To
1506 (nth 1 (mail-extract-address-components to))
1508 (gnus-article-hide-header "to"))))
1509 ((eq elem 'followup-to)
1510 (when (gnus-string-equal
1511 (message-fetch-field "followup-to")
1512 (message-fetch-field "newsgroups"))
1513 (gnus-article-hide-header "followup-to")))
1514 ((eq elem 'reply-to)
1515 (let ((from (message-fetch-field "from"))
1516 (reply-to (message-fetch-field "reply-to")))
1521 (nth 1 (mail-extract-address-components from))
1522 (nth 1 (mail-extract-address-components reply-to)))))
1523 (gnus-article-hide-header "reply-to"))))
1525 (let ((date (message-fetch-field "date")))
1527 (< (days-between (current-time-string) date)
1529 (gnus-article-hide-header "date"))))
1531 (let ((to (message-fetch-field "to"))
1532 (cc (message-fetch-field "cc")))
1533 (when (> (length to) 1024)
1534 (gnus-article-hide-header "to"))
1535 (when (> (length cc) 1024)
1536 (gnus-article-hide-header "cc"))))
1540 (goto-char (point-min))
1541 (while (re-search-forward "^to:" nil t)
1542 (setq to-count (1+ to-count)))
1543 (when (> to-count 1)
1544 (while (> to-count 0)
1545 (goto-char (point-min))
1547 (re-search-forward "^to:" nil nil to-count)
1549 (narrow-to-region (point) (point-max))
1550 (gnus-article-hide-header "to"))
1551 (setq to-count (1- to-count))))
1552 (goto-char (point-min))
1553 (while (re-search-forward "^cc:" nil t)
1554 (setq cc-count (1+ cc-count)))
1555 (when (> cc-count 1)
1556 (while (> cc-count 0)
1557 (goto-char (point-min))
1559 (re-search-forward "^cc:" nil nil cc-count)
1561 (narrow-to-region (point) (point-max))
1562 (gnus-article-hide-header "cc"))
1563 (setq cc-count (1- cc-count)))))))))))))
1565 (defun gnus-article-hide-header (header)
1567 (goto-char (point-min))
1568 (when (re-search-forward (concat "^" header ":") nil t)
1569 (gnus-article-hide-text-type
1570 (progn (beginning-of-line) (point))
1573 (if (re-search-forward "^[^ \t]" nil t)
1578 (defvar gnus-article-normalized-header-length 40
1579 "Length of normalized headers.")
1581 (defun article-normalize-headers ()
1582 "Make all header lines 40 characters long."
1584 (let ((buffer-read-only nil)
1588 (article-narrow-to-head)
1591 ((< (setq column (- (gnus-point-at-eol) (point)))
1592 gnus-article-normalized-header-length)
1594 (insert (make-string
1595 (- gnus-article-normalized-header-length column)
1597 ((> column gnus-article-normalized-header-length)
1598 (gnus-put-text-property
1600 (forward-char gnus-article-normalized-header-length)
1607 (forward-line 1))))))
1609 (defun article-treat-dumbquotes ()
1610 "Translate M****s*** sm*rtq**t*s into proper text.
1611 Note that this function guesses whether a character is a sm*rtq**t* or
1612 not, so it should only be used interactively.
1614 Sm*rtq**t*s are M****s***'s unilateral extension to the character map
1615 in an attempt to provide more quoting characters. If you see
1616 something like \\222 or \\264 where you're expecting some kind of
1617 apostrophe or quotation mark, then try this wash."
1619 (article-translate-strings gnus-article-dumbquotes-map))
1621 (defun article-translate-characters (from to)
1622 "Translate all characters in the body of the article according to FROM and TO.
1623 FROM is a string of characters to translate from; to is a string of
1624 characters to translate to."
1626 (when (article-goto-body)
1627 (let ((buffer-read-only nil)
1628 (x (make-string 225 ?x))
1630 (while (< (incf i) (length x))
1633 (while (< i (length from))
1634 (aset x (aref from i) (aref to i))
1636 (translate-region (point) (point-max) x)))))
1638 (defun article-translate-strings (map)
1639 "Translate all string in the body of the article according to MAP.
1640 MAP is an alist where the elements are on the form (\"from\" \"to\")."
1642 (when (article-goto-body)
1643 (let ((buffer-read-only nil)
1645 (while (setq elem (pop map))
1647 (while (search-forward (car elem) nil t)
1648 (replace-match (cadr elem)))))))))
1650 (defun article-treat-overstrike ()
1651 "Translate overstrikes into bold text."
1654 (when (article-goto-body)
1655 (let ((buffer-read-only nil))
1656 (while (search-forward "\b" nil t)
1657 (let ((next (char-after))
1658 (previous (char-after (- (point) 2))))
1659 ;; We do the boldification/underlining by hiding the
1660 ;; overstrikes and putting the proper text property
1664 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
1665 (put-text-property (point) (1+ (point)) 'face 'bold))
1667 (gnus-article-hide-text-type
1668 (1- (point)) (1+ (point)) 'overstrike)
1670 (- (point) 2) (1- (point)) 'face 'underline))
1672 (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
1674 (point) (1+ (point)) 'face 'underline)))))))))
1676 (defun gnus-article-treat-unfold-headers ()
1677 "Unfold folded message headers.
1678 Only the headers that fit into the current window width will be
1681 (gnus-with-article-headers
1685 (mail-header-narrow-to-field)
1686 (let ((header (buffer-substring (point-min) (point-max))))
1689 (goto-char (point-min))
1690 (while (re-search-forward "\n[\t ]" nil t)
1691 (replace-match " " t t)))
1692 (setq length (- (point-max) (point-min) 1)))
1693 (when (< length (window-width))
1694 (while (re-search-forward "\n[\t ]" nil t)
1695 (replace-match " " t t)))
1696 (goto-char (point-max)))))))
1698 (defun gnus-article-treat-fold-headers ()
1699 "Fold message headers."
1701 (gnus-with-article-headers
1704 (mail-header-narrow-to-field)
1705 (mail-header-fold-field)
1706 (goto-char (point-max))))))
1708 (defun gnus-treat-smiley ()
1709 "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
1711 (gnus-with-article-buffer
1712 (if (memq 'smiley gnus-article-wash-types)
1713 (gnus-delete-images 'smiley)
1715 (let ((images (smiley-region (point) (point-max))))
1717 (gnus-add-wash-type 'smiley)
1718 (dolist (image images)
1719 (gnus-add-image 'smiley image)))))))
1721 (defun gnus-article-remove-images ()
1722 "Remove all images from the article buffer."
1724 (gnus-with-article-buffer
1725 (dolist (elem gnus-article-image-alist)
1726 (gnus-delete-images (car elem)))))
1728 (defun gnus-article-treat-fold-newsgroups ()
1729 "Unfold folded message headers.
1730 Only the headers that fit into the current window width will be
1733 (gnus-with-article-headers
1734 (while (gnus-article-goto-header "newsgroups\\|followup-to")
1736 (mail-header-narrow-to-field)
1737 (while (re-search-forward ", *" nil t)
1738 (replace-match ", " t t))
1739 (mail-header-fold-field)
1740 (goto-char (point-max))))))
1742 (defun gnus-article-treat-body-boundary ()
1743 "Place a boundary line at the end of the headers."
1745 (when (and gnus-body-boundary-delimiter
1746 (> (length gnus-body-boundary-delimiter) 0))
1747 (gnus-with-article-headers
1748 (goto-char (point-max))
1749 (let ((start (point)))
1750 (insert "X-Boundary: ")
1751 (gnus-add-text-properties start (point) '(invisible t intangible t))
1753 (while (>= (1- (window-width)) (length str))
1754 (setq str (concat str gnus-body-boundary-delimiter)))
1755 (substring str 0 (1- (window-width))))
1757 (gnus-add-text-properties start (point) '(gnus-decoration 'header))))))
1759 (defun article-fill-long-lines ()
1760 "Fill lines that are wider than the window width."
1763 (let ((buffer-read-only nil)
1764 (width (window-width (get-buffer-window (current-buffer)))))
1767 (let ((adaptive-fill-mode nil)) ;Why? -sm
1770 (when (>= (current-column) (min fill-column width))
1771 (narrow-to-region (point) (gnus-point-at-bol))
1772 (fill-paragraph nil)
1773 (goto-char (point-max))
1775 (forward-line 1)))))))
1777 (defun article-capitalize-sentences ()
1778 "Capitalize the first word in each sentence."
1781 (let ((buffer-read-only nil)
1782 (paragraph-start "^[\n\^L]"))
1786 (forward-sentence)))))
1788 (defun article-remove-cr ()
1789 "Remove trailing CRs and then translate remaining CRs into LFs."
1792 (let ((buffer-read-only nil))
1793 (goto-char (point-min))
1794 (while (re-search-forward "\r+$" nil t)
1795 (replace-match "" t t))
1796 (goto-char (point-min))
1797 (while (search-forward "\r" nil t)
1798 (replace-match "\n" t t)))))
1800 (defun article-remove-trailing-blank-lines ()
1801 "Remove all trailing blank lines from the article."
1804 (let ((buffer-read-only nil))
1805 (goto-char (point-max))
1809 (while (and (not (bobp))
1810 (looking-at "^[ \t]*$")
1811 (not (gnus-annotation-in-region-p
1812 (point) (gnus-point-at-eol))))
1817 (defun article-display-x-face (&optional force)
1818 "Look for an X-Face header and display it if present."
1819 (interactive (list 'force))
1820 (let ((wash-face-p buffer-read-only)) ;; When type `W f'
1821 (gnus-with-article-headers
1822 ;; Delete the old process, if any.
1823 (when (process-status "article-x-face")
1824 (delete-process "article-x-face"))
1825 (if (memq 'xface gnus-article-wash-types)
1826 ;; We have already displayed X-Faces, so we remove them
1828 (gnus-delete-images 'xface)
1830 (let (x-faces from face grey)
1832 (when (and wash-face-p
1834 (goto-char (point-min))
1835 (not (re-search-forward
1836 "^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t)))
1837 (gnus-buffer-live-p gnus-original-article-buffer))
1838 ;; If type `W f', use gnus-original-article-buffer,
1839 ;; otherwise use the current buffer because displaying
1840 ;; RFC822 parts calls this function too.
1841 (set-buffer gnus-original-article-buffer))
1843 (mail-narrow-to-head)
1844 (if gnus-treat-display-grey-xface
1846 (while (gnus-article-goto-header "X-Face\\(-[0-9]+\\)?")
1847 (if (match-beginning 2)
1850 (push (cons (- (string-to-number (match-string 2)))
1851 (mail-header-field-value))
1853 (push (cons 0 (mail-header-field-value)) x-faces)))
1854 (dolist (x-face (prog1
1856 (sort x-faces 'car-less-than-car)
1858 (setq x-faces nil)))
1859 (push (cdr x-face) x-faces)))
1860 (while (gnus-article-goto-header "X-Face")
1861 (push (mail-header-field-value) x-faces)))
1862 (setq from (message-fetch-field "from"))))
1864 (let ((xpm (gnus-convert-gray-x-face-to-xpm x-faces))