* rfc2047.el (rfc2047-fold-line): New function.
[gnus] / lisp / gnus-art.el
index 5aaa2b7..291d32d 100644 (file)
@@ -32,6 +32,7 @@
 (require 'gnus-sum)
 (require 'gnus-spec)
 (require 'gnus-int)
+(require 'gnus-win)
 (require 'mm-bodies)
 (require 'mail-parse)
 (require 'mm-decode)
     "^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-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:")
   "*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."
@@ -168,15 +175,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',
-`to-address', `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 "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 "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)
 
@@ -209,20 +224,26 @@ 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 -"
-      "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
-display -"))
+  (if (featurep 'xemacs)
+      (if (or (gnus-image-type-available-p 'xface)
+             (gnus-image-type-available-p 'xpm))
+         'gnus-xmas-article-display-xface
+       "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
+    (if (gnus-image-type-available-p 'xbm)
+       'gnus-article-display-xface
+      (if gnus-article-compface-xbm
+         "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
+       "{ 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
+                 ,(if (featurep 'xemacs)
+                      'gnus-xmas-article-display-xface
+                    'gnus-article-display-xface))
                 function)
   :version "21.1"
   :group 'gnus-article-washing)
@@ -341,6 +362,19 @@ Esample: (_/*word*/_)."
   "Face used for displaying highlighted words."
   :group 'gnus-article-emphasis)
 
+(defface gnus-body-boundary-face
+  '((((class color)
+      (background dark))
+     (:background "white")
+     (:foreground "black"))
+    (((class color)
+      (background light))
+     (:background "black")
+     (:foreground "white"))
+    (t
+     ()))
+  "Face for the body separator.")
+
 (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.
@@ -392,6 +426,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
@@ -399,6 +434,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)))
 
@@ -620,7 +656,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)
@@ -661,7 +698,17 @@ displayed by the first non-nil matching CONTENT face."
   :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))
@@ -765,7 +812,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)
@@ -805,6 +852,13 @@ See the manual 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 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.
@@ -847,13 +901,6 @@ See the manual for details."
   :group 'gnus-article-treat
   :type gnus-article-treat-custom)
 
-(defcustom gnus-treat-hide-citation-maybe 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.
@@ -980,6 +1027,13 @@ See the manual for details."
   :group 'gnus-article-treat
   :type gnus-article-treat-custom)
 
+(defcustom gnus-treat-unfold-headers 'head
+  "Unfold folded header 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.
@@ -1016,13 +1070,47 @@ See the manual for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-display-smileys 'highlight t)
 
-(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil)
-  "Display picons.
+(defcustom gnus-treat-from-picon
+  (if (gnus-image-type-available-p 'xpm)
+      'head nil)
+  "Display picons in the From header.
 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)
+(put 'gnus-treat-from-picon 'highlight t)
+
+(defcustom gnus-treat-mail-picon
+  (if (gnus-image-type-available-p 'xpm)
+      'head nil)
+  "Display picons in To and Cc 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-mail-picon 'highlight t)
+
+(defcustom gnus-treat-newsgroups-picon
+  (if (gnus-image-type-available-p 'xpm)
+      'head nil)
+  "Display picons in the Newsgroups and Followup-To 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-newsgroups-picon 'highlight t)
+
+(defcustom gnus-treat-body-boundary
+  (if (or gnus-treat-newsgroups-picon
+         gnus-treat-mail-picon
+         gnus-treat-from-picon)
+      'head nil)
+  "Draw a boundary at the end of the headers.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :version "21.1"
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
 
 (defcustom gnus-treat-capitalize-sentences nil
   "Capitalize sentence-starting words.
@@ -1095,7 +1183,6 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-fill-article gnus-article-fill-cited-article)
     (gnus-treat-fill-long-lines gnus-article-fill-long-lines)
     (gnus-treat-strip-cr gnus-article-remove-cr)
-    (gnus-treat-emphasize gnus-article-emphasize)
     (gnus-treat-display-xface gnus-article-display-x-face)
     (gnus-treat-date-ut gnus-article-date-ut)
     (gnus-treat-date-local gnus-article-date-local)
@@ -1110,8 +1197,12 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-hide-citation gnus-article-hide-citation)
     (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
     (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
+    (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
     (gnus-treat-strip-pgp gnus-article-hide-pgp)
     (gnus-treat-strip-pem gnus-article-hide-pem)
+    (gnus-treat-from-picon gnus-treat-from-picon)
+    (gnus-treat-mail-picon gnus-treat-mail-picon)
+    (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
     (gnus-treat-highlight-headers gnus-article-highlight-headers)
     (gnus-treat-highlight-citation gnus-article-highlight-citation)
     (gnus-treat-highlight-signature gnus-article-highlight-signature)
@@ -1122,10 +1213,12 @@ It is a string, such as \"PGP\". If nil, ask user."
     (gnus-treat-strip-multiple-blank-lines
      gnus-article-strip-multiple-blank-lines)
     (gnus-treat-overstrike gnus-article-treat-overstrike)
+    (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
     (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
     (gnus-treat-display-smileys gnus-smiley-display)
     (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
-    (gnus-treat-display-picons gnus-article-display-picons)
+    (gnus-treat-emphasize gnus-article-emphasize)
+    (gnus-treat-body-boundary gnus-article-treat-body-boundary)
     (gnus-treat-play-sounds gnus-earcon-display)))
 
 (defvar gnus-article-mime-handle-alist nil)
@@ -1153,6 +1246,21 @@ Initialized from `text-mode-syntax-table.")
 
 (defvar gnus-inhibit-hiding nil)
 
+;;; Macros for dealing with the article buffer.
+
+(defmacro gnus-with-article-headers (&rest forms)
+  `(save-excursion
+     (set-buffer gnus-article-buffer)
+     (save-restriction
+       (let ((buffer-read-only nil)
+            (inhibit-point-motion-hooks t)
+            (case-fold-search t))
+        (article-narrow-to-head)
+        ,@forms))))
+
+(put 'gnus-with-article-headers 'lisp-indent-function 0)
+(put 'gnus-with-article-headers 'edebug-form-spec '(body))
+
 (defsubst gnus-article-hide-text (b e props)
   "Set text PROPS on the B to E region, extending `intangible' 1 past B."
   (gnus-add-text-properties-when 'article-type nil b e props)
@@ -1261,7 +1369,7 @@ Initialized from `text-mode-syntax-table.")
          ;; `gnus-ignored-headers' and `gnus-visible-headers' to
          ;; select which header lines is to remain visible in the
          ;; article buffer.
-         (while (re-search-forward "^[^ \t]*:" nil t)
+         (while (re-search-forward "^[^ \t:]*:" nil t)
            (beginning-of-line)
            ;; Mark the rank of the header.
            (put-text-property
@@ -1323,9 +1431,9 @@ always hide."
             ((eq elem 'to-address)
              (let ((to (message-fetch-field "to"))
                    (to-address
-                    (gnus-group-find-parameter
+                    (gnus-parameter-to-address
                      (if (boundp 'gnus-newsgroup-name)
-                         gnus-newsgroup-name "") 'to-address)))
+                         gnus-newsgroup-name ""))))
                (when (and to to-address
                           (ignore-errors
                             (gnus-string-equal
@@