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

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