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