message.el (message-display-completion-list): Abolish
[bpt/emacs.git] / lisp / gnus / gnus-sum.el
index c8f593e..94f4e70 100644 (file)
@@ -847,7 +847,6 @@ controls how articles are sorted."
                           (function :tag "other"))
                   (boolean :tag "Reverse order"))))
 
-
 (defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
   "*List of functions used for sorting threads in the summary buffer.
 By default, threads are sorted by article number.
@@ -873,7 +872,11 @@ and `gnus-thread-sort-by-total-score' (see
 `gnus-thread-score-function').
 
 When threading is turned off, the variable
-`gnus-article-sort-functions' controls how articles are sorted."
+`gnus-article-sort-functions' controls how articles are sorted.
+
+By default, threads and their subthreads are sorted according to
+the value of this variable.  To use a different sorting order for
+subthreads, customize `gnus-subthread-sort-functions'."
   :group 'gnus-summary-sort
   :type '(repeat
           (gnus-widget-reversible
@@ -890,6 +893,28 @@ When threading is turned off, the variable
                    (function :tag "other"))
            (boolean :tag "Reverse order"))))
 
+(defcustom gnus-subthread-sort-functions 'gnus-thread-sort-functions
+  "*List of functions used for sorting subthreads in the summary buffer.
+By default, subthreads are sorted the same as threads, i.e.,
+according to the value of `gnus-thread-sort-functions'."
+  :group 'gnus-summary-sort
+  :type '(choice
+         (const :tag "Sort subthreads like threads" gnus-thread-sort-functions)
+         (repeat
+          (gnus-widget-reversible
+           (choice (function-item gnus-thread-sort-by-number)
+                   (function-item gnus-thread-sort-by-author)
+                   (function-item gnus-thread-sort-by-recipient)
+                   (function-item gnus-thread-sort-by-subject)
+                   (function-item gnus-thread-sort-by-date)
+                   (function-item gnus-thread-sort-by-score)
+                   (function-item gnus-thread-sort-by-most-recent-number)
+                   (function-item gnus-thread-sort-by-most-recent-date)
+                   (function-item gnus-thread-sort-by-random)
+                   (function-item gnus-thread-sort-by-total-score)
+                   (function :tag "other"))
+           (boolean :tag "Reverse order")))))
+
 (defcustom gnus-thread-score-function '+
   "*Function used for calculating the total score of a thread.
 
@@ -1524,6 +1549,9 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
 (defvar gnus-newsgroup-seen nil
   "Range of seen articles in the current newsgroup.")
 
+(defvar gnus-newsgroup-unexist nil
+  "Range of unexisting articles in the current newsgroup.")
+
 (defvar gnus-newsgroup-articles nil
   "List of articles in the current newsgroup.")
 
@@ -1571,6 +1599,7 @@ This list will always be a subset of gnus-newsgroup-undownloaded.")
     gnus-newsgroup-killed
     gnus-newsgroup-unseen
     gnus-newsgroup-seen
+    gnus-newsgroup-unexist
     gnus-newsgroup-cached
     gnus-newsgroup-downloadable
     gnus-newsgroup-undownloaded
@@ -2330,7 +2359,8 @@ increase the score of each group you read."
           ["Mark above" gnus-summary-mark-above t]
           ["Tick above" gnus-summary-tick-above t]
           ["Clear above" gnus-summary-clear-above t])
-         ["Current score" gnus-summary-current-score t]
+         ["Current article score" gnus-summary-current-score t]
+         ["Current thread score" (gnus-summary-current-score 'total) t]
          ["Set score" gnus-summary-set-score t]
          ["Switch current score file..." gnus-score-change-score-file t]
          ["Set mark below..." gnus-score-set-mark-below t]
@@ -3653,18 +3683,17 @@ buffer that was in action when the last article was fetched."
   (or (car (funcall gnus-extract-address-components from))
       from))
 
-(defun gnus-summary-from-or-to-or-newsgroups (header from)
+(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
   (let ((mail-parse-charset gnus-newsgroup-charset)
-        (ignored-from-addresses (gnus-ignored-from-addresses))
-        ;; Is it really necessary to do this next part for each summary line?
-        ;; Luckily, doesn't seem to slow things down much.
-        (mail-parse-ignored-charsets
-         (with-current-buffer gnus-summary-buffer
-           gnus-newsgroup-ignored-charsets))
-        (address (cadr (gnus-extract-address-components from))))
+       (ignored-from-addresses (gnus-ignored-from-addresses))
+       ;; Is it really necessary to do this next part for each summary line?
+       ;; Luckily, doesn't seem to slow things down much.
+       (mail-parse-ignored-charsets
+        (with-current-buffer gnus-summary-buffer
+          gnus-newsgroup-ignored-charsets)))
     (or
      (and ignored-from-addresses
-         (string-match ignored-from-addresses address)
+         (string-match ignored-from-addresses gnus-tmp-from)
          (let ((extra-headers (mail-header-extra header))
                to
                newsgroups)
@@ -3679,11 +3708,13 @@ buffer that was in action when the last article was fetched."
                     (cdr (assq 'Newsgroups extra-headers))
                     (and
                      (memq 'Newsgroups gnus-extra-headers)
-                      (eq (car (gnus-find-method-for-group
-                                gnus-newsgroup-name)) 'nntp)
+                     (eq (car (gnus-find-method-for-group
+                               gnus-newsgroup-name)) 'nntp)
                      (gnus-group-real-name gnus-newsgroup-name))))
              (concat gnus-summary-newsgroup-prefix newsgroups)))))
-     (gnus-string-mark-left-to-right (gnus-summary-extract-address-component from)))))
+     (gnus-string-mark-left-to-right
+      (inline
+       (gnus-summary-extract-address-component gnus-tmp-from))))))
 
 (defun gnus-summary-insert-line (gnus-tmp-header
                                 gnus-tmp-level gnus-tmp-current
@@ -4842,10 +4873,25 @@ If LINE, insert the rebuilt thread starting on line LINE."
            (gnus-delete-line)))))))
 
 (defun gnus-sort-threads-recursive (threads func)
+  ;; Responsible for sorting the root articles of threads.
+  (let ((subthread-sort-func (if (eq gnus-subthread-sort-functions
+                                    'gnus-thread-sort-functions)
+                                func
+                              (gnus-make-sort-function
+                               gnus-subthread-sort-functions))))
+    (sort (mapcar (lambda (thread)
+                   (cons (car thread)
+                         (and (cdr thread)
+                              (gnus-sort-subthreads-recursive
+                               (cdr thread) subthread-sort-func))))
+                 threads) func)))
+
+(defun gnus-sort-subthreads-recursive (threads func)
+  ;; Responsible for sorting subthreads.
   (sort (mapcar (lambda (thread)
                  (cons (car thread)
                        (and (cdr thread)
-                            (gnus-sort-threads-recursive (cdr thread) func))))
+                            (gnus-sort-subthreads-recursive (cdr thread) func))))
                threads) func))
 
 (defun gnus-sort-threads-loop (threads func)
@@ -4871,9 +4917,9 @@ If LINE, insert the rebuilt thread starting on line LINE."
     (gnus-message 8 "Sorting threads...")
     (prog1
        (condition-case nil
-           (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
-             (gnus-sort-threads-recursive
-              threads (gnus-make-sort-function gnus-thread-sort-functions)))
+           (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000))
+                 (sort-func (gnus-make-sort-function gnus-thread-sort-functions)))
+             (gnus-sort-threads-recursive threads sort-func))
          ;; Even after binding max-lisp-eval-depth, the recursive
          ;; sorter might fail for very long threads.  In that case,
          ;; try using a (less well-tested) non-recursive sorter.
@@ -5789,6 +5835,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
   "Find out what articles the user wants to read."
   (let* ((only-read-p t)
         (articles
+         (gnus-list-range-difference
          ;; Select all articles if `read-all' is non-nil, or if there
          ;; are no unread articles.
          (if (or read-all
@@ -5815,7 +5862,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
            (setq only-read-p nil)
            (gnus-sorted-nunion
             (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
-            gnus-newsgroup-unreads)))
+            gnus-newsgroup-unreads))
+         (cdr (assq 'unexist (gnus-info-marks (gnus-get-info group))))))
         (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
         (scored (length scored-list))
         (number (length articles))
@@ -5985,7 +6033,9 @@ If SELECT-ARTICLES, only select those articles from GROUP."
                          (and (numberp (car articles))
                               (> min (car articles)))))
            (pop articles))
-         (set var articles))))))))
+         (set var articles))
+        ((eq mark 'unexist)
+         (set var (cdr marks)))))))))
 
 (defun gnus-update-missing-marks (missing)
   "Go through the list of MISSING articles and remove them from the mark lists."
@@ -6061,7 +6111,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
                         (gnus-active gnus-newsgroup-name) del))
              (push (list del 'del (list (cdr type))) delta-marks))))
 
-       (when list
+       (when (or list
+                 (eq (cdr type) 'unexist))
          (push (cons (cdr type) list) newmarked)))
 
       (when delta-marks
@@ -10305,16 +10356,19 @@ This will be the case if the article has both been mailed and posted."
              'request-expire-articles gnus-newsgroup-name))
     ;; This backend supports expiry.
     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
-          (expirable (if total
-                         (progn
-                           ;; We need to update the info for
-                           ;; this group for `gnus-list-of-read-articles'
-                           ;; to give us the right answer.
-                           (gnus-run-hooks 'gnus-exit-group-hook)
-                           (gnus-summary-update-info)
-                           (gnus-list-of-read-articles gnus-newsgroup-name))
-                       (setq gnus-newsgroup-expirable
-                             (sort gnus-newsgroup-expirable '<))))
+          (expirable
+           (gnus-list-range-difference
+            (if total
+                (progn
+                  ;; We need to update the info for
+                  ;; this group for `gnus-list-of-read-articles'
+                  ;; to give us the right answer.
+                  (gnus-run-hooks 'gnus-exit-group-hook)
+                  (gnus-summary-update-info)
+                  (gnus-list-of-read-articles gnus-newsgroup-name))
+              (setq gnus-newsgroup-expirable
+                    (sort gnus-newsgroup-expirable '<)))
+            gnus-newsgroup-unexist))
           (expiry-wait (if now 'immediate
                          (gnus-group-find-parameter
                           gnus-newsgroup-name 'expiry-wait)))
@@ -12847,7 +12901,9 @@ If ALL is a number, fetch this number of articles."
              ;; Some nntp servers lie about their active range.  When
              ;; this happens, the active range can be in the millions.
              ;; Use a compressed range to avoid creating a huge list.
-             (gnus-range-difference (list gnus-newsgroup-active) old))
+             (gnus-range-difference
+              (gnus-range-difference (list gnus-newsgroup-active) old)
+              gnus-newsgroup-unexist))
        (setq len (gnus-range-length older))
        (cond
         ((null older) nil)