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

   1 ;;; gnus-art.el --- article mode commands for Gnus
   2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
   3 ;;        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 2, or (at your option)
  13 ;; 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; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval-when-compile (require 'cl))
  30
  31 (require 'gnus)
  32 (require 'gnus-sum)
  33 (require 'gnus-spec)
  34 (require 'gnus-int)
  35 (require 'gnus-win)
  36 (require 'mm-bodies)
  37 (require 'mail-parse)
  38 (require 'mm-decode)
  39 (require 'mm-view)
  40 (require 'wid-edit)
  41 (require 'mm-uu)
  42
  43 (autoload 'gnus-msg-mail "gnus-msg" nil t)
  44 (autoload 'gnus-button-mailto "gnus-msg")
  45 (autoload 'gnus-button-reply "gnus-msg" nil t)
  46
  47 (defgroup gnus-article nil
  48   "Article display."
  49   :link '(custom-manual "(gnus)The Article Buffer")
  50   :group 'gnus)
  51
  52 (defgroup gnus-article-treat nil
  53   "Treating article parts."
  54   :link '(custom-manual "(gnus)Article Hiding")
  55   :group 'gnus-article)
  56
  57 (defgroup gnus-article-hiding nil
  58   "Hiding article parts."
  59   :link '(custom-manual "(gnus)Article Hiding")
  60   :group 'gnus-article)
  61
  62 (defgroup gnus-article-highlight nil
  63   "Article highlighting."
  64   :link '(custom-manual "(gnus)Article Highlighting")
  65   :group 'gnus-article
  66   :group 'gnus-visual)
  67
  68 (defgroup gnus-article-signature nil
  69   "Article signatures."
  70   :link '(custom-manual "(gnus)Article Signature")
  71   :group 'gnus-article)
  72
  73 (defgroup gnus-article-headers nil
  74   "Article headers."
  75   :link '(custom-manual "(gnus)Hiding Headers")
  76   :group 'gnus-article)
  77
  78 (defgroup gnus-article-washing nil
  79   "Special commands on articles."
  80   :link '(custom-manual "(gnus)Article Washing")
  81   :group 'gnus-article)
  82
  83 (defgroup gnus-article-emphasis nil
  84   "Fontisizing articles."
  85   :link '(custom-manual "(gnus)Article Fontisizing")
  86   :group 'gnus-article)
  87
  88 (defgroup gnus-article-saving nil
  89   "Saving articles."
  90   :link '(custom-manual "(gnus)Saving Articles")
  91   :group 'gnus-article)
  92
  93 (defgroup gnus-article-mime nil
  94   "Worshiping the MIME wonder."
  95   :link '(custom-manual "(gnus)Using MIME")
  96   :group 'gnus-article)
  97
  98 (defgroup gnus-article-buttons nil
  99   "Pushable buttons in the article buffer."
 100   :link '(custom-manual "(gnus)Article Buttons")
 101   :group 'gnus-article)
 102
 103 (defgroup gnus-article-various nil
 104   "Other article options."
 105   :link '(custom-manual "(gnus)Misc Article")
 106   :group 'gnus-article)
 107
 108 (defcustom gnus-ignored-headers
 109   (mapcar
 110    (lambda (header)
 111      (concat "^" header ":"))
 112    '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
 113      "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
 114      "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
 115      "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
 116      "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
 117      "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
 118      "X-Attribution" "X-Originating-IP" "Delivered-To"
 119      "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
 120      "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
 121      "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
 122      "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
 123      "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
 124      "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
 125      "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
 126      "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
 127      "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
 128      "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
 129      "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
 130      "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
 131      "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
 132      "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
 133      "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
 134      "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
 135      "List-[A-Za-z]+" "X-Listprocessor-Version"
 136      "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
 137      "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
 138      "X-Received" "Content-length" "X-precedence"
 139      "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
 140      "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
 141      "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
 142      "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
 143      "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
 144      "X-Content-length" "X-Posting-Agent" "Original-Received"
 145      "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
 146      "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
 147      "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
 148      "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
 149      "X-Abuse-and-DMCA-Info" "X-Postfilter"))
 150   "*All headers that start with this regexp will be hidden.
 151 This variable can also be a list of regexps of headers to be ignored.
 152 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 153   :type '(choice :custom-show nil
 154                  regexp
 155                  (repeat regexp))
 156   :group 'gnus-article-hiding)
 157
 158 (defcustom gnus-visible-headers
 159   "^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:"
 160   "*All headers that do not match this regexp will be hidden.
 161 This variable can also be a list of regexp of headers to remain visible.
 162 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
 163   :type '(repeat :value-to-internal (lambda (widget value)
 164                                       (custom-split-regexp-maybe value))
 165                  :match (lambda (widget value)
 166                           (or (stringp value)
 167                               (widget-editable-list-match widget value)))
 168                  regexp)
 169   :group 'gnus-article-hiding)
 170
 171 (defcustom gnus-sorted-header-list
 172   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
 173     "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
 174   "*This variable is a list of regular expressions.
 175 If it is non-nil, headers that match the regular expressions will
 176 be placed first in the article buffer in the sequence specified by
 177 this list."
 178   :type '(repeat regexp)
 179   :group 'gnus-article-hiding)
 180
 181 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
 182   "Headers that are only to be displayed if they have interesting data.
 183 Possible values in this list are:
 184
 185   'empty       Headers with no content.
 186   'newsgroups  Newsgroup identical to Gnus group.
 187   'to-address  To identical to To-address.
 188   'followup-to Followup-to identical to Newsgroups.
 189   'reply-to    Reply-to identical to From.
 190   'date        Date less than four days old.
 191   'long-to     To and/or Cc longer than 1024 characters.
 192   'many-to     Multiple To and/or Cc."
 193   :type '(set (const :tag "Headers with no content." empty)
 194               (const :tag "Newsgroups identical to Gnus group." newsgroups)
 195               (const :tag "To identical to To-address." to-address)
 196               (const :tag "Followup-to identical to Newsgroups." followup-to)
 197               (const :tag "Reply-to identical to From." reply-to)
 198               (const :tag "Date less than four days old." date)
 199               (const :tag "To and/or Cc longer than 1024 characters." long-to)
 200               (const :tag "Multiple To and/or Cc headers." many-to))
 201   :group 'gnus-article-hiding)
 202
 203 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
 204   "Regexp matching signature separator.
 205 This can also be a list of regexps.  In that case, it will be checked
 206 from head to tail looking for a separator.  Searches will be done from
 207 the end of the buffer."
 208   :type '(repeat string)
 209   :group 'gnus-article-signature)
 210
 211 (defcustom gnus-signature-limit nil
 212   "Provide a limit to what is considered a signature.
 213 If it is a number, no signature may not be longer (in characters) than
 214 that number.  If it is a floating point number, no signature may be
 215 longer (in lines) than that number.  If it is a function, the function
 216 will be called without any parameters, and if it returns nil, there is
 217 no signature in the buffer.  If it is a string, it will be used as a
 218 regexp.  If it matches, the text in question is not a signature."
 219   :type '(choice (integer :value 200)
 220                  (number :value 4.0)
 221                  (function :value fun)
 222                  (regexp :value ".*"))
 223   :group 'gnus-article-signature)
 224
 225 (defcustom gnus-hidden-properties '(invisible t intangible t)
 226   "Property list to use for hiding text."
 227   :type 'sexp
 228   :group 'gnus-article-hiding)
 229
 230 ;; Fixme: This isn't the right thing for mixed graphical and and
 231 ;; non-graphical frames in a session.
 232 (defcustom gnus-article-x-face-command
 233   (if (featurep 'xemacs)
 234       (if (or (gnus-image-type-available-p 'xface)
 235               (gnus-image-type-available-p 'pbm))
 236           'gnus-display-x-face-in-from
 237         "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
 238     (if (gnus-image-type-available-p 'pbm)
 239         'gnus-display-x-face-in-from
 240       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
 241 display -"))
 242   "*String or function to be executed to display an X-Face header.
 243 If it is a string, the command will be executed in a sub-shell
 244 asynchronously.  The compressed face will be piped to this command."
 245   :type `(choice string
 246                  (function-item gnus-display-x-face-in-from)
 247                  function)
 248   :version "21.1"
 249   :group 'gnus-picon
 250   :group 'gnus-article-washing)
 251
 252 (defcustom gnus-article-x-face-too-ugly nil
 253   "Regexp matching posters whose face shouldn't be shown automatically."
 254   :type '(choice regexp (const nil))
 255   :group 'gnus-article-washing)
 256
 257 (defcustom gnus-article-banner-alist nil
 258   "Banner alist for stripping.
 259 For example,
 260      ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
 261   :version "21.1"
 262   :type '(repeat (cons symbol regexp))
 263   :group 'gnus-article-washing)
 264
 265 (gnus-define-group-parameter
 266  banner
 267  :variable-document
 268  "Alist of regexps (to match group names) and banner."
 269  :variable-group gnus-article-washing
 270  :parameter-type
 271  '(choice :tag "Banner"
 272           :value nil
 273           (const :tag "Remove signature" signature)
 274           (symbol :tag "Item in `gnus-article-banner-alist'" none)
 275           regexp
 276           (const :tag "None" nil))
 277  :parameter-document
 278  "If non-nil, specify how to remove `banners' from articles.
 279
 280 Symbol `signature' means to remove signatures delimited by
 281 `gnus-signature-separator'.  Any other symbol is used to look up a
 282 regular expression to match the banner in `gnus-article-banner-alist'.
 283 A string is used as a regular expression to match the banner
 284 directly.")
 285
 286 (defcustom gnus-article-address-banner-alist nil
 287   "Alist of mail addresses and banners.
 288 Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
 289 to match a mail address in the From: header, BANNER is one of a symbol
 290 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
 291 If ADDRESS matches author's mail address, it will remove things like
 292 advertisements.  For example:
 293
 294 \((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
 295 "
 296   :type '(repeat
 297           (cons
 298            (regexp :tag "Address")
 299            (choice :tag "Banner" :value nil
 300                    (const :tag "Remove signature" signature)
 301                    (symbol :tag "Item in `gnus-article-banner-alist'" none)
 302                    regexp
 303                    (const :tag "None" nil))))
 304   :group 'gnus-article-washing)
 305
 306 (defcustom gnus-emphasis-alist
 307   (let ((format
 308          "\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)")
 309         (types
 310          '(("\\*" "\\*" bold)
 311            ("_" "_" underline)
 312            ("/" "/" italic)
 313            ("_/" "/_" underline-italic)
 314            ("_\\*" "\\*_" underline-bold)
 315            ("\\*/" "/\\*" bold-italic)
 316            ("_\\*/" "/\\*_" underline-bold-italic))))
 317     `(,@(mapcar
 318          (lambda (spec)
 319            (list
 320             (format format (car spec) (cadr spec))
 321             2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
 322          types)
 323         ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
 324          2 3 gnus-emphasis-strikethru)
 325         ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
 326          2 3 gnus-emphasis-underline)))
 327   "*Alist that says how to fontify certain phrases.
 328 Each item looks like this:
 329
 330   (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
 331
 332 The first element is a regular expression to be matched.  The second
 333 is a number that says what regular expression grouping used to find
 334 the entire emphasized word.  The third is a number that says what
 335 regexp grouping should be displayed and highlighted.  The fourth
 336 is the face used for highlighting."
 337   :type '(repeat (list :value ("" 0 0 default)
 338                        regexp
 339                        (integer :tag "Match group")
 340                        (integer :tag "Emphasize group")
 341                        face))
 342   :group 'gnus-article-emphasis)
 343
 344 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
 345   "A regexp to describe whitespace which should not be emphasized.
 346 Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
 347 The former avoids underlining of leading and trailing whitespace,
 348 and the latter avoids underlining any whitespace at all."
 349   :version "21.1"
 350   :group 'gnus-article-emphasis
 351   :type 'regexp)
 352
 353 (defface gnus-emphasis-bold '((t (:bold t)))
 354   "Face used for displaying strong emphasized text (*word*)."
 355   :group 'gnus-article-emphasis)
 356
 357 (defface gnus-emphasis-italic '((t (:italic t)))
 358   "Face used for displaying italic emphasized text (/word/)."
 359   :group 'gnus-article-emphasis)
 360
 361 (defface gnus-emphasis-underline '((t (:underline t)))
 362   "Face used for displaying underlined emphasized text (_word_)."
 363   :group 'gnus-article-emphasis)
 364
 365 (defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
 366   "Face used for displaying underlined bold emphasized text (_*word*_)."
 367   :group 'gnus-article-emphasis)
 368
 369 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
 370   "Face used for displaying underlined italic emphasized text (_/word/_)."
 371   :group 'gnus-article-emphasis)
 372
 373 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
 374   "Face used for displaying bold italic emphasized text (/*word*/)."
 375   :group 'gnus-article-emphasis)
 376
 377 (defface gnus-emphasis-underline-bold-italic
 378   '((t (:bold t :italic t :underline t)))
 379   "Face used for displaying underlined bold italic emphasized text.
 380 Example: (_/*word*/_)."
 381   :group 'gnus-article-emphasis)
 382
 383 (defface gnus-emphasis-strikethru '((t (:strikethru t)))
 384   "Face used for displaying strike-through text (-word-)."
 385   :group 'gnus-article-emphasis)
 386
 387 (defface gnus-emphasis-highlight-words
 388   '((t (:background "black" :foreground "yellow")))
 389   "Face used for displaying highlighted words."
 390   :group 'gnus-article-emphasis)
 391
 392 (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
 393   "Format for display of Date headers in article bodies.
 394 See `format-time-string' for the possible values.
 395
 396 The variable can also be function, which should return a complete Date
 397 header.  The function is called with one argument, the time, which can
 398 be fed to `format-time-string'."
 399   :type '(choice string symbol)
 400   :link '(custom-manual "(gnus)Article Date")
 401   :group 'gnus-article-washing)
 402
 403 (eval-and-compile
 404   (autoload 'mail-extract-address-components "mail-extr"))
 405
 406 (defcustom gnus-save-all-headers t
 407   "*If non-nil, don't remove any headers before saving."
 408   :group 'gnus-article-saving
 409   :type 'boolean)
 410
 411 (defcustom gnus-prompt-before-saving 'always
 412   "*This variable says how much prompting is to be done when saving articles.
 413 If it is nil, no prompting will be done, and the articles will be
 414 saved to the default files.  If this variable is `always', each and
 415 every article that is saved will be preceded by a prompt, even when
 416 saving large batches of articles.  If this variable is neither nil not
 417 `always', there the user will be prompted once for a file name for
 418 each invocation of the saving commands."
 419   :group 'gnus-article-saving
 420   :type '(choice (item always)
 421                  (item :tag "never" nil)
 422                  (sexp :tag "once" :format "%t\n" :value t)))
 423
 424 (defcustom gnus-saved-headers gnus-visible-headers
 425   "Headers to keep if `gnus-save-all-headers' is nil.
 426 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
 427 If that variable is nil, however, all headers that match this regexp
 428 will be kept while the rest will be deleted before saving."
 429   :group 'gnus-article-saving
 430   :type 'regexp)
 431
 432 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
 433   "A function to save articles in your favourite format.
 434 The function must be interactively callable (in other words, it must
 435 be an Emacs command).
 436
 437 Gnus provides the following functions:
 438
 439 * gnus-summary-save-in-rmail (Rmail format)
 440 * gnus-summary-save-in-mail (Unix mail format)
 441 * gnus-summary-save-in-folder (MH folder)
 442 * gnus-summary-save-in-file (article format)
 443 * gnus-summary-save-body-in-file (article body)
 444 * gnus-summary-save-in-vm (use VM's folder format)
 445 * gnus-summary-write-to-file (article format -- overwrite)."
 446   :group 'gnus-article-saving
 447   :type '(radio (function-item gnus-summary-save-in-rmail)
 448                 (function-item gnus-summary-save-in-mail)
 449                 (function-item gnus-summary-save-in-folder)
 450                 (function-item gnus-summary-save-in-file)
 451                 (function-item gnus-summary-save-body-in-file)
 452                 (function-item gnus-summary-save-in-vm)
 453                 (function-item gnus-summary-write-to-file)))
 454
 455 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
 456   "A function generating a file name to save articles in Rmail format.
 457 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 458   :group 'gnus-article-saving
 459   :type 'function)
 460
 461 (defcustom gnus-mail-save-name 'gnus-plain-save-name
 462   "A function generating a file name to save articles in Unix mail format.
 463 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 464   :group 'gnus-article-saving
 465   :type 'function)
 466
 467 (defcustom gnus-folder-save-name 'gnus-folder-save-name
 468   "A function generating a file name to save articles in MH folder.
 469 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
 470   :group 'gnus-article-saving
 471   :type 'function)
 472
 473 (defcustom gnus-file-save-name 'gnus-numeric-save-name
 474   "A function generating a file name to save articles in article format.
 475 The function is called with NEWSGROUP, HEADERS, and optional
 476 LAST-FILE."
 477   :group 'gnus-article-saving
 478   :type 'function)
 479
 480 (defcustom gnus-split-methods
 481   '((gnus-article-archive-name)
 482     (gnus-article-nndoc-name))
 483   "*Variable used to suggest where articles are to be saved.
 484 For instance, if you would like to save articles related to Gnus in
 485 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
 486 you could set this variable to something like:
 487
 488  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
 489    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
 490
 491 This variable is an alist where the where the key is the match and the
 492 value is a list of possible files to save in if the match is non-nil.
 493
 494 If the match is a string, it is used as a regexp match on the
 495 article.  If the match is a symbol, that symbol will be funcalled
 496 from the buffer of the article to be saved with the newsgroup as the
 497 parameter.  If it is a list, it will be evaled in the same buffer.
 498
 499 If this form or function returns a string, this string will be used as
 500 a possible file name; and if it returns a non-nil list, that list will
 501 be used as possible file names."
 502   :group 'gnus-article-saving
 503   :type '(repeat (choice (list :value (fun) function)
 504                          (cons :value ("" "") regexp (repeat string))
 505                          (sexp :value nil))))
 506
 507 (defcustom gnus-page-delimiter "^\^L"
 508   "*Regexp describing what to use as article page delimiters.
 509 The default value is \"^\^L\", which is a form linefeed at the
 510 beginning of a line."
 511   :type 'regexp
 512   :group 'gnus-article-various)
 513
 514 (defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
 515   "*The format specification for the article mode line.
 516 See `gnus-summary-mode-line-format' for a closer description.
 517
 518 The following additional specs are available:
 519
 520 %w  The article washing status.
 521 %m  The number of MIME parts in the article."
 522   :type 'string
 523   :group 'gnus-article-various)
 524
 525 (defcustom gnus-article-mode-hook nil
 526   "*A hook for Gnus article mode."
 527   :type 'hook
 528   :group 'gnus-article-various)
 529
 530 (when (featurep 'xemacs)
 531   ;; Extracted from gnus-xmas-define in order to preserve user settings
 532   (when (fboundp 'turn-off-scroll-in-place)
 533     (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
 534   ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 535   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
 536
 537 (defcustom gnus-article-menu-hook nil
 538   "*Hook run after the creation of the article mode menu."
 539   :type 'hook
 540   :group 'gnus-article-various)
 541
 542 (defcustom gnus-article-prepare-hook nil
 543   "*A hook called after an article has been prepared in the article buffer."
 544   :type 'hook
 545   :group 'gnus-article-various)
 546
 547 (defvar gnus-article-hide-pgp-hook nil)
 548 (make-obsolete-variable 'gnus-article-hide-pgp-hook
 549                         "This variable is obsolete in Gnus 5.10.")
 550
 551 (defcustom gnus-article-button-face 'bold
 552   "Face used for highlighting buttons in the article buffer.
 553
 554 An article button is a piece of text that you can activate by pressing
 555 `RET' or `mouse-2' above it."
 556   :type 'face
 557   :group 'gnus-article-buttons)
 558
 559 (defcustom gnus-article-mouse-face 'highlight
 560   "Face used for mouse highlighting in the article buffer.
 561
 562 Article buttons will be displayed in this face when the cursor is
 563 above them."
 564   :type 'face
 565   :group 'gnus-article-buttons)
 566
 567 (defcustom gnus-signature-face 'gnus-signature-face
 568   "Face used for highlighting a signature in the article buffer.
 569 Obsolete; use the face `gnus-signature-face' for customizations instead."
 570   :type 'face
 571   :group 'gnus-article-highlight
 572   :group 'gnus-article-signature)
 573
 574 (defface gnus-signature-face
 575   '((t
 576      (:italic t)))
 577   "Face used for highlighting a signature in the article buffer."
 578   :group 'gnus-article-highlight
 579   :group 'gnus-article-signature)
 580
 581 (defface gnus-header-from-face
 582   '((((class color)
 583       (background dark))
 584      (:foreground "spring green"))
 585     (((class color)
 586       (background light))
 587      (:foreground "red3"))
 588     (t
 589      (:italic t)))
 590   "Face used for displaying from headers."
 591   :group 'gnus-article-headers
 592   :group 'gnus-article-highlight)
 593
 594 (defface gnus-header-subject-face
 595   '((((class color)
 596       (background dark))
 597      (:foreground "SeaGreen3"))
 598     (((class color)
 599       (background light))
 600      (:foreground "red4"))
 601     (t
 602      (:bold t :italic t)))
 603   "Face used for displaying subject headers."
 604   :group 'gnus-article-headers
 605   :group 'gnus-article-highlight)
 606
 607 (defface gnus-header-newsgroups-face
 608   '((((class color)
 609       (background dark))
 610      (:foreground "yellow" :italic t))
 611     (((class color)
 612       (background light))
 613      (:foreground "MidnightBlue" :italic t))
 614     (t
 615      (:italic t)))
 616   "Face used for displaying newsgroups headers."
 617   :group 'gnus-article-headers
 618   :group 'gnus-article-highlight)
 619
 620 (defface gnus-header-name-face
 621   '((((class color)
 622       (background dark))
 623      (:foreground "SeaGreen"))
 624     (((class color)
 625       (background light))
 626      (:foreground "maroon"))
 627     (t
 628      (:bold t)))
 629   "Face used for displaying header names."
 630   :group 'gnus-article-headers
 631   :group 'gnus-article-highlight)
 632
 633 (defface gnus-header-content-face
 634   '((((class color)
 635       (background dark))
 636      (:foreground "forest green" :italic t))
 637     (((class color)
 638       (background light))
 639      (:foreground "indianred4" :italic t))
 640     (t
 641      (:italic t)))  "Face used for displaying header content."
 642   :group 'gnus-article-headers
 643   :group 'gnus-article-highlight)
 644
 645 (defcustom gnus-header-face-alist
 646   '(("From" nil gnus-header-from-face)
 647     ("Subject" nil gnus-header-subject-face)
 648     ("Newsgroups:.*," nil gnus-header-newsgroups-face)
 649     ("" gnus-header-name-face gnus-header-content-face))
 650   "*Controls highlighting of article header.
 651
 652 An alist of the form (HEADER NAME CONTENT).
 653
 654 HEADER is a regular expression which should match the name of an
 655 header header and NAME and CONTENT are either face names or nil.
 656
 657 The name of each header field will be displayed using the face
 658 specified by the first element in the list where HEADER match the
 659 header name and NAME is non-nil.  Similarly, the content will be
 660 displayed by the first non-nil matching CONTENT face."
 661   :group 'gnus-article-headers
 662   :group 'gnus-article-highlight
 663   :type '(repeat (list (regexp :tag "Header")
 664                        (choice :tag "Name"
 665                                (item :tag "skip" nil)
 666                                (face :value default))
 667                        (choice :tag "Content"
 668                                (item :tag "skip" nil)
 669                                (face :value default)))))
 670
 671 (defcustom gnus-article-decode-hook
 672   '(article-decode-charset article-decode-encoded-words
 673                            article-decode-group-name)
 674   "*Hook run to decode charsets in articles."
 675   :group 'gnus-article-headers
 676   :type 'hook)
 677
 678 (defcustom gnus-display-mime-function 'gnus-display-mime
 679   "Function to display MIME articles."
 680   :group 'gnus-article-mime
 681   :type 'function)
 682
 683 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
 684   "Function used to decode headers.")
 685
 686 (defvar gnus-article-dumbquotes-map
 687   '(("\200" "EUR")
 688     ("\202" ",")
 689     ("\203" "f")
 690     ("\204" ",,")
 691     ("\205" "...")
 692     ("\213" "<")
 693     ("\214" "OE")
 694     ("\221" "`")
 695     ("\222" "'")
 696     ("\223" "``")
 697     ("\224" "\"")
 698     ("\225" "*")
 699     ("\226" "-")
 700     ("\227" "--")
 701     ("\230" "~")
 702     ("\231" "(TM)")
 703     ("\233" ">")
 704     ("\234" "oe")
 705     ("\264" "'"))
 706   "Table for MS-to-Latin1 translation.")
 707
 708 (defcustom gnus-ignored-mime-types nil
 709   "List of MIME types that should be ignored by Gnus."
 710   :version "21.1"
 711   :group 'gnus-article-mime
 712   :type '(repeat regexp))
 713
 714 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
 715   "List of MIME types that should not be given buttons when rendered inline.
 716 See also `gnus-buttonized-mime-types' which may override this variable.
 717 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 718   :version "21.1"
 719   :group 'gnus-article-mime
 720   :type '(repeat regexp))
 721
 722 (defcustom gnus-buttonized-mime-types nil
 723   "List of MIME types that should be given buttons when rendered inline.
 724 If set, this variable overrides `gnus-unbuttonized-mime-types'.
 725 To see e.g. security buttons you could set this to
 726 `(\"multipart/signed\")'.
 727 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 728   :version "21.1"
 729   :group 'gnus-article-mime
 730   :type '(repeat regexp))
 731
 732 (defcustom gnus-inhibit-mime-unbuttonizing nil
 733   "If non-nil, all MIME parts get buttons.
 734 When nil (the default value), then some MIME parts do not get buttons,
 735 as described by the variables `gnus-buttonized-mime-types' and
 736 `gnus-unbuttonized-mime-types'."
 737   :version "21.3"
 738   :type 'boolean)
 739
 740 (defcustom gnus-body-boundary-delimiter "_"
 741   "String used to delimit header and body.
 742 This variable is used by `gnus-article-treat-body-boundary' which can
 743 be controlled by `gnus-treat-body-boundary'."
 744   :group 'gnus-article-various
 745   :type '(choice (item :tag "None" :value nil)
 746                  string))
 747
 748 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
 749   "Defines the location of the faces database.
 750 For information on obtaining this database of pretty pictures, please
 751 see http://www.cs.indiana.edu/picons/ftp/index.html"
 752   :type '(repeat directory)
 753   :link '(url-link :tag "download"
 754                    "http://www.cs.indiana.edu/picons/ftp/index.html")
 755   :link '(custom-manual "(gnus)Picons")
 756   :group 'gnus-picon)
 757
 758 (defun gnus-picons-installed-p ()
 759   "Say whether picons are installed on your machine."
 760   (let ((installed nil))
 761     (dolist (database gnus-picon-databases)
 762       (when (file-exists-p database)
 763         (setq installed t)))
 764     installed))
 765
 766 (defcustom gnus-article-mime-part-function nil
 767   "Function called with a MIME handle as the argument.
 768 This is meant for people who want to do something automatic based
 769 on parts -- for instance, adding Vcard info to a database."
 770   :group 'gnus-article-mime
 771   :type 'function)
 772
 773 (defcustom gnus-mime-multipart-functions nil
 774   "An alist of MIME types to functions to display them."
 775   :version "21.1"
 776   :group 'gnus-article-mime
 777   :type 'alist)
 778
 779 (defcustom gnus-article-date-lapsed-new-header nil
 780   "Whether the X-Sent and Date headers can coexist.
 781 When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
 782 either replace the old \"Date:\" header (if this variable is nil), or
 783 be added below it (otherwise)."
 784   :version "21.1"
 785   :group 'gnus-article-headers
 786   :type 'boolean)
 787
 788 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
 789   "Function called with a MIME handle as the argument.
 790 This is meant for people who want to view first matched part.
 791 For `undisplayed-alternative' (default), the first undisplayed
 792 part or alternative part is used.  For `undisplayed', the first
 793 undisplayed part is used.  For a function, the first part which
 794 the function return t is used.  For nil, the first part is
 795 used."
 796   :version "21.1"
 797   :group 'gnus-article-mime
 798   :type '(choice
 799           (item :tag "first" :value nil)
 800           (item :tag "undisplayed" :value undisplayed)
 801           (item :tag "undisplayed or alternative"
 802                 :value undisplayed-alternative)
 803           (function)))
 804
 805 (defcustom gnus-mime-action-alist
 806   '(("save to file" . gnus-mime-save-part)
 807     ("save and strip" . gnus-mime-save-part-and-strip)
 808     ("display as text" . gnus-mime-inline-part)
 809     ("view the part" . gnus-mime-view-part)
 810     ("pipe to command" . gnus-mime-pipe-part)
 811     ("toggle display" . gnus-article-press-button)
 812     ("toggle display" . gnus-article-view-part-as-charset)
 813     ("view as type" . gnus-mime-view-part-as-type)
 814     ("view internally" . gnus-mime-view-part-internally)
 815     ("view externally" . gnus-mime-view-part-externally))
 816   "An alist of actions that run on the MIME attachment."
 817   :group 'gnus-article-mime
 818   :type '(repeat (cons (string :tag "name")
 819                        (function))))
 820
 821 ;;;
 822 ;;; The treatment variables
 823 ;;;
 824
 825 (defvar gnus-part-display-hook nil
 826   "Hook called on parts that are to receive treatment.")
 827
 828 (defvar gnus-article-treat-custom
 829   '(choice (const :tag "Off" nil)
 830            (const :tag "On" t)
 831            (const :tag "Header" head)
 832            (const :tag "Last" last)
 833            (integer :tag "Less")
 834            (repeat :tag "Groups" regexp)
 835            (sexp :tag "Predicate")))
 836
 837 (defvar gnus-article-treat-head-custom
 838   '(choice (const :tag "Off" nil)
 839            (const :tag "Header" head)))
 840
 841 (defvar gnus-article-treat-types '("text/plain")
 842   "Parts to treat.")
 843
 844 (defvar gnus-inhibit-treatment nil
 845   "Whether to inhibit treatment.")
 846
 847 (defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
 848   "Highlight the signature.
 849 Valid values are nil, t, `head', `last', an integer or a predicate.
 850 See Info node `(gnus)Customizing Articles'."