2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
[gnus] / lisp / gnus-art.el
index 87bd950..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)
@@ -1658,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.
@@ -2711,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))
@@ -2760,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)
@@ -2899,8 +2909,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                  (put-text-property (match-end 0) (point-max)
                                     'face eface)))))))))
 
-(autoload 'canlock-verify "canlock")
-
 (defun article-verify-cancel-lock ()
   "Verify Cancel-Lock header."
   (interactive)
@@ -4090,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
@@ -4104,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)
 
@@ -5205,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)