Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-sum.el
index bffc3dc..9ae9cef 100644 (file)
@@ -54,7 +54,7 @@
 (autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
 (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
 (autoload 'mm-uu-dissect "mm-uu")
-(autoload 'gnus-article-outlook-deuglify-article "deuglify" 
+(autoload 'gnus-article-outlook-deuglify-article "deuglify"
   "Deuglify broken Outlook (Express) articles and redisplay."
   t)
 
@@ -568,7 +568,7 @@ this variable specifies group names."
   :type 'boolean)
 
 (defcustom gnus-auto-expirable-marks
-  (list gnus-spam-mark gnus-killed-mark gnus-del-mark gnus-catchup-mark
+  (list 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."
@@ -671,7 +671,8 @@ was sent, sorting by number means sorting by arrival time.)
 
 Ready-made functions include `gnus-article-sort-by-number',
 `gnus-article-sort-by-author', `gnus-article-sort-by-subject',
-`gnus-article-sort-by-date' and `gnus-article-sort-by-score'.
+`gnus-article-sort-by-date', `gnus-article-sort-by-random'
+and `gnus-article-sort-by-score'.
 
 When threading is turned on, the variable `gnus-thread-sort-functions'
 controls how articles are sorted."
@@ -681,6 +682,7 @@ controls how articles are sorted."
                         (function-item gnus-article-sort-by-subject)
                         (function-item gnus-article-sort-by-date)
                         (function-item gnus-article-sort-by-score)
+                        (function-item gnus-article-sort-by-random)
                         (function :tag "other"))))
 
 (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
@@ -700,7 +702,8 @@ Ready-made functions include `gnus-thread-sort-by-number',
 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
 `gnus-thread-sort-by-most-recent-number',
-`gnus-thread-sort-by-most-recent-date', and
+`gnus-thread-sort-by-most-recent-date',
+`gnus-thread-sort-by-random', and
 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
 
 When threading is turned off, the variable
@@ -712,6 +715,7 @@ When threading is turned off, the variable
                         (function-item gnus-thread-sort-by-date)
                         (function-item gnus-thread-sort-by-score)
                         (function-item gnus-thread-sort-by-total-score)
+                        (function-item gnus-thread-sort-by-random)
                         (function :tag "other"))))
 
 (defcustom gnus-thread-score-function '+
@@ -1132,6 +1136,7 @@ the MIME-Version header is missed."
     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
+    (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
     (?L gnus-tmp-lines ?s)
     (?I gnus-tmp-indentation ?s)
     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
@@ -1180,6 +1185,7 @@ the type of the variable (string, integer, character, etc).")
     (?u gnus-tmp-user-defined ?s)
     (?d (length gnus-newsgroup-dormant) ?d)
     (?t (length gnus-newsgroup-marked) ?d)
+    (?h (length gnus-newsgroup-spam-marked) ?d)
     (?r (length gnus-newsgroup-reads) ?d)
     (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
     (?E gnus-newsgroup-expunged-tally ?d)
@@ -1224,6 +1230,9 @@ end position and text.")
 (defvar gnus-newsgroup-marked nil
   "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
 
+(defvar gnus-newsgroup-spam-marked nil
+  "List of ranges of articles that have been marked as spam.")
+
 (defvar gnus-newsgroup-killed nil
   "List of ranges of articles that have been through the scoring process.")
 
@@ -1312,6 +1321,7 @@ end position and text.")
     gnus-newsgroup-last-folder gnus-newsgroup-last-file
     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
     gnus-newsgroup-unselected gnus-newsgroup-marked
+    gnus-newsgroup-spam-marked
     gnus-newsgroup-reads gnus-newsgroup-saved
     gnus-newsgroup-replied gnus-newsgroup-forwarded
     gnus-newsgroup-recent
@@ -1570,6 +1580,7 @@ increase the score of each group you read."
     "\C-c\C-s\C-d" gnus-summary-sort-by-date
     "\C-c\C-s\C-i" gnus-summary-sort-by-score
     "\C-c\C-s\C-o" gnus-summary-sort-by-original
+    "\C-c\C-s\C-r" gnus-summary-sort-by-random
     "=" gnus-summary-expand-window
     "\C-x\C-s" gnus-summary-reselect-current-group
     "\M-g" gnus-summary-rescan-group
@@ -1598,7 +1609,7 @@ increase the score of each group you read."
     "i" gnus-summary-news-other-window
     "x" gnus-summary-limit-to-unread
     "s" gnus-summary-isearch-article
-    "t" gnus-article-toggle-headers
+    "t" gnus-summary-toggle-header
     "g" gnus-summary-show-article
     "l" gnus-summary-goto-last-article
     "v" gnus-summary-preview-mime-message
@@ -1667,6 +1678,7 @@ increase the score of each group you read."
     "T" gnus-summary-limit-include-thread
     "d" gnus-summary-limit-exclude-dormant
     "t" gnus-summary-limit-to-age
+    "." gnus-summary-limit-to-unseen
     "x" gnus-summary-limit-to-extra
     "p" gnus-summary-limit-to-display-predicate
     "E" gnus-summary-limit-include-expunged
@@ -1766,7 +1778,7 @@ increase the score of each group you read."
     "f" gnus-article-display-x-face
     "l" gnus-summary-stop-page-breaking
     "r" gnus-summary-caesar-message
-    "t" gnus-article-toggle-headers
+    "t" gnus-summary-toggle-header
     "g" gnus-treat-smiley
     "v" gnus-summary-verbose-headers
     "m" gnus-summary-toggle-mime
@@ -1777,7 +1789,7 @@ increase the score of each group you read."
 
   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
     "a" gnus-article-hide
-    "h" gnus-article-toggle-headers
+    "h" gnus-article-hide-headers
     "b" gnus-article-hide-boring-headers
     "s" gnus-article-hide-signature
     "c" gnus-article-hide-citation
@@ -1987,7 +1999,7 @@ increase the score of each group you read."
     (let ((innards
           `(("Hide"
              ["All" gnus-article-hide t]
-             ["Headers" gnus-article-toggle-headers t]
+             ["Headers" gnus-article-hide-headers t]
              ["Signature" gnus-article-hide-signature t]
              ["Citation" gnus-article-hide-citation t]
              ["List identifiers" gnus-article-hide-list-identifiers t]
@@ -2057,7 +2069,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
              ["Rot 13" gnus-summary-caesar-message
               ,@(if (featurep 'xemacs) '(t)
                   '(:help "\"Caesar rotate\" article by 13"))]
-             ["Unix pipe" gnus-summary-pipe-message t]
+             ["Unix pipe..." gnus-summary-pipe-message t]
              ["Add buttons" gnus-article-add-buttons t]
              ["Add buttons to head" gnus-article-add-buttons-to-head t]
              ["Stop page breaking" gnus-summary-stop-page-breaking t]
@@ -2253,9 +2265,10 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
        ["Author..." gnus-summary-limit-to-author t]
        ["Age..." gnus-summary-limit-to-age t]
        ["Extra..." gnus-summary-limit-to-extra t]
-       ["Score" gnus-summary-limit-to-score t]
+       ["Score..." gnus-summary-limit-to-score t]
        ["Display Predicate" gnus-summary-limit-to-display-predicate t]
        ["Unread" gnus-summary-limit-to-unread t]
+       ["Unseen" gnus-summary-limit-to-unseen t]
        ["Non-dormant" gnus-summary-limit-exclude-dormant t]
        ["Articles" gnus-summary-limit-to-articles t]
        ["Pop limit" gnus-summary-pop-limit t]
@@ -2316,6 +2329,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
        ["Sort by score" gnus-summary-sort-by-score t]
        ["Sort by lines" gnus-summary-sort-by-lines t]
        ["Sort by characters" gnus-summary-sort-by-chars t]
+       ["Randomize" gnus-summary-sort-by-random t]
        ["Original sort" gnus-summary-sort-by-original t])
        ("Help"
        ["Fetch group FAQ" gnus-summary-fetch-faq t]
@@ -2733,6 +2747,7 @@ The following commands are available:
 (defun gnus-article-read-p (article)
   "Say whether ARTICLE is read or not."
   (not (or (memq article gnus-newsgroup-marked)
+          (memq article gnus-newsgroup-spam-marked)
           (memq article gnus-newsgroup-unreads)
           (memq article gnus-newsgroup-unselected)
           (memq article gnus-newsgroup-dormant))))
@@ -2838,6 +2853,7 @@ marks of articles."
     ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
     ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
     ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
+    ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark)
     ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
     ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
     (t (or (cdr (assq ,number gnus-newsgroup-reads))
@@ -2978,6 +2994,7 @@ buffer that was in action when the last article was fetched."
     (setq gnus-summary-buffer (current-buffer))
     (let ((name gnus-newsgroup-name)
          (marked gnus-newsgroup-marked)
+         (spam gnus-newsgroup-spam-marked)
          (unread gnus-newsgroup-unreads)
          (headers gnus-current-headers)
          (data gnus-newsgroup-data)
@@ -3000,6 +3017,7 @@ buffer that was in action when the last article was fetched."
        (set-buffer gnus-group-buffer)
        (setq gnus-newsgroup-name name
              gnus-newsgroup-marked marked
+             gnus-newsgroup-spam-marked spam
              gnus-newsgroup-unreads unread
              gnus-current-headers headers
              gnus-newsgroup-data data
@@ -3243,6 +3261,18 @@ the thread are to be displayed."
          gnus-empty-thread-mark)
       number)))
 
+(defsubst gnus-summary-line-message-size (head)
+  "Return pretty-printed version of message size.
+This function is intended to be used in
+`gnus-summary-line-format-alist', which see."
+  (let ((c (or (mail-header-chars head) -1)))
+    (cond ((< c 0) "n/a")              ; chars not available
+         ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
+         ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
+         ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
+         (t (format "%dM" (/ c (* 1024.0 1024)))))))
+
+
 (defun gnus-summary-set-local-parameters (group)
   "Go through the local params of GROUP and set all variable specs in that list."
   (let ((params (gnus-group-find-parameter group))
@@ -4246,6 +4276,15 @@ using some other form will lead to serious barfage."
   (gnus-article-sort-by-number
    (gnus-thread-header h1) (gnus-thread-header h2)))
 
+(defsubst gnus-article-sort-by-random (h1 h2)
+  "Sort articles by article number."
+  (zerop (random 2)))
+
+(defun gnus-thread-sort-by-random (h1 h2)
+  "Sort threads by root article number."
+  (gnus-article-sort-by-random
+   (gnus-thread-header h1) (gnus-thread-header h2)))
+
 (defsubst gnus-article-sort-by-lines (h1 h2)
   "Sort articles by article Lines header."
   (< (mail-header-lines h1)
@@ -4973,6 +5012,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
     (cond
      ((eq type 'tick)
       (memq article gnus-newsgroup-marked))
+     ((eq type 'spam)
+      (memq article gnus-newsgroup-spam-marked))
      ((eq type 'unsend)
       (memq article gnus-newsgroup-unsendable))
      ((eq type 'undownload)
@@ -6513,10 +6554,6 @@ previous group instead."
   (let ((current-group gnus-newsgroup-name)
        (current-buffer (current-buffer))
        entered)
-    ;; First we semi-exit this group to update Xrefs and all variables.
-    ;; We can't do a real exit, because the window conf must remain
-    ;; the same in case the user is prompted for info, and we don't
-    ;; want the window conf to change before that...
     (gnus-summary-exit t)
     (while (not entered)
       ;; Then we find what group we are supposed to enter.
@@ -6542,10 +6579,18 @@ previous group instead."
        (let ((unreads (gnus-group-group-unread)))
          (if (and (or (eq t unreads)
                       (and unreads (not (zerop unreads))))
-                  (gnus-summary-read-group
-                   target-group nil no-article
-                   (and (buffer-name current-buffer) current-buffer)
-                   nil backward))
+                  (progn
+                    ;; Now we semi-exit this group to update Xrefs
+                    ;; and all variables.  We can't do a real exit,
+                    ;; because the window conf must remain the same
+                    ;; in case the user is prompted for info, and we
+                    ;; don't want the window conf to change before
+                    ;; that...
+                    (gnus-summary-exit t)
+                    (gnus-summary-read-group
+                     target-group nil no-article
+                     (and (buffer-name current-buffer) current-buffer)
+                     nil backward)))
              (setq entered t)
            (setq current-group target-group
                  target-group nil)))))))
@@ -7367,6 +7412,13 @@ Returns how many articles were removed."
        (gnus-summary-limit articles)
       (gnus-summary-position-point))))
 
+(defun gnus-summary-limit-to-unseen ()
+  "Limit to unseen articles."
+  (interactive)
+  (prog1
+      (gnus-summary-limit gnus-newsgroup-unseen)
+    (gnus-summary-position-point)))
+
 (defun gnus-summary-limit-include-thread (id)
   "Display all the hidden articles that is in the thread with ID in it.
 When called interactively, ID is the Message-ID of the current
@@ -8428,34 +8480,38 @@ If ARG is a negative number, turn header display off."
 If ARG is a positive number, show the entire header.
 If ARG is a negative number, hide the unwanted header lines."
   (interactive "P")
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
+  (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
+                    (get-buffer-window gnus-article-buffer t))))
+    (with-current-buffer gnus-article-buffer
+      (widen)
+      (article-narrow-to-head)
       (let* ((buffer-read-only nil)
             (inhibit-point-motion-hooks t)
-            hidden s e)
-       (save-restriction
-         (article-narrow-to-head)
-         (setq e (point-max)
-               hidden (if (numberp arg)
-                          (>= arg 0)
-                        (gnus-article-hidden-text-p 'headers))))
-       (delete-region (point-min) e)
-       (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))))
+            (hidden (if (numberp arg)
+                        (>= arg 0)
+                      (gnus-article-hidden-text-p 'headers)))
+            s e)
+       (delete-region (point-min) (point-max))
+       (with-current-buffer gnus-original-article-buffer
+         (goto-char (setq s (point-min)))
+         (setq e (if (search-forward "\n\n" nil t)
+                     (1- (point))
+                   (point-max))))
        (insert-buffer-substring gnus-original-article-buffer s e)
-       (save-restriction
-         (narrow-to-region (point-min) (point))
-         (article-decode-encoded-words)
-         (if  hidden
-             (let ((gnus-treat-hide-headers nil)
-                   (gnus-treat-hide-boring-headers nil))
-               (gnus-delete-wash-type 'headers)
-               (gnus-treat-article 'head))
-           (gnus-treat-article 'head)))
+       (article-decode-encoded-words)
+       (if hidden
+           (let ((gnus-treat-hide-headers nil)
+                 (gnus-treat-hide-boring-headers nil))
+             (gnus-delete-wash-type 'headers)
+             (gnus-treat-article 'head))
+         (gnus-treat-article 'head))
+       (widen)
+       (if window
+           (set-window-start window (goto-char (point-min))))
+       (setq gnus-page-broken
+             (when gnus-break-pages
+               (gnus-narrow-to-page)
+               t))
        (gnus-set-mode-line 'article)))))
 
 (defun gnus-summary-show-all-headers ()
@@ -8973,6 +9029,7 @@ delete these instead."
     (error "Couldn't open server"))
   ;; Compute the list of articles to delete.
   (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
+       (nnmail-expiry-target 'delete)
        not-deleted)
     (if (and gnus-novice-user
             (not (gnus-yes-or-no-p
@@ -9414,6 +9471,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited."
   (let ((article (gnus-summary-article-number)))
     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+    (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
     (push (cons article mark) gnus-newsgroup-reads)
     ;; Possibly remove from cache, if that is used.
@@ -9445,6 +9503,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited."
            (gnus-error 1 "Can't mark negative article numbers")
            nil)
        (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+       (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
        (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
        (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
        (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
@@ -9452,6 +9511,10 @@ Iff NO-EXPIRE, auto-expiry will be inhibited."
               (setq gnus-newsgroup-marked
                     (gnus-add-to-sorted-list gnus-newsgroup-marked
                                              article)))
+             ((= mark gnus-spam-mark)
+              (setq gnus-newsgroup-spam-marked
+                    (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
+                                             article)))
              ((= mark gnus-dormant-mark)
               (setq gnus-newsgroup-dormant
                     (gnus-add-to-sorted-list gnus-newsgroup-dormant
@@ -9504,6 +9567,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited."
        (error "No article on current line"))
       (if (not (if (or (= mark gnus-unread-mark)
                       (= mark gnus-ticked-mark)
+                      (= mark gnus-spam-mark)
                       (= mark gnus-dormant-mark))
                   (gnus-mark-article-as-unread article mark)
                 (gnus-mark-article-as-read article mark)))
@@ -9578,6 +9642,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited."
     ;; Remove from unread and marked lists.
     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+    (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
     (push (cons article mark) gnus-newsgroup-reads)
     ;; Possibly remove from cache, if that is used.
@@ -9593,6 +9658,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited."
          (gnus-error 1 "Can't mark negative article numbers")
          nil)
       (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
+           gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)
            gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
            gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
            gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
@@ -9604,6 +9670,9 @@ Iff NO-EXPIRE, auto-expiry will be inhibited."
       (cond ((= mark gnus-ticked-mark)
             (setq gnus-newsgroup-marked
                   (gnus-add-to-sorted-list gnus-newsgroup-marked article)))
+           ((= mark gnus-spam-mark)
+            (setq gnus-newsgroup-spam-marked
+                  (gnus-add-to-sorted-list gnus-newsgroup-spam-marked article)))
            ((= mark gnus-dormant-mark)
             (setq gnus-newsgroup-dormant
                   (gnus-add-to-sorted-list gnus-newsgroup-dormant article)))
@@ -9817,6 +9886,7 @@ The number of articles marked as read is returned."
              (progn
                (when all
                  (setq gnus-newsgroup-marked nil
+                       gnus-newsgroup-spam-marked nil
                        gnus-newsgroup-dormant nil))
                (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable))
            ;; We actually mark all articles as canceled, which we
@@ -10248,6 +10318,12 @@ Argument REVERSE means reverse order."
   (interactive "P")
   (gnus-summary-sort 'number reverse))
 
+(defun gnus-summary-sort-by-random (&optional reverse)
+  "Randomize the order in the summary buffer.
+Argument REVERSE means to randomize in reverse order."
+  (interactive "P")
+  (gnus-summary-sort 'random reverse))
+
 (defun gnus-summary-sort-by-author (&optional reverse)
   "Sort the summary buffer by author name alphabetically.
 If `case-fold-search' is non-nil, case of letters is ignored.
@@ -11349,7 +11425,7 @@ If ALL is a number, fetch this number of articles."
          (if (and (numberp gnus-large-newsgroup)
                   (> len gnus-large-newsgroup))
              (let* ((cursor-in-echo-area nil)
-                    (initial (gnus-parameter-large-newsgroup-initial 
+                    (initial (gnus-parameter-large-newsgroup-initial
                               gnus-newsgroup-name))
                     (input
                      (read-string
@@ -11382,13 +11458,12 @@ If ALL is a number, fetch this number of articles."
            i new)
        (setq gnus-newsgroup-active
              (gnus-activate-group gnus-newsgroup-name 'scan))
-       (setq i (1+ (cdr old-active)))
-       (while (<= i (cdr gnus-newsgroup-active))
+       (setq i (cdr gnus-newsgroup-active))
+       (while (> i (cdr old-active))
          (push i new)
-         (incf i))
+         (decf i))
        (if (not new)
            (message "No gnus is bad news.")
-         (setq new (nreverse new))
          (gnus-summary-insert-articles new)
          (setq gnus-newsgroup-unreads
                (gnus-sorted-nunion gnus-newsgroup-unreads new))