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

   1 ;;; gnus-art.el --- article mode commands for Gnus
   2
   3 ;; Copyright (C) 1996-2013 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 ;; For Emacs <22.2 and XEmacs.
  28 (eval-and-compile
  29   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
  30 (eval-when-compile
  31   (require 'cl))
  32 (defvar tool-bar-map)
  33 (defvar w3m-minor-mode-map)
  34
  35 (require 'gnus)
  36 (require 'gnus-util)
  37 (require 'gnus-sum)
  38 (require 'gnus-spec)
  39 (require 'gnus-int)
  40 (require 'gnus-win)
  41 (require 'mm-bodies)
  42 (require 'mail-parse)
  43 (require 'mm-decode)
  44 (require 'mm-view)
  45 (require 'wid-edit)
  46 (require 'mm-uu)
  47 (require 'message)
  48 (require 'mouse)
  49
  50 (autoload 'gnus-msg-mail "gnus-msg" nil t)
  51 (autoload 'gnus-button-mailto "gnus-msg")
  52 (autoload 'gnus-button-reply "gnus-msg" nil t)
  53 (autoload 'parse-time-string "parse-time" nil nil)
  54 (autoload 'ansi-color-apply-on-region "ansi-color")
  55 (autoload 'mm-url-insert-file-contents-external "mm-url")
  56 (autoload 'mm-extern-cache-contents "mm-extern")
  57
  58 (defgroup gnus-article nil
  59   "Article display."
  60   :link '(custom-manual "(gnus)Article Buffer")
  61   :group 'gnus)
  62
  63 (defgroup gnus-article-treat nil
  64   "Treating article parts."
  65   :link '(custom-manual "(gnus)Article Hiding")
  66   :group 'gnus-article)
  67
  68 (defgroup gnus-article-hiding nil
  69   "Hiding article parts."
  70   :link '(custom-manual "(gnus)Article Hiding")
  71   :group 'gnus-article)
  72
  73 (defgroup gnus-article-highlight nil
  74   "Article highlighting."
  75   :link '(custom-manual "(gnus)Article Highlighting")
  76   :group 'gnus-article
  77   :group 'gnus-visual)
  78
  79 (defgroup gnus-article-signature nil
  80   "Article signatures."
  81   :link '(custom-manual "(gnus)Article Signature")
  82   :group 'gnus-article)
  83
  84 (defgroup gnus-article-headers nil
  85   "Article headers."
  86   :link '(custom-manual "(gnus)Hiding Headers")
  87   :group 'gnus-article)
  88
  89 (defgroup gnus-article-washing nil
  90   "Special commands on articles."
  91   :link '(custom-manual "(gnus)Article Washing")
  92   :group 'gnus-article)
  93
  94 (defgroup gnus-article-emphasis nil
  95   "Fontisizing articles."
  96   :link '(custom-manual "(gnus)Article Fontisizing")
  97   :group 'gnus-article)
  98
  99 (defgroup gnus-article-saving nil
 100   "Saving articles."
 101   :link '(custom-manual "(gnus)Saving Articles")
 102   :group 'gnus-article)
 103
 104 (defgroup gnus-article-mime nil
 105   "Worshiping the MIME wonder."
 106   :link '(custom-manual "(gnus)Using MIME")
 107   :group 'gnus-article)
 108
 109 (defgroup gnus-article-buttons nil
 110   "Pushable buttons in the article buffer."
 111   :link '(custom-manual "(gnus)Article Buttons")
 112   :group 'gnus-article)
 113
 114 (defgroup gnus-article-various nil
 115   "Other article options."
 116   :link '(custom-manual "(gnus)Misc Article")
 117   :group 'gnus-article)
 118
 119 (defcustom gnus-ignored-headers
 120   (mapcar
 121    (lambda (header)
 122      (concat "^" header ":"))
 123    '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
 124      "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
 125      "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
 126      "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
 127      "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
 128      "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
 129      "X-Attribution" "X-Originating-IP" "Delivered-To"
 130      "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
 131      "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
 132      "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
 133      "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
 134      "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
 135      "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
 136      "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
 137      "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
 138      "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
 139      "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
 140      "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
 141      "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
 142      "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
 143      "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
 144      "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
 145      "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
 146      "List-[A-Za-z]+" "X-Listprocessor-Version"
 147      "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
 148      "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
 149      "X-Received" "Content-length" "X-precedence"
 150      "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
 151      "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
 152      "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
 153      "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
 154      "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
 155      "X-Content-length" "X-Posting-Agent" "Original-Received"
 156      "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
 157      "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
 158      "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
 159      "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
 160      "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"
 161      "Envelope-To" "X-Spam-Score" "System-Type" "X-Injected-Via-Gmane"
 162      "X-Gmane-NNTP-Posting-Host" "Jabber-ID" "Archived-At"
 163      "Envelope-Sender" "Envelope-Recipients"))
 164   "*All headers that start with this regexp will be hidden.
 165 This variable can also be a list of regexps of headers to be ignored.
 166 If `gnus-visible-headers' is non-nil, this variable will be ignored."
 167   :type '(choice regexp
 168                  (repeat regexp))
 169   :group 'gnus-article-hiding)
 170
 171 (defcustom gnus-visible-headers
 172   "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:"
 173   "*All headers that do not match this regexp will be hidden.
 174 This variable can also be a list of regexp of headers to remain visible.
 175 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
 176   :type '(choice
 177           (repeat :value-to-internal (lambda (widget value)
 178                                        (custom-split-regexp-maybe value))
 179                   :match (lambda (widget value)
 180                            (or (stringp value)
 181                                (widget-editable-list-match widget value)))
 182                   regexp)
 183           (const :tag "Use gnus-ignored-headers" nil)
 184           regexp)
 185   :group 'gnus-article-hiding)
 186
 187 (defcustom gnus-sorted-header-list
 188   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
 189     "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
 190   "*This variable is a list of regular expressions.
 191 If it is non-nil, headers that match the regular expressions will
 192 be placed first in the article buffer in the sequence specified by
 193 this list."
 194   :type '(repeat regexp)
 195   :group 'gnus-article-hiding)
 196
 197 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
 198   "Headers that are only to be displayed if they have interesting data.
 199 Possible values in this list are:
 200
 201   'empty       Headers with no content.
 202   'newsgroups  Newsgroup identical to Gnus group.
 203   'to-address  To identical to To-address.
 204   'to-list     To identical to To-list.
 205   'cc-list     CC identical to To-list.
 206   'followup-to Followup-to identical to Newsgroups.
 207   'reply-to    Reply-to identical to From.
 208   'date        Date less than four days old.
 209   'long-to     To and/or Cc longer than 1024 characters.
 210   'many-to     Multiple To and/or Cc."
 211   :type '(set (const :tag "Headers with no content." empty)
 212               (const :tag "Newsgroups identical to Gnus group." newsgroups)
 213               (const :tag "To identical to To-address." to-address)
 214               (const :tag "To identical to To-list." to-list)
 215               (const :tag "CC identical to To-list." cc-list)
 216               (const :tag "Followup-to identical to Newsgroups." followup-to)
 217               (const :tag "Reply-to identical to From." reply-to)
 218               (const :tag "Date less than four days old." date)
 219               (const :tag "To and/or Cc longer than 1024 characters." long-to)
 220               (const :tag "Multiple To and/or Cc headers." many-to))
 221   :group 'gnus-article-hiding)
 222
 223 (defcustom gnus-article-skip-boring nil
 224   "Skip over text that is not worth reading.
 225 By default, if you set this t, then Gnus will display citations and
 226 signatures, but will never scroll down to show you a page consisting
 227 only of boring text.  Boring text is controlled by
 228 `gnus-article-boring-faces'."
 229   :version "22.1"
 230   :type 'boolean
 231   :group 'gnus-article-hiding)
 232
 233 (defcustom gnus-signature-separator '("^-- $" "^-- *$")
 234   "Regexp matching signature separator.
 235 This can also be a list of regexps.  In that case, it will be checked
 236 from head to tail looking for a separator.  Searches will be done from
 237 the end of the buffer."
 238   :type '(choice :format "%{%t%}: %[Value Menu%]\n%v"
 239                  (regexp)
 240                  (repeat :tag "List of regexp" regexp))
 241   :group 'gnus-article-signature)
 242
 243 (defcustom gnus-signature-limit nil
 244   "Provide a limit to what is considered a signature.
 245 If it is a number, no signature may not be longer (in characters) than
 246 that number.  If it is a floating point number, no signature may be
 247 longer (in lines) than that number.  If it is a function, the function
 248 will be called without any parameters, and if it returns nil, there is
 249 no signature in the buffer.  If it is a string, it will be used as a
 250 regexp.  If it matches, the text in question is not a signature.
 251
 252 This can also be a list of the above values."
 253   :type '(choice (const nil)
 254                  (integer :value 200)
 255                  (number :value 4.0)
 256                  function
 257                  (regexp :value ".*"))
 258   :group 'gnus-article-signature)
 259
 260 (defcustom gnus-hidden-properties '(invisible t intangible t)
 261   "Property list to use for hiding text."
 262   :type 'sexp
 263   :group 'gnus-article-hiding)
 264
 265 ;; Fixme: This isn't the right thing for mixed graphical and non-graphical
 266 ;; frames in a session.
 267 (defcustom gnus-article-x-face-command
 268   (if (featurep 'xemacs)
 269       (if (or (gnus-image-type-available-p 'xface)
 270               (gnus-image-type-available-p 'pbm))
 271           'gnus-display-x-face-in-from
 272         "{ echo \
 273 '/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
 274 ; uncompface; } | icontopbm | ee -")
 275     (if (gnus-image-type-available-p 'pbm)
 276         'gnus-display-x-face-in-from
 277       "{ echo \
 278 '/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
 279 ; uncompface; } | icontopbm | display -"))
 280   "*String or function to be executed to display an X-Face header.
 281 If it is a string, the command will be executed in a sub-shell
 282 asynchronously.  The compressed face will be piped to this command."
 283   :type `(choice string
 284                  (function-item gnus-display-x-face-in-from)
 285                  function)
 286   :version "21.1"
 287   :group 'gnus-picon
 288   :group 'gnus-article-washing)
 289
 290 (defcustom gnus-article-x-face-too-ugly nil
 291   "Regexp matching posters whose face shouldn't be shown automatically."
 292   :type '(choice regexp (const nil))
 293   :group 'gnus-article-washing)
 294
 295 (defcustom gnus-article-banner-alist nil
 296   "Banner alist for stripping.
 297 For example,
 298      ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
 299   :version "21.1"
 300   :type '(repeat (cons symbol regexp))
 301   :group 'gnus-article-washing)
 302
 303 (gnus-define-group-parameter
 304  banner
 305  :variable-document
 306  "Alist of regexps (to match group names) and banner."
 307  :variable-group gnus-article-washing
 308  :parameter-type
 309  '(choice :tag "Banner"
 310           :value nil
 311           (const :tag "Remove signature" signature)
 312           (symbol :tag "Item in `gnus-article-banner-alist'" none)
 313           regexp
 314           (const :tag "None" nil))
 315  :parameter-document
 316  "If non-nil, specify how to remove `banners' from articles.
 317
 318 Symbol `signature' means to remove signatures delimited by
 319 `gnus-signature-separator'.  Any other symbol is used to look up a
 320 regular expression to match the banner in `gnus-article-banner-alist'.
 321 A string is used as a regular expression to match the banner
 322 directly.")
 323
 324 (defcustom gnus-article-address-banner-alist nil
 325   "Alist of mail addresses and banners.
 326 Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
 327 to match a mail address in the From: header, BANNER is one of a symbol
 328 `signature', an item in `gnus-article-banner-alist', a regexp and nil.
 329 If ADDRESS matches author's mail address, it will remove things like
 330 advertisements.  For example:
 331
 332 \((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
 333 "
 334   :type '(repeat
 335           (cons
 336            (regexp :tag "Address")
 337            (choice :tag "Banner" :value nil
 338                    (const :tag "Remove signature" signature)
 339                    (symbol :tag "Item in `gnus-article-banner-alist'" none)
 340                    regexp
 341                    (const :tag "None" nil))))
 342   :version "22.1"
 343   :group 'gnus-article-washing)
 344
 345 (defmacro gnus-emphasis-custom-with-format (&rest body)
 346   `(let ((format "\
 347 \\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\
 348 \\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)"))
 349      ,@body))
 350
 351 (defun gnus-emphasis-custom-value-to-external (value)
 352   (gnus-emphasis-custom-with-format
 353    (if (consp (car value))
 354        (list (format format (car (car value)) (cdr (car value)))
 355              2
 356              (if (nth 1 value) 2 3)
 357              (nth 2 value))
 358      value)))
 359
 360 (defun gnus-emphasis-custom-value-to-internal (value)
 361   (gnus-emphasis-custom-with-format
 362    (let ((regexp (concat "\\`"
 363                          (format (regexp-quote format)
 364                                  "\\([^()]+\\)" "\\([^()]+\\)")
 365                          "\\'"))
 366          pattern)
 367      (if (string-match regexp (setq pattern (car value)))
 368          (list (cons (match-string 1 pattern) (match-string 2 pattern))
 369                (= (nth 2 value) 2)
 370                (nth 3 value))
 371        value))))
 372
 373 (defcustom gnus-emphasis-alist
 374   (let ((types
 375          '(("\\*" "\\*" bold nil 2)
 376            ("_" "_" underline)
 377            ("/" "/" italic)
 378            ("_/" "/_" underline-italic)
 379            ("_\\*" "\\*_" underline-bold)
 380            ("\\*/" "/\\*" bold-italic)
 381            ("_\\*/" "/\\*_" underline-bold-italic))))
 382     (nconc
 383      (gnus-emphasis-custom-with-format
 384       (mapcar (lambda (spec)
 385                 (list (format format (car spec) (cadr spec))
 386                       (or (nth 3 spec) 2)
 387                       (or (nth 4 spec) 3)
 388                       (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
 389               types))
 390      '(;; I've never seen anyone use this strikethru convention whereas I've
 391        ;; several times seen it triggered by normal text.  --Stef
 392        ;; Miles suggests that this form is sometimes used but for italics,
 393        ;; so maybe we should map it to `italic'.
 394        ;; ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
 395        ;; 2 3 gnus-emphasis-strikethru)
 396        ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
 397         2 3 gnus-emphasis-underline))))
 398   "*Alist that says how to fontify certain phrases.
 399 Each item looks like this:
 400
 401   (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
 402
 403 The first element is a regular expression to be matched.  The second
 404 is a number that says what regular expression grouping used to find
 405 the entire emphasized word.  The third is a number that says what
 406 regexp grouping should be displayed and highlighted.  The fourth
 407 is the face used for highlighting."
 408   :type
 409   '(repeat
 410     (menu-choice
 411      :format "%[Customizing Style%]\n%v"
 412      :indent 2
 413      (group :tag "Default"
 414             :value ("" 0 0 default)
 415             :value-create
 416             (lambda (widget)
 417               (let ((value (widget-get
 418                             (cadr (widget-get (widget-get widget :parent)
 419                                               :args))
 420                             :value)))
 421                 (if (not (eq (nth 2 value) 'default))
 422                     (widget-put
 423                      widget
 424                      :value
 425                      (gnus-emphasis-custom-value-to-external value))))
 426               (widget-group-value-create widget))
 427             regexp
 428             (integer :format "Match group: %v")
 429             (integer :format "Emphasize group: %v")
 430             face)
 431      (group :tag "Simple"
 432             :value (("_" . "_") nil default)
 433             (cons :format "%v"
 434                   (regexp :format "Start regexp: %v")
 435                   (regexp :format "End regexp: %v"))
 436             (boolean :format "Show start and end patterns: %[%v%]\n"
 437                      :on " On " :off " Off ")
 438             face)))
 439   :get (lambda (symbol)
 440          (mapcar 'gnus-emphasis-custom-value-to-internal
 441                  (default-value symbol)))
 442   :set (lambda (symbol value)
 443          (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
 444                                      value)))
 445   :group 'gnus-article-emphasis)
 446
 447 (defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
 448   "A regexp to describe whitespace which should not be emphasized.
 449 Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
 450 The former avoids underlining of leading and trailing whitespace,
 451 and the latter avoids underlining any whitespace at all."
 452   :version "21.1"
 453   :group 'gnus-article-emphasis
 454   :type 'regexp)
 455
 456 (defface gnus-emphasis-bold '((t (:bold t)))
 457   "Face used for displaying strong emphasized text (*word*)."
 458   :group 'gnus-article-emphasis)
 459
 460 (defface gnus-emphasis-italic '((t (:italic t)))
 461   "Face used for displaying italic emphasized text (/word/)."
 462   :group 'gnus-article-emphasis)
 463
 464 (defface gnus-emphasis-underline '((t (:underline t)))
 465   "Face used for displaying underlined emphasized text (_word_)."
 466   :group 'gnus-article-emphasis)
 467
 468 (defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
 469   "Face used for displaying underlined bold emphasized text (_*word*_)."
 470   :group 'gnus-article-emphasis)
 471
 472 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
 473   "Face used for displaying underlined italic emphasized text (_/word/_)."
 474   :group 'gnus-article-emphasis)
 475
 476 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
 477   "Face used for displaying bold italic emphasized text (/*word*/)."
 478   :group 'gnus-article-emphasis)
 479
 480 (defface gnus-emphasis-underline-bold-italic
 481   '((t (:bold t :italic t :underline t)))
 482   "Face used for displaying underlined bold italic emphasized text.
 483 Example: (_/*word*/_)."
 484   :group 'gnus-article-emphasis)
 485
 486 (defface gnus-emphasis-strikethru (if (featurep 'xemacs)
 487                                       '((t (:strikethru t)))
 488                                     '((t (:strike-through t))))
 489   "Face used for displaying strike-through text (-word-)."
 490   :group 'gnus-article-emphasis)
 491
 492 (defface gnus-emphasis-highlight-words
 493   '((t (:background "black" :foreground "yellow")))
 494   "Face used for displaying highlighted words."
 495   :group 'gnus-article-emphasis)
 496
 497 (defcustom gnus-article-time-format "%a, %d %b %Y %T %Z"
 498   "Format for display of Date headers in article bodies.
 499 See `format-time-string' for the possible values.
 500
 501 The variable can also be function, which should return a complete Date
 502 header.  The function is called with one argument, the time, which can
 503 be fed to `format-time-string'."
 504   :type '(choice string function)
 505   :link '(custom-manual "(gnus)Article Date")
 506   :group 'gnus-article-washing)
 507
 508 (defcustom gnus-save-all-headers t
 509   "*If non-nil, don't remove any headers before saving.
 510 This will be overridden by the `:headers' property that the symbol of
 511 the saver function, which is specified by `gnus-default-article-saver',
 512 might have."
 513   :group 'gnus-article-saving
 514   :type 'boolean)
 515
 516 (defcustom gnus-prompt-before-saving 'always
 517   "*This variable says how much prompting is to be done when saving articles.
 518 If it is nil, no prompting will be done, and the articles will be
 519 saved to the default files.  If this variable is `always', each and
 520 every article that is saved will be preceded by a prompt, even when
 521 saving large batches of articles.  If this variable is neither nil not
 522 `always', there the user will be prompted once for a file name for
 523 each invocation of the saving commands."
 524   :group 'gnus-article-saving
 525   :type '(choice (item always)
 526                  (item :tag "never" nil)
 527                  (sexp :tag "once" :format "%t\n" :value t)))
 528
 529 (defcustom gnus-saved-headers gnus-visible-headers
 530   "Headers to keep if `gnus-save-all-headers' is nil.
 531 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
 532 If that variable is nil, however, all headers that match this regexp
 533 will be kept while the rest will be deleted before saving.  This and
 534 `gnus-save-all-headers' will be overridden by the `:headers' property
 535 that the symbol of the saver function, which is specified by
 536 `gnus-default-article-saver', might have."
 537   :group 'gnus-article-saving
 538   :type 'regexp)
 539
 540 ;; Note that "Rmail format" is mbox since Emacs 23, but Babyl before.
 541 (defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
 542   "A function to save articles in your favorite format.
 543 The function will be called by way of the `gnus-summary-save-article'
 544 command, and friends such as `gnus-summary-save-article-rmail'.
 545
 546 Gnus provides the following functions:
 547
 548 * gnus-summary-save-in-rmail (Rmail format)
 549 * gnus-summary-save-in-mail (Unix mail format)
 550 * gnus-summary-save-in-folder (MH folder)
 551 * gnus-summary-save-in-file (article format)
 552 * gnus-summary-save-body-in-file (article body)
 553 * gnus-summary-save-in-vm (use VM's folder format)
 554 * gnus-summary-write-to-file (article format -- overwrite)
 555 * gnus-summary-write-body-to-file (article body -- overwrite)
 556 * gnus-summary-save-in-pipe (article format)
 557
 558 The symbol of each function may have the following properties:
 559
 560 * :decode
 561 The value non-nil means save decoded articles.  This is meaningful
 562 only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
 563 `gnus-summary-write-to-file', `gnus-summary-write-body-to-file', and
 564 `gnus-summary-save-in-pipe'.
 565
 566 * :function
 567 The value specifies an alternative function which appends, not
 568 overwrites, articles to a file.  This implies that when saving many
 569 articles at a time, `gnus-prompt-before-saving' is bound to t and all
 570 articles are saved in a single file.  This is meaningful only with
 571 `gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'.
 572
 573 * :headers
 574 The value specifies the symbol of a variable of which the value
 575 specifies headers to be saved.  If it is omitted,
 576 `gnus-save-all-headers' and `gnus-saved-headers' control what
 577 headers should be saved."
 578   :group 'gnus-article-saving
 579   :type '(radio (function-item gnus-summary-save-in-rmail)
 580                 (function-item gnus-summary-save-in-mail)
 581                 (function-item gnus-summary-save-in-folder)
 582                 (function-item gnus-summary-save-in-file)
 583                 (function-item gnus-summary-save-body-in-file)
 584                 (function-item gnus-summary-save-in-vm)
 585                 (function-item gnus-summary-write-to-file)
 586                 (function-item gnus-summary-write-body-to-file)
 587                 (function-item gnus-summary-save-in-pipe)
 588                 (function)))
 589
 590 (defcustom gnus-article-save-coding-system
 591   (or (and (mm-coding-system-p 'utf-8) 'utf-8)
 592       (and (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit)
 593       (and (mm-coding-system-p 'emacs-mule) 'emacs-mule)
 594       (and (mm-coding-system-p 'escape-quoted) 'escape-quoted))
 595   "Coding system used to save decoded articles to a file.
 596
 597 The recommended coding systems are `utf-8', `iso-2022-7bit' and so on,
 598 which can safely encode any characters in text.  This is used by the
 599 commands including:
 600
 601 * gnus-summary-save-article-file
 602 * gnus-summary-save-article-body-file
 603 * gnus-summary-write-article-file
 604 * gnus-summary-write-article-body-file
 605
 606 and the functions to which you may set `gnus-default-article-saver':
 607
 608 * gnus-summary-save-in-file
 609 * gnus-summary-save-body-in-file
 610 * gnus-summary-write-to-file
 611 * gnus-summary-write-body-to-file
 612
 613 Those commands and functions save just text displayed in the article
 614 buffer to a file if the value of this variable is non-nil.  Note that
 615 buttonized MIME parts will be lost in a saved file in that case.
 616 Otherwise, raw articles will be saved."
 617   :group 'gnus-article-saving
 618   :type `(choice
 619           :format "%{%t%}:\n %[Value Menu%] %v"
 620           (const :tag "Save raw articles" nil)
 621           ,@(delq nil
 622                   (mapcar
 623                    (lambda (arg) (if (mm-coding-system-p (nth 3 arg)) arg))
 624                    '((const :tag "UTF-8" utf-8)
 625                      (const :tag "iso-2022-7bit" iso-2022-7bit)
 626                      (const :tag "Emacs internal" emacs-mule)
 627                      (const :tag "escape-quoted" escape-quoted))))
 628           (symbol :tag "Coding system")))
 629
 630 (defcustom gnus-rmail-save-name 'gnus-plain-save-name
 631   "A function generating a file name to save articles in Rmail format.
 632 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 633   :group 'gnus-article-saving
 634   :type 'function)
 635
 636 (defcustom gnus-mail-save-name 'gnus-plain-save-name
 637   "A function generating a file name to save articles in Unix mail format.
 638 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
 639   :group 'gnus-article-saving
 640   :type 'function)
 641
 642 (defcustom gnus-folder-save-name 'gnus-folder-save-name
 643   "A function generating a file name to save articles in MH folder.
 644 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
 645   :group 'gnus-article-saving
 646   :type 'function)
 647
 648 (defcustom gnus-file-save-name 'gnus-numeric-save-name
 649   "A function generating a file name to save articles in article format.
 650 The function is called with NEWSGROUP, HEADERS, and optional
 651 LAST-FILE."
 652   :group 'gnus-article-saving
 653   :type 'function)
 654
 655 (defcustom gnus-split-methods
 656   '((gnus-article-archive-name)
 657     (gnus-article-nndoc-name))
 658   "*Variable used to suggest where articles are to be saved.
 659 For instance, if you would like to save articles related to Gnus in
 660 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
 661 you could set this variable to something like:
 662
 663  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
 664    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
 665
 666 This variable is an alist where the key is the match and the
 667 value is a list of possible files to save in if the match is
 668 non-nil.
 669
 670 If the match is a string, it is used as a regexp match on the
 671 article.  If the match is a symbol, that symbol will be funcalled
 672 from the buffer of the article to be saved with the newsgroup as the
 673 parameter.  If it is a list, it will be evalled in the same buffer.
 674
 675 If this form or function returns a string, this string will be used as a
 676 possible file name; and if it returns a non-nil list, that list will be
 677 used as possible file names."
 678   :group 'gnus-article-saving
 679   :type '(repeat (choice (list :value (fun) function)
 680                          (cons :value ("" "") regexp (repeat string))
 681                          (sexp :value nil))))
 682
 683 (defcustom gnus-page-delimiter "^\^L"
 684   "*Regexp describing what to use as article page delimiters.
 685 The default value is \"^\^L\", which is a form linefeed at the
 686 beginning of a line."
 687   :type 'regexp
 688   :group 'gnus-article-various)
 689
 690 (defcustom gnus-article-mode-line-format "Gnus: %g %S%m"
 691   "*The format specification for the article mode line.
 692 See `gnus-summary-mode-line-format' for a closer description.
 693
 694 The following additional specs are available:
 695
 696 %w  The article washing status.
 697 %m  The number of MIME parts in the article."
 698   :version "24.1"
 699   :type 'string
 700   :group 'gnus-article-various)
 701
 702 (defcustom gnus-article-mode-hook nil
 703   "*A hook for Gnus article mode."
 704   :type 'hook
 705   :group 'gnus-article-various)
 706
 707 (when (featurep 'xemacs)
 708   ;; Extracted from gnus-xmas-define in order to preserve user settings
 709   (when (fboundp 'turn-off-scroll-in-place)
 710     (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
 711   ;; Extracted from gnus-xmas-redefine in order to preserve user settings
 712   (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
 713
 714 (defcustom gnus-article-menu-hook nil
 715   "*Hook run after the creation of the article mode menu."
 716   :type 'hook
 717   :group 'gnus-article-various)
 718
 719 (defcustom gnus-article-prepare-hook nil
 720   "*A hook called after an article has been prepared in the article buffer."
 721   :type 'hook
 722   :group 'gnus-article-various)
 723
 724 (defcustom gnus-copy-article-ignored-headers nil
 725   "List of headers to be removed when copying an article.
 726 Each element is a regular expression."
 727   :version "23.1" ;; No Gnus
 728   :type '(repeat regexp)
 729   :group 'gnus-article-various)
 730
 731 (make-obsolete-variable 'gnus-article-hide-pgp-hook nil
 732                         "Gnus 5.10 (Emacs 22.1)")
 733
 734 (defface gnus-button
 735   '((t (:weight bold)))
 736   "Face used for highlighting a button in the article buffer."
 737   :group 'gnus-article-buttons)
 738
 739 (defcustom gnus-article-button-face 'gnus-button
 740   "Face used for highlighting buttons in the article buffer.
 741
 742 An article button is a piece of text that you can activate by pressing
 743 `RET' or `mouse-2' above it."
 744   :type 'face
 745   :group 'gnus-article-buttons)
 746
 747 (defcustom gnus-article-mouse-face 'highlight
 748   "Face used for mouse highlighting in the article buffer.
 749
 750 Article buttons will be displayed in this face when the cursor is
 751 above them."
 752   :type 'face
 753   :group 'gnus-article-buttons)
 754
 755 (defcustom gnus-signature-face 'gnus-signature
 756   "Face used for highlighting a signature in the article buffer.
 757 Obsolete; use the face `gnus-signature' for customizations instead."
 758   :type 'face
 759   :group 'gnus-article-highlight
 760   :group 'gnus-article-signature)
 761
 762 (defface gnus-signature
 763   '((t
 764      (:italic t)))
 765   "Face used for highlighting a signature in the article buffer."
 766   :group 'gnus-article-highlight
 767   :group 'gnus-article-signature)
 768 ;; backward-compatibility alias
 769 (put 'gnus-signature-face 'face-alias 'gnus-signature)
 770 (put 'gnus-signature-face 'obsolete-face "22.1")
 771
 772 (defface gnus-header-from
 773   '((((class color)
 774       (background dark))
 775      (:foreground "PaleGreen1"))
 776     (((class color)
 777       (background light))
 778      (:foreground "red3"))
 779     (t
 780      (:italic t)))
 781   "Face used for displaying from headers."
 782   :group 'gnus-article-headers
 783   :group 'gnus-article-highlight)
 784 ;; backward-compatibility alias
 785 (put 'gnus-header-from-face 'face-alias 'gnus-header-from)
 786 (put 'gnus-header-from-face 'obsolete-face "22.1")
 787
 788 (defface gnus-header-subject
 789   '((((class color)
 790       (background dark))
 791      (:foreground "SeaGreen1"))
 792     (((class color)
 793       (background light))
 794      (:foreground "red4"))
 795     (t
 796      (:bold t :italic t)))
 797   "Face used for displaying subject headers."
 798   :group 'gnus-article-headers
 799   :group 'gnus-article-highlight)
 800 ;; backward-compatibility alias
 801 (put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
 802 (put 'gnus-header-subject-face 'obsolete-face "22.1")
 803
 804 (defface gnus-header-newsgroups
 805   '((((class color)
 806       (background dark))
 807      (:foreground "yellow" :italic t))
 808     (((class color)
 809       (background light))
 810      (:foreground "MidnightBlue" :italic t))
 811     (t
 812      (:italic t)))
 813   "Face used for displaying newsgroups headers.
 814 In the default setup this face is only used for crossposted
 815 articles."
 816   :group 'gnus-article-headers
 817   :group 'gnus-article-highlight)
 818 ;; backward-compatibility alias
 819 (put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
 820 (put 'gnus-header-newsgroups-face 'obsolete-face "22.1")
 821
 822 (defface gnus-header-name
 823   '((((class color)
 824       (background dark))
 825      (:foreground "SpringGreen2"))
 826     (((class color)
 827       (background light))
 828      (:foreground "maroon"))
 829     (t
 830      (:bold t)))
 831   "Face used for displaying header names."
 832   :group 'gnus-article-headers
 833   :group 'gnus-article-highlight)
 834 ;; backward-compatibility alias
 835 (put 'gnus-header-name-face 'face-alias 'gnus-header-name)
 836 (put 'gnus-header-name-face 'obsolete-face "22.1")
 837
 838 (defface gnus-header-content
 839   '((((class color)
 840       (background dark))
 841      (:foreground "SpringGreen1" :italic t))
 842     (((class color)
 843       (background light))
 844      (:foreground "indianred4" :italic t))
 845     (t
 846      (:italic t)))  "Face used for displaying header content."
 847   :group 'gnus-article-headers
 848   :group 'gnus-article-highlight)
 849 ;; backward-compatibility alias
 850 (put 'gnus-header-content-face 'face-alias 'gnus-header-content)
 851 (put 'gnus-header-content-face 'obsolete-face "22.1")
 852
 853 (defcustom gnus-header-face-alist
 854   '(("From" nil gnus-header-from)
 855     ("Subject" nil gnus-header-subject)
 856     ("Newsgroups:.*," nil gnus-header-newsgroups)
 857     ("" gnus-header-name gnus-header-content))
 858   "*Controls highlighting of article headers.
 859
 860 An alist of the form (HEADER NAME CONTENT).
 861
 862 HEADER is a regular expression which should match the name of a
 863 header and NAME and CONTENT are either face names or nil.
 864
 865 The name of each header field will be displayed using the face
 866 specified by the first element in the list where HEADER matches
 867 the header name and NAME is non-nil.  Similarly, the content will
 868 be displayed by the first non-nil matching CONTENT face."
 869   :group 'gnus-article-headers
 870   :group 'gnus-article-highlight
 871   :type '(repeat (list (regexp :tag "Header")
 872                        (choice :tag "Name"
 873                                (item :tag "skip" nil)
 874                                (face :value default))
 875                        (choice :tag "Content"
 876                                (item :tag "skip" nil)
 877                                (face :value default)))))
 878
 879 (defcustom gnus-face-properties-alist (if (featurep 'xemacs)
 880                                           '((xface . (:face gnus-x-face)))
 881                                         '((pbm . (:face gnus-x-face))
 882                                           (png . nil)))
 883   "Alist of image types and properties applied to Face and X-Face images.
 884 Here are examples:
 885
 886 ;; Specify the altitude of Face images in the From header.
 887 \(setq gnus-face-properties-alist
 888       '((pbm . (:face gnus-x-face :ascent 80))
 889         (png . (:ascent 80))))
 890
 891 ;; Show Face images as pressed buttons.
 892 \(setq gnus-face-properties-alist
 893       '((pbm . (:face gnus-x-face :relief -2))
 894         (png . (:relief -2))))
 895
 896 See the manual for the valid properties for various image types.
 897 Currently, `pbm' is used for X-Face images and `png' is used for Face
 898 images in Emacs.  Only the `:face' property is effective on the `xface'
 899 image type in XEmacs if it is built with the libcompface library."
 900   :version "23.1" ;; No Gnus
 901   :group 'gnus-article-headers
 902   :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
 903
 904 (defcustom gnus-article-decode-hook
 905   '(article-decode-charset article-decode-encoded-words
 906                            article-decode-group-name article-decode-idna-rhs)
 907   "*Hook run to decode charsets in articles."
 908   :group 'gnus-article-headers
 909   :type 'hook)
 910
 911 (defcustom gnus-display-mime-function 'gnus-display-mime
 912   "Function to display MIME articles."
 913   :group 'gnus-article-mime
 914   :type 'function)
 915
 916 (defvar gnus-decode-header-function 'mail-decode-encoded-word-region
 917   "Function used to decode headers.")
 918
 919 (defvar gnus-decode-address-function 'mail-decode-encoded-address-region
 920   "Function used to decode addresses.")
 921
 922 (defvar gnus-article-dumbquotes-map
 923   '((?\200 "EUR")
 924     (?\202 ",")
 925     (?\203 "f")
 926     (?\204 ",,")
 927     (?\205 "...")
 928     (?\213 "<")
 929     (?\214 "OE")
 930     (?\221 "`")
 931     (?\222 "'")
 932     (?\223 "``")
 933     (?\224 "\"")
 934     (?\225 "*")
 935     (?\226 "-")
 936     (?\227 "--")
 937     (?\230 "~")
 938     (?\231 "(TM)")
 939     (?\233 ">")
 940     (?\234 "oe")
 941     (?\264 "'"))
 942   "Table for MS-to-Latin1 translation.")
 943
 944 (defcustom gnus-ignored-mime-types nil
 945   "List of MIME types that should be ignored by Gnus."
 946   :version "21.1"
 947   :group 'gnus-article-mime
 948   :type '(repeat regexp))
 949
 950 (defcustom gnus-unbuttonized-mime-types '(".*/.*")
 951   "List of MIME types that should not be given buttons when rendered inline.
 952 See also `gnus-buttonized-mime-types' which may override this variable.
 953 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 954   :version "21.1"
 955   :group 'gnus-article-mime
 956   :type '(repeat regexp))
 957
 958 (defcustom gnus-buttonized-mime-types nil
 959   "List of MIME types that should be given buttons when rendered inline.
 960 If set, this variable overrides `gnus-unbuttonized-mime-types'.
 961 To see e.g. security buttons you could set this to
 962 `(\"multipart/signed\")'.  You could also add \"multipart/alternative\" to
 963 this list to display radio buttons that allow you to choose one of two
 964 media types those mails include.  See also `mm-discouraged-alternatives'.
 965 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 966   :version "22.1"
 967   :group 'gnus-article-mime
 968   :type '(repeat regexp))
 969
 970 (defcustom gnus-inhibit-mime-unbuttonizing nil
 971   "If non-nil, all MIME parts get buttons.
 972 When nil (the default value), then some MIME parts do not get buttons,
 973 as described by the variables `gnus-buttonized-mime-types' and
 974 `gnus-unbuttonized-mime-types'."
 975   :version "22.1"
 976   :group 'gnus-article-mime
 977   :type 'boolean)
 978
 979 (defcustom gnus-body-boundary-delimiter "_"
 980   "String used to delimit header and body.
 981 This variable is used by `gnus-article-treat-body-boundary' which can
 982 be controlled by `gnus-treat-body-boundary'."
 983   :version "22.1"
 984   :group 'gnus-article-various
 985   :type '(choice (item :tag "None" :value nil)
 986                  string))
 987
 988 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
 989                                   "/usr/share/picons")
 990   "Defines the location of the faces database.
 991 For information on obtaining this database of pretty pictures, please
 992 see http://www.cs.indiana.edu/picons/ftp/index.html"
 993   :version "22.1"
 994   :type '(repeat directory)
 995   :link '(url-link :tag "download"
 996                    "http://www.cs.indiana.edu/picons/ftp/index.html")
 997   :link '(custom-manual "(gnus)Picons")
 998   :group 'gnus-picon)
 999
1000 (defun gnus-picons-installed-p ()
1001   "Say whether picons are installed on your machine."
1002   (let ((installed nil))
1003     (dolist (database gnus-picon-databases)
1004       (when (file-exists-p database)
1005         (setq installed t)))
1006     installed))
1007
1008 (defcustom gnus-article-mime-part-function nil
1009   "Function called with a MIME handle as the argument.
1010 This is meant for people who want to do something automatic based
1011 on parts -- for instance, adding Vcard info to a database."
1012   :group 'gnus-article-mime
1013   :type '(choice (const nil)
1014                  function))
1015
1016 (defcustom gnus-mime-multipart-functions nil
1017   "An alist of MIME types to functions to display them."
1018   :version "21.1"
1019   :group 'gnus-article-mime
1020   :type '(repeat (cons :format "%v" (string :tag "MIME type") function)))
1021
1022 (defcustom gnus-article-date-headers '(combined-lapsed)
1023   "A list of Date header formats to display.
1024 Valid formats are `ut' (universal time), `local' (local time
1025 zone), `english' (readable English), `lapsed' (elapsed time),
1026 `combined-lapsed' (both the original date and the elapsed time),
1027 `original' (the original date header), `iso8601' (ISO8601
1028 format), and `user-defined' (a user-defined format defined by the
1029 `gnus-article-time-format' variable).
1030
1031 You have as many date headers as you want in the article buffer.
1032 Some of these headers are updated automatically.  See
1033 `gnus-article-update-date-headers' for details."
1034   :version "24.1"
1035   :group 'gnus-article-headers
1036   :type '(set
1037           (const :tag "Universal time (UT)" ut)
1038           (const :tag "Local time zone" local)
1039           (const :tag "Readable English" english)
1040           (const :tag "Elapsed time" lapsed)
1041           (const :tag "Original and elapsed time" combined-lapsed)
1042           (const :tag "Original date header" original)
1043           (const :tag "ISO8601 format" iso8601)
1044           (const :tag "User-defined" user-defined)))
1045
1046 (defcustom gnus-article-update-date-headers nil
1047   "A number that says how often to update the date header (in seconds).
1048 If nil, don't update it at all."
1049   :version "24.1"
1050   :group 'gnus-article-headers
1051   :type '(choice
1052           (item :tag "Don't update" :value nil)
1053           integer))
1054
1055 (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
1056   "Function called with a MIME handle as the argument.
1057 This is meant for people who want to view first matched part.
1058 For `undisplayed-alternative' (default), the first undisplayed
1059 part or alternative part is used.  For `undisplayed', the first
1060 undisplayed part is used.  For a function, the first part which
1061 the function return t is used.  For nil, the first part is
1062 used."
1063   :version "21.1"
1064   :group 'gnus-article-mime
1065   :type '(choice
1066           (item :tag "first" :value nil)
1067           (item :tag "undisplayed" :value undisplayed)
1068           (item :tag "undisplayed or alternative"
1069                 :value undisplayed-alternative)
1070           (function)))
1071
1072 (defcustom gnus-mime-action-alist
1073   '(("save to file" . gnus-mime-save-part)
1074     ("save and strip" . gnus-mime-save-part-and-strip)
1075     ("replace with file" . gnus-mime-replace-part)
1076     ("delete part" . gnus-mime-delete-part)
1077     ("display as text" . gnus-mime-inline-part)
1078     ("view the part" . gnus-mime-view-part)
1079     ("pipe to command" . gnus-mime-pipe-part)
1080     ("toggle display" . gnus-article-press-button)
1081     ("toggle display" . gnus-article-view-part-as-charset)
1082     ("view as type" . gnus-mime-view-part-as-type)
1083     ("view internally" . gnus-mime-view-part-internally)
1084     ("view externally" . gnus-mime-view-part-externally))
1085   "An alist of actions that run on the MIME attachment."
1086   :group 'gnus-article-mime
1087   :type '(repeat (cons (string :tag "name")
1088                        (function))))
1089
1090 (defcustom gnus-auto-select-part 1
1091   "Advance to next MIME part when deleting or stripping parts.
1092
1093 When 0, point will be placed on the same part as before.  When
1094 positive (negative), move point forward (backwards) this many
1095 parts.  When nil, redisplay article."
1096   :version "23.1" ;; No Gnus
1097   :group 'gnus-article-mime
1098   :type '(choice (const nil :tag "Redisplay article.")
1099                  (const 1 :tag "Next part.")
1100                  (const 0 :tag "Current part.")
1101                  integer))
1102
1103 ;;;
1104 ;;; The treatment variables
1105 ;;;
1106
1107 (defvar gnus-part-display-hook nil
1108   "Hook called on parts that are to receive treatment.")
1109
1110 (defvar gnus-article-treat-custom
1111   '(choice (const :tag "Off" nil)
1112            (const :tag "On" t)
1113            (const :tag "Header" head)
1114            (const :tag "First" first)
1115            (const :tag "Last" last)
1116            (integer :tag "Less")
1117            (repeat :tag "Groups" regexp)
1118            (sexp :tag "Predicate")))
1119
1120 (defvar gnus-article-treat-head-custom
1121   '(choice (const :tag "Off" nil)
1122            (const :tag "Header" head)))
1123
1124 (defvar gnus-article-treat-types '("text/plain" "text/x-verbatim"
1125                                    "text/x-patch" "text/html")
1126   "Part types eligible for treatment.")
1127
1128 (defvar gnus-inhibit-treatment nil
1129   "Whether to inhibit treatment.")
1130
1131 (defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
1132   "Highlight the signature.
1133 Valid values are nil, t, `head', `first', `last', an integer or a
1134 predicate.  See Info node `(gnus)Customizing Articles'."
1135   :group 'gnus-article-treat
1136   :link '(custom-manual "(gnus)Customizing Articles")
1137   :type gnus-article-treat-custom)
1138 (put 'gnus-treat-highlight-signature 'highlight t)
1139
1140 (defcustom gnus-treat-buttonize 100000
1141   "Add buttons.
1142 Valid values are nil, t, `head', `first', `last', an integer or a
1143 predicate.  See Info node `(gnus)Customizing Articles'."
1144   :group 'gnus-article-treat
1145   :link '(custom-manual "(gnus)Customizing Articles")
1146   :type gnus-article-treat-custom)
1147 (put 'gnus-treat-buttonize 'highlight t)
1148
1149 (defcustom gnus-treat-buttonize-head 'head
1150   "Add buttons to the head.
1151 Valid values are nil, t, `head', `first', `last', an integer or a
1152 predicate.  See Info node `(gnus)Customizing Articles'."
1153   :group 'gnus-article-treat
1154   :link '(custom-manual "(gnus)Customizing Articles")
1155   :type gnus-article-treat-head-custom)
1156 (put 'gnus-treat-buttonize-head 'highlight t)
1157
1158 (defcustom gnus-treat-date 'head
1159   "Display dates according to the `gnus-article-date-headers' variable.
1160 Valid values are nil, t, `head', `first', `last', an integer or a
1161 predicate.  See Info node `(gnus)Customizing Articles'."
1162   :version "24.1"
1163   :group 'gnus-article-treat
1164   :link '(custom-manual "(gnus)Customizing Articles")
1165   :type gnus-article-treat-head-custom)
1166
1167 (defcustom gnus-treat-emphasize 50000
1168   "Emphasize text.
1169 Valid values are nil, t, `head', `first', `last', an integer or a
1170 predicate.  See Info node `(gnus)Customizing Articles'."
1171   :group 'gnus-article-treat
1172   :link '(custom-manual "(gnus)Customizing Articles")
1173   :type gnus-article-treat-custom)
1174 (put 'gnus-treat-emphasize 'highlight t)
1175
1176 (defcustom gnus-treat-strip-cr nil
1177   "Remove carriage returns.
1178 Valid values are nil, t, `head', `first', `last', an integer or a
1179 predicate.  See Info node `(gnus)Customizing Articles'."
1180   :version "22.1"
1181   :group 'gnus-article-treat
1182   :link '(custom-manual "(gnus)Customizing Articles")
1183   :type gnus-article-treat-custom)
1184
1185 (defcustom gnus-treat-unsplit-urls nil
1186   "Remove newlines from within URLs.
1187 Valid values are nil, t, `head', `first', `last', an integer or a
1188 predicate.  See Info node `(gnus)Customizing Articles'."
1189   :version "22.1"
1190   :group 'gnus-article-treat
1191   :link '(custom-manual "(gnus)Customizing Articles")
1192   :type gnus-article-treat-custom)
1193
1194 (defcustom gnus-treat-leading-whitespace nil
1195   "Remove leading whitespace in headers.
1196 Valid values are nil, t, `head', `first', `last', an integer or a
1197 predicate.  See Info node `(gnus)Customizing Articles'."
1198   :version "22.1"
1199   :group 'gnus-article-treat
1200   :link '(custom-manual "(gnus)Customizing Articles")
1201   :type gnus-article-treat-custom)
1202
1203 (defcustom gnus-treat-hide-headers 'head
1204   "Hide headers.
1205 Valid values are nil, t, `head', `first', `last', an integer or a
1206 predicate.  See Info node `(gnus)Customizing Articles'."
1207   :group 'gnus-article-treat
1208   :link '(custom-manual "(gnus)Customizing Articles")
1209   :type gnus-article-treat-head-custom)
1210
1211 (defcustom gnus-treat-hide-boring-headers nil
1212   "Hide boring headers.
1213 Valid values are nil, t, `head', `first', `last', an integer or a
1214 predicate.  See Info node `(gnus)Customizing Articles'."
1215   :group 'gnus-article-treat
1216   :link '(custom-manual "(gnus)Customizing Articles")
1217   :type gnus-article-treat-head-custom)
1218
1219 (defcustom gnus-treat-hide-signature nil
1220   "Hide the signature.
1221 Valid values are nil, t, `head', `first', `last', an integer or a
1222 predicate.  See Info node `(gnus)Customizing Articles'."
1223   :group 'gnus-article-treat
1224   :link '(custom-manual "(gnus)Customizing Articles")
1225   :type gnus-article-treat-custom)
1226
1227 (defcustom gnus-treat-fill-article nil
1228   "Fill the article.
1229 Valid values are nil, t, `head', `first', `last', an integer or a
1230 predicate.  See Info node `(gnus)Customizing Articles'."
1231   :group 'gnus-article-treat
1232   :link '(custom-manual "(gnus)Customizing Articles")
1233   :type gnus-article-treat-custom)
1234
1235 (defcustom gnus-treat-hide-citation nil
1236   "Hide cited text.
1237 Valid values are nil, t, `head', `first', `last', an integer or a
1238 predicate.  See Info node `(gnus)Customizing Articles'.
1239
1240 See `gnus-article-highlight-citation' for variables used to
1241 control what it hides."
1242   :group 'gnus-article-treat
1243   :link '(custom-manual "(gnus)Customizing Articles")
1244   :type gnus-article-treat-custom)
1245
1246 (defcustom gnus-treat-hide-citation-maybe nil
1247   "Hide cited text according to certain conditions.
1248 Valid values are nil, t, `head', `first', `last', an integer or a
1249 predicate.  See Info node `(gnus)Customizing Articles'.
1250
1251 See `gnus-cite-hide-percentage' and `gnus-cite-hide-absolute' for
1252 how to control what it hides."
1253   :group 'gnus-article-treat
1254   :link '(custom-manual "(gnus)Customizing Articles")
1255   :type gnus-article-treat-custom)
1256
1257 (defcustom gnus-treat-strip-list-identifiers 'head
1258   "Strip list identifiers from `gnus-list-identifiers`.
1259 Valid values are nil, t, `head', `first', `last', an integer or a
1260 predicate.  See Info node `(gnus)Customizing Articles'."
1261   :version "21.1"
1262   :group 'gnus-article-treat
1263   :link '(custom-manual "(gnus)Customizing Articles")
1264   :type gnus-article-treat-custom)
1265
1266 (gnus-define-group-parameter
1267  list-identifier
1268  :variable-document
1269  "Alist of regexps and correspondent identifiers."
1270  :variable-group gnus-article-washing
1271  :parameter-type
1272  '(choice :tag "Identifier"
1273           :value nil
1274           (symbol :tag "Item in `gnus-list-identifiers'" none)
1275           regexp
1276           (const :tag "None" nil))
1277  :parameter-document
1278  "If non-nil, specify how to remove `identifiers' from articles' subject.
1279
1280 Any symbol is used to look up a regular expression to match the
1281 banner in `gnus-list-identifiers'.  A string is used as a regular
1282 expression to match the identifier directly.")
1283
1284 (make-obsolete-variable 'gnus-treat-strip-pgp nil
1285                         "Gnus 5.10 (Emacs 22.1)")
1286
1287 (defcustom gnus-treat-strip-pem nil
1288   "Strip PEM signatures.
1289 Valid values are nil, t, `head', `first', `last', an integer or a
1290 predicate.  See Info node `(gnus)Customizing Articles'."
1291   :group 'gnus-article-treat
1292   :link '(custom-manual "(gnus)Customizing Articles")
1293   :type gnus-article-treat-custom)
1294
1295 (defcustom gnus-treat-strip-banner t
1296   "Strip banners from articles.
1297 The banner to be stripped is specified in the `banner' group parameter.
1298 Valid values are nil, t, `head', `first', `last', an integer or a
1299 predicate.  See Info node `(gnus)Customizing Articles'."
1300   :group 'gnus-article-treat
1301   :link '(custom-manual "(gnus)Customizing Articles")
1302   :type gnus-article-treat-custom)
1303
1304 (defcustom gnus-treat-highlight-headers 'head
1305   "Highlight the headers.
1306 Valid values are nil, t, `head', `first', `last', an integer or a
1307 predicate.  See Info node `(gnus)Customizing Articles'."
1308   :group 'gnus-article-treat
1309   :link '(custom-manual "(gnus)Customizing Articles")
1310   :type gnus-article-treat-head-custom)
1311 (put 'gnus-treat-highlight-headers 'highlight t)
1312
1313 (defcustom gnus-treat-highlight-citation t
1314   "Highlight cited text.
1315 Valid values are nil, t, `head', `first', `last', an integer or a
1316 predicate.  See Info node `(gnus)Customizing Articles'."
1317   :group 'gnus-article-treat
1318   :link '(custom-manual "(gnus)Customizing Articles")
1319   :type gnus-article-treat-custom)
1320 (put 'gnus-treat-highlight-citation 'highlight t)
1321
1322 (defcustom gnus-treat-strip-headers-in-body t
1323   "Strip the X-No-Archive header line from the beginning of the body.
1324 Valid values are nil, t, `head', `first', `last', an integer or a
1325 predicate.  See Info node `(gnus)Customizing Articles'."
1326   :version "21.1"
1327   :group 'gnus-article-treat
1328   :link '(custom-manual "(gnus)Customizing Articles")
1329   :type gnus-article-treat-custom)
1330
1331 (defcustom gnus-treat-strip-trailing-blank-lines nil
1332   "Strip trailing blank lines.
1333 Valid values are nil, t, `head', `first', `last', an integer or a
1334 predicate.  See Info node `(gnus)Customizing Articles'.
1335
1336 When set to t, it also strips trailing blanks in all MIME parts.
1337 Consider to use `last' instead."
1338   :group 'gnus-article-treat
1339   :link '(custom-manual "(gnus)Customizing Articles")
1340   :type gnus-article-treat-custom)
1341
1342 (defcustom gnus-treat-strip-leading-blank-lines nil
1343   "Strip leading blank lines.
1344 Valid values are nil, t, `head', `first', `last', an integer or a
1345 predicate.  See Info node `(gnus)Customizing Articles'.
1346
1347 When set to t, it also strips trailing blanks in all MIME parts."
1348   :group 'gnus-article-treat
1349   :link '(custom-manual "(gnus)Customizing Articles")
1350   :type gnus-article-treat-custom)
1351
1352 (defcustom gnus-treat-strip-multiple-blank-lines nil
1353   "Strip multiple blank lines.
1354 Valid values are nil, t, `head', `first', `last', an integer or a
1355 predicate.  See Info node `(gnus)Customizing Articles'."
1356   :group 'gnus-article-treat
1357   :link '(custom-manual "(gnus)Customizing Articles")
1358   :type gnus-article-treat-custom)
1359
1360 (defcustom gnus-treat-unfold-headers 'head
1361   "Unfold folded header lines.
1362 Valid values are nil, t, `head', `first', `last', an integer or a
1363 predicate.  See Info node `(gnus)Customizing Articles'."
1364   :version "22.1"
1365   :group 'gnus-article-treat
1366   :link '(custom-manual "(gnus)Customizing Articles")
1367   :type gnus-article-treat-custom)
1368
1369 (defcustom gnus-article-unfold-long-headers nil
1370   "If non-nil, allow unfolding headers even if the header is long.
1371 If it is a regexp, only long headers matching this regexp are unfolded.
1372 If it is t, all long headers are unfolded.
1373
1374 This variable has no effect if `gnus-treat-unfold-headers' is nil."
1375   :version "23.1" ;; No Gnus
1376   :group 'gnus-article-treat
1377   :type '(choice (const nil)
1378                  (const :tag "all" t)
1379                  (regexp)))
1380
1381 (defcustom gnus-treat-fold-headers nil
1382   "Fold headers.
1383 Valid values are nil, t, `head', `first', `last', an integer or a
1384 predicate.  See Info node `(gnus)Customizing Articles'."
1385   :version "22.1"
1386   :group 'gnus-article-treat
1387   :link '(custom-manual "(gnus)Customizing Articles")
1388   :type gnus-article-treat-custom)
1389
1390 (defcustom gnus-treat-fold-newsgroups 'head
1391   "Fold the Newsgroups and Followup-To headers.
1392 Valid values are nil, t, `head', `first', `last', an integer or a
1393 predicate.  See Info node `(gnus)Customizing Articles'."
1394   :version "22.1"
1395   :group 'gnus-article-treat
1396   :link '(custom-manual "(gnus)Customizing Articles")
1397   :type gnus-article-treat-custom)
1398
1399 (defcustom gnus-treat-overstrike t
1400   "Treat overstrike highlighting.
1401 Valid values are nil, t, `head', `first', `last', an integer or a
1402 predicate.  See Info node `(gnus)Customizing Articles'."
1403   :group 'gnus-article-treat
1404   :link '(custom-manual "(gnus)Customizing Articles")
1405   :type gnus-article-treat-custom)
1406 (put 'gnus-treat-overstrike 'highlight t)
1407
1408 (defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t)
1409   "Treat ANSI SGR control sequences.
1410 Valid values are nil, t, `head', `first', `last', an integer or a
1411 predicate.  See Info node `(gnus)Customizing Articles'."
1412   :group 'gnus-article-treat
1413   :link '(custom-manual "(gnus)Customizing Articles")
1414   :type gnus-article-treat-custom)
1415
1416 (make-obsolete-variable 'gnus-treat-display-xface
1417                         'gnus-treat-display-x-face "Emacs 22.1")
1418
1419 (defcustom gnus-treat-display-x-face
1420   (and (not noninteractive)
1421        (gnus-image-type-available-p 'xbm)
1422        (if (featurep 'xemacs)
1423            (featurep 'xface)
1424          (condition-case nil
1425              (and (string-match "^0x" (shell-command-to-string "uncompface"))
1426                   (executable-find "icontopbm"))
1427            ;; shell-command-to-string may signal an error, e.g. if
1428            ;; shell-file-name is not found.
1429            (error nil)))
1430        'head)
1431   "Display X-Face headers.
1432 Valid values are nil and `head'.
1433 See Info node `(gnus)Customizing Articles' and Info node
1434 `(gnus)X-Face' for details."
1435   :group 'gnus-article-treat
1436   :version "21.1"
1437   :link '(custom-manual "(gnus)Customizing Articles")
1438   :link '(custom-manual "(gnus)X-Face")
1439   :type gnus-article-treat-head-custom
1440   :set (lambda (symbol value)
1441          (set-default
1442           symbol
1443           (cond ((or (boundp symbol) (get symbol 'saved-value))
1444                  value)
1445                 ((boundp 'gnus-treat-display-xface)
1446                  (message "\
1447 ** gnus-treat-display-xface is an obsolete variable;\
1448  use gnus-treat-display-x-face instead")
1449                  (default-value 'gnus-treat-display-xface))
1450                 ((get 'gnus-treat-display-xface 'saved-value)
1451                  (message "\
1452 ** gnus-treat-display-xface is an obsolete variable;\
1453  use gnus-treat-display-x-face instead")
1454                  (eval (car (get 'gnus-treat-display-xface 'saved-value))))
1455                 (t
1456                  value)))))
1457 (put 'gnus-treat-display-x-face 'highlight t)
1458
1459 (defcustom gnus-treat-display-face
1460   (and (not noninteractive)
1461        (gnus-image-type-available-p 'png)
1462        'head)
1463   "Display Face headers.
1464 Valid values are nil, t, `head', `first', `last', an integer or a
1465 predicate.  See Info node `(gnus)Customizing Articles' and Info
1466 node `(gnus)Face' for details."
1467   :group 'gnus-article-treat
1468   :version "22.1"
1469   :link '(custom-manual "(gnus)Customizing Articles")
1470   :link '(custom-manual "(gnus)X-Face")
1471   :type gnus-article-treat-head-custom)
1472 (put 'gnus-treat-display-face 'highlight t)
1473
1474 (defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm)
1475   "Display smileys.
1476 Valid values are nil, t, `head', `first', `last', an integer or a
1477 predicate.  See Info node `(gnus)Customizing Articles' and Info
1478 node `(gnus)Smileys' for details."
1479   :group 'gnus-article-treat
1480   :version "21.1"
1481   :link '(custom-manual "(gnus)Customizing Articles")
1482   :link '(custom-manual "(gnus)Smileys")
1483   :type gnus-article-treat-custom)
1484 (put 'gnus-treat-display-smileys 'highlight t)
1485
1486 (defcustom gnus-treat-from-picon
1487   (if (and (gnus-image-type-available-p 'xpm)
1488            (gnus-picons-installed-p))
1489       'head nil)
1490   "Display picons in the From header.
1491 Valid values are nil, t, `head', `first', `last', an integer or a
1492 predicate.  See Info node `(gnus)Customizing Articles' and Info
1493 node `(gnus)Picons' for details."
1494   :version "22.1"
1495   :group 'gnus-article-treat
1496   :group 'gnus-picon
1497   :link '(custom-manual "(gnus)Customizing Articles")
1498   :link '(custom-manual "(gnus)Picons")
1499   :type gnus-article-treat-head-custom)
1500 (put 'gnus-treat-from-picon 'highlight t)
1501
1502 (defcustom gnus-treat-mail-picon
1503   (if (and (gnus-image-type-available-p 'xpm)
1504            (gnus-picons-installed-p))
1505       'head nil)
1506   "Display picons in To and Cc headers.
1507 Valid values are nil, t, `head', `first', `last', an integer or a
1508 predicate.  See Info node `(gnus)Customizing Articles' and Info
1509 node `(gnus)Picons' for details."
1510   :version "22.1"
1511   :group 'gnus-article-treat
1512   :group 'gnus-picon
1513   :link '(custom-manual "(gnus)Customizing Articles")
1514   :link '(custom-manual "(gnus)Picons")
1515   :type gnus-article-treat-head-custom)
1516 (put 'gnus-treat-mail-picon 'highlight t)
1517
1518 (defcustom gnus-treat-newsgroups-picon
1519   (if (and (gnus-image-type-available-p 'xpm)
1520            (gnus-picons-installed-p))
1521       'head nil)
1522   "Display picons in the Newsgroups and Followup-To headers.
1523 Valid values are nil, t, `head', `first', `last', an integer or a
1524 predicate.  See Info node `(gnus)Customizing Articles' and Info
1525 node `(gnus)Picons' for details."
1526   :version "22.1"
1527   :group 'gnus-article-treat
1528   :group 'gnus-picon
1529   :link '(custom-manual "(gnus)Customizing Articles")
1530   :link '(custom-manual "(gnus)Picons")
1531   :type gnus-article-treat-head-custom)
1532 (put 'gnus-treat-newsgroups-picon 'highlight t)
1533
1534 (defcustom gnus-treat-from-gravatar nil
1535   "Display gravatars in the From header.
1536 Valid values are nil, t, `head', `first', `last', an integer or a
1537 predicate.  See Info node `(gnus)Customizing Articles' and Info
1538 node `(gnus)Gravatars' for details."
1539   :version "24.1"
1540   :group 'gnus-article-treat
1541   :group 'gnus-gravatar
1542   :link '(custom-manual "(gnus)Customizing Articles")
1543   :link '(custom-manual "(gnus)Gravatars")
1544   :type gnus-article-treat-head-custom)
1545 (put 'gnus-treat-from-gravatar 'highlight t)
1546
1547 (defcustom gnus-treat-mail-gravatar nil
1548   "Display gravatars in To and Cc headers.
1549 Valid values are nil, t, `head', `first', `last', an integer or a
1550 predicate.  See Info node `(gnus)Customizing Articles' and Info
1551 node `(gnus)Gravatars' for details."
1552   :version "24.1"
1553   :group 'gnus-article-treat
1554   :group 'gnus-gravatar
1555   :link '(custom-manual "(gnus)Customizing Articles")
1556   :link '(custom-manual "(gnus)Gravatars")
1557   :type gnus-article-treat-head-custom)
1558 (put 'gnus-treat-mail-gravatar 'highlight t)
1559
1560 (defcustom gnus-treat-body-boundary
1561   (if (or gnus-treat-newsgroups-picon
1562           gnus-treat-mail-picon
1563           gnus-treat-from-picon
1564           gnus-treat-from-gravatar
1565           gnus-treat-mail-gravatar)
1566       ;; If there's much decoration, the user might prefer a boundary.
1567       'head
1568     nil)
1569   "Draw a boundary at the end of the headers.
1570 Valid values are nil and `head'.
1571 See Info node `(gnus)Customizing Articles' for details."
1572   :version "22.1"
1573   :group 'gnus-article-treat
1574   :link '(custom-manual "(gnus)Customizing Articles")
1575   :type gnus-article-treat-head-custom)
1576
1577 (defcustom gnus-treat-capitalize-sentences nil
1578   "Capitalize sentence-starting words.
1579 Valid values are nil, t, `head', `first', `last', an integer or a
1580 predicate.  See Info node `(gnus)Customizing Articles'."
1581   :version "21.1"
1582   :group 'gnus-article-treat
1583   :link '(custom-manual "(gnus)Customizing Articles")
1584   :type gnus-article-treat-custom)
1585
1586 (defcustom gnus-treat-wash-html nil
1587   "Format as HTML.
1588 Valid values are nil, t, `head', `first', `last', an integer or a
1589 predicate.  See Info node `(gnus)Customizing Articles'."
1590   :version "22.1"
1591   :group 'gnus-article-treat
1592   :link '(custom-manual "(gnus)Customizing Articles")
1593   :type gnus-article-treat-custom)
1594
1595 (defcustom gnus-treat-fill-long-lines '(typep "text/plain")
1596   "Fill long lines.
1597 Valid values are nil, t, `head', `first', `last', an integer or a
1598 predicate.  See Info node `(gnus)Customizing Articles'."
1599   :version "24.1"
1600   :group 'gnus-article-treat
1601   :link '(custom-manual "(gnus)Customizing Articles")
1602   :type gnus-article-treat-custom)
1603
1604 (defcustom gnus-treat-x-pgp-sig nil
1605   "Verify X-PGP-Sig.
1606 To automatically treat X-PGP-Sig, set it to head.
1607 Valid values are nil, t, `head', `first', `last', an integer or a
1608 predicate.  See Info node `(gnus)Customizing Articles'."
1609   :version "22.1"
1610   :group 'gnus-article-treat
1611   :group 'mime-security
1612   :link '(custom-manual "(gnus)Customizing Articles")
1613   :type gnus-article-treat-custom)
1614
1615 (defvar gnus-article-encrypt-protocol-alist
1616   '(("PGP" . mml2015-self-encrypt)))
1617
1618 ;; Set to nil if more than one protocol added to
1619 ;; gnus-article-encrypt-protocol-alist.
1620 (defcustom gnus-article-encrypt-protocol "PGP"
1621   "The protocol used for encrypt articles.
1622 It is a string, such as \"PGP\". If nil, ask user."
1623   :version "22.1"
1624   :type 'string
1625   :group 'mime-security)
1626
1627 (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
1628                               (mm-coding-system-p 'utf-8)
1629                               (executable-find idna-program))
1630   "Whether IDNA decoding of headers is used when viewing messages.
1631 This requires GNU Libidn, and by default only enabled if it is found."
1632   :version "22.1"
1633   :group 'gnus-article-headers
1634   :type 'boolean)
1635
1636 (defcustom gnus-article-over-scroll nil
1637   "If non-nil, allow scrolling the article buffer even when there no more text."
1638   :version "22.1"
1639   :group 'gnus-article
1640   :type 'boolean)
1641
1642 (defcustom gnus-inhibit-images nil
1643   "Non-nil means inhibit displaying of images inline in the article body."
1644   :version "24.1"
1645   :group 'gnus-article
1646   :type 'boolean)
1647
1648 (defcustom gnus-blocked-images 'gnus-block-private-groups
1649   "Images that have URLs matching this regexp will be blocked.
1650 This can also be a function to be evaluated.  If so, it will be
1651 called with the group name as the parameter, and should return a
1652 regexp."
1653   :version "24.1"
1654   :group 'gnus-art
1655   :type '(choice regexp function))
1656
1657 ;;; Internal variables
1658
1659 (defvar gnus-english-month-names
1660   '("January" "February" "March" "April" "May" "June" "July" "August"
1661     "September" "October" "November" "December"))
1662
1663 (defvar article-goto-body-goes-to-point-min-p nil)
1664 (defvar gnus-article-wash-types nil)
1665 (defvar gnus-article-emphasis-alist nil)
1666 (defvar gnus-article-image-alist nil)
1667
1668 (defvar gnus-article-mime-handle-alist-1 nil)
1669 (defvar gnus-treatment-function-alist
1670   '((gnus-treat-strip-cr gnus-article-remove-cr)
1671     (gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
1672     (gnus-treat-strip-banner gnus-article-strip-banner)
1673     (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
1674     (gnus-treat-highlight-signature gnus-article-highlight-signature)
1675     (gnus-treat-buttonize gnus-article-add-buttons)
1676     (gnus-treat-fill-article gnus-article-fill-cited-article)
1677     (gnus-treat-fill-long-lines gnus-article-fill-cited-long-lines)
1678     (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
1679     (gnus-treat-display-x-face gnus-article-display-x-face)
1680     (gnus-treat-display-face gnus-article-display-face)
1681     (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
1682     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
1683     (gnus-treat-hide-signature gnus-article-hide-signature)
1684     (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
1685     (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
1686     (gnus-treat-from-picon gnus-treat-from-picon)
1687     (gnus-treat-mail-picon gnus-treat-mail-picon)
1688     (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
1689     (gnus-treat-strip-pem gnus-article-hide-pem)
1690     (gnus-treat-date gnus-article-treat-date)
1691     (gnus-treat-from-gravatar gnus-treat-from-gravatar)
1692     (gnus-treat-mail-gravatar gnus-treat-mail-gravatar)
1693     (gnus-treat-highlight-headers gnus-article-highlight-headers)
1694     (gnus-treat-highlight-signature gnus-article-highlight-signature)
1695     (gnus-treat-strip-trailing-blank-lines
1696      gnus-article-remove-trailing-blank-lines)
1697     (gnus-treat-strip-leading-blank-lines
1698      gnus-article-strip-leading-blank-lines)
1699     (gnus-treat-strip-multiple-blank-lines
1700      gnus-article-strip-multiple-blank-lines)
1701     (gnus-treat-overstrike gnus-article-treat-overstrike)
1702     (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences)
1703     (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
1704     (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
1705     (gnus-treat-fold-headers gnus-article-treat-fold-headers)
1706     (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
1707     (gnus-treat-display-smileys gnus-treat-smiley)
1708     (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
1709     (gnus-treat-wash-html gnus-article-wash-html)
1710     (gnus-treat-emphasize gnus-article-emphasize)
1711     (gnus-treat-hide-citation gnus-article-hide-citation)
1712     (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
1713     (gnus-treat-highlight-citation gnus-article-highlight-citation)
1714     (gnus-treat-body-boundary gnus-article-treat-body-boundary)))
1715
1716 (defvar gnus-article-mime-handle-alist nil)
1717 (defvar article-lapsed-timer nil)
1718 (defvar gnus-article-current-summary nil)
1719
1720 (defvar gnus-article-mode-syntax-table
1721   (let ((table (copy-syntax-table text-mode-syntax-table)))
1722     ;; This causes the citation match run O(2^n).
1723     ;; (modify-syntax-entry ?- "w" table)
1724     (modify-syntax-entry ?> ")<" table)
1725     (modify-syntax-entry ?< "(>" table)
1726     ;; make M-. in article buffers work for `foo' strings
1727     (modify-syntax-entry ?' " " table)
1728     (modify-syntax-entry ?` " " table)
1729     table)
1730   "Syntax table used in article mode buffers.
1731 Initialized from `text-mode-syntax-table.")
1732
1733 (defvar gnus-save-article-buffer nil)
1734
1735 (defvar gnus-number-of-articles-to-be-saved nil)
1736
1737 (defvar gnus-inhibit-hiding nil)
1738
1739 (defvar gnus-article-edit-mode nil)
1740
1741 ;;; Macros for dealing with the article buffer.
1742
1743 (defmacro gnus-with-article-headers (&rest forms)
1744   `(with-current-buffer gnus-article-buffer
1745      (save-restriction
1746        (let ((inhibit-read-only t)
1747              (inhibit-point-motion-hooks t)
1748              (case-fold-search t))
1749          (article-narrow-to-head)
1750          ,@forms))))
1751
1752 (put 'gnus-with-article-headers 'lisp-indent-function 0)
1753 (put 'gnus-with-article-headers 'edebug-form-spec '(body))
1754
1755 (defmacro gnus-with-article-buffer (&rest forms)
1756   `(when (buffer-live-p (get-buffer gnus-article-buffer))
1757      (with-current-buffer gnus-article-buffer
1758        (let ((inhibit-read-only t))
1759          ,@forms))))
1760
1761 (put 'gnus-with-article-buffer 'lisp-indent-function 0)
1762 (put 'gnus-with-article-buffer 'edebug-form-spec '(body))
1763
1764 (defun gnus-article-goto-header (header)
1765   "Go to HEADER, which is a regular expression."
1766   (re-search-forward (concat "^\\(" header "\\):") nil t))
1767
1768 (defsubst gnus-article-hide-text (b e props)
1769   "Set text PROPS on the B to E region, extending `intangible' 1 past B."
1770   (gnus-add-text-properties-when 'article-type nil b e props)
1771   (when (memq 'intangible props)
1772     (put-text-property
1773      (max (1- b) (point-min))
1774      b 'intangible (cddr (memq 'intangible props)))))
1775
1776 (defsubst gnus-article-unhide-text (b e)
1777   "Remove hidden text properties from region between B and E."
1778   (remove-text-properties b e gnus-hidden-properties)
1779   (when (memq 'intangible gnus-hidden-properties)
1780     (put-text-property (max (1- b) (point-min))
1781                        b 'intangible nil)))
1782
1783 (defun gnus-article-hide-text-type (b e type)
1784   "Hide text of TYPE between B and E."
1785   (gnus-add-wash-type type)
1786   (gnus-article-hide-text
1787    b e (cons 'article-type (cons type gnus-hidden-properties))))
1788
1789 (defun gnus-article-unhide-text-type (b e type)
1790   "Unhide text of TYPE between B and E."
1791   (gnus-delete-wash-type type)
1792   (remove-text-properties
1793    b e (cons 'article-type (cons type gnus-hidden-properties)))
1794   (when (memq 'intangible gnus-hidden-properties)
1795     (put-text-property (max (1- b) (point-min))
1796                        b 'intangible nil)))
1797
1798 (defun gnus-article-delete-text-of-type (type)
1799   "Delete text of TYPE in the current buffer."
1800   (save-excursion
1801     (let ((b (point-min)))
1802       (if (eq type 'multipart)
1803           ;; Remove MIME buttons associated with multipart/alternative parts.
1804           (progn
1805             (goto-char b)
1806             (while (if (get-text-property (point) 'gnus-part)
1807                        (setq b (point))
1808                      (when (setq b (next-single-property-change (point)
1809                                                                 'gnus-part))
1810                        (goto-char b)
1811                        t))
1812               (end-of-line)
1813               (skip-chars-forward "\n")
1814               (when (eq (get-text-property b 'article-type) 'multipart)
1815                 (delete-region b (point)))))
1816         (while (setq b (text-property-any b (point-max) 'article-type type))
1817           (delete-region
1818            b (or (text-property-not-all b (point-max) 'article-type type)
1819                  (point-max))))))))
1820
1821 (defun gnus-article-delete-invisible-text ()
1822   "Delete all invisible text in the current buffer."
1823   (save-excursion
1824     (let ((b (point-min)))
1825       (while (setq b (text-property-any b (point-max) 'invisible t))
1826         (delete-region
1827          b (or (text-property-not-all b (point-max) 'invisible t)
1828                (point-max)))))))
1829
1830 (defsubst gnus-article-header-rank ()
1831   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
1832   (let ((list gnus-sorted-header-list)
1833         (i 1))
1834     (while list
1835       (if (looking-at (car list))
1836           (setq list nil)
1837         (setq list (cdr list))
1838         (incf i)))
1839       i))
1840
1841 (defun article-hide-headers (&optional arg delete)
1842   "Hide unwanted headers and possibly sort them as well."
1843   (interactive)
1844   ;; This function might be inhibited.
1845   (unless gnus-inhibit-hiding
1846     (let ((inhibit-read-only t)
1847           (case-fold-search t)
1848           (max (1+ (length gnus-sorted-header-list)))
1849           (inhibit-point-motion-hooks t)
1850           (cur (current-buffer))
1851           ignored visible beg)
1852       (save-excursion
1853         ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
1854         ;; group parameters, so we should go to the summary buffer.
1855         (when (prog1
1856                   (condition-case nil
1857                       (progn (set-buffer gnus-summary-buffer) t)
1858                     (error nil))
1859                 (setq ignored (when (not gnus-visible-headers)
1860                                 (cond ((stringp gnus-ignored-headers)
1861                                        gnus-ignored-headers)
1862                                       ((listp gnus-ignored-headers)
1863                                        (mapconcat 'identity
1864                                                   gnus-ignored-headers
1865                                                   "\\|"))))
1866                       visible (cond ((stringp gnus-visible-headers)
1867                                      gnus-visible-headers)
1868                                     ((and gnus-visible-headers
1869                                           (listp gnus-visible-headers))
1870                                      (mapconcat 'identity
1871                                                 gnus-visible-headers
1872                                                 "\\|")))))
1873           (set-buffer cur))
1874         (save-restriction
1875           ;; First we narrow to just the headers.
1876           (article-narrow-to-head)
1877           ;; Hide any "From " lines at the beginning of (mail) articles.
1878           (while (looking-at "From ")
1879             (forward-line 1))
1880           (unless (bobp)
1881             (delete-region (point-min) (point)))
1882           ;; Then treat the rest of the header lines.
1883           ;; Then we use the two regular expressions
1884           ;; `gnus-ignored-headers' and `gnus-visible-headers' to
1885           ;; select which header lines is to remain visible in the
1886           ;; article buffer.
1887           (while (re-search-forward "^[^ \t:]*:" nil t)
1888             (beginning-of-line)
1889             ;; Mark the rank of the header.
1890             (put-text-property
1891              (point) (1+ (point)) 'message-rank
1892              (if (or (and visible (looking-at visible))
1893                      (and ignored
1894                           (not (looking-at ignored))))
1895                  (gnus-article-header-rank)
1896                (+ 2 max)))
1897             (forward-line 1))
1898           (message-sort-headers-1)
1899           (when (setq beg (text-property-any
1900                            (point-min) (point-max) 'message-rank (+ 2 max)))
1901             ;; We delete the unwanted headers.
1902             (gnus-add-wash-type 'headers)
1903             (add-text-properties (point-min) (+ 5 (point-min))
1904                                  '(article-type headers dummy-invisible t))
1905             (delete-region beg (point-max))))))))
1906
1907 (defun article-hide-boring-headers (&optional arg)
1908   "Toggle hiding of headers that aren't very interesting.
1909 If given a negative prefix, always show; if given a positive prefix,
1910 always hide."
1911   (interactive (gnus-article-hidden-arg))
1912   (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
1913              (not gnus-show-all-headers))
1914     (save-excursion
1915       (save-restriction
1916         (let ((inhibit-read-only t)
1917               (inhibit-point-motion-hooks t))
1918           (article-narrow-to-head)
1919           (dolist (elem gnus-boring-article-headers)
1920             (goto-char (point-min))
1921             (cond
1922              ;; Hide empty headers.
1923              ((eq elem 'empty)
1924               (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
1925                 (forward-line -1)
1926                 (gnus-article-hide-text-type
1927                  (point-at-bol)
1928                  (progn
1929                    (end-of-line)
1930                    (if (re-search-forward "^[^ \t]" nil t)
1931                        (match-beginning 0)
1932                      (point-max)))
1933                  'boring-headers)))
1934              ;; Hide boring Newsgroups header.
1935              ((eq elem 'newsgroups)
1936               (when (gnus-string-equal
1937                      (gnus-fetch-field "newsgroups")
1938                      (gnus-group-real-name
1939                       (if (boundp 'gnus-newsgroup-name)
1940                           gnus-newsgroup-name
1941                         "")))
1942                 (gnus-article-hide-header "newsgroups")))
1943              ((eq elem 'to-address)
1944               (let ((to (message-fetch-field "to"))
1945                     (to-address
1946                      (gnus-parameter-to-address
1947                       (if (boundp 'gnus-newsgroup-name)
1948                           gnus-newsgroup-name ""))))
1949                 (when (and to to-address
1950                            (ignore-errors
1951                              (gnus-string-equal
1952                               ;; only one address in To
1953                               (nth 1 (mail-extract-address-components to))
1954                               to-address)))
1955                   (gnus-article-hide-header "to"))))
1956              ((eq elem 'to-list)
1957               (let ((to (message-fetch-field "to"))
1958                     (to-list
1959                      (gnus-parameter-to-list
1960                       (if (boundp 'gnus-newsgroup-name)
1961                           gnus-newsgroup-name ""))))
1962                 (when (and to to-list
1963                            (ignore-errors
1964                              (gnus-string-equal
1965                               ;; only one address in To
1966                               (nth 1 (mail-extract-address-components to))
1967                               to-list)))
1968                   (gnus-article-hide-header "to"))))
1969              ((eq elem 'cc-list)
1970               (let ((cc (message-fetch-field "cc"))
1971                     (to-list
1972                      (gnus-parameter-to-list
1973                       (if (boundp 'gnus-newsgroup-name)
1974                           gnus-newsgroup-name ""))))
1975                 (when (and cc to-list
1976                            (ignore-errors
1977                              (gnus-string-equal
1978                               ;; only one address in CC
1979                               (nth 1 (mail-extract-address-components cc))
1980                               to-list)))
1981                   (gnus-article-hide-header "cc"))))
1982              ((eq elem 'followup-to)
1983               (when (gnus-string-equal
1984                      (message-fetch-field "followup-to")
1985                      (message-fetch-field "newsgroups"))
1986                 (gnus-article-hide-header "followup-to")))
1987              ((eq elem 'reply-to)
1988               (if (gnus-group-find-parameter
1989                    gnus-newsgroup-name 'broken-reply-to)
1990                   (gnus-article-hide-header "reply-to")
1991                 (let ((from (message-fetch-field "from"))
1992                       (reply-to (message-fetch-field "reply-to")))
1993                   (when
1994                       (and
1995                        from reply-to
1996                        (ignore-errors
1997                          (equal
1998                           (sort (mapcar
1999                                  (lambda (x) (downcase (cadr x)))
2000                                  (mail-extract-address-components from t))
2001                                 'string<)
2002                           (sort (mapcar
2003                                  (lambda (x) (downcase (cadr x)))
2004                                  (mail-extract-address-components reply-to t))
2005                                 'string<))))
2006                     (gnus-article-hide-header "reply-to")))))
2007              ((eq elem 'date)
2008               (let ((date (with-current-buffer gnus-original-article-buffer
2009                             ;; If date in `gnus-article-buffer' is localized
2010                             ;; (`gnus-treat-date-user-defined'),
2011                             ;; `days-between' might fail.
2012                             (message-fetch-field "date"))))
2013                 (when (and date
2014                            (< (days-between (current-time-string) date)
2015                               4))
2016                   (gnus-article-hide-header "date"))))
2017              ((eq elem 'long-to)
2018               (let ((to (message-fetch-field "to"))
2019                     (cc (message-fetch-field "cc")))
2020                 (when (> (length to) 1024)
2021                   (gnus-article-hide-header "to"))
2022                 (when (> (length cc) 1024)
2023                   (gnus-article-hide-header "cc"))))
2024              ((eq elem 'many-to)
2025               (let ((to-count 0)
2026                     (cc-count 0))
2027                 (goto-char (point-min))
2028                 (while (re-search-forward "^to:" nil t)
2029                   (setq to-count (1+ to-count)))
2030                 (when (> to-count 1)
2031                   (while (> to-count 0)
2032                     (goto-char (point-min))
2033                     (save-restriction
2034                       (re-search-forward "^to:" nil nil to-count)
2035                       (forward-line -1)
2036                       (narrow-to-region (point) (point-max))
2037                       (gnus-article-hide-header "to"))
2038                     (setq to-count (1- to-count))))
2039                 (goto-char (point-min))
2040                 (while (re-search-forward "^cc:" nil t)
2041                   (setq cc-count (1+ cc-count)))
2042                 (when (> cc-count 1)
2043                   (while (> cc-count 0)
2044                     (goto-char (point-min))
2045                     (save-restriction
2046                       (re-search-forward "^cc:" nil nil cc-count)
2047                       (forward-line -1)
2048                       (narrow-to-region (point) (point-max))
2049                       (gnus-article-hide-header "cc"))
2050                     (setq cc-count (1- cc-count)))))))))))))
2051
2052 (defun gnus-article-hide-header (header)
2053   (save-excursion
2054     (goto-char (point-min))
2055     (when (re-search-forward (concat "^" header ":") nil t)
2056       (gnus-article-hide-text-type
2057        (point-at-bol)
2058        (progn
2059          (end-of-line)
2060          (if (re-search-forward "^[^ \t]" nil t)
2061              (match-beginning 0)
2062            (point-max)))
2063        'boring-headers))))
2064
2065 (defvar gnus-article-normalized-header-length 40
2066   "Length of normalized headers.")
2067
2068 (defun article-normalize-headers ()
2069   "Make all header lines 40 characters long."
2070   (interactive)
2071   (let ((inhibit-read-only t)
2072         column)
2073     (save-excursion
2074       (save-restriction
2075         (article-narrow-to-head)
2076         (while (not (eobp))
2077           (cond
2078            ((< (setq column (- (point-at-eol) (point)))
2079                gnus-article-normalized-header-length)
2080             (end-of-line)
2081             (insert (make-string
2082                      (- gnus-article-normalized-header-length column)
2083                      ? )))
2084            ((> column gnus-article-normalized-header-length)
2085             (gnus-put-text-property
2086              (progn
2087                (forward-char gnus-article-normalized-header-length)
2088                (point))
2089              (point-at-eol)
2090              'invisible t))
2091            (t
2092             ;; Do nothing.
2093             ))
2094           (forward-line 1))))))
2095
2096 (defun article-treat-dumbquotes ()
2097   "Translate M****s*** sm*rtq**t*s and other symbols into proper text.
2098 Note that this function guesses whether a character is a sm*rtq**t* or
2099 not, so it should only be used interactively.
2100
2101 Sm*rtq**t*s are M****s***'s unilateral extension to the
2102 iso-8859-1 character map in an attempt to provide more quoting
2103 characters.  If you see something like \\222 or \\264 where
2104 you're expecting some kind of apostrophe or quotation mark, then
2105 try this wash."
2106   (interactive)
2107   (article-translate-strings gnus-article-dumbquotes-map))
2108
2109 (defvar org-entities)
2110
2111 (defun article-treat-non-ascii ()
2112   "Translate many Unicode characters into their ASCII equivalents."
2113   (interactive)
2114   (require 'org-entities)
2115   (let ((table (make-char-table (if (featurep 'xemacs) 'generic))))
2116     (dolist (elem org-entities)
2117       (when (and (listp elem)
2118                  (= (length (nth 6 elem)) 1))
2119         (if (featurep 'xemacs)
2120             (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table)
2121           (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem)))))
2122     (save-excursion
2123       (when (article-goto-body)
2124         (let ((inhibit-read-only t)
2125               replace props)
2126           (while (not (eobp))
2127             (if (not (setq replace (if (featurep 'xemacs)
2128                                        (get-char-table (following-char) table)
2129                                      (aref table (following-char)))))
2130                 (forward-char 1)
2131               (if (prog1
2132                       (setq props (text-properties-at (point)))
2133                     (delete-char 1))
2134                   (add-text-properties (point) (progn (insert replace) (point))
2135                                        props)
2136                 (insert replace)))))))))
2137
2138 (defun article-translate-strings (map)
2139   "Translate all string in the body of the article according to MAP.
2140 MAP is an alist where the elements are on the form (\"from\" \"to\")."
2141   (save-excursion
2142     (when (article-goto-body)
2143       (let ((inhibit-read-only t))
2144         (dolist (elem map)
2145           (let ((from (car elem))
2146                 (to (cadr elem)))
2147             (save-excursion
2148               (if (stringp from)
2149                   (while (search-forward from nil t)
2150                     (replace-match to))
2151                 (while (not (eobp))
2152                   (if (eq (following-char) from)
2153                       (progn
2154                         (delete-char 1)
2155                         (insert to))
2156                     (forward-char 1)))))))))))
2157
2158 (defun article-treat-overstrike ()
2159   "Translate overstrikes into bold text."
2160   (interactive)
2161   (save-excursion
2162     (when (article-goto-body)
2163       (let ((inhibit-read-only t))
2164         (while (search-forward "\b" nil t)
2165           (let ((next (char-after))
2166                 (previous (char-after (- (point) 2))))
2167             ;; We do the boldification/underlining by hiding the
2168             ;; overstrikes and putting the proper text property
2169             ;; on the letters.
2170             (cond
2171              ((eq next previous)
2172               (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2173               (put-text-property (point) (1+ (point)) 'face 'bold))
2174              ((eq next ?_)
2175               (gnus-article-hide-text-type
2176                (1- (point)) (1+ (point)) 'overstrike)
2177               (put-text-property
2178                (- (point) 2) (1- (point)) 'face 'underline))
2179              ((eq previous ?_)
2180               (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
2181               (put-text-property
2182                (point) (1+ (point)) 'face 'underline)))))))))
2183
2184 (defun article-treat-ansi-sequences ()
2185   "Translate ANSI SGR control sequences into overlays or extents."
2186   (interactive)
2187   (save-excursion
2188     (when (article-goto-body)
2189       (let ((inhibit-read-only t))
2190         (ansi-color-apply-on-region (point) (point-max))))))
2191
2192 (defun gnus-article-treat-unfold-headers ()
2193   "Unfold folded message headers.
2194 Only the headers that fit into the current window width will be
2195 unfolded."
2196   (interactive)
2197   (gnus-with-article-headers
2198     (let (length)
2199       (while (not (eobp))
2200         (save-restriction
2201           (mail-header-narrow-to-field)
2202           (let* ((header (buffer-string))
2203                  (unfoldable
2204                   (or (equal gnus-article-unfold-long-headers t)
2205                       (and (stringp gnus-article-unfold-long-headers)
2206                            (string-match gnus-article-unfold-long-headers
2207                                          header)))))
2208             (with-temp-buffer
2209               (insert header)
2210               (goto-char (point-min))
2211               (while (re-search-forward "\n[\t ]" nil t)
2212                 (replace-match " " t t)))
2213             (setq length (- (point-max) (point-min) 1))
2214             (when (or unfoldable
2215                       (< length (window-width)))
2216               (while (re-search-forward "\n[\t ]" nil t)
2217                 (replace-match " " t t))))
2218           (goto-char (point-max)))))))
2219
2220 (defun gnus-article-treat-fold-headers ()
2221   "Fold message headers."
2222   (interactive)
2223   (gnus-with-article-headers
2224     (while (not (eobp))
2225       (save-restriction
2226         (mail-header-narrow-to-field)
2227         (mail-header-fold-field)
2228         (goto-char (point-max))))))
2229
2230 (defun gnus-treat-smiley ()
2231   "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
2232   (interactive)
2233   (gnus-with-article-buffer
2234     (if (memq 'smiley gnus-article-wash-types)
2235         (gnus-delete-images 'smiley)
2236       (article-goto-body)
2237       (let ((images (smiley-region (point) (point-max))))
2238         (when images
2239           (gnus-add-wash-type 'smiley)
2240           (dolist (image images)
2241             (gnus-add-image 'smiley image)))))))
2242
2243 (defun gnus-article-remove-images ()
2244   "Remove all images from the article buffer."
2245   (interactive)
2246   (gnus-with-article-buffer
2247     (save-restriction
2248       (widen)
2249       (dolist (elem gnus-article-image-alist)
2250         (gnus-delete-images (car elem))))))
2251
2252 (autoload 'w3m-toggle-inline-images "w3m")
2253
2254 (defun gnus-article-show-images ()
2255   "Show any images that are in the HTML-rendered article buffer.
2256 This only works if the article in question is HTML."
2257   (interactive)
2258   (gnus-with-article-buffer
2259     (save-restriction
2260       (widen)
2261       (if (eq mm-text-html-renderer 'w3m)
2262           (let ((mm-inline-text-html-with-images nil))
2263             (w3m-toggle-inline-images))
2264         (dolist (region (gnus-find-text-property-region (point-min) (point-max)
2265                                                         'image-displayer))
2266           (destructuring-bind (start end function) region
2267             (funcall function (get-text-property start 'image-url)
2268                      start end)))))))
2269
2270 (defun gnus-article-treat-fold-newsgroups ()
2271   "Unfold folded message headers.
2272 Only the headers that fit into the current window width will be
2273 unfolded."
2274   (interactive)
2275   (gnus-with-article-headers
2276     (while (gnus-article-goto-header "newsgroups\\|followup-to")
2277       (save-restriction
2278         (mail-header-narrow-to-field)
2279         (while (re-search-forward ", *" nil t)
2280           (replace-match ", " t t))
2281         (mail-header-fold-field)
2282         (goto-char (point-max))))))
2283
2284 (defcustom gnus-article-truncate-lines (default-value 'truncate-lines)
2285   "Value of `truncate-lines' in Gnus Article buffer.
2286 Valid values are nil, t, `head', `first', `last', an integer or a
2287 predicate.  See Info node `(gnus)Customizing Articles'."
2288   :version "23.1" ;; No Gnus
2289   :group 'gnus-article
2290   ;; :link '(custom-manual "(gnus)Customizing Articles")
2291   :type 'boolean)
2292
2293 (defun gnus-article-toggle-truncate-lines (&optional arg)
2294   "Toggle whether to fold or truncate long lines in article the buffer.
2295 If ARG is non-nil and not a number, toggle
2296 `gnus-article-truncate-lines' too.  If ARG is a number, truncate
2297 long lines if and only if arg is positive."
2298   (interactive "P")
2299   (cond
2300    ((and (numberp arg) (> arg 0))
2301     (setq gnus-article-truncate-lines t))
2302    ((numberp arg)
2303     (setq gnus-article-truncate-lines nil))
2304    (arg
2305     (setq gnus-article-truncate-lines
2306           (not gnus-article-truncate-lines))))
2307   (gnus-with-article-buffer
2308     (cond
2309      ((and (numberp arg) (> arg 0))
2310       (setq truncate-lines nil))
2311      ((numberp arg)
2312       (setq truncate-lines t)))
2313     ;; In versions of Emacs 22 (CVS) before 2006-05-26,
2314     ;; `toggle-truncate-lines' needs an argument.
2315     (toggle-truncate-lines)))
2316
2317 (defun gnus-article-treat-body-boundary ()
2318   "Place a boundary line at the end of the headers."
2319   (interactive)
2320   (when (and gnus-body-boundary-delimiter
2321              (> (length gnus-body-boundary-delimiter) 0))
2322     (gnus-with-article-headers
2323       (goto-char (point-max))
2324       (let ((start (point)))
2325         (insert "X-Boundary: ")
2326         (gnus-add-text-properties start (point) '(invisible t intangible t))
2327        (insert (let (str (max (window-width)))
2328                  (if (featurep 'xemacs)
2329                      (setq max (1- max)))
2330                  (while (>= max (length str))
2331                     (setq str (concat str gnus-body-boundary-delimiter)))
2332                  (substring str 0 max))
2333                 "\n")
2334         (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
2335
2336 (defun article-fill-long-lines ()
2337   "Fill lines that are wider than the window width."
2338   (interactive)
2339   (save-excursion
2340     (let ((inhibit-read-only t)
2341           (width (window-width (get-buffer-window (current-buffer)))))
2342       (save-restriction
2343         (article-goto-body)
2344         (let ((adaptive-fill-mode nil)) ;Why?  -sm
2345           (while (not (eobp))
2346             (end-of-line)
2347             (when (>= (current-column) (min fill-column width))
2348               (narrow-to-region (min (1+ (point)) (point-max))
2349                                 (point-at-bol))
2350               (let ((goback (point-marker)))
2351                 (fill-paragraph nil)
2352                 (goto-char (marker-position goback)))
2353               (widen))
2354             (forward-line 1)))))))
2355
2356 (defun article-capitalize-sentences ()
2357   "Capitalize the first word in each sentence."
2358   (interactive)
2359   (save-excursion
2360     (let ((inhibit-read-only t)
2361           (paragraph-start "^[\n\^L]"))
2362       (article-goto-body)
2363       (while (not (eobp))
2364         (capitalize-word 1)
2365         (forward-sentence)))))
2366
2367 (defun article-remove-cr ()
2368   "Remove trailing CRs and then translate remaining CRs into LFs."
2369   (interactive)
2370   (save-excursion
2371     (let ((inhibit-read-only t))
2372       (goto-char (point-min))
2373       (while (re-search-forward "\r+$" nil t)
2374         (replace-match "" t t))
2375       (goto-char (point-min))
2376       (while (search-forward "\r" nil t)
2377         (replace-match "\n" t t)))))
2378
2379 (defun article-remove-trailing-blank-lines ()
2380   "Remove all trailing blank lines from the article."
2381   (interactive)
2382   (save-excursion
2383     (let ((inhibit-read-only t))
2384       (goto-char (point-max))
2385       (delete-region
2386        (point)
2387        (progn
2388          (while (and (not (bobp))
2389                      (looking-at "^[ \t]*$")
2390                      (not (gnus-annotation-in-region-p
2391                            (point) (point-at-eol))))
2392            (forward-line -1))
2393          (forward-line 1)
2394          (point))))))
2395
2396 (defvar gnus-face-properties-alist)
2397
2398 (defun article-display-face (&optional force)
2399   "Display any Face headers in the header."
2400   (interactive (list 'force))
2401   (let ((wash-face-p buffer-read-only))
2402     (gnus-with-article-headers
2403       ;; When displaying parts, this function can be called several times on
2404       ;; the same article, without any intended toggle semantic (as typing `W
2405       ;; D d' would have). So face deletion must occur only when we come from
2406       ;; an interactive command, that is when the *Article* buffer is
2407       ;; read-only.
2408       (if (and wash-face-p (memq 'face gnus-article-wash-types))
2409           (gnus-delete-images 'face)
2410         (let ((from (message-fetch-field "from"))
2411               face faces)
2412           (save-current-buffer
2413             (when (and wash-face-p
2414                        (gnus-buffer-live-p gnus-original-article-buffer)
2415                        (not (re-search-forward "^Face:[\t ]*" nil t)))
2416               (set-buffer gnus-original-article-buffer))
2417             (save-restriction
2418               (mail-narrow-to-head)
2419               (when (or force
2420                         ;; Check whether this face is censored.
2421                         (not (and gnus-article-x-face-too-ugly
2422                                   (or from
2423                                       (setq from (message-fetch-field "from")))
2424                                   (string-match gnus-article-x-face-too-ugly
2425                                                 from))))
2426                 (while (gnus-article-goto-header "Face")
2427                   (push (mail-header-field-value) faces)))))
2428           (when faces
2429             (goto-char (point-min))
2430             (let (png image)
2431               (unless (setq from (gnus-article-goto-header "from"))
2432                 (insert "From:")
2433                 (setq from (point))
2434                 (insert " [no `from' set]\n"))
2435               (while faces
2436                 (when (setq png (gnus-convert-face-to-png (pop faces)))
2437                   (setq image
2438                         (apply 'gnus-create-image png 'png t
2439                                (cdr (assq 'png gnus-face-properties-alist))))
2440                   (goto-char from)
2441                   (when image
2442                     (gnus-add-wash-type 'face)
2443                     (gnus-add-image 'face image)
2444                     (gnus-put-image image nil 'face)))))))))))
2445
2446 (defun article-display-x-face (&optional force)
2447   "Look for an X-Face header and display it if present."
2448   (interactive (list 'force))
2449   (let ((wash-face-p buffer-read-only)) ;; When type `W f'
2450     (gnus-with-article-headers
2451       ;; Delete the old process, if any.
2452       (when (process-status "article-x-face")
2453         (delete-process "article-x-face"))
2454       ;; See the comment in `article-display-face'.
2455       (if (and wash-face-p (memq 'xface gnus-article-wash-types))
2456           ;; We have already displayed X-Faces, so we remove them
2457           ;; instead.
2458           (gnus-delete-images 'xface)
2459         ;; Display X-Faces.
2460         (let ((from (message-fetch-field "from"))
2461               x-faces face)
2462           (save-current-buffer
2463             (when (and wash-face-p
2464                        (gnus-buffer-live-p gnus-original-article-buffer)
2465                        (not (re-search-forward "^X-Face:[\t ]*" nil t)))
2466               ;; If type `W f', use gnus-original-article-buffer,
2467               ;; otherwise use the current buffer because displaying
2468               ;; RFC822 parts calls this function too.
2469               (set-buffer gnus-original-article-buffer))
2470             (save-restriction
2471               (mail-narrow-to-head)
2472               (and gnus-article-x-face-command
2473                    (or force
2474                        ;; Check whether this face is censored.
2475                        (not (and gnus-article-x-face-too-ugly
2476                                  (or from
2477                                      (setq from (message-fetch-field "from")))
2478                                  (string-match gnus-article-x-face-too-ugly
2479                                                from))))
2480                    (while (gnus-article-goto-header "X-Face")
2481                      (push (mail-header-field-value) x-faces)))))
2482           (when x-faces
2483             ;; We display the face.
2484             (cond ((functionp gnus-article-x-face-command)
2485                    ;; The command is a lisp function, so we call it.
2486                    (mapc gnus-article-x-face-command x-faces))
2487                   ((stringp gnus-article-x-face-command)
2488                    ;; The command is a string, so we interpret the command
2489                    ;; as a, well, command, and fork it off.
2490                    (let ((process-connection-type nil))
2491                      (gnus-set-process-query-on-exit-flag
2492                       (start-process
2493                        "article-x-face" nil shell-file-name
2494                        shell-command-switch gnus-article-x-face-command)
2495                       nil)
2496                      ;; Sending multiple EOFs to xv doesn't work,
2497                      ;; so we only do a single external face.
2498                      (with-temp-buffer
2499          &nbs