cgit.sxemacs.org Git - gnus/blob - lisp/gnus-art.el

   1 ;;; gnus-art.el --- article mode commands for Gnus
   2
   3 ;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  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 3 of the License, or
  13 ;; (at your option) any later version.
  14
  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.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 ;; For Emacs <22.2 and XEmacs.
  28 (eval-and-compile
  29   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  30 (eval-when-compile
  31   (require 'cl))
  32 (defvar tool-bar-map)
  33 (defvar w3m-minor-mode-map)
  34
  35 (require 'gnus)
  36 (require 'gnus-util)
  37 (require 'gnus-sum)
  38 (require 'gnus-spec)
  39 (require 'gnus-int)
  40 (require 'gnus-win)
  41 (require 'mm-bodies)
  42 (require 'mail-parse)
  43 (require 'mm-decode)
  44 (require 'mm-view)
  45 (require 'wid-edit)
  46 (require 'mm-uu)
  47 (require 'message)
  48 (require 'mouse)
  49
  50 (autoload 'gnus-msg-mail "gnus-msg" nil t)
  51 (autoload 'gnus-button-mailto "gnus-msg")
  52 (autoload 'gnus-button-reply "gnus-msg" nil t)
  53 (autoload 'parse-time-string "parse-time" nil nil)
  54 (autoload 'ansi-color-apply-on-region "ansi-color")
  55 (autoload 'mm-url-insert-file-contents-external "mm-url")
  56 (autoload 'mm-extern-cache-contents "mm-extern")
  57
  58 (defgroup gnus-article nil
  59   "Article display."
  60   :link '(custom-manual "(gnus)Article Buffer")
  61   :group 'gnus)
  62
  63 (defgroup gnus-article-treat nil
  64   "Treating article parts."
  65   :link '(custom-manual "(gnus)Article Hiding")
  66   :group 'gnus-article)
  67
  68 (defgroup gnus-article-hiding nil
  69   "Hiding article parts."
  70   :link '(custom-manual "(gnus)Article Hiding")
  71   :group 'gnus-article)
  72
  73 (defgroup gnus-article-highlight nil
  74   "Article highlighting."
  75   :link '(custom-manual "(gnus)Article Highlighting")
  76   :group 'gnus-article
  77   :group 'gnus-visual)
  78
  79 (defgroup gnus-article-signature nil
  80   "Article signatures."
  81   :link '(custom-manual "(gnus)Article Signature")
  82   :group 'gnus-article)
  83
  84 (defgroup gnus-article-headers nil
  85   "Article headers."
  86   :link '(custom-manual "(gnus)Hiding Headers")
  87   :group 'gnus-article)
  88
  89 (defgroup gnus-article-washing nil
  90   "Special commands on articles."
  91   :link '(custom-manual "(gnus)Article Washing")
  92   :group 'gnus-article)
  93
  94 (defgroup gnus-article-emphasis nil
  95   "Fontisizing articles."
  96   :link '(custom-manual "(gnus)Article Fontisizing")
  97   :group 'gnus-article)
  98
  99 (defgroup gnus-article-saving nil
 100   "Saving articles."
 101   :link '(custom-manual "(gnus)Saving Articles")
 102   :group 'gnus-article)
 103
 104 (defgroup gnus-article-mime nil
 105   "Worshiping the MIME wonder."
 106   :link '(custom-manual "(gnus)Using MIME")
 107   :group 'gnus-article)
 108
 109 (defgroup gnus-article-buttons nil
 110   "Pushable buttons in the article buffer."
 111   :link '(custom-manual "(gnus)Article Buttons")
 112   :group 'gnus-article)
 113
 114 (defgroup gnus-article-various nil
 115   "Other article options."
 116   :link '(custom-manual "(gnus)Misc Article")
 117   :group 'gnus-article)
 118
 119 (defcustom gnus-ignored-headers
 120   (mapcar
 121    (lambda (header)
 122      (concat "^" header ":"))
 123    '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
 124      "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
 125      "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
 126      "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
 127      "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
 128      "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
 129      "X-Attribution" "X-Originating-IP" "Delivered-To"
 130      "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
 131      "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
 132      "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
 133      "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
 134      "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
 135      "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
 136      "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
 137      "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
 138      "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
 139      "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
 140      "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
 141      "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
 142      "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
 143      "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
 144      "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
 145      "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
 146      "List-[A-Za-z]+" "X-Listprocessor-Version"
 147      "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
 148      "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
 149      "X-Received" "Content-length" "X-precedence"
 150      "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
 151      "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
 152      "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
 153      "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
 154      "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
 155      "X-Content-length" "X-Posting-Agent" "Original-Received"
 156      "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
 157      "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
 158      "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
 159      "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
 160      "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"
 161      "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane"
 162      "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At"
 163      "Envelope-Sender" "Envelope-Recipients"))
 164   "*All headers that start with this regexp will be hidden.
 165 This variable can also be a list of regexps of headers to be ignored.
 166 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 167   :type '(choice regexp
 168                  (repeat regexp))
 169   :group 'gnus-article-hiding)
 170
 171 (defcustom gnus-visible-headers
 172   "^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:"
 173   "*All headers that do not match this regexp will be hidden.
 174 This variable can also be a list of regexp of headers to remain visible.
 175 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
 176   :type '(choice
 177           (repeat :value-to-internal (lambda (widget value)
 178                                        (custom-split-regexp-maybe value))
 179                   :match (lambda (widget value)
 180                            (or (stringp value)
 181                                (widget-editable-list-match widget value)))
 182                   regexp)
 183           (const :tag "Use gnus-ignored-headers" nil)
 184           regexp)
 185   :group 'gnus-article-hiding)
 186
 187 (defcustom gnus-sorted-header-list
 188   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
 189     "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
 190   "*This variable is a list of regular expressions.
 191 If it is non-nil, headers that match the regular expressions will
 192 be placed first in the article buffer in the sequence specified by
 193 this list."
 194   :type '(repeat regexp)
 195   :group 'gnus-article-hiding)
 196
 197 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
 198   "Headers that are only to be displayed if they have interesting data.
 199 Possible values in this list are:
 200
 201   'empty       Headers with no content.
 202   'newsgroups  Newsgroup identical to Gnus group.
 203   'to-address  To identical to To-address.
 204   'to-list     To identical to To-list.
 205   'cc-list     CC identical to To-list.
 206   'followup-to Followup-to identical to Newsgroups.
 207   'reply-to    Reply-to identical to From.
 208   'date        Date less than four days old.
 209   'long-to     To and/or Cc longer than 1024 characters.
 210   'many-to     Multiple To and/or Cc."
 211   :type '(set (const :tag "Headers with no content." empty)
 212               (const :tag "Newsgroups identical to Gnus group." newsgroups)
 213               (const :tag "To identical to To-address." to-address)
 214               (const :tag "To identical to To-list." to-list)
 215               (const :tag "CC identical to To-list." cc-list)
 216               (const :tag "Followup-to identical to Newsgroups." followup-to)
 217               (const :tag "Reply-to identical to From." reply-to)
 218               (const :tag "Date less than four days old." date)
 219               (const :tag "To and/or Cc longer than 1024 characters." long-to)
 220               (const :tag "Multiple To and/or Cc headers." many-to))
 221   :group 'gnus-article-hiding)
 222
 223 (defcustom gnus-article-skip-boring nil
 224   "Skip over text that is not worth reading.
 225 By default, if you set this t, then Gnus will display citations and
 226 signatures, but will never scroll down to show you a page consisting
 227 only of boring text.  Boring text is controlled by
 228 `gnus-article-boring-faces'."
 229   :version "22.1"
 230   :type 'boolean
 231   :group 'gnus-article-hiding)
 232
 233 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
 234   "Regexp matching signature separator.
 235 This can also be a list of regexps.  In that case, it will be checked
 236 from head to tail looking for a separator.  Searches will be done from
 237 the end of the buffer."
 238   :type '(choice :format "%{%t%}: %[Value Menu%]\n%v"
 239                  (regexp)
 240                  (repeat :tag "List of regexp" regexp))
 241   :group 'gnus-article-signature)
 242
 243 (defcustom gnus-signature-limit nil
 244   "Provide a limit to what is considered a signature.
 245 If it is a number, no signature may not be longer (in characters) than
 246 that number.  If it is a floating point number, no signature may be
 247 longer (in lines) than that number.  If it is a function, the function
 248 will be called without any parameters, and if it returns nil, there is
 249 no signature in the buffer.  If it is a string, it will be used as a
 250 regexp.  If it matches, the text in question is not a signature.
 251
 252 This can also be a list of the above values."
 253   :type '(choice (const nil)
 254                  (integer :value 200)
 255                  (number :value 4.0)
 256                  function
 257                  (regexp :value ".*"))
 258   :group 'gnus-article-signature)
 259
 260 (defcustom gnus-hidden-properties '(invisible t intangible t)
 261   "Property list to use for hiding text."
 262   :type 'sexp
 263   :group 'gnus-article-hiding)
 264
 265 ;; Fixme: This isn't the right thing for mixed graphical and non-graphical
 266 ;; frames in a session.
 267 (defcustom gnus-article-x-face-command
 268   (if (featurep 'xemacs)
 269       (if (or (gnus-image-type-available-p 'xface)
 270               (gnus-image-type-available-p 'pbm))
 271           'gnus-display-x-face-in-from
 272         "{ echo \
 273 '/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
 274 ; uncompface; } | icontopbm | ee -")
 275     (if (gnus-image-type-available-p 'pbm)
 276         'gnus-display-x-face-in-from
 277       "{ echo \
 278 '/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
 279 ; uncompface; } | icontopbm | display -"))
 280   "*String or function to be executed to display an X-Face header.
 281 If it is a string, the command will be executed in a sub-shell
 282 asynchronously.  The compressed face will be piped to this command."
 283   :type `(choice string
 284                  (function-item gnus-display-x-face-in-from)
 285                  function)
 286   :version "21.1"
 287   :group 'gnus-picon
 288   :group 'gnus-article-washing)
 289
 290 (defcustom gnus-article-x-face-too-ugly nil
 291   "Regexp matching posters whose face shouldn't be shown automatically."
 292   :type '(choice regexp (const nil))
 293   :group 'gnus-article-washing)
 294
 295 (defcustom gnus-article-banner-alist nil
 296   "Banner alist for stripping.
 297 For example,
 298      ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
 299   :version "21.1"
 300   :type '(repeat (cons symbol regexp))
 301   :group 'gnus-article-washing)
 302
 303 (gnus-define-group-parameter
 304  banner
 305  :variable-document
 306  "Alist of regexps (to match group names) and banner."
 307  :variable-group gnus-article-washing
 308  :parameter-type
 309  '(choice :tag "Banner"
 310           :value nil
 311           (const :tag "Remove signature" signature)
 312           (symbol :tag "Item in `gnus-article-banner-alist'" none)
 313           regexp
 314           (const :tag "None" nil))
 315  :parameter-document
 316  "If non-nil, specify how to remove `banners' from articles.
 317
 318 Symbol `signature' means to remove signatures delimited by
 319 `gnus-signature-separator'.  Any other symbol is used to look up a
 320 regular expression to match the banner in `gnus-article-banner-alist'.
 321 A string is used as a regular expression to match the banner
 322 directly.")
 323
 324 (defcustom gnus-article-address-banner-alist nil
 325   "Alist of mail addresses and banners.
 326 Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
 327 to match a mail address in the From: header, BANNER is one of a symbol
 328 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
 329 If ADDRESS matches author's mail address, it will remove things like
 330 advertisements.  For example:
 331
 332 \((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
 333 "
 334   :type '(repeat
 335           (cons
 336            (regexp :tag "Address")
 337            (choice :tag "Banner" :value nil
 338                    (const :tag "Remove signature" signature)
 339                    (symbol :tag "Item in `gnus-article-banner-alist'" none)
 340                    regexp
 341                    (const :tag "None" nil))))
 342   :version "22.1"
 343   :group 'gnus-article-washing)
 344
 345 (defmacro gnus-emphasis-custom-with-format (&rest body)
 346   `(let ((format "\
 347 \\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\
 348 \\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)"))
 349      ,@body))
 350
 351 (defun gnus-emphasis-custom-value-to-external (value)
 352   (gnus-emphasis-custom-with-format
 353    (if (consp (car value))
 354        (list (format format (car (car value)) (cdr (car value)))
 355              2
 356              (if (nth 1 value) 2 3)
 357              (nth 2 value))
 358      value)))
 359
 360 (defun gnus-emphasis-custom-value-to-internal (value)
 361   (gnus-emphasis-custom-with-format
 362    (let ((regexp (concat "\\`"
 363                          (format (regexp-quote format)
 364                                  "\\([^()]+\\)" "\\([^()]+\\)")
 365                          "\\'"))
 366          pattern)
 367      (if (string-match regexp (setq pattern (car value)))
 368          (list (cons (match-string 1 pattern) (match-string 2 pattern))
 369                (= (nth 2 value) 2)
 370                (nth 3 value))
 371        value))))
 372
 373 (defcustom gnus-emphasis-alist
 374   (let ((types
 375          '(("\\*" "\\*" bold nil 2)
 376            ("_" "_" underline)
 377            ("/" "/" italic)
 378            ("_/" "/_" underline-italic)
 379            ("_\\*" "\\*_" underline-bold)
 380            ("\\*/" "/\\*" bold-italic)
 381            ("_\\*/" "/\\*_" underline-bold-italic))))
 382     (nconc
 383      (gnus-emphasis-custom-with-format
 384       (mapcar (lambda (spec)
 385                 (list (format format (car spec) (cadr spec))
 386                       (or (nth 3 spec) 2)
 387                       (or (nth 4 spec) 3)
 388                       (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
 389               types))
 390      '(;; I've never seen anyone use this strikethru convention whereas I've
 391        ;; several times seen it triggered by normal text.  --Stef
 392        ;; Miles suggests that this form is sometimes used but for italics,
 393        ;; so maybe we should map it to `italic'.
 394        ;; ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
 395        ;; 2 3 gnus-emphasis-strikethru)
 396        ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
 397         2 3 gnus-emphasis-underline))))
 398   "*Alist that says how to fontify certain phrases.
 399 Each item looks like this:
 400
 401   (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
 402
 403 The first element is a regular expression to be matched.  The second
 404 is a number that says what regular expression grouping used to find
 405 the entire emphasized word.  The third is a number that says what
 406 regexp grouping should be displayed and highlighted.  The fourth
 407 is the face used for highlighting."
 408   :type
 409   '(repeat
 410     (menu-choice
 411      :format "%[Customizing Style%]\n%v"
 412      :indent 2
 413      (group :tag "Default"
 414             :value ("" 0 0 default)
 415             :value-create
 416             (lambda (widget)
 417               (let ((value (widget-get
 418                             (cadr (widget-get (widget-get widget :parent)
 419                                               :args))
 420                             :value)))
 421                 (if (not (eq (nth 2 value) 'default))
 422                     (widget-put
 423                      widget
 424                      :value
 425                      (gnus-emphasis-custom-value-to-external value))))
 426               (widget-group-value-create widget))
 427             regexp
 428             (integer :format "Match group: %v")
 429             (integer :format "Emphasize group: %v")
 430             face)
 431      (group :tag "Simple"
 432             :value (("_" . "_") nil default)
 433             (cons :format "%v"
 434                   (regexp :format "Start regexp: %v")
 435                   (regexp :format "End regexp: %v"))
 436             (boolean :format "Show start and end patterns: %[%v%]\n"
 437                      :on " On " :off " Off ")
 438             face)))
 439   :get (lambda (symbol)
 440          (mapcar 'gnus-emphasis-custom-value-to-internal
 441                  (default-value symbol)))
 442   :set (lambda (symbol value)
 443          (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
 444                                      value)))
 445   :group 'gnus-article-emphasis)
 446
 447 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
 448   "A regexp to describe whitespace which should not be emphasized.
 449 Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
 450 The former avoids underlining of leading and trailing whitespace,
 451 and the latter avoids underlining any whitespace at all."
 452   :version "21.1"
 453   :group 'gnus-article-emphasis
 454   :type 'regexp)
 455
 456 (defface gnus-emphasis-bold '((t (:bold t)))
 457   "Face used for displaying strong emphasized text (*word*)."
 458   :group 'gnus-article-emphasis)
 459
 460 (defface gnus-emphasis-italic '((t (:italic t)))
 461   "Face used for displaying italic emphasized text (/word/)."
 462   :group 'gnus-article-emphasis)
 463
 464 (defface gnus-emphasis-underline '((t (:underline t)))
 465   "Face used for displaying underlined emphasized text (_word_)."
 466   :group 'gnus-article-emphasis)
 467
 468 (defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
 469   "Face used for displaying underlined bold emphasized text (_*word*_)."
 470   :group 'gnus-article-emphasis)
 471
 472 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
 473   "Face used for displaying underlined italic emphasized text (_/word/_)."
 474   :group 'gnus-article-emphasis)
 475
 476 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
 477   "Face used for displaying bold italic emphasized text (/*word*/)."
 478   :group 'gnus-article-emphasis)
 479
 480 (defface gnus-emphasis-underline-bold-italic
 481   '((t (:bold t :italic t :underline t)))
 482   "Face used for displaying underlined bold italic emphasized text.
 483 Example: (_/*word*/_)."
 484   :group 'gnus-article-emphasis)
 485
 486 (defface gnus-emphasis-strikethru (if (featurep 'xemacs)
 487                                       '((t (:strikethru t)))
 488                                     '((t (:strike-through t))))
 489   "Face used for displaying strike-through text (-word-)."
 490   :group 'gnus-article-emphasis)
 491
 492 (defface gnus-emphasis-highlight-words
 493   '((t (:background "black" :foreground "yellow")))
 494   "Face used for displaying highlighted words."
 495   :group 'gnus-article-emphasis)
 496
 497 (defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
 498   "Format for display of Date headers in article bodies.
 499 See `format-time-string' for the possible values.
 500
 501 The variable can also be function, which should return a complete Date
 502 header.  The function is called with one argument, the time, which can
 503 be fed to `format-time-string'."
 504   :type '(choice string function)
 505   :link '(custom-manual "(gnus)Article Date")
 506   :group 'gnus-article-washing)
 507
 508 (defcustom gnus-save-all-headers t
 509   "*If non-nil, don't remove any headers before saving.
 510 This will be overridden by the `:headers' property that the symbol of
 511 the saver function, which is specified by `gnus-default-article-saver',
 512 might have."
 513   :group 'gnus-article-saving
 514   :type 'boolean)
 515
 516 (defcustom gnus-prompt-before-saving 'always
 517   "*This variable says how much prompting is to be done when saving articles.
 518 If it is nil, no prompting will be done, and the articles will be
 519 saved to the default files.  If this variable is `always', each and
 520 every article that is saved will be preceded by a prompt, even when
 521 saving large batches of articles.  If this variable is neither nil not
 522 `always', there the user will be prompted once for a file name for
 523 each invocation of the saving commands."
 524   :group 'gnus-article-saving
 525   :type '(choice (item always)
 526                  (item :tag "never" nil)
 527                  (sexp :tag "once" :format "%t\n" :value t)))
 528
 529 (defcustom gnus-saved-headers gnus-visible-headers
 530   "Headers to keep if `gnus-save-all-headers' is nil.
 531 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
 532 If that variable is nil, however, all headers that match this regexp
 533 will be kept while the rest will be deleted before saving.  This and
 534 `gnus-save-all-headers' will be overridden by the `:headers' property
 535 that the symbol of the saver function, which is specified by
 536 `gnus-default-article-saver', might have."
 537   :group 'gnus-article-saving
 538   :type 'regexp)
 539
 540 ;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
 541 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
 542   "A function to save articles in your favorite format.
 543 The function will be called by way of the `gnus-summary-save-article'
 544 command, and friends such as `gnus-summary-save-article-rmail'.
 545
 546 Gnus provides the following functions:
 547
 548 * gnus-summary-save-in-rmail (Rmail format)
 549 * gnus-summary-save-in-mail (Unix mail format)
 550 * gnus-summary-save-in-folder (MH folder)
 551 * gnus-summary-save-in-file (article format)
 552 * gnus-summary-save-body-in-file (article body)
 553 * gnus-summary-save-in-vm (use VM's folder format)
 554 * gnus-summary-write-to-file (article format -- overwrite)
 555 * gnus-summary-write-body-to-file (article body -- overwrite)
 556 * gnus-summary-save-in-pipe (article format)
 557
 558 The symbol of each function may have the following properties:
 559
 560 * :decode
 561 The value non-nil means save decoded articles.  This is meaningful
 562 only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
 563 `gnus-summary-write-to-file', `gnus-summary-write-body-to-file', and
 564 `gnus-summary-save-in-pipe'.
 565
 566 * :function
 567 The value specifies an alternative function which appends, not
 568 overwrites, articles to a file.  This implies that when saving many
 569 articles at a time, `gnus-prompt-before-saving' is bound to t and all
 570 articles are saved in a single file.  This is meaningful only with
 571 `gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'.
 572
 573 * :headers
 574 The value specifies the symbol of a variable of which the value
 575 specifies headers to be saved.  If it is omitted,
 576 `gnus-save-all-headers' and `gnus-saved-headers' control what
 577 headers should be saved."
 578   :group 'gnus-article-saving
 579   :type '(radio (function-item gnus-summary-save-in-rmail)
 580                 (function-item gnus-summary-save-in-mail)
 581                 (function-item gnus-summary-save-in-folder)
 582                 (function-item gnus-summary-save-in-file)
 583                 (function-item gnus-summary-save-body-in-file)
 584                 (function-item gnus-summary-save-in-vm)
 585                 (function-item gnus-summary-write-to-file)
 586                 (function-item gnus-summary-write-body-to-file)
 587                 (function-item gnus-summary-save-in-pipe)
 588                 (function)))
 589
 590 (defcustom gnus-article-save-coding-system
 591   (or (and (mm-coding-system-p 'utf-8) 'utf-8)
 592       (and (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit)
 593       (and (mm-coding-system-p 'emacs-mule) 'emacs-mule)
 594       (and (mm-coding-system-p 'escape-quoted) 'escape-quoted))
 595   "Coding system used to save decoded articles to a file.
 596
 597 The recommended coding systems are `utf-8', `iso-2022-7bit' and so on,
 598 which can safely encode any characters in text.  This is used by the
 599 commands including:
 600
 601 * gnus-summary-save-article-file
 602 * gnus-summary-save-article-body-file
 603 * gnus-summary-write-article-file
 604 * gnus-summary-write-article-body-file
 605
 606 and the functions to which you may set `gnus-default-article-saver':
 607
 608 * gnus-summary-save-in-file
 609 * gnus-summary-save-body-in-file
 610 * gnus-summary-write-to-file
 611 * gnus-summary-write-body-to-file
 612
 613 Those commands and functions save just text displayed in the article
 614 buffer to a file if the value of this variable is non-nil.  Note that
 615 buttonized MIME parts will be lost in a saved file in that case.
 616 Otherwise, raw articles will be saved."
 617   :group 'gnus-article-saving
 618   :type `(choice
 619           :format "%{%t%}:\n %[Value Menu%] %v"
 620           (const :tag "Save raw articles" nil)
 621           ,@(delq nil
 622                   (mapcar
 623                    (lambda (arg) (if (mm-coding-system-p (nth 3 arg)) arg))
 624                    '((const :tag "UTF-8" utf-8)
 625                      (const :tag "iso-2022-7bit" iso-2022-7bit)
 626                      (const :tag "Emacs internal" emacs-mule)
 627                      (const :tag "escape-quoted" escape-quoted))))
 628           (symbol :tag "Coding system")))
 629
 630 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
 631   "A function generating a file name to save articles in Rmail format.
 632 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 633   :group 'gnus-article-saving
 634   :type 'function)
 635
 636 (defcustom gnus-mail-save-name 'gnus-plain-save-name
 637   "A function generating a file name to save articles in Unix mail format.
 638 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 639   :group 'gnus-article-saving
 640   :type 'function)
 641
 642 (defcustom gnus-folder-save-name 'gnus-folder-save-name
 643   "A function generating a file name to save articles in MH folder.
 644 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
 645   :group 'gnus-article-saving
 646   :type 'function)
 647
 648 (defcustom gnus-file-save-name 'gnus-numeric-save-name
 649   "A function generating a file name to save articles in article format.
 650 The function is called with NEWSGROUP, HEADERS, and optional
 651 LAST-FILE."
 652   :group 'gnus-article-saving
 653   :type 'function)
 654
 655 (defcustom gnus-split-methods
 656   '((gnus-article-archive-name)
 657     (gnus-article-nndoc-name))
 658   "*Variable used to suggest where articles are to be saved.
 659 For instance, if you would like to save articles related to Gnus in
 660 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
 661 you could set this variable to something like:
 662
 663  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
 664    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
 665
 666 This variable is an alist where the key is the match and the
 667 value is a list of possible files to save in if the match is
 668 non-nil.
 669
 670 If the match is a string, it is used as a regexp match on the
 671 article.  If the match is a symbol, that symbol will be funcalled
 672 from the buffer of the article to be saved with the newsgroup as the
 673 parameter.  If it is a list, it will be evalled in the same buffer.
 674
 675 If this form or function returns a string, this string will be used as a
 676 possible file name; and if it returns a non-nil list, that list will be
 677 used as possible file names."
 678   :group 'gnus-article-saving
 679   :type '(repeat (choice (list :value (fun) function)
 680                          (cons :value ("" "") regexp (repeat string))
 681                          (sexp :value nil))))
 682
 683 (defcustom gnus-page-delimiter "^\^L"
 684   "*Regexp describing what to use as article page delimiters.
 685 The default value is \"^\^L\", which is a form linefeed at the
 686 beginning of a line."
 687   :type 'regexp
 688   :group 'gnus-article-various)
 689
 690 (defcustom gnus-article-mode-line-format "Gnus: %g %S%m"
 691   "*The format specification for the article mode line.
 692 See `gnus-summary-mode-line-format' for a closer description.
 693
 694 The following additional specs are available:
 695
 696 %w  The article washing status.
 697 %m  The number of MIME parts in the article."
 698   :version "24.1"
 699   :type 'string
 700   :group 'gnus-article-various)
 701
 702 (defcustom gnus-article-mode-hook nil
 703   "*A hook for Gnus article mode."
 704   :type 'hook
 705   :group 'gnus-article-various)
 706
 707 (when (featurep 'xemacs)
 708   ;; Extracted from gnus-xmas-define in order to preserve user settings
 709   (when (fboundp 'turn-off-scroll-in-place)
 710     (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
 711   ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 712   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
 713
 714 (defcustom gnus-article-menu-hook nil
 715   "*Hook run after the creation of the article mode menu."
 716   :type 'hook
 717   :group 'gnus-article-various)
 718
 719 (defcustom gnus-article-prepare-hook nil
 720   "*A hook called after an article has been prepared in the article buffer."
 721   :type 'hook
 722   :group 'gnus-article-various)
 723
 724 (defcustom gnus-copy-article-ignored-headers nil
 725   "List of headers to be removed when copying an article.
 726 Each element is a regular expression."
 727   :version "23.1" ;; No Gnus
 728   :type '(repeat regexp)
 729   :group 'gnus-article-various)
 730
 731 (make-obsolete-variable 'gnus-article-hide-pgp-hook nil
 732                         "Gnus 5.10 (Emacs 22.1)")
 733
 734 (defface gnus-button
 735   '((t (:weight bold)))
 736   "Face used for highlighting a button in the article buffer."
 737   :group 'gnus-article-buttons)
 738
 739 (defcustom gnus-article-button-face 'gnus-button
 740   "Face used for highlighting buttons in the article buffer.
 741
 742 An article button is a piece of text that you can activate by pressing
 743 `RET' or `mouse-2' above it."
 744   :type 'face
 745   :group 'gnus-article-buttons)
 746
 747 (defcustom gnus-article-mouse-face 'highlight
 748   "Face used for mouse highlighting in the article buffer.
 749
 750 Article buttons will be displayed in this face when the cursor is
 751 above them."
 752   :type 'face
 753   :group 'gnus-article-buttons)
 754
 755 (defcustom gnus-signature-face 'gnus-signature
 756   "Face used for highlighting a signature in the article buffer.
 757 Obsolete; use the face `gnus-signature' for customizations instead."
 758   :type 'face
 759   :group 'gnus-article-highlight
 760   :group 'gnus-article-signature)
 761
 762 (defface gnus-signature
 763   '((t
 764      (:italic t)))
 765   "Face used for highlighting a signature in the article buffer."
 766   :group 'gnus-article-highlight
 767   :group 'gnus-article-signature)
 768 ;; backward-compatibility alias
 769 (put 'gnus-signature-face 'face-alias 'gnus-signature)
 770 (put 'gnus-signature-face 'obsolete-face "22.1")
 771
 772 (defface gnus-header-from
 773   '((((class color)
 774       (background dark))
 775      (:foreground "PaleGreen1"))
 776     (((class color)
 777       (background light))
 778      (:foreground "red3"))
 779     (t
 780      (:italic t)))
 781   "Face used for displaying from headers."
 782   :group 'gnus-article-headers
 783   :group 'gnus-article-highlight)
 784 ;; backward-compatibility alias
 785 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
 786 (put 'gnus-header-from-face 'obsolete-face "22.1")
 787
 788 (defface gnus-header-subject
 789   '((((class color)
 790       (background dark))
 791      (:foreground "SeaGreen1"))
 792     (((class color)
 793       (background light))
 794      (:foreground "red4"))
 795     (t
 796      (:bold t :italic t)))
 797   "Face used for displaying subject headers."
 798   :group 'gnus-article-headers
 799   :group 'gnus-article-highlight)
 800 ;; backward-compatibility alias
 801 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
 802 (put 'gnus-header-subject-face 'obsolete-face "22.1")
 803
 804 (defface gnus-header-newsgroups
 805   '((((class color)
 806       (background dark))
 807      (:foreground "yellow" :italic t))
 808     (((class color)
 809       (background light))
 810      (:foreground "MidnightBlue" :italic t))
 811     (t
 812      (:italic t)))
 813   "Face used for displaying newsgroups headers.
 814 In the default setup this face is only used for crossposted
 815 articles."
 816   :group 'gnus-article-headers
 817   :group 'gnus-article-highlight)
 818 ;; backward-compatibility alias
 819 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
 820 (put 'gnus-header-newsgroups-face 'obsolete-face "22.1")
 821
 822 (defface gnus-header-name
 823   '((((class color)
 824       (background dark))
 825      (:foreground "SpringGreen2"))
 826     (((class color)
 827       (background light))
 828      (:foreground "maroon"))
 829     (t
 830      (:bold t)))
 831   "Face used for displaying header names."
 832   :group 'gnus-article-headers
 833   :group 'gnus-article-highlight)
 834 ;; backward-compatibility alias
 835 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
 836 (put 'gnus-header-name-face 'obsolete-face "22.1")
 837
 838 (defface gnus-header-content
 839   '((((class color)
 840       (background dark))
 841      (:foreground "SpringGreen1" :italic t))
 842     (((class color)
 843       (background light))
 844      (:foreground "indianred4" :italic t))
 845     (t
 846      (:italic t)))  "Face used for displaying header content."
 847   :group 'gnus-article-headers
 848   :group 'gnus-article-highlight)
 849 ;; backward-compatibility alias
 850 (put 'gnus-header-content-face 'face-alias 'gnus-header-content)
 851 (put 'gnus-header-content-face 'obsolete-face "22.1")
 852
 853 (defcustom gnus-header-face-alist
 854   '(("From" nil gnus-header-from)
 855     ("Subject" nil gnus-header-subject)
 856     ("Newsgroups:.*," nil gnus-header-newsgroups)
 857     ("" gnus-header-name gnus-header-content))
 858   "*Controls highlighting of article headers.
 859
 860 An alist of the form (HEADER NAME CONTENT).
 861
 862 HEADER is a regular expression which should match the name of a
 863 header and NAME and CONTENT are either face names or nil.
 864
 865 The name of each header field will be displayed using the face
 866 specified by the first element in the list where HEADER matches
 867 the header name and NAME is non-nil.  Similarly, the content will
 868 be displayed by the first non-nil matching CONTENT face."
 869   :group 'gnus-article-headers
 870   :group 'gnus-article-highlight
 871   :type '(repeat (list (regexp :tag "Header")
 872                        (choice :tag "Name"
 873                                (item :tag "skip" nil)
 874                                (face :value default))
 875                        (choice :tag "Content"
 876                                (item :tag "skip" nil)
 877                                (face :value default)))))
 878
 879 (defcustom gnus-face-properties-alist (if (featurep 'xemacs)
 880                                           '((xface . (:face gnus-x-face)))
 881                                         '((pbm . (:face gnus-x-face))
 882                                           (png . nil)))
 883   "Alist of image types and properties applied to Face and X-Face images.
 884 Here are examples:
 885
 886 ;; Specify the altitude of Face images in the From header.
 887 \(setq gnus-face-properties-alist
 888       '((pbm . (:face gnus-x-face :ascent 80))
 889         (png . (:ascent 80))))
 890
 891 ;; Show Face images as pressed buttons.
 892 \(setq gnus-face-properties-alist
 893       '((pbm . (:face gnus-x-face :relief -2))
 894         (png . (:relief -2))))
 895
 896 See the manual for the valid properties for various image types.
 897 Currently, `pbm' is used for X-Face images and `png' is used for Face
 898 images in Emacs.  Only the `:face' property is effective on the `xface'
 899 image type in XEmacs if it is built with the libcompface library."
 900   :version "23.1" ;; No Gnus
 901   :group 'gnus-article-headers
 902   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 903
 904 (defcustom gnus-article-decode-hook
 905   '(article-decode-charset article-decode-encoded-words
 906                            article-decode-group-name article-decode-idna-rhs)
 907   "*Hook run to decode charsets in articles."
 908   :group 'gnus-article-headers
 909   :type 'hook)
 910
 911 (defcustom gnus-display-mime-function 'gnus-display-mime
 912   "Function to display MIME articles."
 913   :group 'gnus-article-mime
 914   :type 'function)
 915
 916 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
 917   "Function used to decode headers.")
 918
 919 (defvar gnus-decode-address-function 'mail-decode-encoded-address-region
 920   "Function used to decode addresses.")
 921
 922 (defvar gnus-article-dumbquotes-map
 923   '((?\200 "EUR")
 924     (?\202 ",")
 925     (?\203 "f")
 926     (?\204 ",,")
 927     (?\205 "...")
 928     (?\213 "<")
 929     (?\214 "OE")
 930     (?\221 "`")
 931     (?\222 "'")
 932     (?\223 "``")
 933     (?\224 "\"")
 934     (?\225 "*")
 935     (?\226 "-")
 936     (?\227 "--")
 937     (?\230 "~")
 938     (?\231 "(TM)")
 939     (?\233 ">")
 940     (?\234 "oe")
 941     (?\264 "'"))
 942   "Table for MS-to-Latin1 translation.")
 943
 944 (defcustom gnus-ignored-mime-types nil
 945   "List of MIME types that should be ignored by Gnus."
 946   :version "21.1"
 947   :group 'gnus-article-mime
 948   :type '(repeat regexp))
 949
 950 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
 951   "List of MIME types that should not be given buttons when rendered inline.
 952 See also `gnus-buttonized-mime-types' which may override this variable.
 953 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 954   :version "21.1"
 955   :group 'gnus-article-mime
 956   :type '(repeat regexp))
 957
 958 (defcustom gnus-buttonized-mime-types nil
 959   "List of MIME types that should be given buttons when rendered inline.
 960 If set, this variable overrides `gnus-unbuttonized-mime-types'.
 961 To see e.g. security buttons you could set this to
 962 `(\"multipart/signed\")'.  You could also add \"multipart/alternative\" to
 963 this list to display radio buttons that allow you to choose one of two
 964 media types those mails include.  See also `mm-discouraged-alternatives'.
 965 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 966   :version "22.1"
 967   :group 'gnus-article-mime
 968   :type '(repeat regexp))
 969
 970 (defcustom gnus-inhibit-mime-unbuttonizing nil
 971   "If non-nil, all MIME parts get buttons.
 972 When nil (the default value), then some MIME parts do not get buttons,
 973 as described by the variables `gnus-buttonized-mime-types' and
 974 `gnus-unbuttonized-mime-types'."
 975   :version "22.1"
 976   :group 'gnus-article-mime
 977   :type 'boolean)
 978
 979 (defcustom gnus-body-boundary-delimiter "_"
 980   "String used to delimit header and body.
 981 This variable is used by `gnus-article-treat-body-boundary' which can
 982 be controlled by `gnus-treat-body-boundary'."
 983   :version "22.1"
 984   :group 'gnus-article-various
 985   :type '(choice (item :tag "None" :value nil)
 986                  string))
 987
 988 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
 989                                   "/usr/share/picons")
 990   "Defines the location of the faces database.
 991 For information on obtaining this database of pretty pictures, please
 992 see http://www.cs.indiana.edu/picons/ftp/index.html"
 993   :version "22.1"
 994   :type '(repeat directory)
 995   :link '(url-link :tag "download"
 996                    "http://www.cs.indiana.edu/picons/ftp/index.html")
 997   :link '(custom-manual "(gnus)Picons")
 998   :group 'gnus-picon)
 999
1000 (defun gnus-picons-installed-p ()
1001   "Say whether picons are installed on your machine."
1002   (let ((installed nil))
1003     (dolist (database gnus-picon-databases)
1004       (when (file-exists-p database)
1005         (setq installed t)))
1006     installed))
1007
1008 (defcustom gnus-article-mime-part-function nil
1009   "Function called with a MIME handle as the argument.
1010 This is meant for people who want to do something automatic based
1011 on parts -- for instance, adding Vcard info to a database."
1012   :group 'gnus-article-mime
1013   :type '(choice (const nil)
1014                  function))
1015
1016 (defcustom gnus-mime-multipart-functions nil
1017   "An alist of MIME types to functions to display them."
1018   :version "21.1"
1019   :group 'gnus-article-mime
1020   :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
1021
1022 (defcustom gnus-article-date-headers '(combined-lapsed)
1023   "A list of Date header formats to display.
1024 Valid formats are `ut' (universal time), `local' (local time
1025 zone), `english' (readable English), `lapsed' (elapsed time),
1026 `combined-lapsed' (both the original date and the elapsed time),
1027 `original' (the original date header), `iso8601' (ISO8601
1028 format), and `user-defined' (a user-defined format defined by the
1029 `gnus-article-time-format' variable).
1030
1031 You have as many date headers as you want in the article buffer.
1032 Some of these headers are updated automatically.  See
1033 `gnus-article-update-date-headers' for details."
1034   :version "24.1"
1035   :group 'gnus-article-headers
1036   :type '(set
1037           (const :tag "Universal time (UT)" ut)
1038           (const :tag "Local time zone" local)
1039           (const :tag "Readable English" english)
1040           (const :tag "Elapsed time" lapsed)
1041           (const :tag "Original and elapsed time" combined-lapsed)
1042           (const :tag "Original date header" original)
1043           (const :tag "ISO8601 format" iso8601)
1044           (const :tag "User-defined" user-defined)))
1045
1046 (defcustom gnus-article-update-date-headers nil
1047   "A number that says how often to update the date header (in seconds).
1048 If nil, don't update it at all."
1049   :version "24.1"
1050   :group 'gnus-article-headers
1051   :type '(choice
1052           (item :tag "Don't update" :value nil)
1053           integer))
1054
1055 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
1056   "Function called with a MIME handle as the argument.
1057 This is meant for people who want to view first matched part.
1058 For `undisplayed-alternative' (default), the first undisplayed
1059 part or alternative part is used.  For `undisplayed', the first
1060 undisplayed part is used.  For a function, the first part which
1061 the function return t is used.  For nil, the first part is
1062 used."
1063   :version "21.1"
1064   :group 'gnus-article-mime
1065   :type '(choice
1066           (item :tag "first" :value nil)
1067           (item :tag "undisplayed" :value undisplayed)
1068           (item :tag "undisplayed or alternative"
1069                 :value undisplayed-alternative)
1070           (function)))
1071
1072 (defcustom gnus-mime-action-alist
1073   '(("save to file" . gnus-mime-save-part)
1074     ("save and strip" . gnus-mime-save-part-and-strip)
1075     ("replace with file" . gnus-mime-replace-part)
1076     ("delete part" . gnus-mime-delete-part)
1077     ("display as text" . gnus-mime-inline-part)
1078     ("view the part" . gnus-mime-view-part)
1079     ("pipe to command" . gnus-mime-pipe-part)
1080     ("toggle display" . gnus-article-press-button)
1081     ("toggle display" . gnus-article-view-part-as-charset)
1082     ("view as type" . gnus-mime-view-part-as-type)
1083     ("view internally" . gnus-mime-view-part-internally)
1084     ("view externally" . gnus-mime-view-part-externally))
1085   "An alist of actions that run on the MIME attachment."
1086   :group 'gnus-article-mime
1087   :type '(repeat (cons (string :tag "name")
1088                        (function))))
1089
1090 (defcustom gnus-auto-select-part 1
1091   "Advance to next MIME part when deleting or stripping parts.
1092
1093 When 0, point will be placed on the same part as before.  When
1094 positive (negative), move point forward (backwards) this many
1095 parts.  When nil, redisplay article."
1096   :version "23.1" ;; No Gnus
1097   :group 'gnus-article-mime
1098   :type '(choice (const nil :tag "Redisplay article.")
1099                  (const 1 :tag "Next part.")
1100                  (const 0 :tag "Current part.")
1101                  integer))
1102
1103 ;;;
1104 ;;; The treatment variables
1105 ;;;
1106
1107 (defvar gnus-part-display-hook nil
1108   "Hook called on parts that are to receive treatment.")
1109
1110 (defvar gnus-article-treat-custom
1111   '(choice (const :tag "Off" nil)
1112            (const :tag "On" t)
1113            (const :tag "Header" head)
1114            (const :tag "First" first)
1115            (const :tag "Last" last)
1116            (integer :tag "Less")
1117            (repeat :tag "Groups" regexp)
1118            (sexp :tag "Predicate")))
1119
1120 (defvar gnus-article-treat-head-custom
1121   '(choice (const :tag "Off" nil)
1122            (const :tag "Header" head)))
1123
1124 (defvar gnus-article-treat-types '("text/plain" "text/x-verbatim"
1125                                    "text/x-patch" "text/html")
1126   "Part types eligible for treatment.")
1127
1128 (defvar gnus-inhibit-treatment nil
1129   "Whether to inhibit treatment.")
1130
1131 (defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
1132   "Highlight the signature.
1133 Valid values are nil, t, `head', `first', `last', an integer or a
1134 predicate.  See Info node `(gnus)Customizing Articles'."
1135   :group 'gnus-article-treat
1136   :link '(custom-manual "(gnus)Customizing Articles")
1137   :type gnus-article-treat-custom)
1138 (put 'gnus-treat-highlight-signature 'highlight t)
1139
1140 (defcustom gnus-treat-buttonize 100000
1141   "Add buttons.
1142 Valid values are nil, t, `head', `first', `last', an integer or a
1143 predicate.  See Info node `(gnus)Customizing Articles'."
1144   :group 'gnus-article-treat
1145   :link '(custom-manual "(gnus)Customizing Articles")
1146   :type gnus-article-treat-custom)
1147 (put 'gnus-treat-buttonize 'highlight t)
1148
1149 (defcustom gnus-treat-buttonize-head 'head
1150   "Add buttons to the head.
1151 Valid values are nil, t, `head', `first', `last', an integer or a
1152 predicate.  See Info node `(gnus)Customizing Articles'."
1153   :group 'gnus-article-treat
1154   :link '(custom-manual "(gnus)Customizing Articles")
1155   :type gnus-article-treat-head-custom)
1156 (put 'gnus-treat-buttonize-head 'highlight t)
1157
1158 (defcustom gnus-treat-date 'head
1159   "Display dates according to the `gnus-article-date-headers' variable.
1160 Valid values are nil, t, `head', `first', `last', an integer or a
1161 predicate.  See Info node `(gnus)Customizing Articles'."
1162   :version "24.1"
1163   :group 'gnus-article-treat
1164   :link '(custom-manual "(gnus)Customizing Articles")
1165   :type gnus-article-treat-head-custom)
1166
1167 (defcustom gnus-treat-emphasize 50000
1168   "Emphasize text.
1169 Valid values are nil, t, `head', `first', `last', an integer or a
1170 predicate.  See Info node `(gnus)Customizing Articles'."
1171   :group 'gnus-article-treat
1172   :link '(custom-manual "(gnus)Customizing Articles")
1173   :type gnus-article-treat-custom)
1174 (put 'gnus-treat-emphasize 'highlight t)
1175
1176 (defcustom gnus-treat-strip-cr nil
1177   "Remove carriage returns.
1178 Valid values are nil, t, `head', `first', `last', an integer or a
1179 predicate.  See Info node `(gnus)Customizing Articles'."
1180   :version "22.1"
1181   :group 'gnus-article-treat
1182   :link '(custom-manual "(gnus)Customizing Articles")
1183   :type gnus-article-treat-custom)
1184
1185 (defcustom gnus-treat-unsplit-urls nil
1186   "Remove newlines from within URLs.
1187 Valid values are nil, t, `head', `first', `last', an integer or a
1188 predicate.  See Info node `(gnus)Customizing Articles'."
1189   :version "22.1"
1190   :group 'gnus-article-treat
1191   :link '(custom-manual "(gnus)Customizing Articles")
1192   :type gnus-article-treat-custom)
1193
1194 (defcustom gnus-treat-leading-whitespace nil
1195   "Remove leading whitespace in headers.
1196 Valid values are nil, t, `head', `first', `last', an integer or a
1197 predicate.  See Info node `(gnus)Customizing Articles'."
1198   :version "22.1"
1199   :group 'gnus-article-treat
1200   :link '(custom-manual "(gnus)Customizing Articles")
1201   :type gnus-article-treat-custom)
1202
1203 (defcustom gnus-treat-hide-headers 'head
1204   "Hide headers.
1205 Valid values are nil, t, `head', `first', `last', an integer or a
1206 predicate.  See Info node `(gnus)Customizing Articles'."
1207   :group 'gnus-article-treat
1208   :link '(custom-manual "(gnus)Customizing Articles")
1209   :type gnus-article-treat-head-custom)
1210
1211 (defcustom gnus-treat-hide-boring-headers nil
1212   "Hide boring headers.
1213 Valid values are nil, t, `head', `first', `last', an integer or a
1214 predicate.  See Info node `(gnus)Customizing Articles'."
1215   :group 'gnus-article-treat
1216   :link '(custom-manual "(gnus)Customizing Articles")
1217   :type gnus-article-treat-head-custom)
1218
1219 (defcustom gnus-treat-hide-signature nil
1220   "Hide the signature.
1221 Valid values are nil, t, `head', `first', `last', an integer or a
1222 predicate.  See Info node `(gnus)Customizing Articles'."
1223   :group 'gnus-article-treat
1224   :link '(custom-manual "(gnus)Customizing Articles")
1225   :type gnus-article-treat-custom)
1226
1227 (defcustom gnus-treat-fill-article nil
1228   "Fill the article.
1229 Valid values are nil, t, `head', `first', `last', an integer or a
1230 predicate.  See Info node `(gnus)Customizing Articles'."
1231   :group 'gnus-article-treat
1232   :link '(custom-manual "(gnus)Customizing Articles")
1233   :type gnus-article-treat-custom)
1234
1235 (defcustom gnus-treat-hide-citation nil
1236   "Hide cited text.
1237 Valid values are nil, t, `head', `first', `last', an integer or a
1238 predicate.  See Info node `(gnus)Customizing Articles'.
1239
1240 See `gnus-article-highlight-citation' for variables used to
1241 control what it hides."
1242   :group 'gnus-article-treat
1243   :link '(custom-manual "(gnus)Customizing Articles")
1244   :type gnus-article-treat-custom)
1245
1246 (defcustom gnus-treat-hide-citation-maybe nil
1247   "Hide cited text according to certain conditions.
1248 Valid values are nil, t, `head', `first', `last', an integer or a
1249 predicate.  See Info node `(gnus)Customizing Articles'.
1250
1251 See `gnus-cite-hide-percentage' and `gnus-cite-hide-absolute' for
1252 how to control what it hides."
1253   :group 'gnus-article-treat
1254   :link '(custom-manual "(gnus)Customizing Articles")
1255   :type gnus-article-treat-custom)
1256
1257 (defcustom gnus-treat-strip-list-identifiers 'head
1258   "Strip list identifiers from `gnus-list-identifiers`.
1259 Valid values are nil, t, `head', `first', `last', an integer or a
1260 predicate.  See Info node `(gnus)Customizing Articles'."
1261   :version "21.1"
1262   :group 'gnus-article-treat
1263   :link '(custom-manual "(gnus)Customizing Articles")
1264   :type gnus-article-treat-custom)
1265
1266 (gnus-define-group-parameter
1267  list-identifier
1268  :variable-document
1269  "Alist of regexps and correspondent identifiers."
1270  :variable-group gnus-article-washing
1271  :parameter-type
1272  '(choice :tag "Identifier"
1273           :value nil
1274           (symbol :tag "Item in `gnus-list-identifiers'" none)
1275           regexp
1276           (const :tag "None" nil))
1277  :parameter-document
1278  "If non-nil, specify how to remove `identifiers' from articles' subject.
1279
1280 Any symbol is used to look up a regular expression to match the
1281 banner in `gnus-list-identifiers'.  A string is used as a regular
1282 expression to match the identifier directly.")
1283
1284 (make-obsolete-variable 'gnus-treat-strip-pgp nil
1285                         "Gnus 5.10 (Emacs 22.1)")
1286
1287 (defcustom gnus-treat-strip-pem nil
1288   "Strip PEM signatures.
1289 Valid values are nil, t, `head', `first', `last', an integer or a
1290 predicate.  See Info node `(gnus)Customizing Articles'."
1291   :group 'gnus-article-treat
1292   :link '(custom-manual "(gnus)Customizing Articles")
1293   :type gnus-article-treat-custom)
1294
1295 (defcustom gnus-treat-strip-banner t
1296   "Strip banners from articles.
1297 The banner to be stripped is specified in the `banner' group parameter.
1298 Valid values are nil, t, `head', `first', `last', an integer or a
1299 predicate.  See Info node `(gnus)Customizing Articles'."
1300   :group 'gnus-article-treat
1301   :link '(custom-manual "(gnus)Customizing Articles")
1302   :type gnus-article-treat-custom)
1303
1304 (defcustom gnus-treat-highlight-headers 'head
1305   "Highlight the headers.
1306 Valid values are nil, t, `head', `first', `last', an integer or a
1307 predicate.  See Info node `(gnus)Customizing Articles'."
1308   :group 'gnus-article-treat
1309   :link '(custom-manual "(gnus)Customizing Articles")
1310   :type gnus-article-treat-head-custom)
1311 (put 'gnus-treat-highlight-headers 'highlight t)
1312
1313 (defcustom gnus-treat-highlight-citation t
1314   "Highlight cited text.
1315 Valid values are nil, t, `head', `first', `last', an integer or a
1316 predicate.  See Info node `(gnus)Customizing Articles'."
1317   :group 'gnus-article-treat
1318   :link '(custom-manual "(gnus)Customizing Articles")
1319   :type gnus-article-treat-custom)
1320 (put 'gnus-treat-highlight-citation 'highlight t)
1321
1322 (defcustom gnus-treat-strip-headers-in-body t
1323   "Strip the X-No-Archive header line from the beginning of the body.
1324 Valid values are nil, t, `head', `first', `last', an integer or a
1325 predicate.  See Info node `(gnus)Customizing Articles'."
1326   :version "21.1"
1327   :group 'gnus-article-treat
1328   :link '(custom-manual "(gnus)Customizing Articles")
1329   :type gnus-article-treat-custom)
1330
1331 (defcustom gnus-treat-strip-trailing-blank-lines nil
1332   "Strip trailing blank lines.
1333 Valid values are nil, t, `head', `first', `last', an integer or a
1334 predicate.  See Info node `(gnus)Customizing Articles'.
1335
1336 When set to t, it also strips trailing blanks in all MIME parts.
1337 Consider to use `last' instead."
1338   :group 'gnus-article-treat
1339   :link '(custom-manual "(gnus)Customizing Articles")
1340   :type gnus-article-treat-custom)
1341
1342 (defcustom gnus-treat-strip-leading-blank-lines nil
1343   "Strip leading blank lines.
1344 Valid values are nil, t, `head', `first', `last', an integer or a
1345 predicate.  See Info node `(gnus)Customizing Articles'.
1346
1347 When set to t, it also strips trailing blanks in all MIME parts."
1348   :group 'gnus-article-treat
1349   :link '(custom-manual "(gnus)Customizing Articles")
1350   :type gnus-article-treat-custom)
1351
1352 (defcustom gnus-treat-strip-multiple-blank-lines nil
1353   "Strip multiple blank lines.
1354 Valid values are nil, t, `head', `first', `last', an integer or a
1355 predicate.  See Info node `(gnus)Customizing Articles'."
1356   :group 'gnus-article-treat
1357   :link '(custom-manual "(gnus)Customizing Articles")
1358   :type gnus-article-treat-custom)
1359
1360 (defcustom gnus-treat-unfold-headers 'head
1361   "Unfold folded header lines.
1362 Valid values are nil, t, `head', `first', `last', an integer or a
1363 predicate.  See Info node `(gnus)Customizing Articles'."
1364   :version "22.1"
1365   :group 'gnus-article-treat
1366   :link '(custom-manual "(gnus)Customizing Articles")
1367   :type gnus-article-treat-custom)
1368
1369 (defcustom gnus-article-unfold-long-headers nil
1370   "If non-nil, allow unfolding headers even if the header is long.
1371 If it is a regexp, only long headers matching this regexp are unfolded.
1372 If it is t, all long headers are unfolded.
1373
1374 This variable has no effect if `gnus-treat-unfold-headers' is nil."
1375   :version "23.1" ;; No Gnus
1376   :group 'gnus-article-treat
1377   :type '(choice (const nil)
1378                  (const :tag "all" t)
1379                  (regexp)))
1380
1381 (defcustom gnus-treat-fold-headers nil
1382   "Fold headers.
1383 Valid values are nil, t, `head', `first', `last', an integer or a
1384 predicate.  See Info node `(gnus)Customizing Articles'."
1385   :version "22.1"
1386   :group 'gnus-article-treat
1387   :link '(custom-manual "(gnus)Customizing Articles")
1388   :type gnus-article-treat-custom)
1389
1390 (defcustom gnus-treat-fold-newsgroups 'head
1391   "Fold the Newsgroups and Followup-To headers.
1392 Valid values are nil, t, `head', `first', `last', an integer or a
1393 predicate.  See Info node `(gnus)Customizing Articles'."
1394   :version "22.1"
1395   :group 'gnus-article-treat
1396   :link '(custom-manual "(gnus)Customizing Articles")
1397   :type gnus-article-treat-custom)
1398
1399 (defcustom gnus-treat-overstrike t
1400   "Treat overstrike highlighting.
1401 Valid values are nil, t, `head', `first', `last', an integer or a
1402 predicate.  See Info node `(gnus)Customizing Articles'."
1403   :group 'gnus-article-treat
1404   :link '(custom-manual "(gnus)Customizing Articles")
1405   :type gnus-article-treat-custom)
1406 (put 'gnus-treat-overstrike 'highlight t)
1407
1408 (defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t)
1409   "Treat ANSI SGR control sequences.
1410 Valid values are nil, t, `head', `first', `last', an integer or a
1411 predicate.  See Info node `(gnus)Customizing Articles'."
1412   :group 'gnus-article-treat
1413   :link '(custom-manual "(gnus)Customizing Articles")
1414   :type gnus-article-treat-custom)
1415
1416 (make-obsolete-variable 'gnus-treat-display-xface
1417                         'gnus-treat-display-x-face "Emacs 22.1")
1418
1419 (defcustom gnus-treat-display-x-face
1420   (and (not noninteractive)
1421        (gnus-image-type-available-p 'xbm)
1422        (if (featurep 'xemacs)
1423            (featurep 'xface)
1424          (condition-case nil
1425              (and (string-match "^0x" (shell-command-to-string "uncompface"))
1426                   (executable-find "icontopbm"))
1427            ;; shell-command-to-string may signal an error, e.g. if
1428            ;; shell-file-name is not found.
1429            (error nil)))
1430        'head)
1431   "Display X-Face headers.
1432 Valid values are nil and `head'.
1433 See Info node `(gnus)Customizing Articles' and Info node
1434 `(gnus)X-Face' for details."
1435   :group 'gnus-article-treat
1436   :version "21.1"
1437   :link '(custom-manual "(gnus)Customizing Articles")
1438   :link '(custom-manual "(gnus)X-Face")
1439   :type gnus-article-treat-head-custom
1440   :set (lambda (symbol value)
1441          (set-default
1442           symbol
1443           (cond ((or (boundp symbol) (get symbol 'saved-value))
1444        &nb