* rfc2047.el (rfc2047-fold-line): New function.
[gnus] / lisp / gnus-art.el
index b682471..291d32d 100644 (file)
     "^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:"g)
+     "^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."
@@ -224,12 +226,11 @@ regexp.  If it matches, the text in question is not a signature."
 ;; non-graphical frames in a session.
 (defcustom gnus-article-x-face-command
   (if (featurep 'xemacs)
-      (if (or (featurep 'xface)
-             (featurep 'xpm))
+      (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 (and (fboundp 'image-type-available-p)
-            (image-type-available-p 'xbm))
+    (if (gnus-image-type-available-p 'xbm)
        'gnus-article-display-xface
       (if gnus-article-compface-xbm
          "{ echo '/* Width=48, Height=48 */'; uncompface; } | display -"
@@ -361,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.
@@ -1013,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.
@@ -1049,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-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-display-picons 'highlight t)
+(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.
@@ -1145,6 +1200,9 @@ It is a string, such as \"PGP\". If nil, ask user."
     (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)
@@ -1155,11 +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)
@@ -1187,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)
@@ -1534,6 +1608,42 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
              (put-text-property
               (point) (1+ (point)) 'face 'underline)))))))))
 
+(defun gnus-article-treat-unfold-headers ()
+  "Unfold folded message headers.
+Only the headers that fit into the current window width will be
+unfolded."
+  (interactive)
+  (gnus-with-article-headers
+    (let (length)
+      (while (not (eobp))
+       (save-restriction
+         (mail-header-narrow-to-field)
+         (let ((header (buffer-substring (point-min) (point-max))))
+           (with-temp-buffer
+             (insert header)
+             (goto-char (point-min))
+             (while (re-search-forward "[\t ]*\n[\t ]+" nil t)
+               (replace-match " " t t)))
+           (setq length (- (point-max) (point-min) 1)))
+         (when (< length (window-width))
+           (while (re-search-forward "[\t ]*\n[\t ]+" nil t)
+             (replace-match " " t t)))
+         (goto-char (point-max)))))))
+
+(defun gnus-article-treat-body-boundary ()
+  "Place a boundary line at the end of the headers."
+  (interactive)
+  (gnus-with-article-headers
+    (goto-char (point-max))
+    (let ((start (point)))
+    (insert "X-Boundary: ")
+    (gnus-add-text-properties start (point) '(invisible t intangible t))
+    (insert (make-string (1- (window-width)) ?-)
+           "\n")
+    ;;(put-text-property (point) (progn (forward-line -1) (point))
+    ;; 'face 'gnus-body-bondary-face)
+    )))
+
 (defun article-fill-long-lines ()
   "Fill lines that are wider than the window width."
   (interactive)
@@ -5699,6 +5809,9 @@ For example:
      (cons (set-marker (make-marker) (point-min))
           (set-marker (make-marker) (point-max))))))
 
+(defun gnus-article-goto-header (header)
+  (re-search-forward (concat "^" header ":") nil t))
+
 (gnus-ems-redefine)
 
 (provide 'gnus-art)