Oortified version from Wes.
[gnus] / lisp / gnus-sum.el
index f798e65..179c9e7 100644 (file)
@@ -109,6 +109,11 @@ given by the `gnus-summary-same-subject' variable.)"
                 (const adopt)
                 (const empty)))
 
+(defcustom gnus-summary-make-false-root-always t
+  "Always make a false dummy root."
+  :group 'gnus-thread
+  :type 'boolean)
+
 (defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
   "*A regexp to match subjects to be excluded from loose thread gathering.
 As loose thread gathering is done on subjects only, that means that
@@ -501,11 +506,16 @@ this variable specifies group names."
   :group 'gnus-summary-marks
   :type 'character)
 
-(defcustom gnus-undownloaded-mark ?@
+(defcustom gnus-undownloaded-mark ?-
   "*Mark used for articles that weren't downloaded."
   :group 'gnus-summary-marks
   :type 'character)
 
+(defcustom gnus-downloaded-mark ?+
+  "*Mark used for articles that were downloaded."
+  :group 'gnus-summary-marks
+  :type 'character)
+
 (defcustom gnus-downloadable-mark ?%
   "*Mark used for articles that are to be downloaded."
   :group 'gnus-summary-marks
@@ -578,7 +588,7 @@ list of parameters to that command."
   :type 'boolean)
 
 (defcustom gnus-summary-dummy-line-format
-  "  %(:                          :%) %S\n"
+  "   %(:                             :%) %S\n"
   "*The format specification for the dummy roots in the summary buffer.
 It works along the same lines as a normal formatting string,
 with some simple extensions.
@@ -846,9 +856,17 @@ automatically when it is selected."
   :group 'gnus-summary-visual
   :type 'face)
 
+(defvar gnus-tmp-downloaded nil)
+
 (defcustom gnus-summary-highlight
   '(((eq mark gnus-canceled-mark)
      . gnus-summary-cancelled-face)
+    ((and uncached (> score default-high))
+     . gnus-summary-high-uncached-face)
+    ((and uncached (< score default-low))
+     . gnus-summary-low-uncached-face)
+    (uncached
+     . gnus-summary-normal-uncached-face)
     ((and (> score default-high)
          (or (eq mark gnus-dormant-mark)
              (eq mark gnus-ticked-mark)))
@@ -866,25 +884,12 @@ automatically when it is selected."
      . gnus-summary-low-ancient-face)
     ((eq mark gnus-ancient-mark)
      . gnus-summary-normal-ancient-face)
-    ((and (boundp 'downloaded) downloaded)
-     . gnus-agent-downloaded-article-face)
     ((and (> score default-high) (eq mark gnus-unread-mark))
      . gnus-summary-high-unread-face)
     ((and (< score default-low) (eq mark gnus-unread-mark))
      . gnus-summary-low-unread-face)
     ((eq mark gnus-unread-mark)
      . gnus-summary-normal-unread-face)
-    ((and (> score default-high) (memq mark (list gnus-downloadable-mark
-                                                 gnus-undownloaded-mark)))
-     . gnus-summary-high-unread-face)
-    ((and (< score default-low) (memq mark (list gnus-downloadable-mark
-                                                gnus-undownloaded-mark)))
-     . gnus-summary-low-unread-face)
-    ((and (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
-         (memq article gnus-newsgroup-unreads))
-     . gnus-summary-normal-unread-face)
-    ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark))
-     . gnus-summary-normal-read-face)
     ((> score default-high)
      . gnus-summary-high-read-face)
     ((< score default-low)
@@ -1092,6 +1097,7 @@ the MIME-Version header is missed."
     (?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)
+    (?O gnus-tmp-downloaded ?c)
     (?I gnus-tmp-indentation ?s)
     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
     (?R gnus-tmp-replied ?c)
@@ -1151,6 +1157,8 @@ the type of the variable (string, integer, character, etc).")
 (defvar gnus-last-shell-command nil
   "Default shell command on article.")
 
+(defvar gnus-newsgroup-agentized nil
+  "Locally bound in each summary buffer to indicate whether the server has been agentized.")
 (defvar gnus-newsgroup-begin nil)
 (defvar gnus-newsgroup-end nil)
 (defvar gnus-newsgroup-last-rmail nil)
@@ -2273,7 +2281,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
         ["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]
+        ["Next articles" gnus-summary-limit-to-articles t]
         ["Pop limit" gnus-summary-pop-limit t]
         ["Show dormant" gnus-summary-limit-include-dormant t]
         ["Hide childless dormant"
@@ -2856,7 +2864,6 @@ time; i.e., when generating the summary lines.  After that,
 marks of articles."
   `(cond
     ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
-;;;;    ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark)
     ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
     ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
     ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
@@ -3082,16 +3089,16 @@ buffer that was in action when the last article was fetched."
     (let ((gnus-replied-mark 129)
          (gnus-score-below-mark 130)
          (gnus-score-over-mark 130)
-         (gnus-download-mark 131)
+         (gnus-downloaded-mark 131)
          (spec gnus-summary-line-format-spec)
          gnus-visual pos)
       (save-excursion
        (gnus-set-work-buffer)
        (let ((gnus-summary-line-format-spec spec)
-             (gnus-newsgroup-downloadable '((0 . t))))
+             (gnus-newsgroup-downloadable '(0)))
          (gnus-summary-insert-line
           [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
-          0 nil 128 t nil "" nil 1)
+          0 nil nil 128 t nil "" nil 1)
          (goto-char (point-min))
          (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
                                             (- (point) (point-min) 1)))))
@@ -3146,7 +3153,7 @@ buffer that was in action when the last article was fetched."
 
 (defun gnus-summary-insert-line (gnus-tmp-header
                                 gnus-tmp-level gnus-tmp-current
-                                gnus-tmp-unread gnus-tmp-replied
+                                undownloaded gnus-tmp-unread gnus-tmp-replied
                                 gnus-tmp-expirable gnus-tmp-subject-or-nil
                                 &optional gnus-tmp-dummy gnus-tmp-score
                                 gnus-tmp-process)
@@ -3175,6 +3182,13 @@ buffer that was in action when the last article was fetched."
                ((memq gnus-tmp-number gnus-newsgroup-unseen)
                 gnus-unseen-mark)
                (t gnus-no-mark)))
+        (gnus-tmp-downloaded
+         (cond (undownloaded 
+                 gnus-undownloaded-mark)
+                (gnus-newsgroup-agentized
+                 gnus-downloaded-mark)
+                (t
+                 gnus-no-mark)))
         (gnus-tmp-from (mail-header-from gnus-tmp-header))
         (gnus-tmp-name
          (cond
@@ -3577,7 +3591,16 @@ If NO-DISPLAY, don't generate a summary buffer."
                (setcdr prev (cdr threads))
                (setq threads prev))
            ;; Enter this thread into the hash table.
-           (gnus-sethash subject threads hashtb)))
+           (gnus-sethash subject
+                         (if gnus-summary-make-false-root-always
+                             (progn
+                               ;; If you want a dummy root above all
+                               ;; threads...
+                               (setcar threads (list whole-subject
+                                                     (car threads)))
+                               threads)
+                           threads)
+                         hashtb)))
        (setq prev threads)
        (setq threads (cdr threads)))
       result)))
@@ -3970,7 +3993,9 @@ the id of the parent article (if any)."
           (level (gnus-summary-thread-level)))
       (gnus-delete-line)
       (gnus-summary-insert-line
-       header level nil (gnus-article-mark article)
+       header level nil 
+       (memq article gnus-newsgroup-undownloaded)
+       (gnus-article-mark article)
        (memq article gnus-newsgroup-replied)
        (memq article gnus-newsgroup-expirable)
        ;; Only insert the Subject string when it's different
@@ -4232,11 +4257,11 @@ If LINE, insert the rebuilt thread starting on line LINE."
   (if (not gnus-thread-sort-functions)
       threads
     (gnus-message 8 "Sorting threads...")
-    (prog1
-       (gnus-sort-threads-1
+    (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"))))
+        (gnus-message 8 "Sorting threads...done")))))
 
 (defun gnus-sort-articles (articles)
   "Sort ARTICLES."
@@ -4386,19 +4411,19 @@ Unscored articles will be counted as having a score of zero."
 (defun gnus-thread-latest-date (thread)
   "Return the highest article date in THREAD."
   (let ((previous-time 0))
-    (apply 'max (mapcar
-                (lambda (header)
-                  (setq previous-time
-                        (time-to-seconds
-                         (mail-header-parse-date
-                          (condition-case ()
-                              (mail-header-date header)
-                            (error previous-time))))))
-                (sort
-                 (message-flatten-list thread)
-                 (lambda (h1 h2)
-                   (< (mail-header-number h1)
-                      (mail-header-number h2))))))))
+    (apply 'max
+          (mapcar
+           (lambda (header)
+             (setq previous-time
+                   (time-to-seconds
+                    (condition-case ()
+                        (mail-header-parse-date (mail-header-date header))
+                      (error previous-time)))))
+           (sort
+            (message-flatten-list thread)
+            (lambda (h1 h2)
+              (< (mail-header-number h1)
+                 (mail-header-number h2))))))))
 
 (defun gnus-thread-total-score-1 (root)
   ;; This function find the total score of the thread below ROOT.
@@ -4467,9 +4492,11 @@ or a straight list of headers."
   (let ((gnus-tmp-level 0)
        (default-score (or gnus-summary-default-score 0))
        (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
+       (building-line-count gnus-summary-display-while-building)
+       (building-count (integerp gnus-summary-display-while-building))
        thread number subject stack state gnus-tmp-gathered beg-match
        new-roots gnus-tmp-new-adopts thread-end simp-subject
-       gnus-tmp-header gnus-tmp-unread
+       gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
        gnus-tmp-replied gnus-tmp-subject-or-nil
        gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
        gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
@@ -4486,6 +4513,8 @@ or a straight list of headers."
 
       ;; Do the threaded display.
 
+      (if gnus-summary-display-while-building
+         (switch-to-buffer (buffer-name)))
       (while (or threads stack gnus-tmp-new-adopts new-roots)
 
        (if (and (= gnus-tmp-level 0)
@@ -4673,6 +4702,13 @@ or a straight list of headers."
                   ((memq number gnus-newsgroup-unseen)
                    gnus-unseen-mark)
                   (t gnus-no-mark))
+            gnus-tmp-downloaded
+             (cond ((memq number gnus-newsgroup-undownloaded) 
+                    gnus-undownloaded-mark)
+                   (gnus-newsgroup-agentized
+                    gnus-downloaded-mark)
+                   (t
+                    gnus-no-mark))
             gnus-tmp-from (mail-header-from gnus-tmp-header)
             gnus-tmp-name
             (cond
@@ -4728,6 +4764,17 @@ or a straight list of headers."
        (push (if (nth 1 thread) 1 0) tree-stack)
        (incf gnus-tmp-level)
        (setq threads (if thread-end nil (cdar thread)))
+       (if gnus-summary-display-while-building
+           (if building-count
+               (progn
+                 ;; use a set frequency
+                 (setq building-line-count (1- building-line-count))
+                 (when (= building-line-count 0)
+                   (sit-for 0)
+                   (setq building-line-count
+                         gnus-summary-display-while-building)))
+             ;; always
+             (sit-for 0)))
        (unless threads
          (setq gnus-tmp-level 0)))))
   (gnus-message 7 "Generating summary...done"))
@@ -4761,6 +4808,7 @@ or a straight list of headers."
              gnus-newsgroup-data)
        (gnus-summary-insert-line
         header 0 number
+        (memq number gnus-newsgroup-undownloaded)
         mark (memq number gnus-newsgroup-replied)
         (memq number gnus-newsgroup-expirable)
         (mail-header-subject header) nil
@@ -4997,7 +5045,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
     (gnus-get-predicate display)))
 
 ;; Uses the dynamically bound `number' variable.
-(defvar number)
+(eval-when-compile
+  (defvar number))
 (defun gnus-article-marked-p (type &optional article)
   (let ((article (or article number)))
     (cond
@@ -5041,7 +5090,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
 
 (defun gnus-articles-to-read (group &optional read-all)
   "Find out what articles the user wants to read."
-  (let* ((articles
+  (let* ((display (gnus-group-find-parameter group 'display))
+        (articles
          ;; Select all articles if `read-all' is non-nil, or if there
          ;; are no unread articles.
          (if (or read-all
@@ -5921,8 +5971,7 @@ If EXCLUDE-GROUP, do not go to this group."
                      (progn
                        (while arts
                          (when (or (and undownloaded
-                                        (eq gnus-undownloaded-mark
-                                            (gnus-data-mark (car arts))))
+                                        (memq (car arts) gnus-newsgroup-undownloaded))
                                    (gnus-data-unread-p (car arts)))
                            (setq result (car arts)
                                  arts nil))
@@ -6626,8 +6675,7 @@ Returns the article selected or nil if there are no unread articles."
        (let ((data gnus-newsgroup-data))
          (while (and data
                      (and (not (and undownloaded
-                                    (eq gnus-undownloaded-mark
-                                        (gnus-data-mark (car data)))))
+                                    (memq (car data) gnus-newsgroup-undownloaded)))
                           (if unseen
                               (or (not (memq
                                         (gnus-data-number (car data))
@@ -6930,14 +6978,16 @@ If UNREAD is non-nil, only unread articles are selected."
    (and gnus-auto-select-same
        (gnus-summary-article-subject))))
 
-(defun gnus-summary-next-page (&optional lines circular)
+(defun gnus-summary-next-page (&optional lines circular stop)
   "Show next page of the selected article.
 If at the end of the current article, select the next article.
 LINES says how many lines should be scrolled up.
 
 If CIRCULAR is non-nil, go to the start of the article instead of
 selecting the next article when reaching the end of the current
-article."
+article.
+
+If STOP is non-nil, just stop when reaching the end of the message."
   (interactive "P")
   (setq gnus-summary-buffer (current-buffer))
   (gnus-set-global-variables)
@@ -6963,7 +7013,9 @@ article."
          (gnus-eval-in-buffer-window gnus-article-buffer
            (setq endp (gnus-article-next-page lines)))
          (when endp
-           (cond (circular
+           (cond (stop
+                  (gnus-message 3 "End of message"))
+                 (circular
                   (gnus-summary-beginning-of-article))
                  (lines
                   (gnus-message 3 "End of message"))
@@ -7271,8 +7323,9 @@ articles that are younger than AGE days."
         days)
      (while (not days-got)
        (setq days (if younger
-                     (read-string "Limit to articles within (in days): ")
-                   (read-string "Limit to articles older than (in days): ")))
+                     (read-string "Limit to articles younger than (in days, older when negative): ")
+                   (read-string
+                    "Limit to articles older than (in days, younger when negative): ")))
        (when (> (length days) 0)
         (setq days (read days)))
        (if (numberp days)
@@ -7649,7 +7702,8 @@ 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 ((children
+    (let* ((max-lisp-eval-depth 5000)
+          (children
           (if (cdr thread)
               (apply '+ (mapcar 'gnus-summary-limit-children
                                 (cdr thread)))
@@ -8680,9 +8734,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                       to-group (cdar marks) (list to-article) info)))
                  (setq marks (cdr marks)))
 
-               (gnus-request-set-mark to-group (list (list (list to-article)
-                                                           'add
-                                                           to-marks))))
+               (gnus-request-set-mark
+                to-group (list (list (list to-article) 'add to-marks))))
 
              (gnus-dribble-enter
               (concat "(gnus-group-set-info '"
@@ -8738,6 +8791,15 @@ If nil, use to the current newsgroup method."
   :type 'symbol
   :group 'gnus-summary-mail)
 
+(defcustom gnus-summary-display-while-building nil
+  "If not-nil, show and update the summary buffer as it's being built.
+If the value is t, update the buffer after every line is inserted.  If
+the value is an integer (N), update the display every N lines."
+  :group 'gnus-thread
+  :type '(choice (const :tag "off" nil)
+                number
+                (const :tag "frequently" t)))
+
 (defun gnus-summary-respool-article (&optional n method)
   "Respool the current article.
 The article will be squeezed through the mail spooling process again,
@@ -9571,6 +9633,19 @@ If NO-EXPIRE, auto-expiry will be inhibited."
     (gnus-run-hooks 'gnus-summary-update-hook))
   t)
 
+(defun gnus-summary-update-download-mark (article)
+  "Update the secondary (read, process, cache) mark."
+  (gnus-summary-update-mark
+   (cond ((memq article gnus-newsgroup-undownloaded) 
+          gnus-undownloaded-mark)
+         (gnus-newsgroup-agentized
+          gnus-downloaded-mark)
+         (t
+          gnus-no-mark))
+   'download)
+  (gnus-summary-update-line t)
+  t)
+
 (defun gnus-summary-update-mark (mark type)
   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
        (buffer-read-only nil))
@@ -10399,20 +10474,22 @@ The variable `gnus-default-article-saver' specifies the saver function."
     (gnus-set-mode-line 'summary)
     n))
 
-(defun gnus-summary-pipe-output (&optional arg)
+(defun gnus-summary-pipe-output (&optional arg headers)
   "Pipe the current article to a subprocess.
 If N is a positive number, pipe the N next articles.
 If N is a negative number, pipe the N previous articles.
 If N is nil and any articles have been marked with the process mark,
-pipe those articles instead."
-  (interactive "P")
+pipe those articles instead.
+If HEADERS (the symbolic prefix), include the headers, too."
+  (interactive (gnus-interactive "P\ny"))
   (require 'gnus-art)
-  (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
+  (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
+       (gnus-save-all-headers (or headers gnus-save-all-headers)))
     (gnus-summary-save-article arg t))
   (let ((buffer (get-buffer "*Shell Command Output*")))
-    (if (and buffer
-            (with-current-buffer buffer (> (point-max) (point-min))))
-       (gnus-configure-windows 'pipe))))
+    (when (and buffer
+              (not (zerop (buffer-size buffer))))
+      (gnus-configure-windows 'pipe))))
 
 (defun gnus-summary-save-article-mail (&optional arg)
   "Append the current article to an mail file.
@@ -10859,6 +10936,7 @@ If REVERSE, save parts that do not match TYPE."
 
 (defvar gnus-summary-highlight-line-cached nil)
 (defvar gnus-summary-highlight-line-trigger nil)
+
 (defun gnus-summary-highlight-line-0 ()
   (if (and (eq gnus-summary-highlight-line-trigger 
                gnus-summary-highlight)
@@ -10875,50 +10953,20 @@ If REVERSE, save parts that do not match TYPE."
                     list (cdr list)))
             (gnus-byte-compile (list 'lambda nil cond))))))
 
-(defvar gnus-summary-highlight-line-downloaded-alist nil)
-(defvar gnus-summary-highlight-line-downloaded-cached nil)
-
-;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
 (defun gnus-summary-highlight-line ()
   "Highlight current line according to `gnus-summary-highlight'."
-  (let*
-      ((list gnus-summary-highlight)
-       (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)
-       (default gnus-summary-default-score)
-       (default-high gnus-summary-default-high-score)
-       (default-low gnus-summary-default-low-score)
-       (downloaded
-       (and
-        (boundp 'gnus-agent-article-alist)
-        gnus-agent-article-alist
-        (gnus-agent-group-covered-p gnus-newsgroup-name)
-        ;; Optimized for when gnus-summary-highlight-line is
-        ;; called multiple times for articles in ascending
-        ;; order (i.e. initial generation of summary buffer).
-        (progn 
-          (unless (and
-                   (eq gnus-summary-highlight-line-downloaded-alist
-                       gnus-agent-article-alist)
-                   (<= (caar gnus-summary-highlight-line-downloaded-cached)
-                       article))
-            (setq gnus-summary-highlight-line-downloaded-alist
-                  gnus-agent-article-alist)
-            (setq gnus-summary-highlight-line-downloaded-cached
-                  gnus-agent-article-alist))
-          (let (n)
-            (while (and (< (caar gnus-summary-highlight-line-downloaded-cached)
-                           article)
-                        (setq n (cdr gnus-summary-highlight-line-downloaded-cached)))
-              (setq gnus-summary-highlight-line-downloaded-cached n)))
-          (and (eq (caar gnus-summary-highlight-line-downloaded-cached)
-                   article)
-               (cdar gnus-summary-highlight-line-downloaded-cached))))))
+  (let* ((beg (gnus-point-at-bol))
+        (article (or (gnus-summary-article-number) gnus-current-article))
+        (score (or (cdr (assq article
+                              gnus-newsgroup-scored))
+                   gnus-summary-default-score 0))
+        (mark (or (gnus-summary-article-mark) gnus-unread-mark))
+        (inhibit-read-only t)
+        (default gnus-summary-default-score)
+        (default-high gnus-summary-default-high-score)
+        (default-low gnus-summary-default-low-score)
+        (uncached (memq article gnus-newsgroup-undownloaded))
+        (downloaded (not uncached)))
     (let ((face (funcall (gnus-summary-highlight-line-0))))
       (unless (eq face (get-text-property beg 'face))
        (gnus-put-text-property-excluding-characters-with-faces
@@ -11206,8 +11254,8 @@ If ALL is a number, fetch this number of articles."
       (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
            older len)
        (setq older
-             ;; Some nntp servers lie about their active range.  When this happens, the active
-             ;; range can be in the millions.
+             ;; 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))
        (setq len (gnus-range-length older))