Apply Dave Love's patches.
[gnus] / lisp / gnus-art.el
index 1a4a9c2..1295224 100644 (file)
@@ -1,5 +1,5 @@
 ;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
 (require 'gnus-int)
 (require 'browse-url)
 (require 'mm-bodies)
-(require 'drums)
+(require 'mail-parse)
 (require 'mm-decode)
 (require 'mm-view)
+(require 'wid-edit)
+(require 'mm-uu)
 
 (defgroup gnus-article nil
   "Article display."
   :link '(custom-manual "(gnus)The Article Buffer")
   :group 'gnus)
 
+(defgroup gnus-article-treat nil
+  "Treating article parts."
+  :link '(custom-manual "(gnus)Article Hiding")
+  :group 'gnus-article)
+
 (defgroup gnus-article-hiding nil
   "Hiding article parts."
   :link '(custom-manual "(gnus)Article Hiding")
 
 (defcustom gnus-ignored-headers
   '("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:"
-    "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" 
+    "^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:"
     "^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:"
     "^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:"
     "^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:"
     "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
     "^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:"
     "^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:"
-    "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" 
+    "^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:"
     "^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:"
     "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:"
-    "^Old-Received:" "^X-Pgp-Fingerprint:" "^X-Pgp-Key-Id:"
-    "^X-Pgp-Public-Key-Url:" "^X-Auth:" "^X-From-Line:"
+    "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:"
     "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
-    "^X-Mailing-List:" "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
-    "^Status:")
+    "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
+    "^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:"
+    "^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:"
+    "^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:"
+    "^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:"
+    "^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:"
+    "^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:"
+    "^List-[A-Za-z]+:" "^X-Listprocessor-Version:"
+    "^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:"
+    "^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:"
+    "^X-Received:" "^Content-length:" "X-precedence:")
   "*All headers that start with this regexp will be hidden.
 This variable can also be a list of regexps of headers to be ignored.
 If `gnus-visible-headers' is non-nil, this variable will be ignored."
@@ -123,7 +138,7 @@ If `gnus-visible-headers' is non-nil, this variable will be ignored."
   :group 'gnus-article-hiding)
 
 (defcustom gnus-visible-headers
-  "From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|X-Sent:"
+  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
   "*All headers that do not match this regexp will be hidden.
 This variable can also be a list of regexp of headers to remain visible.
 If this variable is non-nil, `gnus-ignored-headers' will be ignored."
@@ -167,7 +182,7 @@ the end of the buffer."
   :group 'gnus-article-signature)
 
 (defcustom gnus-signature-limit nil
-   "Provide a limit to what is considered a signature.
+  "Provide a limit to what is considered a signature.
 If it is a number, no signature may not be longer (in characters) than
 that number.  If it is a floating point number, no signature may be
 longer (in lines) than that number.  If it is a function, the function
@@ -186,7 +201,7 @@ regexp.  If it matches, the text in question is not a signature."
   :group 'gnus-article-hiding)
 
 (defcustom gnus-article-x-face-command
-  "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
+  "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | display -"
   "*String or function to be executed to display an X-Face header.
 If it is a string, the command will be executed in a sub-shell
 asynchronously.         The compressed face will be piped to this command."
@@ -200,7 +215,7 @@ asynchronously.      The compressed face will be piped to this command."
 
 (defcustom gnus-emphasis-alist
   (let ((format
-        "\\(\\s-\\|^\\|[-\"]\\|\\s(\\|\\s)\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"]\\|\\s(\\|\\s)\\)")
+        "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
        (types
         '(("_" "_" underline)
           ("/" "/" italic)
@@ -251,7 +266,7 @@ is the face used for highlighting."
   :group 'gnus-article-emphasis)
 
 (defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
-  "Face used for displaying underlined italic emphasized text (_*word*_)."
+  "Face used for displaying underlined italic emphasized text (_/word/_)."
   :group 'gnus-article-emphasis)
 
 (defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
@@ -264,6 +279,11 @@ is the face used for highlighting."
 Esample: (_/*word*/_)."
   :group 'gnus-article-emphasis)
 
+(defface gnus-emphasis-highlight-words
+  '((t (:background "black" :foreground "yellow")))
+  "Face used for displaying highlighted words."
+  :group 'gnus-article-emphasis)
+
 (defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
   "Format for display of Date headers in article bodies.
 See `format-time-string' for the possible values.
@@ -384,9 +404,14 @@ beginning of a line."
   :type 'regexp
   :group 'gnus-article-various)
 
-(defcustom gnus-article-mode-line-format "Gnus: %g %S"
+(defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
   "*The format specification for the article mode line.
-See `gnus-summary-mode-line-format' for a closer description."
+See `gnus-summary-mode-line-format' for a closer description.
+
+The following additional specs are available:
+
+%w  The article washing status.
+%m  The number of MIME parts in the article."
   :type 'string
   :group 'gnus-article-various)
 
@@ -401,8 +426,7 @@ See `gnus-summary-mode-line-format' for a closer description."
   :group 'gnus-article-various)
 
 (defcustom gnus-article-prepare-hook nil
-  "*A hook called after an article has been prepared in the article buffer.
-If you want to run a special decoding program like nkf, use this hook."
+  "*A hook called after an article has been prepared in the article buffer."
   :type 'hook
   :group 'gnus-article-various)
 
@@ -532,18 +556,409 @@ displayed by the first non-nil matching CONTENT face."
                               (face :value default)))))
 
 (defcustom gnus-article-decode-hook
-  '(article-decode-charset article-decode-rfc1522)
+  '(article-decode-charset article-decode-encoded-words)
   "*Hook run to decode charsets in articles."
   :group 'gnus-article-headers
   :type 'hook)
 
 (defcustom gnus-display-mime-function 'gnus-display-mime
   "Function to display MIME articles."
-  :group 'gnus-article-headers
+  :group 'gnus-article-mime
   :type 'function)
 
+(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
+  "Function used to decode headers.")
+
+(defvar gnus-article-dumbquotes-map
+  '(("\202" ",")
+    ("\203" "f")
+    ("\204" ",,")
+    ("\205" "...")
+    ("\213" "<")
+    ("\214" "OE")
+    ("\221" "`")
+    ("\222" "'")
+    ("\223" "``")
+    ("\224" "\"")
+    ("\225" "*")
+    ("\226" "---")
+    ("\227" "-")
+    ("\231" "(TM)")
+    ("\233" ">")
+    ("\234" "oe")
+    ("\264" "'"))
+  "Table for MS-to-Latin1 translation.")
+
+(defcustom gnus-ignored-mime-types nil
+  "List of MIME types that should be ignored by Gnus."
+  :group 'gnus-article-mime
+  :type '(repeat regexp))
+
+(defcustom gnus-unbuttonized-mime-types '(".*/.*")
+  "List of MIME types that should not be given buttons when rendered inline."
+  :group 'gnus-article-mime
+  :type '(repeat regexp))
+
+(defcustom gnus-article-mime-part-function nil
+  "Function called with a MIME handle as the argument.
+This is meant for people who want to do something automatic based
+on parts -- for instance, adding Vcard info to a database."
+  :group 'gnus-article-mime
+  :type 'function)
+
+(defcustom gnus-mime-multipart-functions nil
+  "An alist of MIME types to functions to display them.")
+
+(defcustom gnus-article-date-lapsed-new-header nil
+  "Whether the X-Sent and Date headers can coexist.
+When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
+either replace the old \"Date:\" header (if this variable is nil), or
+be added below it (otherwise)."
+  :group 'gnus-article-headers
+  :type 'boolean)
+
+(defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
+  "Function called with a MIME handle as the argument.
+This is meant for people who want to view first matched part.
+For `undisplayed-alternative' (default), the first undisplayed 
+part or alternative part is used.  For `undisplayed', the first 
+undisplayed part is used.  For a function, the first part which 
+the function return `t' is used.  For `nil', the first part is
+used."
+  :group 'gnus-article-mime
+  :type '(choice 
+         (item :tag "first" :value nil)
+         (item :tag "undisplayed" :value undisplayed)
+         (item :tag "undisplayed or alternative" 
+               :value undisplayed-alternative)
+         (function)))
+
+;;;
+;;; The treatment variables
+;;;
+
+(defvar gnus-part-display-hook nil
+  "Hook called on parts that are to receive treatment.")
+
+(defvar gnus-article-treat-custom
+  '(choice (const :tag "Off" nil)
+          (const :tag "On" t)
+          (const :tag "Header" head)
+          (const :tag "Last" last)
+          (integer :tag "Less")
+          (repeat :tag "Groups" regexp)
+          (sexp :tag "Predicate")))
+
+(defvar gnus-article-treat-head-custom
+  '(choice (const :tag "Off" nil)
+          (const :tag "Header" head)))
+
+(defvar gnus-article-treat-types '("text/plain")
+  "Parts to treat.")
+
+(defvar gnus-inhibit-treatment nil
+  "Whether to inhibit treatment.")
+
+(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard"))
+  "Highlight the signature.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+(put 'gnus-treat-highlight-signature 'highlight t)
+
+(defcustom gnus-treat-buttonize 100000
+  "Add buttons.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+(put 'gnus-treat-buttonize 'highlight t)
+
+(defcustom gnus-treat-buttonize-head 'head
+  "Add buttons to the head.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+(put 'gnus-treat-buttonize-head 'highlight t)
+
+(defcustom gnus-treat-emphasize 50000
+  "Emphasize text.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+(put 'gnus-treat-emphasize 'highlight t)
+
+(defcustom gnus-treat-strip-cr nil
+  "Remove carriage returns.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-hide-headers 'head
+  "Hide headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-hide-boring-headers nil
+  "Hide boring headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-hide-signature nil
+  "Hide the signature.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-fill-article nil
+  "Fill the article.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-hide-citation nil
+  "Hide cited text.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-strip-list-identifiers 'head
+  "Strip list identifiers from `gnus-list-identifiers`.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-strip-pgp t
+  "Strip PGP signatures.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-strip-pem nil
+  "Strip PEM signatures.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-strip-banner t
+  "Strip banners from articles.
+The banner to be stripped is specified in the `banner' group parameter.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-highlight-headers 'head
+  "Highlight the headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+(put 'gnus-treat-highlight-headers 'highlight t)
+
+(defcustom gnus-treat-highlight-citation t
+  "Highlight cited text.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+(put 'gnus-treat-highlight-citation 'highlight t)
+
+(defcustom gnus-treat-date-ut nil
+  "Display the Date in UT (GMT).
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-date-local nil
+  "Display the Date in the local timezone.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-date-lapsed nil
+  "Display the Date header in a way that says how much time has elapsed.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-date-original nil
+  "Display the date in the original timezone.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-date-iso8601 nil
+  "Display the date in the ISO8601 format.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-date-user-defined nil
+  "Display the date in a user-defined format.
+The format is defined by the `gnus-article-time-format' variable.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+
+(defcustom gnus-treat-strip-headers-in-body t
+  "Strip the X-No-Archive header line from the beginning of the body.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-strip-trailing-blank-lines nil
+  "Strip trailing blank lines.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-strip-leading-blank-lines nil
+  "Strip leading blank lines.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-strip-multiple-blank-lines nil
+  "Strip multiple blank lines.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-overstrike t
+  "Treat overstrike highlighting.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+(put 'gnus-treat-overstrike 'highlight t)
+
+(defcustom gnus-treat-display-xface (if (and gnus-xemacs (featurep 'xface))
+                                       'head nil)
+  "Display X-Face headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+(put 'gnus-treat-display-xface 'highlight t)
+
+(defcustom gnus-treat-display-smileys (if (and gnus-xemacs
+                                              (featurep 'xpm))
+                                         t nil)
+  "Display smileys.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+(put 'gnus-treat-display-smileys 'highlight t)
+
+(defcustom gnus-treat-display-picons (if gnus-xemacs 'head nil)
+  "Display picons.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-head-custom)
+(put 'gnus-treat-display-picons 'highlight t)
+
+(defcustom gnus-treat-capitalize-sentences nil
+  "Capitalize sentence-starting words.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-fill-long-lines nil
+  "