]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/gnus-sum.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / gnus / gnus-sum.el
index 6bf4142216d8acc65af4f22b80e92a356035f651..56c5fffb7e5c18d900b0e8a58a924c0e3f098213 100644 (file)
@@ -1,7 +1,7 @@
 ;;; gnus-sum.el --- summary mode commands for Gnus
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006 Free Software Foundation, Inc.
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -15,7 +15,7 @@
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
@@ -110,7 +110,7 @@ have all the sub-threads as children.
 If this variable is `adopt', Gnus will make one of the \"children\"
 the parent and mark all the step-children as such.
 If this variable is `empty', the \"children\" are printed with empty
-subject fields.         (Or rather, they will be printed with a string
+subject fields.  (Or rather, they will be printed with a string
 given by the `gnus-summary-same-subject' variable.)"
   :group 'gnus-thread
   :type '(choice (const :tag "off" nil)
@@ -304,12 +304,20 @@ equal will be included."
   :type 'boolean)
 
 (defcustom gnus-auto-select-first t
-  "*If non-nil, select the article under point.
-Which article this is is controlled by the `gnus-auto-select-subject'
-variable.
+  "If non-nil, select an article on group entry.
+An article is selected automatically when entering a group
+e.g. with \\<gnus-group-mode-map>\\[gnus-group-read-group], or via `gnus-summary-next-page' or
+`gnus-summary-catchup-and-goto-next-group'.
+
+Which article is selected is controlled by the variable
+`gnus-auto-select-subject'.
 
 If you want to prevent automatic selection of articles in some
 newsgroups, set the variable to nil in `gnus-select-group-hook'."
+  ;; Commands include...
+  ;; \\<gnus-group-mode-map>\\[gnus-group-read-group]
+  ;; \\<gnus-summary-mode-map>\\[gnus-summary-next-page]
+  ;; \\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]
   :group 'gnus-group-select
   :type '(choice (const :tag "none" nil)
                 (sexp :menu-tag "first" t)))
@@ -965,14 +973,14 @@ automatically when it is selected."
      . gnus-summary-normal-read))
   "*Controls the highlighting of summary buffer lines.
 
-A list of (FORM . FACE) pairs.  When deciding how a particular
+A list of (FORM . FACE) pairs.  When deciding how a particular
 summary line should be displayed, each form is evaluated.  The content
 of the face field after the first true form is used.  You can change
 how those summary lines are displayed, by editing the face field.
 
 You can use the following variables in the FORM field.
 
-score:        The article's score
+score:        The article's score.
 default:      The default article score.
 default-high: The default score for high scored articles.
 default-low:  The default score for low scored articles.
@@ -3343,16 +3351,17 @@ buffer that was in action when the last article was fetched."
       t
     (not (cdr (gnus-data-find-list article)))))
 
-(defun gnus-make-thread-indent-array ()
-  (let ((n 200))
-    (unless (and gnus-thread-indent-array
-                (= gnus-thread-indent-level gnus-thread-indent-array-level))
-      (setq gnus-thread-indent-array (make-vector 201 "")
-           gnus-thread-indent-array-level gnus-thread-indent-level)
-      (while (>= n 0)
-       (aset gnus-thread-indent-array n
-             (make-string (* n gnus-thread-indent-level) ? ))
-       (setq n (1- n))))))
+(defun gnus-make-thread-indent-array (&optional n)
+  (when (or n
+           (progn (setq n 200) nil)
+           (null gnus-thread-indent-array)
+           (/= gnus-thread-indent-level gnus-thread-indent-array-level))
+    (setq gnus-thread-indent-array (make-vector (1+ n) "")
+         gnus-thread-indent-array-level gnus-thread-indent-level)
+    (while (>= n 0)
+      (aset gnus-thread-indent-array n
+           (make-string (* n gnus-thread-indent-level) ? ))
+      (setq n (1- n)))))
 
 (defun gnus-update-summary-mark-positions ()
   "Compute where the summary marks are to go."
@@ -3451,6 +3460,9 @@ buffer that was in action when the last article was fetched."
                                 gnus-tmp-expirable gnus-tmp-subject-or-nil
                                 &optional gnus-tmp-dummy gnus-tmp-score
                                 gnus-tmp-process)
+  (if (>= gnus-tmp-level (length gnus-thread-indent-array))
+      (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
+                                         gnus-tmp-level)))
   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
         (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
         (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
@@ -3975,7 +3987,7 @@ If NO-DISPLAY, don't generate a summary buffer."
     infloop))
 
 (defun gnus-make-threads ()
-  "Go through the dependency hashtb and find the roots.         Return all threads."
+  "Go through the dependency hashtb and find the roots.  Return all threads."
   (let (threads)
     (while (catch 'infloop
             (mapatoms
@@ -4481,7 +4493,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
     ;; First go up in this thread until we find the root.
     (setq last-id (gnus-root-id id)
          headers (message-flatten-list (gnus-id-to-thread last-id)))
-    ;; We have now found the real root of this thread. It might have
+    ;; We have now found the real root of this thread.  It might have
     ;; been gathered into some loose thread, so we have to search
     ;; through the threads to find the thread we wanted.
     (let ((threads gnus-newsgroup-threads)
@@ -4549,23 +4561,46 @@ If LINE, insert the rebuilt thread starting on line LINE."
              (1+ (gnus-point-at-eol))
            (gnus-delete-line)))))))
 
-(defun gnus-sort-threads-1 (threads func)
+(defun gnus-sort-threads-recursive (threads func)
   (sort (mapcar (lambda (thread)
                  (cons (car thread)
                        (and (cdr thread)
-                            (gnus-sort-threads-1 (cdr thread) func))))
+                            (gnus-sort-threads-recursive (cdr thread) func))))
                threads) func))
 
+(defun gnus-sort-threads-loop (threads func)
+  (let* ((superthread (cons nil threads))
+        (stack (list (cons superthread threads)))
+        remaining-threads thread)
+    (while stack
+      (setq remaining-threads (cdr (car stack)))
+      (if remaining-threads
+         (progn (setq thread (car remaining-threads))
+                (setcdr (car stack) (cdr remaining-threads))
+                (if (cdr thread)
+                    (push (cons thread (cdr thread)) stack)))
+       (setq thread (caar stack))
+       (setcdr thread (sort (cdr thread) func))
+       (pop stack)))
+    (cdr superthread)))
+
 (defun gnus-sort-threads (threads)
   "Sort THREADS."
   (if (not gnus-thread-sort-functions)
       threads
     (gnus-message 8 "Sorting threads...")
-    (let ((max-lisp-eval-depth 5000))
-      (prog1 (gnus-sort-threads-1
-        threads
-        (gnus-make-sort-function gnus-thread-sort-functions))
-        (gnus-message 8 "Sorting threads...done")))))
+    (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)))
+         ;; 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.
+         (error (gnus-sort-threads-loop
+                 threads (gnus-make-sort-function
+                          gnus-thread-sort-functions))))
+      (gnus-message 8 "Sorting threads...done"))))
 
 (defun gnus-sort-articles (articles)
   "Sort ARTICLES."
@@ -4990,6 +5025,10 @@ or a straight list of headers."
                      gnus-tmp-closing-bracket ?\>)
              (setq gnus-tmp-opening-bracket ?\[
                    gnus-tmp-closing-bracket ?\]))
+           (if (>= gnus-tmp-level (length gnus-thread-indent-array))
+               (gnus-make-thread-indent-array
+                (max (* 2 (length gnus-thread-indent-array))
+                     gnus-tmp-level)))
            (setq
             gnus-tmp-indentation
             (aref gnus-thread-indent-array gnus-tmp-level)
@@ -5927,7 +5966,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
       (let ((case-fold-search t)
            in-reply-to header p lines chars)
        (goto-char (point-min))
-       ;; Search to the beginning of the next header.  Error messages
+       ;; Search to the beginning of the next header.  Error messages
        ;; do not begin with 2 or 3.
        (while (re-search-forward "^[23][0-9]+ " nil t)
          (setq id nil
@@ -5935,7 +5974,7 @@ The resulting hash table is returned, or nil if no Xrefs were found."
          ;; This implementation of this function, with nine
          ;; search-forwards instead of the one re-search-forward and
          ;; a case (which basically was the old function) is actually
-         ;; about twice as fast, even though it looks messier.  You
+         ;; about twice as fast, even though it looks messier.  You
          ;; can't have everything, I guess.  Speed and elegance
          ;; doesn't always go hand in hand.
          (setq
@@ -7302,6 +7341,9 @@ If UNREAD, only unread articles are selected.
 If SUBJECT, only articles with SUBJECT are selected.
 If BACKWARD, the previous article is selected instead of the next."
   (interactive "P")
+  ;; Make sure we are in the summary buffer.
+  (unless (eq major-mode 'gnus-summary-mode)
+    (set-buffer gnus-summary-buffer))
   (cond
    ;; Is there such an article?
    ((and (gnus-summary-search-forward unread subject backward)
@@ -7956,7 +7998,7 @@ article."
   (interactive)
   (let ((gnus-verbose (max 6 gnus-verbose)))
     (if (not gnus-newsgroup-dormant)
-       (gnus-message 3 "No cached articles for this group")
+       (gnus-message 3 "No dormant articles for this group")
       (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
 
 (defun gnus-summary-limit-include-dormant ()
@@ -8165,7 +8207,7 @@ fetch-old-headers verbiage, and so on."
   ;; will really go down to a leaf article first, before slowly
   ;; working its way up towards the root.
   (when thread
-    (let* ((max-lisp-eval-depth 5000)
+    (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
           (children
           (if (cdr thread)
               (apply '+ (mapcar 'gnus-summary-limit-children
@@ -10472,7 +10514,8 @@ The number of articles marked as read is returned."
                      (gnus-sorted-nunion
                        (gnus-sorted-intersection gnus-newsgroup-unreads
                                                 gnus-newsgroup-downloadable)
-                       gnus-newsgroup-unfetched)))
+                      (gnus-sorted-difference gnus-newsgroup-unfetched
+                                              gnus-newsgroup-cached))))
            ;; We actually mark all articles as canceled, which we
            ;; have to do when using auto-expiry or adaptive scoring.
            (gnus-summary-show-all-threads)