2002-01-04 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / gnus-art.el
index 999cd08..08f1bf3 100644 (file)
@@ -1,5 +1,6 @@
 ;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -31,6 +32,7 @@
 (require 'gnus-sum)
 (require 'gnus-spec)
 (require 'gnus-int)
+(require 'gnus-win)
 (require 'mm-bodies)
 (require 'mail-parse)
 (require 'mm-decode)
 (require 'wid-edit)
 (require 'mm-uu)
 
+(autoload 'gnus-msg-mail "gnus-msg" nil t)
+(autoload 'gnus-button-mailto "gnus-msg")
+(autoload 'gnus-button-reply "gnus-msg" nil t)
+
 (defgroup gnus-article nil
   "Article display."
   :link '(custom-manual "(gnus)The Article Buffer")
     "^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-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:"
+    "^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face"
     "^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:"
     "^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:"
     "^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:"
     "^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:"
     "^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:"
     "^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:"
-    "^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:"
+    "^MBOX-Line" "^Priority:" "^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:"
     "^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:")
+    "^X-Received:" "^Content-length:" "X-precedence:"
+    "^X-Authenticated-User:" "^X-Comment" "^X-Report:" "^X-Abuse-Info:"
+    "^X-HTTP-Proxy:" "^X-Mydeja-Info:" "^X-Copyright" "^X-No-Markup:"
+    "^X-Abuse-Info:" "^X-From_:" "^X-Accept-Language:" "^Errors-To:"
+    "^X-BeenThere:" "^X-Mailman-Version:" "^List-Help:" "^List-Post:"
+    "^List-Subscribe:" "^List-Id:" "^List-Unsubscribe:" "^List-Archive:"
+     "^X-Content-length:" "^X-Posting-Agent:" "^Original-Received:"
+     "^X-Request-PGP:" "^X-Fingerprint:" "^X-WRIEnvto:" "^X-WRIEnvfrom:"
+     "^X-Virus-Scanned:" "^X-Delivery-Agent:" "^Posted-Date:" "^X-Gateway:"
+     "^X-Local-Origin:" "^X-Local-Destination:" "^X-UserInfo1:"
+     "^X-Received-Date:")
   "*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."
@@ -160,14 +176,23 @@ this list."
 
 (defcustom gnus-boring-article-headers '(empty followup-to reply-to)
   "Headers that are only to be displayed if they have interesting data.
-Possible values in this list are `empty', `newsgroups', `followup-to',
-`reply-to', `date', `long-to', and `many-to'."
+Possible values in this list are:
+
+  'empty       Headers with no content.
+  'newsgroups  Newsgroup identical to Gnus group.
+  'to-address  To identical to To-address.
+  'followup-to Followup-to identical to Newsgroups.
+  'reply-to    Reply-to identical to From.
+  'date        Date less than four days old.
+  'long-to     To and/or Cc longer than 1024 characters.
+  'many-to     Multiple To and/or Cc."
   :type '(set (const :tag "Headers with no content." empty)
-             (const :tag "Newsgroups with only one group." newsgroups)
-             (const :tag "Followup-to identical to newsgroups." followup-to)
-             (const :tag "Reply-to identical to from." reply-to)
+             (const :tag "Newsgroups identical to Gnus group." newsgroups)
+             (const :tag "To identical to To-address." to-address)
+             (const :tag "Followup-to identical to Newsgroups." followup-to)
+             (const :tag "Reply-to identical to From." reply-to)
              (const :tag "Date less than four days old." date)
-             (const :tag "Very long To and/or Cc header." long-to)
+             (const :tag "To and/or Cc longer than 1024 characters." long-to)
              (const :tag "Multiple To and/or Cc headers." many-to))
   :group 'gnus-article-hiding)
 
@@ -200,21 +225,23 @@ regexp.  If it matches, the text in question is not a signature."
 
 ;; Fixme: This isn't the right thing for mixed graphical and and
 ;; non-graphical frames in a session.
-;; gnus-xmas.el overrides this for XEmacs.
 (defcustom gnus-article-x-face-command
-  (if (and (fboundp 'image-type-available-p)
-          (image-type-available-p 'xbm))
-      'gnus-article-display-xface
-    (if gnus-article-compface-xbm
-       "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
+  (if (featurep 'xemacs)
+      (if (or (gnus-image-type-available-p 'xface)
+             (gnus-image-type-available-p 'pbm))
+         'gnus-display-x-face-in-from
+       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
+    (if (gnus-image-type-available-p 'pbm)
+       'gnus-display-x-face-in-from
       "{ 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."
-  :type '(choice string
-                (function-item gnus-article-display-xface)
+  :type `(choice string
+                (function-item gnus-display-x-face-in-from)
                 function)
+  :version "21.1"
   :group 'gnus-article-washing)
 
 (defcustom gnus-article-x-face-too-ugly nil
@@ -224,11 +251,33 @@ asynchronously.    The compressed face will be piped to this command."
 
 (defcustom gnus-article-banner-alist nil
   "Banner alist for stripping.
-For example, 
-     ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+For example,
+     ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+  :version "21.1"
   :type '(repeat (cons symbol regexp))
   :group 'gnus-article-washing)
 
+(gnus-define-group-parameter
+ banner
+ :variable-document
+ "Alist of regexps (to match group names) and banner."
+ :variable-group gnus-article-washing
+ :parameter-type
+ '(choice :tag "Banner"
+         :value nil
+         (const :tag "Remove signature" signature)
+         (symbol :tag "Item in `gnus-article-banner-alist'" none)
+         regexp
+         (const :tag "None" nil))
+ :parameter-document
+ "If non-nil, specify how to remove `banners' from articles.
+
+Symbol `signature' means to remove signatures delimited by
+`gnus-signature-separator'.  Any other symbol is used to look up a
+regular expression to match the banner in `gnus-article-banner-alist'.
+A string is used as a regular expression to match the banner
+directly.")
+
 (defcustom gnus-emphasis-alist
   (let ((format
         "\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
@@ -270,6 +319,7 @@ is the face used for highlighting."
 Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
 The former avoids underlining of leading and trailing whitespace,
 and the latter avoids underlining any whitespace at all."
+  :version "21.1"
   :group 'gnus-article-emphasis
   :type 'regexp)
 
@@ -359,6 +409,7 @@ Gnus provides the following functions:
 * gnus-summary-save-in-mail (Unix mail format)
 * gnus-summary-save-in-folder (MH folder)
 * gnus-summary-save-in-file (article format)
+* gnus-summary-save-body-in-file (article body)
 * gnus-summary-save-in-vm (use VM's folder format)
 * gnus-summary-write-to-file (article format -- overwrite)."
   :group 'gnus-article-saving
@@ -366,6 +417,7 @@ Gnus provides the following functions:
                (function-item gnus-summary-save-in-mail)
                (function-item gnus-summary-save-in-folder)
                (function-item gnus-summary-save-in-file)
+               (function-item gnus-summary-save-body-in-file)
                (function-item gnus-summary-save-in-vm)
                (function-item gnus-summary-write-to-file)))
 
@@ -444,6 +496,13 @@ The following additional specs are available:
   :type 'hook
   :group 'gnus-article-various)
 
+(when (featurep 'xemacs)
+  ;; Extracted from gnus-xmas-define in order to preserve user settings
+  (when (fboundp 'turn-off-scroll-in-place)
+    (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
+  ;; Extracted from gnus-xmas-redefine in order to preserve user settings
+  (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
+
 (defcustom gnus-article-menu-hook nil
   "*Hook run after the creation of the article mode menu."
   :type 'hook
@@ -580,7 +639,8 @@ displayed by the first non-nil matching CONTENT face."
                               (face :value default)))))
 
 (defcustom gnus-article-decode-hook
-  '(article-decode-charset article-decode-encoded-words)
+  '(article-decode-charset article-decode-encoded-words
+                          article-decode-group-name)
   "*Hook run to decode charsets in articles."
   :group 'gnus-article-headers
   :type 'hook)
@@ -594,7 +654,8 @@ displayed by the first non-nil matching CONTENT face."
   "Function used to decode headers.")
 
 (defvar gnus-article-dumbquotes-map
-  '(("\202" ",")
+  '(("\200" "EUR")
+    ("\202" ",")
     ("\203" "f")
     ("\204" ",,")
     ("\205" "...")
@@ -615,14 +676,34 @@ displayed by the first non-nil matching CONTENT face."
 
 (defcustom gnus-ignored-mime-types nil
   "List of MIME types that should be ignored by Gnus."
+  :version "21.1"
   :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."
+  "List of MIME types that should not be given buttons when rendered inline.
+See also `gnus-buttonized-mime-types' which may override this variable."
+  :version "21.1"
   :group 'gnus-article-mime
   :type '(repeat regexp))
 
+(defcustom gnus-buttonized-mime-types nil
+  "List of MIME types that should be given buttons when rendered inline.
+If set, this variable overrides `gnus-unbuttonized-mime-types'.
+To see e.g. security buttons you could set this to
+`(\"multipart/signed\")'."
+  :version "21.1"
+  :group 'gnus-article-mime
+  :type '(repeat regexp))
+
+(defcustom gnus-body-boundary-delimiter "_"
+  "String used to delimit header and body.
+This variable is used by `gnus-article-treat-body-boundary' which can
+be controlled by `gnus-treat-body-boundary'."
+  :group 'gnus-article-various
+  :type '(choice (item :tag "None" :value nil)
+                string))
+
 (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
@@ -631,29 +712,34 @@ on parts -- for instance, adding Vcard info to a database."
   :type 'function)
 
 (defcustom gnus-mime-multipart-functions nil
-  "An alist of MIME types to functions to display them.")
+  "An alist of MIME types to functions to display them."
+  :version "21.1"
+  :group 'gnus-article-mime
+  :type 'alist)
 
 (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)."
+  :version "21.1"
   :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 
+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."
+  :version "21.1"
   :group 'gnus-article-mime
-  :type '(choice 
+  :type '(choice
          (item :tag "first" :value nil)
          (item :tag "undisplayed" :value undisplayed)
-         (item :tag "undisplayed or alternative" 
+         (item :tag "undisplayed or alternative"
                :value undisplayed-alternative)
          (function)))
 
@@ -673,6 +759,21 @@ used."
   :type '(repeat (cons (string :tag "name")
                       (function))))
 
+(defcustom gnus-mime-action-alist
+  '(("save to file" . gnus-mime-save-part)
+    ("display as text" . gnus-mime-inline-part)
+    ("view the part" . gnus-mime-view-part)
+    ("pipe to command" . gnus-mime-pipe-part)
+    ("toggle display" . gnus-article-press-button)
+    ("view as type" . gnus-mime-view-part-as-type)
+    ("internalize type" . gnus-mime-internalize-part)
+    ("externalize type" . gnus-mime-externalize-part))
+  "An alist of actions that run on the MIME attachment."
+  :version "21.1"
+  :group 'gnus-article-mime
+  :type '(repeat (cons (string :tag "name")
+                      (function))))
+
 ;;;
 ;;; The treatment variables
 ;;;
@@ -702,7 +803,7 @@ used."
 (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."
+See Info node `(gnus)Customizing Articles'."
   :group 'gnus-article-treat
   :type gnus-article-treat-custom)
 (put 'gnus-treat-highlight-signature 'highlight t)
@@ -710,7 +811,7 @@ See the manual for details."
 (defcustom gnus-treat-buttonize 100000
   "Add buttons.
 Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles'."
   :group 'gnus-article-treat
   :type gnus-article-treat-custom)
 (put 'gnus-treat-buttonize 'highlight t)
@@ -718,15 +819,19 @@ See the manual for details."
 (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."
+See Info node `(gnus)Customizing Articles' for details."
   :group 'gnus-article-treat
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-buttonize-head 'highlight t)
 
-(defcustom gnus-treat-emphasize 50000
+(defcustom gnus-treat-emphasize
+  (and (or window-system
+          (featurep 'xemacs)
+          (>= (string-to-number emacs-version) 21))
+       50000)
   "Emphasize text.
 Valid values are nil, t, `head', `last', an integer or a predicate.
-See the manual for details."
+See Info node `(gnus)Customizing Articles' for details."
   :group 'gnus-article-treat
   :type gnus-article-treat-custom)
 (put 'gnus-treat-emphasize 'highlight t)
@@ -734,70 +839,78 @@ See the manual for details."
 (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."
+See Info node `(gnus)Customizing Articles' for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
+(defcustom gnus-treat-leading-whitespace nil
+  "Remove leading whitespace in headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See Info node `(gnus)Customizing Articles' 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."
+See Info node `(gnus)Customizing Articles' 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."
+See Info node `(gnus)Customizing Articles' 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."
+See Info node `(gnus)Customizing Articles' 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."
+See Info node `(gnus)Customizing Articles' 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."
+See