2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / gnus-art.el
index b353831..1b3cf01 100644 (file)
@@ -410,6 +410,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
@@ -417,6 +418,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)))
 
@@ -794,7 +796,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)
@@ -883,13 +885,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.
@@ -1665,7 +1660,8 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
          ;; We now have the area of the buffer where the X-Face is stored.
          (save-excursion
            (let ((beg (point))
-                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
+                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))
+                 buffer-read-only)
              ;; We display the face.
              (if (symbolp gnus-article-x-face-command)
                  ;; The command is a lisp function, so we call it.
@@ -1763,19 +1759,19 @@ If PROMPT (the prefix), prompt for a coding system to use."
     (when (and (or gnus-group-name-charset-method-alist
                   gnus-group-name-charset-group-alist)
               (gnus-buffer-live-p gnus-original-article-buffer))
-      (when (mail-fetch-field "Newsgroups")
+      (when (nnmail-fetch-field "Newsgroups")
        (nnheader-replace-header "Newsgroups"
                                 (gnus-decode-newsgroups
                                  (with-current-buffer
                                      gnus-original-article-buffer
-                                   (mail-fetch-field "Newsgroups"))
+                                   (nnmail-fetch-field "Newsgroups"))
                                  gnus-newsgroup-name method)))
-      (when (mail-fetch-field "Followup-To")
+      (when (nnmail-fetch-field "Followup-To")
        (nnheader-replace-header "Followup-To"
                                 (gnus-decode-newsgroups
                                  (with-current-buffer
                                      gnus-original-article-buffer
-                                   (mail-fetch-field "Followup-To"))
+                                   (nnmail-fetch-field "Followup-To"))
                                  gnus-newsgroup-name method))))))
 
 (defun article-de-quoted-unreadable (&optional force read-charset)
@@ -2510,13 +2506,13 @@ This format is defined by the `gnus-article-time-format' variable."
                face (nth 3 elem))
          (while (re-search-forward regexp nil t)
            (when (and (match-beginning visible) (match-beginning invisible))
-             (push 'emphasis gnus-article-wash-types)
              (gnus-article-hide-text
               (match-beginning invisible) (match-end invisible) props)
              (gnus-article-unhide-text-type
               (match-beginning visible) (match-end visible) 'emphasis)
              (gnus-put-text-property-excluding-newlines
               (match-beginning visible) (match-end visible) 'face face)
+             (push 'emphasis gnus-article-wash-types)
              (goto-char (match-end invisible)))))))))
 
 (defun gnus-article-setup-highlight-words (&optional highlight-words)
@@ -2718,7 +2714,7 @@ Directory to save to is default to `gnus-article-save-directory'."
   filename)
 
 (defun gnus-summary-write-to-file (&optional filename)
-  "Write this article to a file.
+  "Write this article to a file, overwriting it if the file exists.
 Optional argument FILENAME specifies file name.
 The directory to save in defaults to `gnus-article-save-directory'."
   (gnus-summary-save-in-file nil t))
@@ -2767,6 +2763,13 @@ The directory to save in defaults to `gnus-article-save-directory'."
       (shell-command-on-region (point-min) (point-max) command nil)))
   (setq gnus-last-shell-command command))
 
+(defun gnus-summary-pipe-to-muttprint (&optional command)
+  "Pipe this article to muttprint."
+  (setq command (read-string
+                "Print using command: " gnus-summary-muttprint-program
+                nil gnus-summary-muttprint-program))
+  (gnus-summary-save-in-pipe command))
+
 ;;; Article file names when saving.
 
 (defun gnus-capitalize-newsgroup (newsgroup)
@@ -2906,6 +2909,12 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                  (put-text-property (match-end 0) (point-max)
                                     'face eface)))))))))
 
+(defun article-verify-cancel-lock ()
+  "Verify Cancel-Lock header."
+  (interactive)
+  (if (gnus-buffer-live-p gnus-original-article-buffer)
+      (canlock-verify gnus-original-article-buffer)))
+
 (eval-and-compile
   (mapcar
    (lambda (func)
@@ -2927,6 +2936,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                  (apply ',afunc args))))))))
    '(article-hide-headers
      article-verify-x-pgp-sig
+     article-verify-cancel-lock
      article-hide-boring-headers
      article-treat-overstrike
      article-fill-long-lines
@@ -4088,6 +4098,39 @@ If no internal viewer is available, use an external viewer."
     (when ibegend
       (goto-char point))))
 
+(defconst gnus-article-wash-status-strings
+  (let ((alist '((cite "c" "Possible hidden citation text" 
+                      " " "All citation text visible")
+                (headers "h" "Hidden headers"
+                         " " "All headers visible.")
+                (pgp "p" "Encrypted or signed message status hidden" 
+                     " " "No hidden encryption nor digital signature status")
+                (signature "s" "Signature has been hidden"
+                           " " "Signature is visible")
+                (overstrike "o" "Overstrike (^H) characters applied"
+                            " " "No overstrike characters applied")
+                (emphasis "e" "/*_Emphasis_*/ characters applied"
+                          " " "No /*_emphasis_*/ characters applied")))
+       result)
+    (dolist (entry alist result)
+      (let ((key (nth 0 entry))
+           (on (copy-sequence (nth 1 entry)))
+           (on-help (nth 2 entry))
+           (off (copy-sequence (nth 3 entry)))
+           (off-help (nth 4 entry)))
+       (put-text-property 0 1 'help-echo on-help on)
+       (put-text-property 0 1 'help-echo off-help off)
+       (push (list key on off) result))))
+  "Alist of strings describing wash status in the mode line.
+Each entry has the form (KEY ON OF), where the KEY is a symbol
+representing the particular washing function, ON is the string to use
+in the article mode line when the washing function is active, and OFF
+is the string to use when it is inactive.")
+      
+(defun gnus-gnus-article-wash-status-entry (key value)
+  (let ((entry (assoc key gnus-article-wash-status-strings)))
+    (if value (nth 1 entry) (nth 2 entry))))
+
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."
   (save-excursion
@@ -4102,13 +4145,14 @@ If no internal viewer is available, use an external viewer."
          (signature (memq 'signature gnus-article-wash-types))
          (overstrike (memq 'overstrike gnus-article-wash-types))
          (emphasis (memq 'emphasis gnus-article-wash-types)))
-      (format "%c%c%c%c%c%c"
-             (if cite ?c ? )
-             (if (or headers boring) ?h ? )
-             (if (or pgp pem signed encrypted) ?p ? )
-             (if signature ?s ? )
-             (if overstrike ?o ? )
-             (if emphasis ?e ? )))))
+      (concat (gnus-gnus-article-wash-status-entry 'cite cite)
+             (gnus-gnus-article-wash-status-entry 'headers 
+                                                  (or headers boring))
+             (gnus-gnus-article-wash-status-entry 
+              'pgp (or pgp pem signed encrypted))
+             (gnus-gnus-article-wash-status-entry 'signature signature)
+             (gnus-gnus-article-wash-status-entry 'overstrike overstrike)
+             (gnus-gnus-article-wash-status-entry 'emphasis emphasis)))))
 
 (defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
 
@@ -5058,14 +5102,21 @@ specified by `gnus-button-alist'."
     (let ((buffer-read-only nil)
          (inhibit-point-motion-hooks t))
       (if (text-property-any end (point-max) 'article-type 'signature)
-         (gnus-remove-text-properties-when
-          'article-type 'signature end (point-max)
-          (cons 'article-type (cons 'signature
-                                    gnus-hidden-properties)))
+         (progn
+           (setq gnus-article-wash-types
+                 (delq 'signature gnus-article-wash-types))
+           (gnus-remove-text-properties-when
+            'article-type 'signature end (point-max)
+            (cons 'article-type (cons 'signature
+                                      gnus-hidden-properties))))
+       (or (memq 'signature gnus-article-wash-types)
+           (push 'signature gnus-article-wash-types))
        (gnus-add-text-properties-when
         'article-type nil end (point-max)
         (cons 'article-type (cons 'signature
-                                  gnus-hidden-properties)))))))
+                                  gnus-hidden-properties)))))
+    (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
+      (gnus-set-mode-line 'article))))
 
 (defun gnus-button-entry ()
   ;; Return the first entry in `gnus-button-alist' matching this place.
@@ -5196,38 +5247,6 @@ specified by `gnus-button-alist'."
          (setq retval (cons (list key val) retval)))))
     retval))
 
-(defun gnus-url-unhex (x)
-  (if (> x ?9)
-      (if (>= x ?a)
-         (+ 10 (- x ?a))
-       (+ 10 (- x ?A)))
-    (- x ?0)))
-
-(defun gnus-url-unhex-string (str &optional allow-newlines)
-  "Remove %XXX embedded spaces, etc in a url.
-If optional second argument ALLOW-NEWLINES is non-nil, then allow the
-decoding of carriage returns and line feeds in the string, which is normally
-forbidden in URL encoding."
-  (setq str (or (mm-subst-char-in-string ?+ ?  str) ""))
-  (let ((tmp "")
-       (case-fold-search t))
-    (while (string-match "%[0-9a-f][0-9a-f]" str)
-      (let* ((start (match-beginning 0))
-            (ch1 (gnus-url-unhex (elt str (+ start 1))))
-            (code (+ (* 16 ch1)
-                     (gnus-url-unhex (elt str (+ start 2))))))
-       (setq tmp (concat
-                  tmp (substring str 0 start)
-                  (cond
-                   (allow-newlines
-                    (char-to-string code))
-                   ((or (= code ?\n) (= code ?\r))
-                    " ")
-                   (t (char-to-string code))))
-             str (substring str (match-end 0)))))
-    (setq tmp (concat tmp str))
-    tmp))
-
 (defun gnus-url-mailto (url)
   ;; Send mail to someone
   (when (string-match "mailto:/*\\(.*\\)" url)