2002-05-20 Jason <jbaker@cs.utah.edu>
[gnus] / lisp / gnus-sum.el
index 82b9fa3..dd18ff8 100644 (file)
@@ -136,8 +136,9 @@ comparing subjects."
   "List of functions taking a string argument that simplify subjects.
 The functions are applied recursively.
 
-Useful functions to put in this list include: `gnus-simplify-subject-re',
-`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'."
+Useful functions to put in this list include:
+`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy',
+`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'."
   :group 'gnus-thread
   :type '(repeat function))
 
@@ -420,6 +421,11 @@ this variable specifies group names."
   :group 'gnus-summary-marks
   :type 'character)
 
+(defcustom gnus-spam-mark ?H
+  "*Mark used for spam articles."
+  :group 'gnus-summary-marks
+  :type 'character)
+
 (defcustom gnus-souped-mark ?F
   "*Mark used for souped articles."
   :group 'gnus-summary-marks
@@ -536,7 +542,7 @@ this variable specifies group names."
   :type 'boolean)
 
 (defcustom gnus-auto-expirable-marks
-  (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
+  (list gnus-spam-mark gnus-killed-mark gnus-del-mark gnus-catchup-mark
        gnus-low-score-mark gnus-ancient-mark gnus-read-mark
        gnus-souped-mark gnus-duplicate-mark)
   "*The list of marks converted into expiration if a group is auto-expirable."
@@ -580,7 +586,7 @@ with some simple extensions.
 %S  The subject
 
 General format specifiers can also be used.
-See (gnus)Formatting Variables."
+See `(gnus)Formatting Variables'."
   :link '(custom-manual "(gnus)Formatting Variables")
   :group 'gnus-threading
   :type 'string)
@@ -837,30 +843,30 @@ automatically when it is selected."
   :type 'face)
 
 (defcustom gnus-summary-highlight
-  '(((= mark gnus-canceled-mark)
+  '(((eq mark gnus-canceled-mark)
      . gnus-summary-cancelled-face)
     ((and (> score default-high)
-         (or (= mark gnus-dormant-mark)
-             (= mark gnus-ticked-mark)))
+         (or (eq mark gnus-dormant-mark)
+             (eq mark gnus-ticked-mark)))
      . gnus-summary-high-ticked-face)
     ((and (< score default-low)
-         (or (= mark gnus-dormant-mark)
-             (= mark gnus-ticked-mark)))
+         (or (eq mark gnus-dormant-mark)
+             (eq mark gnus-ticked-mark)))
      . gnus-summary-low-ticked-face)
-    ((or (= mark gnus-dormant-mark)
-        (= mark gnus-ticked-mark))
+    ((or (eq mark gnus-dormant-mark)
+        (eq mark gnus-ticked-mark))
      . gnus-summary-normal-ticked-face)
-    ((and (> score default-high) (= mark gnus-ancient-mark))
+    ((and (> score default-high) (eq mark gnus-ancient-mark))
      . gnus-summary-high-ancient-face)
-    ((and (< score default-low) (= mark gnus-ancient-mark))
+    ((and (< score default-low) (eq mark gnus-ancient-mark))
      . gnus-summary-low-ancient-face)
-    ((= mark gnus-ancient-mark)
+    ((eq mark gnus-ancient-mark)
      . gnus-summary-normal-ancient-face)
-    ((and (> score default-high) (= mark gnus-unread-mark))
+    ((and (> score default-high) (eq mark gnus-unread-mark))
      . gnus-summary-high-unread-face)
-    ((and (< score default-low) (= mark gnus-unread-mark))
+    ((and (< score default-low) (eq mark gnus-unread-mark))
      . gnus-summary-low-unread-face)
-    ((= mark gnus-unread-mark)
+    ((eq mark gnus-unread-mark)
      . gnus-summary-normal-unread-face)
     ((and (> score default-high) (memq mark (list gnus-downloadable-mark
                                                  gnus-undownloaded-mark)))
@@ -991,14 +997,6 @@ For example: ((1 . cn-gb-2312) (2 . big5))."
   :type '(choice (const nil)
                 integer))
 
-(defcustom gnus-summary-save-parts-default-mime "image/.*"
-  "*A regexp to match MIME parts when saving multiple parts of a message
-with gnus-summary-save-parts (X m). This regexp will be used by default
-when prompting the user for which type of files to save."
-  :group 'gnus-summary
-  :type 'regexp)
-
-
 (defcustom gnus-summary-save-parts-default-mime "image/.*"
   "*A regexp to match MIME parts when saving multiple parts of a message
 with gnus-summary-save-parts (X m). This regexp will be used by default
@@ -1053,9 +1051,6 @@ the MIME-Version header is missed."
 (defvar gnus-summary-save-parts-type-history nil)
 (defvar gnus-summary-save-parts-last-directory nil)
 
-(defvar gnus-summary-save-parts-type-history nil)
-(defvar gnus-summary-save-parts-last-directory nil)
-
 ;; Avoid highlighting in kill files.
 (defvar gnus-summary-inhibit-highlight nil)
 (defvar gnus-newsgroup-selected-overlay nil)
@@ -1368,6 +1363,13 @@ For example:
       (setq mystr (substring mystr 0 (match-beginning 0))))
     mystr))
 
+(defun gnus-simplify-all-whitespace (str)
+  "Remove all whitespace from STR."
+  (let ((mystr str))
+    (while (string-match "[ \t\n]+" mystr)
+      (setq mystr (replace-match "" nil nil mystr)))
+    mystr))
+
 (defsubst gnus-simplify-subject-re (subject)
   "Remove \"Re:\" from subject lines."
   (if (string-match message-subject-re-regexp subject)
@@ -1984,7 +1986,28 @@ increase the score of each group you read."
              ["Show X-Face" gnus-article-display-x-face t]
              ["Show picons in From" gnus-treat-from-picon t]
              ["Show picons in mail headers" gnus-treat-mail-picon t]
-             ["Show picons in news headers" gnus-treat-newsgroups-picon t])
+             ["Show picons in news headers" gnus-treat-newsgroups-picon t]
+             ("View as different encoding"
+              ,@(mapcar
+                 (lambda (cs)
+                   ;; Since easymenu under FSF Emacs doesn't allow lambda
+                   ;; forms for menu commands, we should provide intern'ed
+                   ;; function symbols.
+                   (let ((command (intern (format "\
+gnus-summary-show-article-from-menu-as-charset-%s" cs))))
+                     (fset command
+                           `(lambda ()
+                              (interactive)
+                              (let ((gnus-summary-show-article-charset-alist
+                                     '((1 . ,cs))))
+                                (gnus-summary-show-article 1))))
+                     `[,(symbol-name cs) ,command t]))
+                 (sort (if (fboundp 'coding-system-list)
+                           (coding-system-list)
+                         (mapcar 'car mm-mime-mule-charset-alist))
+                       (lambda (a b)
+                         (string< (symbol-name a)
+                                  (symbol-name b)))))))
             ("Washing"
              ("Remove Blanks"
               ["Leading" gnus-article-strip-leading-blank-lines t]
@@ -2070,7 +2093,7 @@ increase the score of each group you read."
              ["Save" gnus-uu-decode-save t]
              ["Binhex" gnus-uu-decode-binhex t]
              ["Postscript" gnus-uu-decode-postscript t]
-             ["all MIME parts" gnus-summary-save-parts t])
+             ["All MIME parts" gnus-summary-save-parts t])
             ("Cache"
              ["Enter article" gnus-cache-enter-article t]
              ["Remove article" gnus-cache-remove-article t])
@@ -3018,17 +3041,19 @@ buffer that was in action when the last article was fetched."
           0 nil 128 t nil "" nil 1)
          (goto-char (point-min))
          (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
-                                            (- (point) 2)))))
+                                            (- (point) (point-min) 1)))))
          (goto-char (point-min))
          (push (cons 'replied (and (search-forward "\201" nil t)
-                                   (- (point) 2)))
+                                   (- (point) (point-min) 1)))
                pos)
          (goto-char (point-min))
-         (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
+         (push (cons 'score (and (search-forward "\202" nil t)
+                                 (- (point) (point-min) 1)))
                pos)
          (goto-char (point-min))
          (push (cons 'download
-                     (and (search-forward "\203" nil t) (- (point) 2)))
+                     (and (search-forward "\203" nil t)
+                          (- (point) (point-min) 1)))
                pos)))
       (setq gnus-summary-mark-positions pos))))
 
@@ -4324,20 +4349,32 @@ Unscored articles will be counted as having a score of zero."
 
 (defvar gnus-tmp-thread-tree-header-string "")
 
-(defvar gnus-sum-thread-tree-root "> "
+(defcustom gnus-sum-thread-tree-root "> "
   "With %B spec, used for the root of a thread.
-If nil, use subject instead.")
-(defvar gnus-sum-thread-tree-single-indent ""
+If nil, use subject instead."
+  :type 'string
+  :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-single-indent ""
   "With %B spec, used for a thread with just one message.
-If nil, use subject instead.")
-(defvar gnus-sum-thread-tree-vertical "| "
-  "With %B spec, used for drawing a vertical line.")
-(defvar gnus-sum-thread-tree-indent "  "
-  "With %B spec, used for indenting.")
-(defvar gnus-sum-thread-tree-leaf-with-other "+-> "
-  "With %B spec, used for a leaf with brothers.")
-(defvar gnus-sum-thread-tree-single-leaf "\\-> "
-  "With %B spec, used for a leaf without brothers.")
+If nil, use subject instead."
+  :type 'string
+  :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-vertical "| "
+  "With %B spec, used for drawing a vertical line."
+  :type 'string
+  :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-indent "  "
+  "With %B spec, used for indenting."
+  :type 'string
+  :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
+  "With %B spec, used for a leaf with brothers."
+  :type 'string
+  :group 'gnus-thread)
+(defcustom gnus-sum-thread-tree-single-leaf "\\-> "
+  "With %B spec, used for a leaf without brothers."
+  :type 'string
+  :group 'gnus-thread)
 
 (defun gnus-summary-prepare-threads (threads)
   "Prepare summary buffer from THREADS and indentation LEVEL.
@@ -6653,7 +6690,10 @@ be displayed."
 (defun gnus-summary-force-verify-and-decrypt ()
   (interactive)
   (let ((mm-verify-option 'known)
-       (mm-decrypt-option 'known))
+       (mm-decrypt-option 'known)
+       (gnus-buttonized-mime-types (append (list "multipart/signed" 
+                                                 "multipart/encrypted")
+                                           gnus-buttonized-mime-types)))
     (gnus-summary-select-article nil 'force)))
 
 (defun gnus-summary-set-current-mark (&optional current-mark)
@@ -7221,7 +7261,7 @@ If ALL is non-nil, limit strictly to unread articles."
      ;; Concat all the marks that say that an article is read and have
      ;; those removed.
      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
-          gnus-killed-mark gnus-kill-file-mark
+          gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
           gnus-low-score-mark gnus-expirable-mark
           gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
           gnus-duplicate-mark gnus-souped-mark)
@@ -7229,7 +7269,7 @@ If ALL is non-nil, limit strictly to unread articles."
 
 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
 (make-obsolete 'gnus-summary-delete-marked-with
-              'gnus-summary-limit-exlude-marks)
+              'gnus-summary-limit-exclude-marks)
 
 (defun gnus-summary-limit-exclude-marks (marks &optional reverse)
   "Exclude articles that are marked with MARKS (e.g. \"DK\").
@@ -7773,8 +7813,8 @@ to guess what the document format is."
        (set-buffer gnus-original-article-buffer)
        ;; Have the digest group inherit the main mail address of
        ;; the parent article.
-       (when (setq to-address (or (message-fetch-field "reply-to")
-                                  (message-fetch-field "from")))
+       (when (setq to-address (or (gnus-fetch-field "reply-to")
+                                  (gnus-fetch-field "from")))
          (setq params (append
                        (list (cons 'to-address
                                    (funcall gnus-decode-encoded-word-function
@@ -8106,6 +8146,7 @@ to save in."
          (copy-to-buffer buffer (point-min) (point-max))
          (set-buffer buffer)
          (gnus-article-delete-invisible-text)
+         (gnus-remove-text-with-property 'gnus-decoration)
          (when (gnus-visual-p 'article-highlight 'highlight)
            ;; Copy-to-buffer doesn't copy overlay.  So redo
            ;; highlight.
@@ -8236,7 +8277,7 @@ If ARG is a negative number, hide the unwanted header lines."
     (save-restriction
       (let* ((buffer-read-only nil)
             (inhibit-point-motion-hooks t)
-            hidden e)
+            hidden e)
        (save-restriction
          (article-narrow-to-head)
          (setq e (point-max)
@@ -8245,12 +8286,11 @@ If ARG is a negative number, hide the unwanted header lines."
                         (gnus-article-hidden-text-p 'headers))))
        (delete-region (point-min) e)
        (goto-char (point-min))
-       (save-excursion
-         (set-buffer gnus-original-article-buffer)
-         (goto-char (point-min))
+       (with-current-buffer gnus-original-article-buffer
+         (goto-char (setq s (point-min)))
          (setq e (search-forward "\n\n" nil t)
                e (if e (1- e) (point-max))))
-       (insert-buffer-substring gnus-original-article-buffer 1 e)
+       (insert-buffer-substring gnus-original-article-buffer s e)
        (save-restriction
          (narrow-to-region (point-min) (point))
          (article-decode-encoded-words)
@@ -8305,6 +8345,10 @@ If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
 re-spool using this method.
 
+When called interactively with TO-NEWSGROUP being nil, the value of
+the variable `gnus-move-split-methods' is used for finding a default
+for the target newsgroup.
+
 For this function to work, both the current newsgroup and the
 newsgroup that you want to move to have to support the `request-move'
 and `request-accept' functions.
@@ -8533,6 +8577,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
   "Move the current article to a different newsgroup.
 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
+When called interactively, if TO-NEWSGROUP is nil, use the value of
+the variable `gnus-move-split-methods' for finding a default target
+newsgroup.
 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
 re-spool using this method."
   (interactive "P")
@@ -9099,6 +9146,13 @@ the actual number of articles marked is returned."
   (interactive "p")
   (gnus-summary-mark-forward n gnus-expirable-mark))
 
+(defun gnus-summary-mark-as-spam (n)
+  "Mark N articles forward as spam.
+If N is negative, mark backward instead.  The difference between N and
+the actual number of articles marked is returned."
+  (interactive "p")
+  (gnus-summary-mark-forward n gnus-spam-mark))
+
 (defun gnus-summary-mark-article-as-replied (article)
   "Mark ARTICLE as replied to and update the summary line.
 ARTICLE can also be a list of articles."
@@ -10635,31 +10689,27 @@ If REVERSE, save parts that do not match TYPE."
 (defun gnus-summary-highlight-line ()
   "Highlight current line according to `gnus-summary-highlight'."
   (let* ((list gnus-summary-highlight)
-        (p (point))
-        (end (progn (end-of-line) (point)))
-        ;; now find out where the line starts and leave point there.
-        (beg (progn (beginning-of-line) (point)))
+        (beg (gnus-point-at-bol))
         (article (gnus-summary-article-number))
         (score (or (cdr (assq (or article gnus-current-article)
                               gnus-newsgroup-scored))
                    gnus-summary-default-score 0))
         (mark (or (gnus-summary-article-mark) gnus-unread-mark))
-        (inhibit-read-only t))
+        (inhibit-read-only t)
+        (default gnus-summary-default-score)
+        (default-high gnus-summary-default-high-score)
+        (default-low gnus-summary-default-low-score))
     ;; Eval the cars of the lists until we find a match.
-    (let ((default gnus-summary-default-score)
-         (default-high gnus-summary-default-high-score)
-         (default-low gnus-summary-default-low-score))
-      (while (and list
-                 (not (eval (caar list))))
-       (setq list (cdr list))))
+    (while (and list
+               (not (eval (caar list))))
+      (setq list (cdr list)))
     (let ((face (cdar list)))
       (unless (eq face (get-text-property beg 'face))
        (gnus-put-text-property-excluding-characters-with-faces
-        beg end 'face
+        beg (gnus-point-at-eol) 'face
         (setq face (if (boundp face) (symbol-value face) face)))
        (when gnus-summary-highlight-line-function
-         (funcall gnus-summary-highlight-line-function article face))))
-    (goto-char p)))
+         (funcall gnus-summary-highlight-line-function article face))))))
 
 (defun gnus-update-read-articles (group unread &optional compute)
   "Update the list of read articles in GROUP.