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

   1 ;;; gnus-art.el --- article mode commands for Gnus
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
   5
   6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 ;; For Emacs < 22.2.
  29 (eval-and-compile
  30   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  31 (eval-when-compile
  32   (require 'cl))
  33 (defvar tool-bar-map)
  34 (defvar w3m-minor-mode-map)
  35
  36 (require 'gnus)
  37 ;; Avoid the "Recursive load suspected" error in Emacs 21.1.
  38 (eval-and-compile
  39   (let ((recursive-load-depth-limit 100))
  40     (require 'gnus-sum)))
  41 (require 'gnus-spec)
  42 (require 'gnus-int)
  43 (require 'gnus-win)
  44 (require 'mm-bodies)
  45 (require 'mail-parse)
  46 (require 'mm-decode)
  47 (require 'mm-view)
  48 (require 'wid-edit)
  49 (require 'mm-uu)
  50 (require 'message)
  51
  52 (autoload 'gnus-msg-mail "gnus-msg" nil t)
  53 (autoload 'gnus-button-mailto "gnus-msg")
  54 (autoload 'gnus-button-reply "gnus-msg" nil t)
  55 (autoload 'parse-time-string "parse-time" nil nil)
  56 (autoload 'ansi-color-apply-on-region "ansi-color")
  57 (autoload 'mm-url-insert-file-contents-external "mm-url")
  58 (autoload 'mm-extern-cache-contents "mm-extern")
  59
  60 (defgroup gnus-article nil
  61   "Article display."
  62   :link '(custom-manual "(gnus)Article Buffer")
  63   :group 'gnus)
  64
  65 (defgroup gnus-article-treat nil
  66   "Treating article parts."
  67   :link '(custom-manual "(gnus)Article Hiding")
  68   :group 'gnus-article)
  69
  70 (defgroup gnus-article-hiding nil
  71   "Hiding article parts."
  72   :link '(custom-manual "(gnus)Article Hiding")
  73   :group 'gnus-article)
  74
  75 (defgroup gnus-article-highlight nil
  76   "Article highlighting."
  77   :link '(custom-manual "(gnus)Article Highlighting")
  78   :group 'gnus-article
  79   :group 'gnus-visual)
  80
  81 (defgroup gnus-article-signature nil
  82   "Article signatures."
  83   :link '(custom-manual "(gnus)Article Signature")
  84   :group 'gnus-article)
  85
  86 (defgroup gnus-article-headers nil
  87   "Article headers."
  88   :link '(custom-manual "(gnus)Hiding Headers")
  89   :group 'gnus-article)
  90
  91 (defgroup gnus-article-washing nil
  92   "Special commands on articles."
  93   :link '(custom-manual "(gnus)Article Washing")
  94   :group 'gnus-article)
  95
  96 (defgroup gnus-article-emphasis nil
  97   "Fontisizing articles."
  98   :link '(custom-manual "(gnus)Article Fontisizing")
  99   :group 'gnus-article)
 100
 101 (defgroup gnus-article-saving nil
 102   "Saving articles."
 103   :link '(custom-manual "(gnus)Saving Articles")
 104   :group 'gnus-article)
 105
 106 (defgroup gnus-article-mime nil
 107   "Worshiping the MIME wonder."
 108   :link '(custom-manual "(gnus)Using MIME")
 109   :group 'gnus-article)
 110
 111 (defgroup gnus-article-buttons nil
 112   "Pushable buttons in the article buffer."
 113   :link '(custom-manual "(gnus)Article Buttons")
 114   :group 'gnus-article)
 115
 116 (defgroup gnus-article-various nil
 117   "Other article options."
 118   :link '(custom-manual "(gnus)Misc Article")
 119   :group 'gnus-article)
 120
 121 (defcustom gnus-ignored-headers
 122   (mapcar
 123    (lambda (header)
 124      (concat "^" header ":"))
 125    '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
 126      "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
 127      "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
 128      "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
 129      "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
 130      "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
 131      "X-Attribution" "X-Originating-IP" "Delivered-To"
 132      "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
 133      "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
 134      "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
 135      "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
 136      "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
 137      "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
 138      "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
 139      "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
 140      "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
 141      "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
 142      "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
 143      "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
 144      "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
 145      "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
 146      "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
 147      "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
 148      "List-[A-Za-z]+" "X-Listprocessor-Version"
 149      "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
 150      "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
 151      "X-Received" "Content-length" "X-precedence"
 152      "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
 153      "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
 154      "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
 155      "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
 156      "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
 157      "X-Content-length" "X-Posting-Agent" "Original-Received"
 158      "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
 159      "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
 160      "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
 161      "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
 162      "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"
 163      "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane"
 164      "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At"
 165      "Envelope-Sender" "Envelope-Recipients"))
 166   "*All headers that start with this regexp will be hidden.
 167 This variable can also be a list of regexps of headers to be ignored.
 168 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 169   :type '(choice :custom-show nil
 170                  regexp
 171                  (repeat regexp))
 172   :group 'gnus-article-hiding)
 173
 174 (defcustom gnus-visible-headers
 175   "^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:"
 176   "*All headers that do not match this regexp will be hidden.
 177 This variable can also be a list of regexp of headers to remain visible.
 178 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
 179   :type '(choice
 180           (repeat :value-to-internal (lambda (widget value)
 181                                        (custom-split-regexp-maybe value))
 182                   :match (lambda (widget value)
 183                            (or (stringp value)
 184                                (widget-editable-list-match widget value)))
 185                   regexp)
 186           (const :tag "Use gnus-ignored-headers" nil)
 187           regexp)
 188   :group 'gnus-article-hiding)
 189
 190 (defcustom gnus-sorted-header-list
 191   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
 192     "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
 193   "*This variable is a list of regular expressions.
 194 If it is non-nil, headers that match the regular expressions will
 195 be placed first in the article buffer in the sequence specified by
 196 this list."
 197   :type '(repeat regexp)
 198   :group 'gnus-article-hiding)
 199
 200 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
 201   "Headers that are only to be displayed if they have interesting data.
 202 Possible values in this list are:
 203
 204   'empty       Headers with no content.
 205   'newsgroups  Newsgroup identical to Gnus group.
 206   'to-address  To identical to To-address.
 207   'to-list     To identical to To-list.
 208   'cc-list     CC identical to To-list.
 209   'followup-to Followup-to identical to Newsgroups.
 210   'reply-to    Reply-to identical to From.
 211   'date        Date less than four days old.
 212   'long-to     To and/or Cc longer than 1024 characters.
 213   'many-to     Multiple To and/or Cc."
 214   :type '(set (const :tag "Headers with no content." empty)
 215               (const :tag "Newsgroups identical to Gnus group." newsgroups)
 216               (const :tag "To identical to To-address." to-address)
 217               (const :tag "To identical to To-list." to-list)
 218               (const :tag "CC identical to To-list." cc-list)
 219               (const :tag "Followup-to identical to Newsgroups." followup-to)
 220               (const :tag "Reply-to identical to From." reply-to)
 221               (const :tag "Date less than four days old." date)
 222               (const :tag "To and/or Cc longer than 1024 characters." long-to)
 223               (const :tag "Multiple To and/or Cc headers." many-to))
 224   :group 'gnus-article-hiding)
 225
 226 (defcustom gnus-article-skip-boring nil
 227   "Skip over text that is not worth reading.
 228 By default, if you set this t, then Gnus will display citations and
 229 signatures, but will never scroll down to show you a page consisting
 230 only of boring text.  Boring text is controlled by
 231 `gnus-article-boring-faces'."
 232   :version "22.1"
 233   :type 'boolean
 234   :group 'gnus-article-hiding)
 235
 236 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
 237   "Regexp matching signature separator.
 238 This can also be a list of regexps.  In that case, it will be checked
 239 from head to tail looking for a separator.  Searches will be done from
 240 the end of the buffer."
 241   :type '(choice :format "%{%t%}: %[Value Menu%]\n%v"
 242                  (regexp)
 243                  (repeat :tag "List of regexp" regexp))
 244   :group 'gnus-article-signature)
 245
 246 (defcustom gnus-signature-limit nil
 247   "Provide a limit to what is considered a signature.
 248 If it is a number, no signature may not be longer (in characters) than
 249 that number.  If it is a floating point number, no signature may be
 250 longer (in lines) than that number.  If it is a function, the function
 251 will be called without any parameters, and if it returns nil, there is
 252 no signature in the buffer.  If it is a string, it will be used as a
 253 regexp.  If it matches, the text in question is not a signature.
 254
 255 This can also be a list of the above values."
 256   :type '(choice (const nil)
 257                  (integer :value 200)
 258                  (number :value 4.0)
 259                  function
 260                  (regexp :value ".*"))
 261   :group 'gnus-article-signature)
 262
 263 (defcustom gnus-hidden-properties '(invisible t intangible t)
 264   "Property list to use for hiding text."
 265   :type 'sexp
 266   :group 'gnus-article-hiding)
 267
 268 ;; Fixme: This isn't the right thing for mixed graphical and non-graphical
 269 ;; frames in a session.
 270 (defcustom gnus-article-x-face-command
 271   (if (featurep 'xemacs)
 272       (if (or (gnus-image-type-available-p 'xface)
 273               (gnus-image-type-available-p 'pbm))
 274           'gnus-display-x-face-in-from
 275         "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
 276     (if (gnus-image-type-available-p 'pbm)
 277         'gnus-display-x-face-in-from
 278       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
 279 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 favourite 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 evaled 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 [%w] %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   :type 'string
 699   :group 'gnus-article-various)
 700
 701 (defcustom gnus-article-mode-hook nil
 702   "*A hook for Gnus article mode."
 703   :type 'hook
 704   :group 'gnus-article-various)
 705
 706 (when (featurep 'xemacs)
 707   ;; Extracted from gnus-xmas-define in order to preserve user settings
 708   (when (fboundp 'turn-off-scroll-in-place)
 709     (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
 710   ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 711   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
 712
 713 (defcustom gnus-article-menu-hook nil
 714   "*Hook run after the creation of the article mode menu."
 715   :type 'hook
 716   :group 'gnus-article-various)
 717
 718 (defcustom gnus-article-prepare-hook nil
 719   "*A hook called after an article has been prepared in the article buffer."
 720   :type 'hook
 721   :group 'gnus-article-various)
 722
 723 (defcustom gnus-copy-article-ignored-headers nil
 724   "List of headers to be removed when copying an article.
 725 Each element is a regular expression."
 726   :version "23.1" ;; No Gnus
 727   :type '(repeat regexp)
 728   :group 'gnus-article-various)
 729
 730 (make-obsolete-variable 'gnus-article-hide-pgp-hook nil
 731                         "Gnus 5.10 (Emacs-22.1)")
 732
 733 (defface gnus-button
 734   '((t (:weight bold)))
 735   "Face used for highlighting a button in the article buffer."
 736   :group 'gnus-article-buttons)
 737
 738 (defcustom gnus-article-button-face 'gnus-button
 739   "Face used for highlighting buttons in the article buffer.
 740
 741 An article button is a piece of text that you can activate by pressing
 742 `RET' or `mouse-2' above it."
 743   :type 'face
 744   :group 'gnus-article-buttons)
 745
 746 (defcustom gnus-article-mouse-face 'highlight
 747   "Face used for mouse highlighting in the article buffer.
 748
 749 Article buttons will be displayed in this face when the cursor is
 750 above them."
 751   :type 'face
 752   :group 'gnus-article-buttons)
 753
 754 (defcustom gnus-signature-face 'gnus-signature
 755   "Face used for highlighting a signature in the article buffer.
 756 Obsolete; use the face `gnus-signature' for customizations instead."
 757   :type 'face
 758   :group 'gnus-article-highlight
 759   :group 'gnus-article-signature)
 760
 761 (defface gnus-signature
 762   '((t
 763      (:italic t)))
 764   "Face used for highlighting a signature in the article buffer."
 765   :group 'gnus-article-highlight
 766   :group 'gnus-article-signature)
 767 ;; backward-compatibility alias
 768 (put 'gnus-signature-face 'face-alias 'gnus-signature)
 769 (put 'gnus-signature-face 'obsolete-face "22.1")
 770
 771 (defface gnus-header-from
 772   '((((class color)
 773       (background dark))
 774      (:foreground "PaleGreen1"))
 775     (((class color)
 776       (background light))
 777      (:foreground "red3"))
 778     (t
 779      (:italic t)))
 780   "Face used for displaying from headers."
 781   :group 'gnus-article-headers
 782   :group 'gnus-article-highlight)
 783 ;; backward-compatibility alias
 784 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
 785 (put 'gnus-header-from-face 'obsolete-face "22.1")
 786
 787 (defface gnus-header-subject
 788   '((((class color)
 789       (background dark))
 790      (:foreground "SeaGreen1"))
 791     (((class color)
 792       (background light))
 793      (:foreground "red4"))
 794     (t
 795      (:bold t :italic t)))
 796   "Face used for displaying subject headers."
 797   :group 'gnus-article-headers
 798   :group 'gnus-article-highlight)
 799 ;; backward-compatibility alias
 800 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
 801 (put 'gnus-header-subject-face 'obsolete-face "22.1")
 802
 803 (defface gnus-header-newsgroups
 804   '((((class color)
 805       (background dark))
 806      (:foreground "yellow" :italic t))
 807     (((class color)
 808       (background light))
 809      (:foreground "MidnightBlue" :italic t))
 810     (t
 811      (:italic t)))
 812   "Face used for displaying newsgroups headers.
 813 In the default setup this face is only used for crossposted
 814 articles."
 815   :group 'gnus-article-headers
 816   :group 'gnus-article-highlight)
 817 ;; backward-compatibility alias
 818 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
 819 (put 'gnus-header-newsgroups-face 'obsolete-face "22.1")
 820
 821 (defface gnus-header-name
 822   '((((class color)
 823       (background dark))
 824      (:foreground "SpringGreen2"))
 825     (((class color)
 826       (background light))
 827      (:foreground "maroon"))
 828     (t
 829      (:bold t)))
 830   "Face used for displaying header names."
 831   :group 'gnus-article-headers
 832   :group 'gnus-article-highlight)
 833 ;; backward-compatibility alias
 834 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
 835 (put 'gnus-header-name-face 'obsolete-face "22.1")
 836
 837 (defface gnus-header-content
 838   '((((class color)
 839       (background dark))
 840      (:foreground "SpringGreen1" :italic t))
 841     (((class color)
 842       (background light))
 843      (:foreground "indianred4" :italic t))
 844     (t
 845      (:italic t)))  "Face used for displaying header content."
 846   :group 'gnus-article-headers
 847   :group 'gnus-article-highlight)
 848 ;; backward-compatibility alias
 849 (put 'gnus-header-content-face 'face-alias 'gnus-header-content)
 850 (put 'gnus-header-content-face 'obsolete-face "22.1")
 851
 852 (defcustom gnus-header-face-alist
 853   '(("From" nil gnus-header-from)
 854     ("Subject" nil gnus-header-subject)
 855     ("Newsgroups:.*," nil gnus-header-newsgroups)
 856     ("" gnus-header-name gnus-header-content))
 857   "*Controls highlighting of article headers.
 858
 859 An alist of the form (HEADER NAME CONTENT).
 860
 861 HEADER is a regular expression which should match the name of a
 862 header and NAME and CONTENT are either face names or nil.
 863
 864 The name of each header field will be displayed using the face
 865 specified by the first element in the list where HEADER matches
 866 the header name and NAME is non-nil.  Similarly, the content will
 867 be displayed by the first non-nil matching CONTENT face."
 868   :group 'gnus-article-headers
 869   :group 'gnus-article-highlight
 870   :type '(repeat (list (regexp :tag "Header")
 871                        (choice :tag "Name"
 872                                (item :tag "skip" nil)
 873                                (face :value default))
 874                        (choice :tag "Content"
 875                                (item :tag "skip" nil)
 876                                (face :value default)))))
 877
 878 (defcustom gnus-face-properties-alist (if (featurep 'xemacs)
 879                                           '((xface . (:face gnus-x-face)))
 880                                         '((pbm . (:face gnus-x-face))
 881                                           (png . nil)))
 882   "Alist of image types and properties applied to Face and X-Face images.
 883 Here are examples:
 884
 885 ;; Specify the altitude of Face images in the From header.
 886 \(setq gnus-face-properties-alist
 887       '((pbm . (:face gnus-x-face :ascent 80))
 888         (png . (:ascent 80))))
 889
 890 ;; Show Face images as pressed buttons.
 891 \(setq gnus-face-properties-alist
 892       '((pbm . (:face gnus-x-face :relief -2))
 893         (png . (:relief -2))))
 894
 895 See the manual for the valid properties for various image types.
 896 Currently, `pbm' is used for X-Face images and `png' is used for Face
 897 images in Emacs.  Only the `:face' property is effective on the `xface'
 898 image type in XEmacs if it is built with the libcompface library."
 899   :version "23.1" ;; No Gnus
 900   :group 'gnus-article-headers
 901   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 902
 903 (defcustom gnus-article-decode-hook
 904   '(article-decode-charset article-decode-encoded-words
 905                            article-decode-group-name article-decode-idna-rhs)
 906   "*Hook run to decode charsets in articles."
 907   :group 'gnus-article-headers
 908   :type 'hook)
 909
 910 (defcustom gnus-display-mime-function 'gnus-display-mime
 911   "Function to display MIME articles."
 912   :group 'gnus-article-mime
 913   :type 'function)
 914
 915 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
 916   "Function used to decode headers.")
 917
 918 (defvar gnus-decode-address-function 'mail-decode-encoded-address-region
 919   "Function used to decode addresses.")
 920
 921 (defvar gnus-article-dumbquotes-map
 922   '(("\200" "EUR")
 923     ("\202" ",")
 924     ("\203" "f")
 925     ("\204" ",,")
 926     ("\205" "...")
 927     ("\213" "<")
 928     ("\214" "OE")
 929     ("\221" "`")
 930     ("\222" "'")
 931     ("\223" "``")
 932     ("\224" "\"")
 933     ("\225" "*")
 934     ("\226" "-")
 935     ("\227" "--")
 936     ("\230" "~")
 937     ("\231" "(TM)")
 938     ("\233" ">")
 939     ("\234" "oe")
 940     ("\264" "'"))
 941   "Table for MS-to-Latin1 translation.")
 942
 943 (defcustom gnus-ignored-mime-types nil
 944   "List of MIME types that should be ignored by Gnus."
 945   :version "21.1"
 946   :group 'gnus-article-mime
 947   :type '(repeat regexp))
 948
 949 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
 950   "List of MIME types that should not be given buttons when rendered inline.
 951 See also `gnus-buttonized-mime-types' which may override this variable.
 952 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 953   :version "21.1"
 954   :group 'gnus-article-mime
 955   :type '(repeat regexp))
 956
 957 (defcustom gnus-buttonized-mime-types nil
 958   "List of MIME types that should be given buttons when rendered inline.
 959 If set, this variable overrides `gnus-unbuttonized-mime-types'.
 960 To see e.g. security buttons you could set this to
 961 `(\"multipart/signed\")'.  You could also add \"multipart/alternative\" to
 962 this list to display radio buttons that allow you to choose one of two
 963 media types those mails include.  See also `mm-discouraged-alternatives'.
 964 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 965   :version "22.1"
 966   :group 'gnus-article-mime
 967   :type '(repeat regexp))
 968
 969 (defcustom gnus-inhibit-mime-unbuttonizing nil
 970   "If non-nil, all MIME parts get buttons.
 971 When nil (the default value), then some MIME parts do not get buttons,
 972 as described by the variables `gnus-buttonized-mime-types' and
 973 `gnus-unbuttonized-mime-types'."
 974   :version "22.1"
 975   :group 'gnus-article-mime
 976   :type 'boolean)
 977
 978 (defcustom gnus-body-boundary-delimiter "_"
 979   "String used to delimit header and body.
 980 This variable is used by `gnus-article-treat-body-boundary' which can
 981 be controlled by `gnus-treat-body-boundary'."
 982   :version "22.1"
 983   :group 'gnus-article-various
 984   :type '(choice (item :tag "None" :value nil)
 985                  string))
 986
 987 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
 988                                   "/usr/share/picons")
 989   "Defines the location of the faces database.
 990 For information on obtaining this database of pretty pictures, please
 991 see http://www.cs.indiana.edu/picons/ftp/index.html"
 992   :version "22.1"
 993   :type '(repeat directory)
 994   :link '(url-link :tag "download"
 995                    "http://www.cs.indiana.edu/picons/ftp/index.html")
 996   :link '(custom-manual "(gnus)Picons")
 997   :group 'gnus-picon)
 998
 999 (defun gnus-picons-installed-p ()
1000   "Say whether picons are installed on your machine."
1001   (let ((installed nil))
1002     (dolist (database gnus-picon-databases)
1003       (when (file-exists-p database)
1004         (setq installed t)))
1005     installed))
1006
1007 (defcustom gnus-article-mime-part-function nil
1008   "Function called with a MIME handle as the argument.
1009 This is meant for people who want to do something automatic based
1010 on parts -- for instance, adding Vcard info to a database."
1011   :group 'gnus-article-mime
1012   :type '(choice (const nil)
1013                  function))
1014
1015 (defcustom gnus-mime-multipart-functions nil
1016   "An alist of MIME types to functions to display them."
1017   :version "21.1"
1018   :group 'gnus-article-mime
1019   :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
1020
1021 (defcustom gnus-article-date-lapsed-new-header nil
1022   "Whether the X-Sent and Date headers can coexist.
1023 When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
1024 either replace the old \"Date:\" header (if this variable is nil), or
1025 be added below it (otherwise)."
1026   :version "21.1"
1027   :group 'gnus-article-headers
1028   :type 'boolean)
1029
1030 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
1031   "Function called with a MIME handle as the argument.
1032 This is meant for people who want to view first matched part.
1033 For `undisplayed-alternative' (default), the first undisplayed
1034 part or alternative part is used.  For `undisplayed', the first
1035 undisplayed part is used.  For a function, the first part which
1036 the function return t is used.  For nil, the first part is
1037 used."
1038   :version "21.1"
1039   :group 'gnus-article-mime
1040   :type '(choice
1041           (item :tag "first" :value nil)
1042           (item :tag "undisplayed" :value undisplayed)
1043           (item :tag "undisplayed or alternative"
1044                 :value undisplayed-alternative)
1045           (function)))
1046
1047 (defcustom gnus-mime-action-alist
1048   '(("save to file" . gnus-mime-save-part)
1049     ("save and strip" . gnus-mime-save-part-and-strip)
1050     ("replace with file" . gnus-mime-replace-part)
1051     ("delete part" . gnus-mime-delete-part)
1052     ("display as text" . gnus-mime-inline-part)
1053     ("view the part" . gnus-mime-view-part)
1054     ("pipe to command" . gnus-mime-pipe-part)
1055     ("toggle display" . gnus-article-press-button)
1056     ("toggle display" . gnus-article-view-part-as-charset)
1057     ("view as type" . gnus-mime-view-part-as-type)
1058     ("view internally" . gnus-mime-view-part-internally)
1059     ("view externally" . gnus-mime-view-part-externally))
1060   "An alist of actions that run on the MIME attachment."
1061   :group 'gnus-article-mime
1062   :type '(repeat (cons (string :tag "name")
1063                        (function))))
1064
1065 (defcustom gnus-auto-select-part 1
1066   "Advance to next MIME part when deleting or stripping parts.
1067
1068 When 0, point will be placed on the same part as before.  When
1069 positive (negative), move point forward (backwards) this many
1070 parts.  When nil, redisplay article."
1071   :version "23.1" ;; No Gnus
1072   :group 'gnus-article-mime
1073   :type '(choice (const nil :tag "Redisplay article.")