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 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 2, or (at your option)
  14 ;; 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (eval-when-compile
  31   (require 'cl)
  32   (defvar tool-bar-map)
  33   (defvar w3m-minor-mode-map))
  34
  35 (require 'gnus)
  36 ;; Avoid the "Recursive load suspected" error in Emacs 21.1.
  37 (eval-and-compile
  38   (let ((recursive-load-depth-limit 100))
  39     (require 'gnus-sum)))
  40 (require 'gnus-spec)
  41 (require 'gnus-int)
  42 (require 'gnus-win)
  43 (require 'mm-bodies)
  44 (require 'mail-parse)
  45 (require 'mm-decode)
  46 (require 'mm-view)
  47 (require 'wid-edit)
  48 (require 'mm-uu)
  49 (require 'message)
  50
  51 (autoload 'gnus-msg-mail "gnus-msg" nil t)
  52 (autoload 'gnus-button-mailto "gnus-msg")
  53 (autoload 'gnus-button-reply "gnus-msg" nil t)
  54 (autoload 'parse-time-string "parse-time" nil nil)
  55 (autoload 'ansi-color-apply-on-region "ansi-color")
  56
  57 (defgroup gnus-article nil
  58   "Article display."
  59   :link '(custom-manual "(gnus)Article Buffer")
  60   :group 'gnus)
  61
  62 (defgroup gnus-article-treat nil
  63   "Treating article parts."
  64   :link '(custom-manual "(gnus)Article Hiding")
  65   :group 'gnus-article)
  66
  67 (defgroup gnus-article-hiding nil
  68   "Hiding article parts."
  69   :link '(custom-manual "(gnus)Article Hiding")
  70   :group 'gnus-article)
  71
  72 (defgroup gnus-article-highlight nil
  73   "Article highlighting."
  74   :link '(custom-manual "(gnus)Article Highlighting")
  75   :group 'gnus-article
  76   :group 'gnus-visual)
  77
  78 (defgroup gnus-article-signature nil
  79   "Article signatures."
  80   :link '(custom-manual "(gnus)Article Signature")
  81   :group 'gnus-article)
  82
  83 (defgroup gnus-article-headers nil
  84   "Article headers."
  85   :link '(custom-manual "(gnus)Hiding Headers")
  86   :group 'gnus-article)
  87
  88 (defgroup gnus-article-washing nil
  89   "Special commands on articles."
  90   :link '(custom-manual "(gnus)Article Washing")
  91   :group 'gnus-article)
  92
  93 (defgroup gnus-article-emphasis nil
  94   "Fontisizing articles."
  95   :link '(custom-manual "(gnus)Article Fontisizing")
  96   :group 'gnus-article)
  97
  98 (defgroup gnus-article-saving nil
  99   "Saving articles."
 100   :link '(custom-manual "(gnus)Saving Articles")
 101   :group 'gnus-article)
 102
 103 (defgroup gnus-article-mime nil
 104   "Worshiping the MIME wonder."
 105   :link '(custom-manual "(gnus)Using MIME")
 106   :group 'gnus-article)
 107
 108 (defgroup gnus-article-buttons nil
 109   "Pushable buttons in the article buffer."
 110   :link '(custom-manual "(gnus)Article Buttons")
 111   :group 'gnus-article)
 112
 113 (defgroup gnus-article-various nil
 114   "Other article options."
 115   :link '(custom-manual "(gnus)Misc Article")
 116   :group 'gnus-article)
 117
 118 (defcustom gnus-ignored-headers
 119   (mapcar
 120    (lambda (header)
 121      (concat "^" header ":"))
 122    '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
 123      "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
 124      "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
 125      "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
 126      "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
 127      "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
 128      "X-Attribution" "X-Originating-IP" "Delivered-To"
 129      "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
 130      "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
 131      "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
 132      "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
 133      "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
 134      "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
 135      "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
 136      "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
 137      "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
 138      "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
 139      "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
 140      "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
 141      "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
 142      "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
 143      "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
 144      "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
 145      "List-[A-Za-z]+" "X-Listprocessor-Version"
 146      "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
 147      "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
 148      "X-Received" "Content-length" "X-precedence"
 149      "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
 150      "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
 151      "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
 152      "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
 153      "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
 154      "X-Content-length" "X-Posting-Agent" "Original-Received"
 155      "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
 156      "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
 157      "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
 158      "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
 159      "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"))
 160   "*All headers that start with this regexp will be hidden.
 161 This variable can also be a list of regexps of headers to be ignored.
 162 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 163   :type '(choice :custom-show nil
 164                  regexp
 165                  (repeat regexp))
 166   :group 'gnus-article-hiding)
 167
 168 (defcustom gnus-visible-headers
 169   "^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:"
 170   "*All headers that do not match this regexp will be hidden.
 171 This variable can also be a list of regexp of headers to remain visible.
 172 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
 173   :type '(repeat :value-to-internal (lambda (widget value)
 174                                       (custom-split-regexp-maybe value))
 175                  :match (lambda (widget value)
 176                           (or (stringp value)
 177                               (widget-editable-list-match widget value)))
 178                  regexp)
 179   :group 'gnus-article-hiding)
 180
 181 (defcustom gnus-sorted-header-list
 182   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
 183     "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
 184   "*This variable is a list of regular expressions.
 185 If it is non-nil, headers that match the regular expressions will
 186 be placed first in the article buffer in the sequence specified by
 187 this list."
 188   :type '(repeat regexp)
 189   :group 'gnus-article-hiding)
 190
 191 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
 192   "Headers that are only to be displayed if they have interesting data.
 193 Possible values in this list are:
 194
 195   'empty       Headers with no content.
 196   'newsgroups  Newsgroup identical to Gnus group.
 197   'to-address  To identical to To-address.
 198   'to-list     To identical to To-list.
 199   'cc-list     CC identical to To-list.
 200   'followup-to Followup-to identical to Newsgroups.
 201   'reply-to    Reply-to identical to From.
 202   'date        Date less than four days old.
 203   'long-to     To and/or Cc longer than 1024 characters.
 204   'many-to     Multiple To and/or Cc."
 205   :type '(set (const :tag "Headers with no content." empty)
 206               (const :tag "Newsgroups identical to Gnus group." newsgroups)
 207               (const :tag "To identical to To-address." to-address)
 208               (const :tag "To identical to To-list." to-list)
 209               (const :tag "CC identical to To-list." cc-list)
 210               (const :tag "Followup-to identical to Newsgroups." followup-to)
 211               (const :tag "Reply-to identical to From." reply-to)
 212               (const :tag "Date less than four days old." date)
 213               (const :tag "To and/or Cc longer than 1024 characters." long-to)
 214               (const :tag "Multiple To and/or Cc headers." many-to))
 215   :group 'gnus-article-hiding)
 216
 217 (defcustom gnus-article-skip-boring nil
 218   "Skip over text that is not worth reading.
 219 By default, if you set this t, then Gnus will display citations and
 220 signatures, but will never scroll down to show you a page consisting
 221 only of boring text.  Boring text is controlled by
 222 `gnus-article-boring-faces'."
 223   :version "22.1"
 224   :type 'boolean
 225   :group 'gnus-article-hiding)
 226
 227 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
 228   "Regexp matching signature separator.
 229 This can also be a list of regexps.  In that case, it will be checked
 230 from head to tail looking for a separator.  Searches will be done from
 231 the end of the buffer."
 232   :type '(choice :format "%{%t%}: %[Value Menu%]\n%v"
 233                  (regexp)
 234                  (repeat :tag "List of regexp" regexp))
 235   :group 'gnus-article-signature)
 236
 237 (defcustom gnus-signature-limit nil
 238   "Provide a limit to what is considered a signature.
 239 If it is a number, no signature may not be longer (in characters) than
 240 that number.  If it is a floating point number, no signature may be
 241 longer (in lines) than that number.  If it is a function, the function
 242 will be called without any parameters, and if it returns nil, there is
 243 no signature in the buffer.  If it is a string, it will be used as a
 244 regexp.  If it matches, the text in question is not a signature.
 245
 246 This can also be a list of the above values."
 247   :type '(choice (const nil)
 248                  (integer :value 200)
 249                  (number :value 4.0)
 250                  (function :value fun)
 251                  (regexp :value ".*"))
 252   :group 'gnus-article-signature)
 253
 254 (defcustom gnus-hidden-properties '(invisible t intangible t)
 255   "Property list to use for hiding text."
 256   :type 'sexp
 257   :group 'gnus-article-hiding)
 258
 259 ;; Fixme: This isn't the right thing for mixed graphical and non-graphical
 260 ;; frames in a session.
 261 (defcustom gnus-article-x-face-command
 262   (if (featurep 'xemacs)
 263       (if (or (gnus-image-type-available-p 'xface)
 264               (gnus-image-type-available-p 'pbm))
 265           'gnus-display-x-face-in-from
 266         "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
 267     (if (gnus-image-type-available-p 'pbm)
 268         'gnus-display-x-face-in-from
 269       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
 270 display -"))
 271   "*String or function to be executed to display an X-Face header.
 272 If it is a string, the command will be executed in a sub-shell
 273 asynchronously.  The compressed face will be piped to this command."
 274   :type `(choice string
 275                  (function-item gnus-display-x-face-in-from)
 276                  function)
 277   :version "21.1"
 278   :group 'gnus-picon
 279   :group 'gnus-article-washing)
 280
 281 (defcustom gnus-article-x-face-too-ugly nil
 282   "Regexp matching posters whose face shouldn't be shown automatically."
 283   :type '(choice regexp (const nil))
 284   :group 'gnus-article-washing)
 285
 286 (defcustom gnus-article-banner-alist nil
 287   "Banner alist for stripping.
 288 For example,
 289      ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
 290   :version "21.1"
 291   :type '(repeat (cons symbol regexp))
 292   :group 'gnus-article-washing)
 293
 294 (gnus-define-group-parameter
 295  banner
 296  :variable-document
 297  "Alist of regexps (to match group names) and banner."
 298  :variable-group gnus-article-washing
 299  :parameter-type
 300  '(choice :tag "Banner"
 301           :value nil
 302           (const :tag "Remove signature" signature)
 303           (symbol :tag "Item in `gnus-article-banner-alist'" none)
 304           regexp
 305           (const :tag "None" nil))
 306  :parameter-document
 307  "If non-nil, specify how to remove `banners' from articles.
 308
 309 Symbol `signature' means to remove signatures delimited by
 310 `gnus-signature-separator'.  Any other symbol is used to look up a
 311 regular expression to match the banner in `gnus-article-banner-alist'.
 312 A string is used as a regular expression to match the banner
 313 directly.")
 314
 315 (defcustom gnus-article-address-banner-alist nil
 316   "Alist of mail addresses and banners.
 317 Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
 318 to match a mail address in the From: header, BANNER is one of a symbol
 319 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
 320 If ADDRESS matches author's mail address, it will remove things like
 321 advertisements.  For example:
 322
 323 \((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
 324 "
 325   :type '(repeat
 326           (cons
 327            (regexp :tag "Address")
 328            (choice :tag "Banner" :value nil
 329                    (const :tag "Remove signature" signature)
 330                    (symbol :tag "Item in `gnus-article-banner-alist'" none)
 331                    regexp
 332                    (const :tag "None" nil))))
 333   :version "22.1"
 334   :group 'gnus-article-washing)
 335
 336 (defmacro gnus-emphasis-custom-with-format (&rest body)
 337   `(let ((format "\
 338 \\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\
 339 \\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)"))
 340      ,@body))
 341
 342 (defun gnus-emphasis-custom-value-to-external (value)
 343   (gnus-emphasis-custom-with-format
 344    (if (consp (car value))
 345        (list (format format (car (car value)) (cdr (car value)))
 346              2
 347              (if (nth 1 value) 2 3)
 348              (nth 2 value))
 349      value)))
 350
 351 (defun gnus-emphasis-custom-value-to-internal (value)
 352   (gnus-emphasis-custom-with-format
 353    (let ((regexp (concat "\\`"
 354                          (format (regexp-quote format)
 355                                  "\\([^()]+\\)" "\\([^()]+\\)")
 356                          "\\'"))
 357          pattern)
 358      (if (string-match regexp (setq pattern (car value)))
 359          (list (cons (match-string 1 pattern) (match-string 2 pattern))
 360                (= (nth 2 value) 2)
 361                (nth 3 value))
 362        value))))
 363
 364 (defcustom gnus-emphasis-alist
 365   (let ((types
 366          '(("\\*" "\\*" bold nil 2)
 367            ("_" "_" underline)
 368            ("/" "/" italic)
 369            ("_/" "/_" underline-italic)
 370            ("_\\*" "\\*_" underline-bold)
 371            ("\\*/" "/\\*" bold-italic)
 372            ("_\\*/" "/\\*_" underline-bold-italic))))
 373     (nconc
 374      (gnus-emphasis-custom-with-format
 375       (mapcar (lambda (spec)
 376                 (list (format format (car spec) (cadr spec))
 377                       (or (nth 3 spec) 2)
 378                       (or (nth 4 spec) 3)
 379                       (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
 380               types))
 381      '(;; I've never seen anyone use this strikethru convention whereas I've
 382        ;; several times seen it triggered by normal text.  --Stef
 383        ;; Miles suggests that this form is sometimes used but for italics,
 384        ;; so maybe we should map it to `italic'.
 385        ;; ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
 386        ;; 2 3 gnus-emphasis-strikethru)
 387        ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
 388         2 3 gnus-emphasis-underline))))
 389   "*Alist that says how to fontify certain phrases.
 390 Each item looks like this:
 391
 392   (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
 393
 394 The first element is a regular expression to be matched.  The second
 395 is a number that says what regular expression grouping used to find
 396 the entire emphasized word.  The third is a number that says what
 397 regexp grouping should be displayed and highlighted.  The fourth
 398 is the face used for highlighting."
 399   :type
 400   '(repeat
 401     (menu-choice
 402      :format "%[Customizing Style%]\n%v"
 403      :indent 2
 404      (group :tag "Default"
 405             :value ("" 0 0 default)
 406             :value-create
 407             (lambda (widget)
 408               (let ((value (widget-get
 409                             (cadr (widget-get (widget-get widget :parent)
 410                                               :args))
 411                             :value)))
 412                 (if (not (eq (nth 2 value) 'default))
 413                     (widget-put
 414                      widget
 415                      :value
 416                      (gnus-emphasis-custom-value-to-external value))))
 417               (widget-group-value-create widget))
 418             regexp
 419             (integer :format "Match group: %v")
 420             (integer :format "Emphasize group: %v")
 421             face)
 422      (group :tag "Simple"
 423             :value (("_" . "_") nil default)
 424             (cons :format "%v"
 425                   (regexp :format "Start regexp: %v")
 426                   (regexp :format "End regexp: %v"))
 427             (boolean :format "Show start and end patterns: %[%v%]\n"
 428                      :on " On " :off " Off ")
 429             face)))
 430   :get (lambda (symbol)
 431          (mapcar 'gnus-emphasis-custom-value-to-internal
 432                  (default-value symbol)))
 433   :set (lambda (symbol value)
 434          (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
 435                                      value)))
 436   :group 'gnus-article-emphasis)
 437
 438 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
 439   "A regexp to describe whitespace which should not be emphasized.
 440 Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
 441 The former avoids underlining of leading and trailing whitespace,
 442 and the latter avoids underlining any whitespace at all."
 443   :version "21.1"
 444   :group 'gnus-article-emphasis
 445   :type 'regexp)
 446
 447 (defface gnus-emphasis-bold '((t (:bold t)))
 448   "Face used for displaying strong emphasized text (*word*)."
 449   :group 'gnus-article-emphasis)
 450
 451 (defface gnus-emphasis-italic '((t (:italic t)))
 452   "Face used for displaying italic emphasized text (/word/)."
 453   :group 'gnus-article-emphasis)
 454
 455 (defface gnus-emphasis-underline '((t (:underline t)))
 456   "Face used for displaying underlined emphasized text (_word_)."
 457   :group 'gnus-article-emphasis)
 458
 459 (defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
 460   "Face used for displaying underlined bold emphasized text (_*word*_)."
 461   :group 'gnus-article-emphasis)
 462
 463 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
 464   "Face used for displaying underlined italic emphasized text (_/word/_)."
 465   :group 'gnus-article-emphasis)
 466
 467 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
 468   "Face used for displaying bold italic emphasized text (/*word*/)."
 469   :group 'gnus-article-emphasis)
 470
 471 (defface gnus-emphasis-underline-bold-italic
 472   '((t (:bold t :italic t :underline t)))
 473   "Face used for displaying underlined bold italic emphasized text.
 474 Example: (_/*word*/_)."
 475   :group 'gnus-article-emphasis)
 476
 477 (defface gnus-emphasis-strikethru (if (featurep 'xemacs)
 478                                       '((t (:strikethru t)))
 479                                     '((t (:strike-through t))))
 480   "Face used for displaying strike-through text (-word-)."
 481   :group 'gnus-article-emphasis)
 482
 483 (defface gnus-emphasis-highlight-words
 484   '((t (:background "black" :foreground "yellow")))
 485   "Face used for displaying highlighted words."
 486   :group 'gnus-article-emphasis)
 487
 488 (defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
 489   "Format for display of Date headers in article bodies.
 490 See `format-time-string' for the possible values.
 491
 492 The variable can also be function, which should return a complete Date
 493 header.  The function is called with one argument, the time, which can
 494 be fed to `format-time-string'."
 495   :type '(choice string function)
 496   :link '(custom-manual "(gnus)Article Date")
 497   :group 'gnus-article-washing)
 498
 499 (defcustom gnus-save-all-headers t
 500   "*If non-nil, don't remove any headers before saving."
 501   :group 'gnus-article-saving
 502   :type 'boolean)
 503
 504 (defcustom gnus-prompt-before-saving 'always
 505   "*This variable says how much prompting is to be done when saving articles.
 506 If it is nil, no prompting will be done, and the articles will be
 507 saved to the default files.  If this variable is `always', each and
 508 every article that is saved will be preceded by a prompt, even when
 509 saving large batches of articles.  If this variable is neither nil not
 510 `always', there the user will be prompted once for a file name for
 511 each invocation of the saving commands."
 512   :group 'gnus-article-saving
 513   :type '(choice (item always)
 514                  (item :tag "never" nil)
 515                  (sexp :tag "once" :format "%t\n" :value t)))
 516
 517 (defcustom gnus-saved-headers gnus-visible-headers
 518   "Headers to keep if `gnus-save-all-headers' is nil.
 519 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
 520 If that variable is nil, however, all headers that match this regexp
 521 will be kept while the rest will be deleted before saving."
 522   :group 'gnus-article-saving
 523   :type 'regexp)
 524
 525 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
 526   "A function to save articles in your favourite format.
 527 The function must be interactively callable (in other words, it must
 528 be an Emacs command).
 529
 530 Gnus provides the following functions:
 531
 532 * gnus-summary-save-in-rmail (Rmail format)
 533 * gnus-summary-save-in-mail (Unix mail format)
 534 * gnus-summary-save-in-folder (MH folder)
 535 * gnus-summary-save-in-file (article format)
 536 * gnus-summary-save-body-in-file (article body)
 537 * gnus-summary-save-in-vm (use VM's folder format)
 538 * gnus-summary-write-to-file (article format -- overwrite)."
 539   :group 'gnus-article-saving
 540   :type '(radio (function-item gnus-summary-save-in-rmail)
 541                 (function-item gnus-summary-save-in-mail)
 542                 (function-item gnus-summary-save-in-folder)
 543                 (function-item gnus-summary-save-in-file)
 544                 (function-item gnus-summary-save-body-in-file)
 545                 (function-item gnus-summary-save-in-vm)
 546                 (function-item gnus-summary-write-to-file)))
 547
 548 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
 549   "A function generating a file name to save articles in Rmail format.
 550 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 551   :group 'gnus-article-saving
 552   :type 'function)
 553
 554 (defcustom gnus-mail-save-name 'gnus-plain-save-name
 555   "A function generating a file name to save articles in Unix mail format.
 556 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 557   :group 'gnus-article-saving
 558   :type 'function)
 559
 560 (defcustom gnus-folder-save-name 'gnus-folder-save-name
 561   "A function generating a file name to save articles in MH folder.
 562 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
 563   :group 'gnus-article-saving
 564   :type 'function)
 565
 566 (defcustom gnus-file-save-name 'gnus-numeric-save-name
 567   "A function generating a file name to save articles in article format.
 568 The function is called with NEWSGROUP, HEADERS, and optional
 569 LAST-FILE."
 570   :group 'gnus-article-saving
 571   :type 'function)
 572
 573 (defcustom gnus-split-methods
 574   '((gnus-article-archive-name)
 575     (gnus-article-nndoc-name))
 576   "*Variable used to suggest where articles are to be saved.
 577 For instance, if you would like to save articles related to Gnus in
 578 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
 579 you could set this variable to something like:
 580
 581  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
 582    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
 583
 584 This variable is an alist where the key is the match and the
 585 value is a list of possible files to save in if the match is
 586 non-nil.
 587
 588 If the match is a string, it is used as a regexp match on the
 589 article.  If the match is a symbol, that symbol will be funcalled
 590 from the buffer of the article to be saved with the newsgroup as
 591 the parameter.  If it is a list, it will be evaled in the same
 592 buffer.
 593
 594 If this form or function returns a string, this string will be
 595 used as a possible file name; and if it returns a non-nil list,
 596 that list will be used as possible file names."
 597   :group 'gnus-article-saving
 598   :type '(repeat (choice (list :value (fun) function)
 599                          (cons :value ("" "") regexp (repeat string))
 600                          (sexp :value nil))))
 601
 602 (defcustom gnus-page-delimiter "^\^L"
 603   "*Regexp describing what to use as article page delimiters.
 604 The default value is \"^\^L\", which is a form linefeed at the
 605 beginning of a line."
 606   :type 'regexp
 607   :group 'gnus-article-various)
 608
 609 (defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
 610   "*The format specification for the article mode line.
 611 See `gnus-summary-mode-line-format' for a closer description.
 612
 613 The following additional specs are available:
 614
 615 %w  The article washing status.
 616 %m  The number of MIME parts in the article."
 617   :type 'string
 618   :group 'gnus-article-various)
 619
 620 (defcustom gnus-article-mode-hook nil
 621   "*A hook for Gnus article mode."
 622   :type 'hook
 623   :group 'gnus-article-various)
 624
 625 (when (featurep 'xemacs)
 626   ;; Extracted from gnus-xmas-define in order to preserve user settings
 627   (when (fboundp 'turn-off-scroll-in-place)
 628     (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
 629   ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 630   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
 631
 632 (defcustom gnus-article-menu-hook nil
 633   "*Hook run after the creation of the article mode menu."
 634   :type 'hook
 635   :group 'gnus-article-various)
 636
 637 (defcustom gnus-article-prepare-hook nil
 638   "*A hook called after an article has been prepared in the article buffer."
 639   :type 'hook
 640   :group 'gnus-article-various)
 641
 642 (defcustom gnus-copy-article-ignored-headers nil
 643   "List of headers to be removed when copying an article.
 644 Each element is a regular expression."
 645   :version "23.0" ;; No Gnus
 646   :type '(repeat regexp)
 647   :group 'gnus-article-various)
 648
 649 (make-obsolete-variable 'gnus-article-hide-pgp-hook
 650                         "This variable is obsolete in Gnus 5.10.")
 651
 652 (defcustom gnus-article-button-face 'bold
 653   "Face used for highlighting buttons in the article buffer.
 654
 655 An article button is a piece of text that you can activate by pressing
 656 `RET' or `mouse-2' above it."
 657   :type 'face
 658   :group 'gnus-article-buttons)
 659
 660 (defcustom gnus-article-mouse-face 'highlight
 661   "Face used for mouse highlighting in the article buffer.
 662
 663 Article buttons will be displayed in this face when the cursor is
 664 above them."
 665   :type 'face
 666   :group 'gnus-article-buttons)
 667
 668 (defcustom gnus-signature-face 'gnus-signature
 669   "Face used for highlighting a signature in the article buffer.
 670 Obsolete; use the face `gnus-signature' for customizations instead."
 671   :type 'face
 672   :group 'gnus-article-highlight
 673   :group 'gnus-article-signature)
 674
 675 (defface gnus-signature
 676   '((t
 677      (:italic t)))
 678   "Face used for highlighting a signature in the article buffer."
 679   :group 'gnus-article-highlight
 680   :group 'gnus-article-signature)
 681 ;; backward-compatibility alias
 682 (put 'gnus-signature-face 'face-alias 'gnus-signature)
 683
 684 (defface gnus-header-from
 685   '((((class color)
 686       (background dark))
 687      (:foreground "spring green"))
 688     (((class color)
 689       (background light))
 690      (:foreground "red3"))
 691     (t
 692      (:italic t)))
 693   "Face used for displaying from headers."
 694   :group 'gnus-article-headers
 695   :group 'gnus-article-highlight)
 696 ;; backward-compatibility alias
 697 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
 698
 699 (defface gnus-header-subject
 700   '((((class color)
 701       (background dark))
 702      (:foreground "SeaGreen3"))
 703     (((class color)
 704       (background light))
 705      (:foreground "red4"))
 706     (t
 707      (:bold t :italic t)))
 708   "Face used for displaying subject headers."
 709   :group 'gnus-article-headers
 710   :group 'gnus-article-highlight)
 711 ;; backward-compatibility alias
 712 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
 713
 714 (defface gnus-header-newsgroups
 715   '((((class color)
 716       (background dark))
 717      (:foreground "yellow" :italic t))
 718     (((class color)
 719       (background light))
 720      (:foreground "MidnightBlue" :italic t))
 721     (t
 722      (:italic t)))
 723   "Face used for displaying newsgroups headers.
 724 In the default setup this face is only used for crossposted
 725 articles."
 726   :group 'gnus-article-headers
 727   :group 'gnus-article-highlight)
 728 ;; backward-compatibility alias
 729 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
 730
 731 (defface gnus-header-name
 732   '((((class color)
 733       (background dark))
 734      (:foreground "SeaGreen"))
 735     (((class color)
 736       (background light))
 737      (:foreground "maroon"))
 738     (t
 739      (:bold t)))
 740   "Face used for displaying header names."
 741   :group 'gnus-article-headers
 742   :group 'gnus-article-highlight)
 743 ;; backward-compatibility alias
 744 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
 745
 746 (defface gnus-header-content
 747   '((((class color)
 748       (background dark))
 749      (:foreground "forest green" :italic t))
 750     (((class color)
 751       (background light))
 752      (:foreground "indianred4" :italic t))
 753     (t
 754      (:italic t)))  "Face used for displaying header content."
 755   :group 'gnus-article-headers
 756   :group 'gnus-article-highlight)
 757 ;; backward-compatibility alias
 758 (put 'gnus-header-content-face 'face-alias 'gnus-header-content)
 759
 760 (defcustom gnus-header-face-alist
 761   '(("From" nil gnus-header-from)
 762     ("Subject" nil gnus-header-subject)
 763     ("Newsgroups:.*," nil gnus-header-newsgroups)
 764     ("" gnus-header-name gnus-header-content))
 765   "*Controls highlighting of article headers.
 766
 767 An alist of the form (HEADER NAME CONTENT).
 768
 769 HEADER is a regular expression which should match the name of a
 770 header and NAME and CONTENT are either face names or nil.
 771
 772 The name of each header field will be displayed using the face
 773 specified by the first element in the list where HEADER matches
 774 the header name and NAME is non-nil.  Similarly, the content will
 775 be displayed by the first non-nil matching CONTENT face."
 776   :group 'gnus-article-headers
 777   :group 'gnus-article-highlight
 778   :type '(repeat (list (regexp :tag "Header")
 779                        (choice :tag "Name"
 780                                (item :tag "skip" nil)
 781                                (face :value default))
 782                        (choice :tag "Content"
 783                                (item :tag "skip" nil)
 784                                (face :value default)))))
 785
 786 (defcustom gnus-article-decode-hook
 787   '(article-decode-charset article-decode-encoded-words
 788                            article-decode-group-name article-decode-idna-rhs)
 789   "*Hook run to decode charsets in articles."
 790   :group 'gnus-article-headers
 791   :type 'hook)
 792
 793 (defcustom gnus-display-mime-function 'gnus-display-mime
 794   "Function to display MIME articles."
 795   :group 'gnus-article-mime
 796   :type 'function)
 797
 798 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
 799   "Function used to decode headers.")
 800
 801 (defvar gnus-article-dumbquotes-map
 802   '(("\200" "EUR")
 803     ("\202" ",")
 804     ("\203" "f")
 805     ("\204" ",,")
 806     ("\205" "...")
 807     ("\213" "<")
 808     ("\214" "OE")
 809     ("\221" "`")
 810     ("\222" "'")
 811     ("\223" "``")
 812     ("\224" "\"")
 813     ("\225" "*")
 814     ("\226" "-")
 815     ("\227" "--")
 816     ("\230" "~")
 817     ("\231" "(TM)")
 818     ("\233" ">")
 819     ("\234" "oe")
 820     ("\264" "'"))
 821   "Table for MS-to-Latin1 translation.")
 822
 823 (defcustom gnus-ignored-mime-types nil
 824   "List of MIME types that should be ignored by Gnus."
 825   :version "21.1"
 826   :group 'gnus-article-mime
 827   :type '(repeat regexp))
 828
 829 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
 830   "List of MIME types that should not be given buttons when rendered inline.
 831 See also `gnus-buttonized-mime-types' which may override this variable.
 832 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 833   :version "21.1"
 834   :group 'gnus-article-mime
 835   :type '(repeat regexp))
 836
 837 (defcustom gnus-buttonized-mime-types nil
 838   "List of MIME types that should be given buttons when rendered inline.
 839 If set, this variable overrides `gnus-unbuttonized-mime-types'.
 840 To see e.g. security buttons you could set this to
 841 `(\"multipart/signed\")'.  You could also add \"multipart/alternative\" to
 842 this list to display radio buttons that allow you to choose one of two
 843 media types those mails include.  See also `mm-discouraged-alternatives'.
 844 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 845   :version "22.1"
 846   :group 'gnus-article-mime
 847   :type '(repeat regexp))
 848
 849 (defcustom gnus-inhibit-mime-unbuttonizing nil
 850   "If non-nil, all MIME parts get buttons.
 851 When nil (the default value), then some MIME parts do not get buttons,
 852 as described by the variables `gnus-buttonized-mime-types' and
 853 `gnus-unbuttonized-mime-types'."
 854   :version "22.1"
 855   :group 'gnus-article-mime
 856   :type 'boolean)
 857
 858 (defcustom gnus-body-boundary-delimiter "_"
 859   "String used to delimit header and body.
 860 This variable is used by `gnus-article-treat-body-boundary' which can
 861 be controlled by `gnus-treat-body-boundary'."
 862   :version "22.1"
 863   :group 'gnus-article-various
 864   :type '(choice (item :tag "None" :value nil)
 865                  string))
 866
 867 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
 868                                   "/usr/share/picons")
 869   "Defines the location of the faces database.
 870 For information on obtaining this database of pretty pictures, please
 871 see http://www.cs.indiana.edu/picons/ftp/index.html"
 872   :version "22.1"
 873   :type '(repeat directory)
 874   :link '(url-link :tag "download"
 875                    "http://www.cs.indiana.edu/picons/ftp/index.html")
 876   :link '(custom-manual "(gnus)Picons")
 877   :group 'gnus-picon)
 878
 879 (defun gnus-picons-installed-p ()
 880   "Say whether picons are installed on your machine."
 881   (let ((installed nil))
 882     (dolist (database gnus-picon-databases)
 883       (when (file-exists-p database)
 884         (setq installed t)))
 885     installed))
 886
 887 (defcustom gnus-article-mime-part-function nil
 888   "Function called with a MIME handle as the argument.
 889 This is meant for people who want to do something automatic based
 890 on parts -- for instance, adding Vcard info to a database."
 891   :group 'gnus-article-mime
 892   :type '(choice (const nil)
 893                  function))
 894
 895 (defcustom gnus-mime-multipart-functions nil
 896   "An alist of MIME types to functions to display them."
 897   :version "21.1"
 898   :group 'gnus-article-mime
 899   :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
 900
 901 (defcustom gnus-article-date-lapsed-new-header nil
 902   "Whether the X-Sent and Date headers can coexist.
 903 When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
 904 either replace the old \"Date:\" header (if this variable is nil), or
 905 be added below it (otherwise)."
 906   :version "21.1"
 907   :group 'gnus-article-headers
 908   :type 'boolean)
 909
 910 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
 911   "Function called with a MIME handle as the argument.
 912 This is meant for people who want to view first matched part.
 913 For `undisplayed-alternative' (default), the first undisplayed
 914 part or alternative part is used.  For `undisplayed', the first
 915 undisplayed part is used.  For a function, the first part which
 916 the function return t is used.  For nil, the first part is
 917 used."
 918   :version "21.1"
 919   :group 'gnus-article-mime
 920   :type '(choice
 921           (item :tag "first" :value nil)
 922           (item :tag "undisplayed" :value undisplayed)
 923           (item :tag "undisplayed or alternative"
 924                 :value undisplayed-alternative)
 925           (function)))
 926
 927 (defcustom gnus-mime-action-alist
 928   '(("save to file" . gnus-mime-save-part)
 929     ("save and strip" . gnus-mime-save-part-and-strip)
 930     ("replace with file" . gnus-mime-replace-part)
 931     ("delete part" . gnus-mime-delete-part)
 932     ("display as text" . gnus-mime-inline-part)
 933     ("view the part" . gnus-mime-view-part)
 934     ("pipe to command" . gnus-mime-pipe-part)
 935     ("toggle display" . gnus-article-press-button)
 936     ("toggle display" . gnus-article-view-part-as-charset)
 937     ("view as type" . gnus-mime-view-part-as-type)
 938     ("view internally" . gnus-mime-view-part-internally)
 939     ("view externally" . gnus-mime-view-part-externally))
 940   "An alist of actions that run on the MIME attachment."
 941   :group 'gnus-article-mime
 942   :type '(repeat (cons (string :tag "name")
 943                        (function))))
 944
 945 (defcustom gnus-auto-select-part 1
 946   "Advance to next MIME part when deleting or stripping parts.
 947
 948 When 0, point will be placed on the same part as before.  When
 949 positive (negative), move point forward (backwards) this many
 950 parts.  When nil, redisplay article."
 951   :version "23.0" ;; No Gnus
 952   :group 'gnus-article-mime
 953   :type '(choice (const nil :tag "Redisplay article.")
 954                  (const 1 :tag "Next part.")
 955                  (const 0 :tag "Current part.")
 956                  integer))
 957
 958 ;;;
 959 ;;; The treatment variables
 960 ;;;
 961
 962 (defvar gnus-part-display-hook nil
 963   "Hook called on parts that are to receive treatment.")
 964
 965 (defvar gnus-article-treat-custom
 966   '(choice (const :tag "Off" nil)
 967            (const :tag "On" t)
 968            (const :tag "Header" head)
 969            (const :tag "First" first)
 970            (const :tag "Last" last)
 971            (integer :tag "Less")
 972            (repeat :tag "Groups" regexp)
 973            (sexp :tag "Predicate")))
 974
 975 (defvar gnus-article-treat-head-custom
 976   '(choice (const :tag "Off" nil)
 977            (const :tag "Header" head)))
 978
 979 (defvar gnus-article-treat-types '("text/plain")
 980   "Parts to treat.")
 981
 982 (defvar gnus-inhibit-treatment nil
 983   "Whether to inhibit treatment.")
 984
 985 (defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
 986   "Highlight the signature.
 987 Valid values are nil, t, `head', `first', `last', an integer or a
 988 predicate.  See Info node `(gnus)Customizing Articles'."
 989   :group 'gnus-article-treat
 990   :link '(custom-manual "(gnus)Customizing Articles")
 991   :type gnus-article-treat-custom)
 992 (put 'gnus-treat-highlight-signature 'highlight t)
 993
 994 (defcustom gnus-treat-buttonize 100000
 995   "Add buttons.
 996 Valid values are nil, t, `head', `first', `last', an integer or a
 997 predicate.  See Info node `(gnus)Customizing Articles'."
 998   :group 'gnus-article-treat
 999   :link '(custom-manual "(gnus)Customizing Articles")
1000   :type gnus-article-treat-custom)
1001 (put 'gnus-treat-buttonize 'highlight t)
1002
1003 (defcustom gnus-treat-buttonize-head 'head
1004   "Add buttons to the head.
1005 Valid values are nil, t, `head', `first', `last', an integer or a
1006 predicate.  See Info node `(gnus)Customizing Articles'."
1007   :group 'gnus-article-treat
1008   :link '(custom-manual "(gnus)Customizing Articles")
1009   :type gnus-article-treat-head-custom)
1010 (put 'gnus-treat-buttonize-head 'highlight t)
1011
1012 (defcustom gnus-treat-emphasize
1013   (and (or window-system
1014            (featurep 'xemacs))
1015        50000)
1016   "Emphasize text.
1017 Valid values are nil, t, `head', `first', `last', an integer or a
1018 predicate.  See Info node `(gnus)Customizing Articles'."
1019   :group 'gnus-article-treat
1020   :link '(custom-manual "(gnus)Customizing Articles")
1021   :type gnus-article-treat-custom)
1022 (put 'gnus-treat-emphasize 'highlight t)
1023
1024 (defcustom gnus-treat-strip-cr nil
1025   "Remove carriage returns.
1026 Valid values are nil, t, `head', `first', `last', an integer or a
1027 predicate.  See Info node `(gnus)Customizing Articles'."
1028   :version "22.1"
1029   :group 'gnus-article-treat
1030   :link '(custom-manual "(gnus)Customizing Articles")
1031   :type gnus-article-treat-custom)
1032
1033 (defcustom gnus-treat-unsplit-urls nil
1034   "Remove newlines from within URLs.
1035 Valid values are nil, t, `head', `first', `last', an integer or a
1036 predicate.  See Info node `(gnus)Customizing Articles'."
1037   :version "22.1"
1038   :group 'gnus-article-treat
1039   :link '(custom-manual "(gnus)Customizing Articles")
1040   :type gnus-article-treat-custom)
1041
1042 (defcustom gnus-treat-leading-whitespace nil
1043   "Remove leading whitespace in headers.
1044 Valid values are nil, t, `head', `first', `last', an integer or a
1045 predicate.  See Info node `(gnus)Customizing Articles'."
1046   :version "22.1"
1047   :group 'gnus-article-treat
1048   :link '(custom-manual "(gnus)Customizing Articles")
1049   :type gnus-article-treat-custom)
1050
1051 (defcustom gnus-treat-hide-headers 'head
1052   "Hide headers.
1053 Valid values are nil, t, `head', `first', `last', an integer or a
1054 predicate.  See Info node `(gnus)Customizing Articles'."
1055   :group 'gnus-article-treat
1056   :link '(custom-manual "(gnus)Customizing Articles")
1057   :type gnus-article-treat-head-custom)
1058
1059 (defcustom gnus-treat-hide-boring-headers nil
1060   "Hide boring headers.
1061 Valid values are nil, t, `head', `first', `last', an integer or a
1062 predicate.  See Info node `(gnus)Customizing Articles'."
1063   :group 'gnus-article-treat
1064   :link '(custom-manual "(gnus)Customizing Articles")
1065   :type gnus-article-treat-head-custom)
1066
1067 (defcustom gnus-treat-hide-signature nil
1068   "Hide the signature.
1069 Valid values are nil, t, `head', `first', `last', an integer or a
1070 predicate.  See Info node `(gnus)Customizing Articles'."
1071   :group 'gnus-article-treat
1072   :link '(custom-manual "(gnus)Customizing Articles")
1073   :type gnus-article-treat-custom)
1074
1075 (defcustom gnus-treat-fill-article nil
1076   "Fill the article.
1077 Valid values are nil, t, `head', `first', `last', an integer or a
1078 predicate.  See Info node `(gnus)Customizing Articles'."
1079   :group 'gnus-article-treat
1080   :link '(custom-manual "(gnus)Customizing Articles")
1081   :type gnus-article-treat-custom)
1082
1083 (defcustom gnus-treat-hide-citation nil
1084   "Hide cited text.
1085 Valid values are nil, t, `head', `first', `last', an integer or a
1086 predicate.  See Info node `(gnus)Customizing Articles'."
1087   :group 'gnus-article-treat
1088   :link '(custom-manual "(gnus)Customizing Articles")
1089   :type gnus-article-treat-custom)
1090
1091 (defcustom gnus-treat-hide-citation-maybe nil
1092   "Hide cited text.
1093 Valid values are nil, t, `head', `first', `last', an integer or a
1094 predicate.  See Info node `(gnus)Customizing Articles'."
1095   :group 'gnus-article-treat
1096   :link '(custom-manual "(gnus)Customizing Articles")
1097   :type gnus-article-treat-custom)
1098
1099 (defcustom gnus-treat-strip-list-identifiers 'head
1100   "Strip list identifiers from `gnus-list-identifiers`.
1101 Valid values are nil, t, `head', `first', `last', an integer or a
1102 predicate.  See Info node `(gnus)Customizing Articles'."
1103   :version "21.1"
1104   :group 'gnus-article-treat
1105   :link '(custom-manual "(gnus)Customizing Articles")
1106   :type gnus-article-treat-custom)
1107
1108 (make-obsolete-variable 'gnus-treat-strip-pgp
1109                         "This option is obsolete in Gnus 5.10.")
1110
1111 (defcustom gnus-treat-strip-pem nil
1112   "Strip PEM signatures.
1113 Valid values are nil, t, `head', `first', `last', an integer or a
1114 predicate.  See Info node `(gnus)Customizing Articles'."
1115   :group 'gnus-article-treat
1116   :link '(custom-manual "(gnus)Customizing Articles")
1117   :type gnus-article-treat-custom)
1118
1119 (defcustom gnus-treat-strip-banner t
1120   "Strip banners from articles.
1121 The banner to be stripped is specified in the `banner' group parameter.
1122 Valid values are nil, t, `head', `first', `last', an integer or a
1123 predicate.  See Info node `(gnus)Customizing Articles'."
1124   :group 'gnus-article-treat
1125   :link '(custom-manual "(gnus)Customizing Articles")
1126   :type gnus-article-treat-custom)
1127
1128 (defcustom gnus-treat-highlight-headers 'head
1129   "Highlight the headers.
1130 Valid values are nil, t, `head', `first', `last', an integer or a
1131 predicate.  See Info node `(gnus)Customizing Articles'."
1132   :group 'gnus-article-treat
1133   :link '(custom-manual "(gnus)Customizing Articles")
1134   :type gnus-article-treat-head-custom)
1135 (put 'gnus-treat-highlight-headers 'highlight t)
1136
1137 (defcustom gnus-treat-highlight-citation t
1138   "Highlight cited text.
1139 Valid values are nil, t, `head', `first', `last', an integer or a
1140 predicate.  See Info node `(gnus)Customizing Articles'."
1141   :group 'gnus-article-treat
1142   :link '(custom-manual "(gnus)Customizing Articles")
1143   :type gnus-article-treat-custom)
1144 (put 'gnus-treat-highlight-citation 'highlight t)
1145
1146 (defcustom gnus-treat-date-ut nil
1147   "Display the Date in UT (GMT).
1148 Valid values are nil, t, `head', `first', `last', an integer or a
1149 predicate.  See Info node `(gnus)Customizing Articles'."
1150   :group 'gnus-article-treat
1151   :link '(custom-manual "(gnus)Customizing Articles")
1152   :type gnus-article-treat-head-custom)
1153
1154 (defcustom gnus-treat-date-local nil
1155   "Display the Date in the local timezone.
1156 Valid values are nil, t, `head', `first', `last', an integer or a
1157 predicate.  See Info node `(gnus)Customizing Articles'."
1158   :group 'gnus-article-treat
1159   :link '(custom-manual "(gnus)Customizing Articles")
1160   :type gnus-article-treat-head-custom)
1161
1162 (defcustom gnus-treat-date-english nil
1163   "Display the Date in a format that can be read aloud in English.
1164 Valid values are nil, t, `head', `first', `last', an integer or a
1165 predicate.  See Info node `(gnus)Customizing Articles'."
1166   :version "22.1"
1167   :group 'gnus-article-treat
1168   :link '(custom-manual "(gnus)Customizing Articles")
1169   :type gnus-article-treat-head-custom)
1170
1171 (defcustom gnus-treat-date-lapsed nil
1172   "Display the Date header in a way that says how much time has elapsed.
1173 Valid values are nil, t, `head', `first', `last', an integer or a
1174 predicate.  See Info node `(gnus)Customizing Articles'."
1175   :group 'gnus-article-treat
1176   :link '(custom-manual "(gnus)Customizing Articles")
1177   :type gnus-article-treat-head-custom)
1178
1179 (defcustom gnus-treat-date-original nil
1180   "Display the date in the original timezone.
1181 Valid values are nil, t, `head', `first', `last', an integer or a
1182 predicate.  See Info node `(gnus)Customizing Articles'."
1183   :group 'gnus-article-treat
1184   :link '(custom-manual "(gnus)Customizing Articles")
1185   :type gnus-article-treat-head-custom)
1186
1187 (defcustom gnus-treat-date-iso8601 nil
1188   "Display the date in the ISO8601 format.
1189 Valid values are nil, t, `head', `first', `last', an integer or a
1190 predicate.  See Info node `(gnus)Customizing Articles'."
1191   :version "21.1"
1192   :group 'gnus-article-treat
1193   :link '(custom-manual "(gnus)Customizing Articles")
1194   :type gnus-article-treat-head-custom)
1195
1196 (defcustom gnus-treat-date-user-defined nil
1197   "Display the date in a user-defined format.
1198 The format is defined by the `gnus-article-time-format' variable.
1199 Valid values are nil, t, `head', `first', `last', an integer or a
1200 predicate.  See Info node `(gnus)Customizing Articles'."
1201   :group 'gnus-article-treat
1202   :link '(custom-manual "(gnus)Customizing Articles")
1203   :type gnus-article-treat-head-custom)
1204
1205 (defcustom gnus-treat-strip-headers-in-body t
1206   "Strip the X-No-Archive header line from the beginning of the body.
1207 Valid values are nil, t, `head', `first', `last', an integer or a
1208 predicate.  See Info node `(gnus)Customizing Articles'."
1209   :version "21.1"
1210   :group 'gnus-article-treat
1211   :link '(custom-manual "(gnus)Customizing Articles")
1212   :type gnus-article-treat-custom)
1213
1214 (defcustom gnus-treat-strip-trailing-blank-lines nil
1215   "Strip trailing blank lines.
1216 Valid values are nil, t, `head', `first', `last', an integer or a
1217 predicate.  See Info node `(gnus)Customizing Articles'.
1218
1219 When set to t, it also strips trailing blanks in all MIME parts.
1220 Consider to use `last' instead."
1221   :group 'gnus-article-treat
1222   :link '(custom-manual "(gnus)Customizing Articles")
1223   :type gnus-article-treat-custom)
1224
1225 (defcustom gnus-treat-strip-leading-blank-lines nil
1226   "Strip leading blank lines.
1227 Valid values are nil, t, `head', `first', `last', an integer or a
1228 predicate.  See Info node `(gnus)Customizing Articles'.
1229
1230 When set to t, it also strips trailing blanks in all MIME parts."
1231   :group 'gnus-article-treat
1232   :link '(custom-manual "(gnus)Customizing Articles")
1233   :type gnus-article-treat-custom)
1234
1235 (defcustom gnus-treat-strip-multiple-blank-lines nil
1236   "Strip multiple blank lines.
1237 Valid values are nil, t, `head', `first', `last', an integer or a
1238 predicate.  See Info node `(gnus)Customizing Articles'."
1239   :group 'gnus-article-treat
1240   :link '(custom-manual "(gnus)Customizing Articles")
1241   :type gnus-article-treat-custom)
1242
1243 (defcustom gnus-treat-unfold-headers 'head
1244   "Unfold folded header lines.
1245 Valid values are nil, t, `head', `first', `last', an integer or a
1246 predicate.  See Info node `(gnus)Customizing Articles'."
1247   :version "22.1"
1248   :group 'gnus-article-treat
1249   :link '(custom-manual "(gnus)Customizing Articles")
1250   :type gnus-article-treat-custom)
1251
1252 (defcustom gnus-treat-fold-headers nil
1253   "Fold headers.
1254 Valid values are nil, t, `head', `first', `last', an integer or a
1255 predicate.  See Info node `(gnus)Customizing Articles'."
1256   :version "22.1"
1257   :group 'gnus-article-treat
1258   :link '(custom-manual "(gnus)Customizing Articles")
1259   :type gnus-article-treat-custom)
1260
1261 (defcustom gnus-treat-fold-newsgroups 'head
1262   "Fold the Newsgroups and Followup-To headers.
1263 Valid values are nil, t, `head', `first', `last', an integer or a
1264 predicate.  See Info node `(gnus)Customizing Articles'."
1265   :version "22.1"
1266   :group 'gnus-article-treat
1267   :link '(custom-manual "(gnus)Customizing Articles")
1268   :type gnus-article-treat-custom)
1269
1270 (defcustom gnus-treat-overstrike t
1271   "Treat overstrike highlighting.
1272 Valid values are nil, t, `head', `first', `last', an integer or a
1273 predicate.  See Info node `(gnus)Customizing Articles'."
1274   :group 'gnus-article-treat
1275   :link '(custom-manual "(gnus)Customizing Articles")
1276   :type gnus-article-treat-custom)
1277 (put 'gnus-treat-overstrike 'highlight t)
1278
1279 (defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t)
1280   "Treat ANSI SGR control sequences.
1281 Valid values are nil, t, `head', `first', `last', an integer or a
1282 predicate.  See Info node `(gnus)Customizing Articles'."
1283   :group 'gnus-article-treat
1284   :link '(custom-manual "(gnus)Customizing Articles")
1285   :type gnus-article-treat-custom)
1286
1287 (make-obsolete-variable 'gnus-treat-display-xface
1288                         'gnus-treat-display-x-face)
1289
1290 (defcustom gnus-treat-display-x-face
1291   (and (not noninteractive)
1292        (or (and (fboundp 'image-type-available-p)
1293                 (image-type-available-p 'xbm)
1294                 (string-match "^0x" (shell-command-to-string "uncompface"))
1295                 (executable-find "icontopbm"))
1296            (and (featurep 'xemacs)
1297                 (featurep 'xface)))
1298        'head)
1299   "Display X-Face headers.
1300 Valid values are nil, t, `head', `first', `last', an integer or a
1301 predicate.  See Info node `(gnus)Customizing Articles' and Info
1302 node `(gnus)X-Face' for details."
1303   :group 'gnus-article-treat
1304   :version "21.1"
1305   :link '(custom-manual "(gnus)Customizing Articles")
1306   :link '(custom-manual "(gnus)X-Face")
1307   :type gnus-article-treat-head-custom
1308   :set (lambda (symbol value)
1309          (set-default
1310           symbol
1311           (cond ((or (boundp symbol) (get symbol 'saved-value))
1312                  value)
1313                 ((boundp 'gnus-treat-display-xface)
1314                  (message "\
1315 ** gnus-treat-display-xface is an obsolete variable;\
1316  use gnus-treat-display-x-face instead")
1317                  (default-value 'gnus-treat-display-xface))
1318                 ((get 'gnus-treat-display-xface 'saved-value)
1319                  (message "\
1320 ** gnus-treat-display-xface is an obsolete variable;\
1321  use gnus-treat-display-x-face instead")
1322                  (eval (car (get 'gnus-treat-display-xface 'saved-value))))
1323                 (t
1324                  value)))))
1325 (put 'gnus-treat-display-x-face 'highlight t)
1326
1327 (defcustom gnus-treat-display-face
1328   (and (not noninteractive)
1329        (or (and (fboundp 'image-type-available-p)
1330                 (image-type-available-p 'png))
1331            (and (featurep 'xemacs)
1332                 (featurep 'png)))
1333        'head)
1334   "Display Face headers.
1335 Valid values are nil, t, `head', `first', `last', an integer or a
1336 predicate.  See Info node `(gnus)Customizing Articles' and Info
1337 node `(gnus)X-Face' for details."
1338   :group 'gnus-article-treat
1339   :version "22.1"
1340   :link '(custom-manual "(gnus)Customizing Articles")
1341   :link '(custom-manual "(gnus)X-Face")
1342   :type gnus-article-treat-head-custom)
1343 (put 'gnus-treat-display-face 'highlight t)
1344
1345 (defcustom gnus-treat-display-smileys
1346   (if (or (and (featurep 'xemacs)
1347                (featurep 'xpm))
1348           (and (fboundp 'image-type-available-p)
1349                (image-type-available-p 'pbm)))
1350       t nil)
1351   "Display smileys.
1352 Valid values are nil, t, `head', `first', `last', an integer or a
1353 predicate.  See Info node `(gnus)Customizing Articles' and Info
1354 node `(gnus)Smileys' for details."
1355   :group 'gnus-article-treat
1356   :version "21.1"
1357   :link '(custom-manual "(gnus)Customizing Articles")
1358   :link '(custom-manual "(gnus)Smileys")
1359   :type gnus-article-treat-custom)
1360 (put 'gnus-treat-display-smileys 'highlight t)
1361
1362 (defcustom gnus-treat-from-picon
1363   (if (and (gnus-image-type-available-p 'xpm)
1364            (gnus-picons-installed-p))
1365       'head nil)
1366   "Display picons in the From header.
1367 Valid values are nil, t, `head', `first', `last', an integer or a
1368 predicate.  See Info node `(gnus)Customizing Articles' and Info
1369 node `(gnus)Picons' for details."
1370   :version "22.1"
1371   :group 'gnus-article-treat
1372   :group 'gnus-picon
1373   :link '(custom-manual "(gnus)Customizing Articles")
1374   :link '(custom-manual "(gnus)Picons")
1375   :type gnus-article-treat-head-custom)
1376 (put 'gnus-treat-from-picon 'highlight t)
1377
1378 (defcustom gnus-treat-mail-picon
1379   (if (and (gnus-image-type-available-p 'xpm)
1380            (gnus-picons-installed-p))
1381       'head nil)
1382   "Display picons in To and Cc headers.
1383 Valid values are nil, t, `head', `first', `last', an integer or a
1384 predicate.  See Info node `(gnus)Customizing Articles' and Info
1385 node `(gnus)Picons' for details."
1386   :version "22.1"
1387   :group 'gnus-article-treat
1388   :group 'gnus-picon
1389   :link '(custom-manual "(gnus)Customizing Articles")
1390   :link '(custom-manual "(gnus)Picons")
1391   :type gnus-article-treat-head-custom)
1392 (put 'gnus-treat-mail-picon 'highlight t)
1393
1394 (defcustom gnus-treat-newsgroups-picon
1395   (if (and (gnus-image-type-available-p 'xpm)
1396            (gnus-picons-installed-p))
1397       'head nil)
1398   "Display picons in the Newsgroups and Followup-To headers.
1399 Valid values are nil, t, `head', `first', `last', an integer or a
1400 predicate.  See Info node `(gnus)Customizing Articles' and Info
1401 node `(gnus)Picons' for details."
1402   :version "22.1"
1403   :group 'gnus-article-treat
1404   :group 'gnus-picon
1405   :link '(custom-manual "(gnus)Customizing Articles")
1406   :link '(custom-manual "(gnus)Picons")
1407   :type gnus-article-treat-head-custom)
1408 (put 'gnus-treat-newsgroups-picon 'highlight t)
1409
1410 (defcustom gnus-treat-body-boundary
1411   (if (and (eq window-system 'x)
1412            (or gnus-treat-newsgroups-picon
1413                gnus-treat-mail-picon
1414                gnus-treat-from-picon))
1415       'head nil)
1416   "Draw a boundary at the end of the headers.
1417 Valid values are nil and `head'.
1418 See Info node `(gnus)Customizing Articles' for details."
1419   :version "22.1"
1420   :group 'gnus-article-treat
1421   :link '(custom-manual "(gnus)Customizing Articles")
1422   :type gnus-article-treat-head-custom)
1423
1424 (defcustom gnus-treat-capitalize-sentences nil
1425   "Capitalize sentence-starting words.
1426 Valid values are nil, t, `head', `first', `last', an integer or a
1427 predicate.  See Info node `(gnus)Customizing Articles'."
1428   :version "21.1"
1429   :group 'gnus-article-treat
1430   :link '(custom-manual "(gnus)Customizing Articles")
1431   :type gnus-article-treat-custom)
1432
1433 (defcustom gnus-treat-wash-html nil
1434   "Format as HTML.
1435 Valid values are nil, t, `head', `first', `last', an integer or a
1436 predicate.  See Info node `(gnus)Customizing Articles'."
1437   :version "22.1"
1438   :group 'gnus-article-treat
1439   :link '(custom-manual "(gnus)Customizing Articles")
1440   :type gnus-article-treat-custom)
1441
1442 (defcustom gnus-treat-fill-long-lines nil
1443   "Fill long lines.
1444 Valid values are nil, t, `head', `first', `last', an integer or a
1445 predicate.  See Info node `(gnus)Customizing Articles'."
1446   :group 'gnus-article-treat
1447   :link '(custom-manual "(gnus)Customizing Articles")
1448   :type gnus-article-treat-custom)
1449
1450 (defcustom gnus-treat-play-sounds nil
1451   "Play sounds.
1452 Valid values are nil, t, `head', `first', `last', an integer or a
1453 predicate.  See Info node `(gnus)Customizing Articles'."
1454   :version "21.1"
1455   :group 'gnus-article-treat
1456   :link '(custom-manual "(gnus)Customizing Articles")
1457   :type gnus-article-treat-custom)
1458
1459 (defcustom gnus-treat-translate nil
1460   "Translate articles from one language to another.
1461 Valid values are nil, t, `head', `first', `last', an integer or a
1462 predicate.  See Info node `(gnus)Customizing Articles'."
1463   :version "21.1"
1464   :group 'gnus-article-treat
1465   :link '(custom-manual "(gnus)Customizing Articles")
1466   :type gnus-article-treat-custom)
1467
1468 (defcustom gnus-treat-x-pgp-sig nil
1469   "Verify X-PGP-Sig.
1470 To automatically treat X-PGP-Sig, set it to head.
1471 Valid values are nil, t, `head', `first', `last', an integer or a
1472 predicate.  See Info node `(gnus)Customizing Articles'."
1473   :version "22.1"
1474   :group 'gnus-article-treat
1475   :group 'mime-security
1476   :link '(custom-manual "(gnus)Customizing Articles")
1477   :type gnus-article-treat-custom)
1478
1479 (defvar gnus-article-encrypt-protocol-alist
1480   '(("PGP" . mml2015-self-encrypt)))
1481
1482 ;; Set to nil if more than one protocol added to
1483 ;; gnus-article-encrypt-protocol-alist.
1484 (defcustom gnus-article-encrypt-protocol "PGP"
1485   "The protocol used for encrypt articles.
1486 It is a string, such as \"PGP\". If nil, ask user."
1487   :version "22.1"
1488   :type 'string
1489   :group 'mime-security)
1490
1491 (defvar gnus-article-wash-function nil
1492   "Function used for converting HTML into text.")
1493
1494 (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
1495                               (mm-coding-system-p 'utf-8)
1496                               (executable-find idna-program))
1497   "Whether IDNA decoding of headers is used when viewing messages.
1498 This requires GNU Libidn, and by default only enabled if it is found."
1499   :version "22.1"
1500   :group 'gnus-article-headers
1501   :type 'boolean)
1502
1503 (defcustom gnus-article-over-scroll nil
1504   "If non-nil, allow scrolling the article buffer even when there no more text."
1505   :version "22.1"
1506   :group 'gnus-article
1507   :type 'boolean)
1508
1509 ;;; Internal variables
1510
1511 (defvar gnus-english-month-names
1512   '("January" "February" "March" "April" "May" "June" "July" "August"
1513     "September" "October" "November" "December"))
1514
1515 (defvar gnus-button-regexp nil)
1516 (defvar gnus-button-marker-list nil)
1517 ;; Regexp matching any of the regexps from `gnus-button-alist'.
1518
1519 (defvar gnus-button-last nil)
1520 ;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
1521
1522 (defvar article-goto-body-goes-to-point-min-p nil)
1523 (defvar gnus-article-wash-types nil)
1524 (defvar gnus-article-emphasis-alist nil)
1525 (defvar gnus-article-image-alist nil)
1526
1527 (defvar gnus-article-mime-handle-alist-1 nil)
1528 (defvar gnus-treatment-function-alist
1529   '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
1530     (gnus-treat-strip-banner gnus-article-strip-banner)
1531     (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
1532     (gnus-treat-highlight-signature gnus-article-highlight-signature)
1533     (gnus-treat-buttonize gnus-article-add-buttons)
1534     (gnus-treat-fill-article gnus-article-fill-cited-article)
1535     (gnus-treat-fill-long-lines gnus-article-fill-long-lines)
1536     (gnus-treat-strip-cr gnus-article-remove-cr)
1537     (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1538     (gnus-treat-date-ut gnus-article-date-ut)
1539     (gnus-treat-date-local gnus-article-date-local)
1540     (gnus-treat-date-english gnus-article-date-english)
1541     (gnus-treat-date-original gnus-article-date-original)
1542     (gnus-treat-date-user-defined gnus-article-date-user)
1543     (gnus-treat-date-iso8601 gnus-article-date-iso8601)
1544     (gnus-treat-date-lapsed gnus-article-date-lapsed)
1545     (gnus-treat-display-x-face gnus-article-display-x-face)
1546     (gnus-treat-display-face gnus-article-display-face)
1547     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
1548     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
1549     (gnus-treat-hide-signature gnus-article-hide-signature)
1550     (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
1551     (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
1552     (gnus-treat-strip-pem gnus-article-hide-pem)
1553     (gnus-treat-from-picon gnus-treat-from-picon)
1554     (gnus-treat-mail-picon gnus-treat-mail-picon)
1555     (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
1556     (gnus-treat-highlight-headers gnus-article-highlight-headers)
1557     (gnus-treat-highlight-signature gnus-article-highlight-signature)
1558     (gnus-treat-strip-trailing-blank-lines
1559      gnus-article-remove-trailing-blank-lines)
1560     (gnus-treat-strip-leading-blank-lines
1561      gnus-article-strip-leading-blank-lines)
1562     (gnus-treat-strip-multiple-blank-lines
1563      gnus-article-strip-multiple-blank-lines)
1564     (gnus-treat-overstrike gnus-article-treat-overstrike)
1565     (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences)
1566     (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
1567     (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1568     (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
1569     (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
1570     (gnus-treat-display-smileys gnus-treat-smiley)
1571     (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
1572     (gnus-treat-wash-html gnus-article-wash-html)
1573     (gnus-treat-emphasize gnus-article-emphasize)
1574     (gnus-treat-hide-citation gnus-article-hide-citation)
1575     (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
1576     (gnus-treat-highlight-citation gnus-article-highlight-citation)
1577     (gnus-treat-body-boundary gnus-article-treat-body-boundary)
1578     (gnus-treat-play-sounds gnus-earcon-display)))
1579
1580 (defvar gnus-article-mime-handle-alist nil)
1581 (defvar article-lapsed-timer nil)
1582 (defvar gnus-article-current-summary nil)
1583
1584 (defvar gnus-article-mode-syntax-table
1585   (let ((table (copy-syntax-table text-mode-syntax-table)))
1586     ;; This causes the citation match run O(2^n).
1587     ;; (modify-syntax-entry ?- "w" table)
1588     (modify-syntax-entry ?> ")<" table)
1589     (modify-syntax-entry ?< "(>" table)
1590     ;; make M-. in article buffers work for `foo' strings
1591     (modify-syntax-entry ?' " " table)
1592     (modify-syntax-entry ?` " " table)
1593     table)
1594   "Syntax table used in article mode buffers.
1595 Initialized from `text-mode-syntax-table.")
1596
1597 (defvar gnus-save-article-buffer nil)
1598
1599 (defvar gnus-article-mode-line-format-alist
1600   (nconc '((?w (gnus-article-wash-status) ?s)
1601            (?m (gnus-article-mime-part-status) ?s))
1602          gnus-summary-mode-line-format-alist))
1603
1604 (defvar gnus-number-of-articles-to-be-saved nil)
1605
1606 (defvar gnus-inhibit-hiding nil)
1607
1608 (defvar gnus-article-edit-mode nil)
1609
1610 ;;; Macros for dealing with the article buffer.
1611
1612 (defmacro gnus-with-article-headers (&rest forms)
1613   `(save-excursion
1614      (set-buffer gnus-article-buffer)
1615      (save-restriction
1616        (let ((inhibit-read-only t)
1617              (inhibit-point-motion-hooks t)
1618              (case-fold-search t))
1619          (article-narrow-to-head)
1620          ,@forms))))
1621
1622 (put 'gnus-with-article-headers 'lisp-indent-function 0)
1623 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
1624
1625 (defmacro gnus-with-article-buffer (&rest forms)
1626   `(save-excursion
1627      (set-buffer gnus-article-buffer)
1628      (let ((inhibit-read-only t))
1629        ,@forms)))
1630
1631 (put 'gnus-with-article-buffer 'lisp-indent-function 0)
1632 (put 'gnus-with-article-buffer 'edebug-form-spec '(body))
1633
1634 (defun gnus-article-goto-header (header)
1635   "Go to HEADER, which is a regular expression."
1636   (re-search-forward (concat "^\\(" header "\\):") nil t))
1637
1638 (defsubst gnus-article-hide-text (b e props)
1639   "Set text PROPS on the B to E region, extending `intangible' 1 past B."
1640   (gnus-add-text-properties-when 'article-type nil b e props)
1641   (when (memq 'intangible props)
1642     (put-text-property
1643      (max (1- b) (point-min))
1644      b 'intangible (cddr (memq 'intangible props)))))
1645
1646 (defsubst gnus-article-unhide-text (b e)
1647   "Remove hidden text properties from region between B and E."
1648   (remove-text-properties b e gnus-hidden-properties)
1649   (when (memq 'intangible gnus-hidden-properties)
1650     (put-text-property (max (1- b) (point-min))
1651                        b 'intangible nil)))
1652
1653 (defun gnus-article-hide-text-type (b e type)
1654   "Hide text of TYPE between B and E."
1655   (gnus-add-wash-type type)
1656   (gnus-article-hide-text
1657    b e (cons 'article-type (cons type gnus-hidden-properties))))
1658
1659 (defun gnus-article-unhide-text-type (b e type)
1660   "Unhide text of TYPE between B and E."
1661   (gnus-delete-wash-type type)
1662   (remove-text-properties
1663    b e (cons 'article-type (cons type gnus-hidden-properties)))
1664   (when (memq 'intangible gnus-hidden-properties)
1665     (put-text-property (max (1- b) (point-min))
1666                        b 'intangible nil)))
1667
1668 (defun gnus-article-hide-text-of-type (type)
1669   "Hide text of TYPE in the current buffer."
1670   (save-excursion
1671     (let ((b (point-min))
1672           (e (point-max)))
1673       (while (setq b (text-property-any b e 'article-type type))
1674         (add-text-properties b (incf b) gnus-hidden-properties)))))
1675
1676 (defun gnus-article-delete-text-of-type (type)
1677   "Delete text of TYPE in the current buffer."
1678   (save-excursion
1679     (let ((b (point-min)))
1680       (if (eq type 'multipart)
1681           ;; Remove MIME buttons associated with multipart/alternative parts.
1682           (progn
1683             (goto-char b)
1684             (while (if (get-text-property (point) 'gnus-part)
1685                        (setq b (point))
1686                      (when (setq b (next-single-property-change (point)
1687                                                                 'gnus-part))
1688                        (goto-char b)
1689                        t))
1690               (end-of-line)
1691               (skip-chars-forward "\n")
1692               (when (eq (get-text-property b 'article-type) 'multipart)
1693                 (delete-region b (point)))))
1694         (while (setq b (text-property-any b (point-max) 'article-type type))
1695           (delete-region
1696            b (or (text-property-not-all b (point-max) 'article-type type)
1697                  (point-max))))))))
1698
1699 (defun gnus-article-delete-invisible-text ()
1700   "Delete all invisible text in the current buffer."
1701   (save-excursion
1702     (let ((b (point-min)))
1703       (while (setq b (text-property-any b (point-max) 'invisible t))
1704         (delete-region
1705          b (or (text-property-not-all b (point-max) 'invisible t)
1706                (point-max)))))))
1707
1708 (defun gnus-article-text-type-exists-p (type)
1709   "Say whether any text of type TYPE exists in the buffer."
1710   (text-property-any (point-min) (point-max) 'article-type type))
1711
1712 (defsubst gnus-article-header-rank ()
1713   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
1714   (let ((list gnus-sorted-header-list)
1715         (i 1))
1716     (while list
1717       (if (looking-at (car list))
1718           (setq list nil)
1719         (setq list (cdr list))
1720         (incf i)))
1721       i))
1722
1723 (defun article-hide-headers (&optional arg delete)
1724   "Hide unwanted headers and possibly sort them as well."
1725   (interactive)
1726   ;; This function might be inhibited.
1727   (unless gnus-inhibit-hiding
1728     (let ((inhibit-read-only nil)
1729           (case-fold-search t)
1730           (max (1+ (length gnus-sorted-header-list)))
1731           (inhibit-point-motion-hooks t)
1732           (cur (current-buffer))
1733           ignored visible beg)
1734       (save-excursion
1735         ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
1736         ;; group parameters, so we should go to the summary buffer.
1737         (when (prog1
1738                   (condition-case nil
1739                       (progn (set-buffer gnus-summary-buffer) t)
1740                     (error nil))
1741                 (setq ignored (when (not gnus-visible-headers)
1742                                 (cond ((stringp gnus-ignored-headers)
1743                                        gnus-ignored-headers)
1744                                       ((listp gnus-ignored-headers)
1745                                        (mapconcat 'identity
1746                                                   gnus-ignored-headers
1747                                                   "\\|"))))
1748                       visible (cond ((stringp gnus-visible-headers)
1749                                      gnus-visible-headers)
1750                                     ((and gnus-visible-headers
1751                                           (listp gnus-visible-headers))
1752                                      (mapconcat 'identity
1753                                                 gnus-visible-headers
1754                                                 "\\|")))))
1755           (set-buffer cur))
1756         (save-restriction
1757           ;; First we narrow to just the headers.
1758           (article-narrow-to-head)
1759           ;; Hide any "From " lines at the beginning of (mail) articles.
1760           (while (looking-at "From ")
1761             (forward-line 1))
1762           (unless (bobp)
1763             (delete-region (point-min) (point)))
1764           ;; Then treat the rest of the header lines.
1765           ;; Then we use the two regular expressions
1766           ;; `gnus-ignored-headers' and `gnus-visible-headers' to
1767           ;; select which header lines is to remain visible in the
1768           ;; article buffer.
1769           (while (re-search-forward "^[^ \t:]*:" nil t)
1770             (beginning-of-line)
1771             ;; Mark the rank of the header.
1772             (put-text-property
1773              (point) (1+ (point)) 'message-rank
1774              (if (or (and visible (looking-at visible))
1775                      (and ignored
1776                           (not (looking-at ignored))))
1777                  (gnus-article-header-rank)
1778                (+ 2 max)))
1779             (forward-line 1))
1780           (message-sort-headers-1)
1781           (when (setq beg (text-property-any
1782                            (point-min) (point-max) 'message-rank (+ 2 max)))
1783             ;; We delete the unwanted headers.
1784             (gnus-add-wash-type 'headers)
1785             (add-text-properties (point-min) (+ 5 (point-min))
1786                                  '(article-type headers dummy-invisible t))
1787             (delete-region beg (point-max))))))))
1788
1789 (defun article-hide-boring-headers (&optional arg)
1790   "Toggle hiding of headers that aren't very interesting.
1791 If given a negative prefix, always show; if given a positive prefix,
1792 always hide."
1793   (interactive (gnus-article-hidden-arg))
1794   (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
1795              (not gnus-show-all-headers))
1796     (save-excursion
1797       (save-restriction
1798         (let ((inhibit-read-only t)
1799               (inhibit-point-motion-hooks t))
1800           (article-narrow-to-head)
1801           (dolist (elem gnus-boring-article-headers)
1802             (goto-char (point-min))
1803             (cond
1804              ;; Hide empty headers.
1805              ((eq elem 'empty)
1806               (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
1807                 (forward-line -1)
1808                 (gnus-article-hide-text-type
1809                  (point-at-bol)
1810                  (progn
1811                    (end-of-line)
1812                    (if (re-search-forward "^[^ \t]" nil t)
1813                        (match-beginning 0)
1814                      (point-max)))
1815                  'boring-headers)))
1816              ;; Hide boring Newsgroups header.
1817              ((eq elem 'newsgroups)
1818               (when (gnus-string-equal
1819                      (gnus-fetch-field "newsgroups")
1820                      (gnus-group-real-name
1821                       (if (boundp 'gnus-newsgroup-name)
1822                           gnus-newsgroup-name
1823                         "")))
1824                 (gnus-article-hide-header "newsgroups")))
1825              ((eq elem 'to-address)
1826               (let ((to (message-fetch-field "to"))
1827                     (to-address
1828                      (gnus-parameter-to-address
1829                       (if (boundp 'gnus-newsgroup-name)
1830                           gnus-newsgroup-name ""))))
1831                 (when (and to to-address
1832                            (ignore-errors
1833                              (gnus-string-equal
1834                               ;; only one address in To
1835                               (nth 1 (mail-extract-address-components to))
1836                               to-address)))
1837                   (gnus-article-hide-header "to"))))
1838              ((eq elem 'to-list)
1839               (let ((to (message-fetch-field "to"))
1840                     (to-list
1841                      (gnus-parameter-to-list
1842                       (if (boundp 'gnus-newsgroup-name)
1843                           gnus-newsgroup-name ""))))
1844                 (when (and to to-list
1845                            (ignore-errors
1846                              (gnus-string-equal
1847                               ;; only one address in To
1848                               (nth 1 (mail-extract-address-components to))
1849                               to-list)))
1850                   (gnus-article-hide-header "to"))))
1851              ((eq elem 'cc-list)
1852               (let ((cc (message-fetch-field "cc"))
1853                     (to-list
1854                      (gnus-parameter-to-list
1855                       (if (boundp 'gnus-newsgroup-name)
1856                           gnus-newsgroup-name ""))))
1857                 (when (and cc to-list
1858                            (ignore-errors
1859                              (gnus-string-equal
1860                               ;; only one address in CC
1861                               (nth 1 (mail-extract-address-components cc))
1862                               to-list)))
1863                   (gnus-article-hide-header "cc"))))
1864              ((eq elem 'followup-to)
1865               (when (gnus-string-equal
1866                      (message-fetch-field "followup-to")
1867                      (message-fetch-field "newsgroups"))
1868                 (gnus-article-hide-header "followup-to")))
1869              ((eq elem 'reply-to)
1870               (if (gnus-group-find-parameter
1871                    gnus-newsgroup-name 'broken-reply-to)
1872                   (gnus-article-hide-header "reply-to")
1873                 (let ((from (message-fetch-field "from"))
1874                       (reply-to (message-fetch-field "reply-to")))
1875                   (when
1876                       (and
1877                        from reply-to
1878                        (ignore-errors
1879                          (equal
1880                           (sort (mapcar
1881                                  (lambda (x) (downcase (cadr x)))
1882                                  (mail-extract-address-components from t))
1883                                 'string<)
1884                           (sort (mapcar
1885                                  (lambda (x) (downcase (cadr x)))
1886                                  (mail-extract-address-components reply-to t))
1887                                 'string<))))
1888                     (gnus-article-hide-header "reply-to")))))
1889              ((eq elem 'date)
1890               (let ((date (message-fetch-field "date")))
1891                 (when (and date
1892                            (< (days-between (current-time-string) date)
1893                               4))
1894                   (gnus-article-hide-header "date"))))
1895              ((eq elem 'long-to)
1896               (let ((to (message-fetch-field "to"))
1897                     (cc (message-fetch-field "cc")))
1898                 (when (> (length to) 1024)
1899                   (gnus-article-hide-header "to"))
1900                 (when (> (length cc) 1024)
1901                   (gnus-article-hide-header "cc"))))
1902              ((eq elem 'many-to)
1903               (let ((to-count 0)
1904                     (cc-count 0))
1905                 (goto-char (point-min))
1906                 (while (re-search-forward "^to:" nil t)
1907                   (setq to-count (1+ to-count)))
1908                 (when (> to-count 1)
1909                   (while (> to-count 0)
1910                     (goto-char (point-min))
1911                     (save-restriction
1912                       (re-search-forward "^to:" nil nil to-count)
1913                       (forward-line -1)
1914                       (narrow-to-region (point) (point-max))
1915                       (gnus-article-hide-header "to"))
1916                     (setq to-count (1- to-count))))
1917                 (goto-char (point-min))
1918                 (while (re-search-forward "^cc:" nil t)
1919                   (setq cc-count (1+ cc-count)))
1920                 (when (> cc-count 1)
1921                   (while (> cc-count 0)
1922                     (goto-char (point-min))
1923                     (save-restriction
1924                       (re-search-forward "^cc:" nil nil cc-count)
1925                       (forward-line -1)
1926                       (narrow-to-region (point) (point-max))
1927                       (gnus-article-hide-header "cc"))
1928                     (setq cc-count (1- cc-count)))))))))))))
1929
1930 (defun gnus-article-hide-header (header)
1931   (save-excursion
1932     (goto-char (point-min))
1933     (when (re-search-forward (concat "^" header ":") nil t)
1934       (gnus-article-hide-text-type
1935        (point-at-bol)
1936        (progn
1937          (end-of-line)
1938          (if (re-search-forward "^[^ \t]" nil t)
1939              (match-beginning 0)
1940            (point-max)))
1941        'boring-headers))))
1942
1943 (defvar gnus-article-normalized-header-length 40
1944   "Length of normalized headers.")
1945
1946 (defun article-normalize-headers ()
1947   "Make all header lines 40 characters long."
1948   (interactive)
1949   (let ((inhibit-read-only t)
1950         column)
1951     (save-excursion
1952       (save-restriction
1953         (article-narrow-to-head)
1954         (while (not (eobp))
1955           (cond
1956            ((< (setq column (- (point-at-eol) (point)))
1957                gnus-article-normalized-header-length)
1958             (end-of-line)
1959             (insert (make-string
1960                      (- gnus-article-normalized-header-length column)
1961                      ? )))
1962            ((> column gnus-article-normalized-header-length)
1963             (gnus-put-text-property
1964              (progn
1965                (forward-char gnus-article-normalized-header-length)
1966                (point))
1967              (point-at-eol)
1968              'invisible t))