2001-09-07 Raja R Harinath <harinath@cs.umn.edu>
[gnus] / lisp / gnus-sum.el
index c0747f0..16e8165 100644 (file)
@@ -1600,6 +1600,7 @@ increase the score of each group you read."
     "d" gnus-summary-limit-exclude-dormant
     "t" gnus-summary-limit-to-age
     "x" gnus-summary-limit-to-extra
+    "p" gnus-summary-limit-to-display-predicate
     "E" gnus-summary-limit-include-expunged
     "c" gnus-summary-limit-exclude-childless-dormant
     "C" gnus-summary-limit-mark-excluded-as-read
@@ -1699,6 +1700,7 @@ increase the score of each group you read."
     "l" gnus-summary-stop-page-breaking
     "r" gnus-summary-caesar-message
     "t" gnus-summary-toggle-header
+    "g" gnus-summary-toggle-smiley
     "v" gnus-summary-verbose-headers
     "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
     "p" gnus-article-verify-x-pgp-sig
@@ -1893,6 +1895,7 @@ increase the score of each group you read."
              ["Stop page breaking" gnus-summary-stop-page-breaking t]
              ["Verbose header" gnus-summary-verbose-headers t]
              ["Toggle header" gnus-summary-toggle-header t]
+             ["Toggle smiley" gnus-summary-toggle-smiley t]
              ["Html" gnus-article-wash-html t]
              ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
              ["HZ" gnus-article-decode-HZ t])
@@ -2071,6 +2074,7 @@ increase the score of each group you read."
         ["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-display-predicate t]
         ["Unread" gnus-summary-limit-to-unread t]
         ["Non-dormant" gnus-summary-limit-exclude-dormant t]
         ["Articles" gnus-summary-limit-to-articles t]
@@ -2943,13 +2947,20 @@ buffer that was in action when the last article was fetched."
              ?                         ;Whitespace
            (if (< gnus-tmp-score gnus-summary-default-score)
                gnus-score-below-mark gnus-score-over-mark)))
+        (gnus-tmp-number (mail-header-number gnus-tmp-header))
         (gnus-tmp-replied
          (cond (gnus-tmp-process gnus-process-mark)
                ((memq gnus-tmp-current gnus-newsgroup-cached)
                 gnus-cached-mark)
                (gnus-tmp-replied gnus-replied-mark)
+               ((memq gnus-tmp-current gnus-newsgroup-forwarded)
+                gnus-forwarded-mark)
                ((memq gnus-tmp-current gnus-newsgroup-saved)
                 gnus-saved-mark)
+               ((memq gnus-tmp-number gnus-newsgroup-recent)
+                gnus-recent-mark)
+               ((memq gnus-tmp-number gnus-newsgroup-unseen)
+                gnus-unseen-mark)
                (t gnus-no-mark)))
         (gnus-tmp-from (mail-header-from gnus-tmp-header))
         (gnus-tmp-name
@@ -2964,7 +2975,6 @@ buffer that was in action when the last article was fetched."
                       (1+ (match-beginning 0)) (1- (match-end 0))))
           (t gnus-tmp-from)))
         (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
-        (gnus-tmp-number (mail-header-number gnus-tmp-header))
         (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
         (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
         (buffer-read-only nil))
@@ -2972,8 +2982,9 @@ buffer that was in action when the last article was fetched."
       (setq gnus-tmp-name gnus-tmp-from))
     (unless (numberp gnus-tmp-lines)
       (setq gnus-tmp-lines -1))
-    (when (= gnus-tmp-lines -1)
-      (setq gnus-tmp-lines "?"))
+    (if (= gnus-tmp-lines -1)
+       (setq gnus-tmp-lines "?")
+      (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
     (gnus-put-text-property
      (point)
      (progn (eval gnus-summary-line-format-spec) (point))
@@ -4384,8 +4395,9 @@ or a straight list of headers."
              (setq gnus-tmp-name gnus-tmp-from))
            (unless (numberp gnus-tmp-lines)
              (setq gnus-tmp-lines -1))
-           (when (= gnus-tmp-lines -1)
-             (setq gnus-tmp-lines "?"))
+           (if (= gnus-tmp-lines -1)
+               (setq gnus-tmp-lines "?")
+             (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
            (gnus-put-text-property
             (point)
             (progn (eval gnus-summary-line-format-spec) (point))
@@ -4527,16 +4539,15 @@ If SELECT-ARTICLES, only select those articles from GROUP."
          gnus-newsgroup-unselected nil
          gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
     
-    (setq gnus-newsgroup-display (gnus-group-find-parameter group 'display))
-    (setq gnus-newsgroup-display
-         (cond
-          ((eq gnus-newsgroup-display 'all)
-           (setq gnus-newsgroup-display 'identity))
-          ((arrayp gnus-newsgroup-display)
-           (gnus-summary-display-make-predicate
-            (mapcar 'identity gnus-newsgroup-display)))
-          (t
-           nil)))
+    (let ((display (gnus-group-find-parameter group 'display)))
+      (setq gnus-newsgroup-display
+           (cond
+            ((eq display 'all)
+             'gnus-not-ignore)
+            ((arrayp display)
+             (gnus-summary-display-make-predicate (mapcar 'identity display)))
+            (t
+             nil))))
       
     (gnus-summary-setup-default-charset)
 
@@ -4640,11 +4651,13 @@ If SELECT-ARTICLES, only select those articles from GROUP."
   (when (= (length display) 1)
     (setq display (car display)))
   (unless gnus-summary-display-cache
-    (dolist (elem gnus-article-mark-lists)
-       (push (cons (cdr elem)
-                   (gnus-byte-compile
-                    `(lambda () (gnus-article-marked-p ',(cdr elem)))))
-             gnus-summary-display-cache)))
+    (dolist (elem (append (list (cons 'read 'read)
+                               (cons 'unseen 'unseen))
+                         gnus-article-mark-lists))
+      (push (cons (cdr elem)
+                 (gnus-byte-compile
+                  `(lambda () (gnus-article-marked-p ',(cdr elem)))))
+           gnus-summary-display-cache)))
   (let ((gnus-category-predicate-alist gnus-summary-display-cache))
     (gnus-get-predicate display)))
 
@@ -4683,6 +4696,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
       (memq article gnus-newsgroup-cached))
      ((eq type 'forward)
       (memq article gnus-newsgroup-forwarded))
+     ((eq type 'seen)
+      (not (memq article gnus-newsgroup-unseen)))
      ((eq type 'recent)
       (memq article gnus-newsgroup-recent))
      (t t))))
@@ -4695,7 +4710,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
          (if (or read-all
                  (and (zerop (length gnus-newsgroup-marked))
                       (zerop (length gnus-newsgroup-unreads)))
-                 gnus-newsgroup-display)
+                 (eq gnus-newsgroup-display 'gnus-not-ignore))
              ;; We want to select the headers for all the articles in
              ;; the group, so we select either all the active
              ;; articles in the group, or (if that's nil), the
@@ -4791,6 +4806,11 @@ If SELECT-ARTICLES, only select those articles from GROUP."
       (setq marks (cdr marks)))
     out))
 
+(defun gnus-article-mark-to-type (mark)
+  "Return the type of MARK."
+  (or (cadr (assq mark gnus-article-special-mark-lists))
+      'list))
+
 (defun gnus-adjust-marked-articles (info)
   "Set all article lists and remove all marks that are no longer valid."
   (let* ((marked-lists (gnus-info-marks info))
@@ -4798,56 +4818,53 @@ If SELECT-ARTICLES, only select those articles from GROUP."
         (min (car active))
         (max (cdr active))
         (types gnus-article-mark-lists)
-        (uncompressed '(score bookmark killed))
-        marks var articles article mark)
+        marks var articles article mark mark-type)
 
     (dolist (marks marked-lists)
-      (setq mark (car marks))
-      (unless (eq mark 'seen)
-       ;; Do the rest of the marks.
-       (set (setq var (intern (format "gnus-newsgroup-%s"
-                                      (car (rassq mark types)))))
-            (cond
-             ((memq mark uncompressed)
-              (cdr marks))
-             (t
-              (gnus-uncompress-range (cdr marks)))))
-
-       (setq articles (symbol-value var))
+      (setq mark (car marks)
+           mark-type (gnus-article-mark-to-type mark)
+           var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
 
-       ;; All articles have to be subsets of the active articles.
-       (cond
-        ;; Adjust "simple" lists.
-        ((memq mark '(tick dormant expire reply save))
+      ;; We set the variable according to the type of the marks list,
+      ;; and then adjust the marks to a subset of the active articles.
+      (cond
+       ;; Adjust "simple" lists.
+       ((eq mark-type 'list)
+       (set var (setq articles (gnus-uncompress-range (cdr marks))))
+       (when (memq mark '(tick dormant expire reply save))
          (while articles
            (when (or (< (setq article (pop articles)) min) (> article max))
-             (set var (delq article (symbol-value var))))))
-        ;; Adjust assocs.
-        ((memq mark uncompressed)
-         (when (not (listp (cdr (symbol-value var))))
-           (set var (list (symbol-value var))))
-         (when (not (listp (cdr articles)))
-           (setq articles (list articles)))
-         (while articles
-           (when (or (not (consp (setq article (pop articles))))
-                     (< (car article) min)
-                     (> (car article) max))
-             (set var (delq article (symbol-value var)))))))))))
+             (set var (delq article (symbol-value var)))))))
+       ;; Adjust assocs.
+       ((eq mark-type 'tuple)
+       (set var (setq articles (cdr marks)))
+       (when (not (listp (cdr (symbol-value var))))
+         (set var (list (symbol-value var))))
+       (when (not (listp (cdr articles)))
+         (setq articles (list articles)))
+       (while articles
+         (when (or (not (consp (setq article (pop articles))))
+                   (< (car article) min)
+                   (> (car article) max))
+           (set var (delq article (symbol-value var))))))
+       ((eq mark-type 'range)
+       (cond
+        ((eq mark 'seen))))))))
 
 (defun gnus-update-missing-marks (missing)
   "Go through the list of MISSING articles and remove them from the mark lists."
   (when missing
-    (let ((types gnus-article-mark-lists)
-         var m)
+    (let (var m)
       ;; Go through all types.
-      (while types
-       (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
-       (when (symbol-value var)
-        ;; This list has articles.  So we delete all missing articles
-         ;; from it.
-         (setq m missing)
-         (while m
-           (set var (delq (pop m) (symbol-value var)))))))))
+      (dolist (elem gnus-article-mark-lists)
+       (when (eq (gnus-article-mark-to-type (cdr elem)) 'list)
+         (setq var (intern (format "gnus-newsgroup-%s" (car elem))))
+         (when (symbol-value var)
+           ;; This list has articles.  So we delete all missing
+           ;; articles from it.
+           (setq m missing)
+           (while m
+             (set var (delq (pop m) (symbol-value var))))))))))
 
 (defun gnus-update-marks ()
   "Enter the various lists of marked articles into the newsgroup info list."
@@ -6871,6 +6888,18 @@ articles that are younger than AGE days."
          (gnus-summary-limit articles))
       (gnus-summary-position-point))))
 
+(defun gnus-summary-limit-to-display-predicate ()
+  "Limit the summary buffer to the predicated in the `display' group parameter."
+  (interactive)
+  (unless gnus-newsgroup-display
+    (error "There is no `diplay' group parameter"))
+  (let (articles)
+    (dolist (number gnus-newsgroup-articles)
+      (when (funcall gnus-newsgroup-display)
+       (push number articles)))
+    (gnus-summary-limit articles))
+  (gnus-summary-position-point))
+
 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
 (make-obsolete
  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
@@ -7130,7 +7159,7 @@ fetch-old-headers verbiage, and so on."
   ;; Most groups have nothing to remove.
   (if (or gnus-inhibit-limiting
          (and (null gnus-newsgroup-dormant)
-              (eq gnus-newsgroup-display 'identity)
+              (eq gnus-newsgroup-display 'gnus-not-ignore)
               (not (eq gnus-fetch-old-headers 'some))
               (not (numberp gnus-fetch-old-headers))
               (not (eq gnus-fetch-old-headers 'invisible))
@@ -7953,10 +7982,6 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
   (interactive "P")
   (unless action
     (setq action 'move))
-  ;; Disable marking as read.
-  (let (gnus-mark-article-hook)
-    (save-window-excursion
-      (gnus-summary-select-article)))
   ;; Check whether the source group supports the required functions.
   (cond ((and (eq action 'move)
              (not (gnus-check-backend-function
@@ -8107,21 +8132,22 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
                  (setcdr gnus-newsgroup-active to-article))
 
                (while marks
-                 (when (memq article (symbol-value
-                                      (intern (format "gnus-newsgroup-%s"
-                                                      (caar marks)))))
-                   (push (cdar marks) to-marks)
-                   ;; If the other group is the same as this group,
-                   ;; then we have to add the mark to the list.
-                   (when (equal to-group gnus-newsgroup-name)
-                     (set (intern (format "gnus-newsgroup-%s" (caar marks)))
-                          (cons to-article
-                                (symbol-value
-                                 (intern (format "gnus-newsgroup-%s"
-                                                 (caar marks)))))))
-                   ;; Copy the marks to other group.
-                   (gnus-add-marked-articles
-                    to-group (cdar marks) (list to-article) info))
+                 (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+                   (when (memq article (symbol-value
+                                        (intern (format "gnus-newsgroup-%s"
+                                                        (caar marks)))))
+                     (push (cdar marks) to-marks)
+                     ;; If the other group is the same as this group,
+                     ;; then we have to add the mark to the list.
+                     (when (equal to-group gnus-newsgroup-name)
+                       (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+                            (cons to-article
+                                  (symbol-value
+                                   (intern (format "gnus-newsgroup-%s"
+                                                   (caar marks)))))))
+                     ;; Copy the marks to other group.
+                     (gnus-add-marked-articles
+                      to-group (cdar marks) (list to-article) info)))
                  (setq marks (cdr marks)))
 
                (gnus-request-set-mark to-group (list (list (list to-article)
@@ -8315,7 +8341,7 @@ This will be the case if the article has both been mailed and posted."
           (expirable (if total
                          (progn
                            ;; We need to update the info for
-                       ;; this group for `gnus-list-of-read-articles'
+                           ;; 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)
@@ -8578,6 +8604,15 @@ groups."
   (execute-kbd-macro (concat (this-command-keys) key))
   (gnus-article-edit-done))
 
+
+(defun gnus-summary-toggle-smiley (&optional arg)
+  "Toggle the display of smilies as small graphical icons."
+  (interactive "P")
+  (save-excursion
+    (set-buffer gnus-article-buffer)
+    (gnus-smiley-display arg)
+    ))
+
 ;;; Respooling
 
 (defun gnus-summary-respool-query (&optional silent trace)