[PATCH] Allow applying filters to summary consecutively (was: Summary by thread in rmail)

[Andrea Monaco <andrea.monaco@autistici.org>]

This patch adds optional argument keep-filtering to rmail-summary-by-*
commands.  When t, the filter works on the currently displayed summary.
I also wrote a command rmail-summary-negate to invert the current
selection of displayed messages.


Andrea Monaco



diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index b959f45250..24cad60bda 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -50,6 +50,13 @@ rmail-summary-line-count-flag
   :type 'boolean
   :group 'rmail-summary)
 
+(defvar rmail-summary-currently-displayed-msgs nil
+  "String made of 'y' and 'n'.  At index i it tells wether
+message i is shown on the summary or not.  First character is
+ignored.  Used when applying rmail-summary-by-* commands
+consecutively.")
+(put 'rmail-summary-currently-displayed-msgs 'permanent-local t)
+
 (defvar rmail-summary-font-lock-keywords
   '(("^ *[0-9]+D.*" . font-lock-string-face)			; Deleted.
     ("^ *[0-9]+-.*" . font-lock-type-face)			; Unread.
@@ -267,6 +274,33 @@ rmail-summary-mode-map
 (defun rmail-update-summary (&rest _)
   (apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
 
+(defun rmail-summary-fill-displayed-messages ()
+  "Fill the rmail-summary-currently-displayed-msgs string."
+  (with-current-buffer rmail-buffer
+    (with-current-buffer rmail-summary-buffer
+      (setq rmail-summary-currently-displayed-msgs
+	    (make-string (1+ rmail-total-messages) ?n))
+      (goto-char (point-min))
+      (while (not (eobp))
+	(aset rmail-summary-currently-displayed-msgs
+	      (string-to-number (thing-at-point 'line))
+	      ?y)
+	(forward-line 1)))))
+
+(defun rmail-summary-negate ()
+  "Invert the current set of displayed messages in the summary."
+  (interactive)
+  (rmail-summary-fill-displayed-messages)
+  (rmail-new-summary "Negate"
+		     '(rmail-summary-by-regexp ".*" t)
+		     (lambda (msg)
+		       (if
+			   (char-equal (aref rmail-summary-currently-displayed-msgs msg)
+				       ?n)
+			   (progn
+			     (aset rmail-summary-currently-displayed-msgs msg ?y) t)
+			 (progn
+			   (aset rmail-summary-currently-displayed-msgs msg ?n) nil)))))
 ;;;###autoload
 (defun rmail-summary ()
   "Display a summary of all messages, one line per message."
@@ -274,7 +308,7 @@ rmail-summary
   (rmail-new-summary "All" '(rmail-summary) nil))
 
 ;;;###autoload
-(defun rmail-summary-by-labels (labels)
+(defun rmail-summary-by-labels (labels &optional keep-filtering)
   "Display a summary of all messages with one or more LABELS.
 LABELS should be a string containing the desired labels, separated by commas."
   (interactive "sLabels to summarize by: ")
@@ -282,25 +316,40 @@ rmail-summary-by-labels
       (setq labels (or rmail-last-multi-labels
 		       (error "No label specified"))))
   (setq rmail-last-multi-labels labels)
+  (if keep-filtering
+      (rmail-summary-fill-displayed-messages))
   (rmail-new-summary (concat "labels " labels)
-		     (list 'rmail-summary-by-labels labels)
-		     'rmail-message-labels-p
+		     (list 'rmail-summary-by-labels labels keep-filtering)
+		     (if keep-filtering
+			 (lambda (msg l)
+			   (and (char-equal (aref rmail-summary-currently-displayed-msgs msg)
+					    ?y)
+				(rmail-message-labels-p msg l)))
+		       'rmail-message-labels-p)
 		     (concat " \\("
 			     (mail-comma-list-regexp labels)
 			     "\\)\\(,\\|\\'\\)")))
 
 ;;;###autoload
-(defun rmail-summary-by-recipients (recipients &optional primary-only)
+(defun rmail-summary-by-recipients (recipients &optional primary-only keep-filtering)
   "Display a summary of all messages with the given RECIPIENTS.
 Normally checks the To, From and Cc fields of headers;
 but if PRIMARY-ONLY is non-nil (prefix arg given),
  only look in the To and From fields.
 RECIPIENTS is a regular expression."
   (interactive "sRecipients to summarize by: \nP")
+  (if keep-filtering
+      (rmail-summary-fill-displayed-messages))
   (rmail-new-summary
    (concat "recipients " recipients)
-   (list 'rmail-summary-by-recipients recipients primary-only)
-   'rmail-message-recipients-p recipients primary-only))
+   (list 'rmail-summary-by-recipients recipients primary-only keep-filtering)
+   (if keep-filtering
+       (lambda (msg r)
+	 (and (char-equal (aref rmail-summary-currently-displayed-msgs msg)
+			  ?y)
+	      (rmail-message-recipients-p msg r)))
+     'rmail-message-recipients-p)
+   recipients primary-only))
 
 (defun rmail-message-recipients-p (msg recipients &optional primary-only)
   (rmail-apply-in-message msg 'rmail-message-recipients-p-1
@@ -318,7 +367,7 @@ rmail-message-recipients-p-1
 ;; Also, the optional WHOLE-MESSAGE argument of r-s-by-topic would
 ;; seem more natural here.
 ;;;###autoload
-(defun rmail-summary-by-regexp (regexp)
+(defun rmail-summary-by-regexp (regexp &optional keep-filtering)
   "Display a summary of all messages according to regexp REGEXP.
 If the regular expression is found in the header of the message
 \(including in the date and other lines, as well as the subject line),
@@ -328,9 +377,16 @@ rmail-summary-by-regexp
       (setq regexp (or rmail-last-regexp
 			 (error "No regexp specified"))))
   (setq rmail-last-regexp regexp)
+  (if keep-filtering
+      (rmail-summary-fill-displayed-messages))
   (rmail-new-summary (concat "regexp " regexp)
-		     (list 'rmail-summary-by-regexp regexp)
-		     'rmail-message-regexp-p
+		     (list 'rmail-summary-by-regexp regexp keep-filtering)
+		     (if keep-filtering
+			 (lambda (msg r)
+			   (and (char-equal (aref rmail-summary-currently-displayed-msgs msg)
+					    ?y)
+				(rmail-message-regexp-p msg r)))
+		       'rmail-message-regexp-p)
                      regexp))
 
 (defun rmail-message-regexp-p (msg regexp)
@@ -363,7 +419,7 @@ rmail-message-regexp-p-1
     (rmail--decode-and-apply 're-search-forward regexp nil t)))
 
 ;;;###autoload
-(defun rmail-summary-by-topic (subject &optional whole-message)
+(defun rmail-summary-by-topic (subject &optional whole-message keep-filtering)
   "Display a summary of all messages with the given SUBJECT.
 Normally checks just the Subject field of headers; but with prefix
 argument WHOLE-MESSAGE is non-nil, looks in the whole message.
@@ -376,10 +432,18 @@ rmail-summary-by-topic
 			  (if subject ", default current subject" "")
 			  "): ")))
      (list (read-string prompt nil nil subject) current-prefix-arg)))
+  (if keep-filtering
+      (rmail-summary-fill-displayed-messages))
   (rmail-new-summary
    (concat "about " subject)
-   (list 'rmail-summary-by-topic subject whole-message)
-   'rmail-message-subject-p subject whole-message))
+   (list 'rmail-summary-by-topic subject whole-message keep-filtering)
+   (if keep-filtering
+       (lambda (msg s wo)
+	 (and (char-equal (aref rmail-summary-currently-displayed-msgs msg)
+			  ?y)
+	      (rmail-message-subject-p msg s wo)))
+     'rmail-message-subject-p)
+   subject whole-message))
 
 (defun rmail-message-subject-p (msg subject &optional whole-message)
   (if whole-message
@@ -389,7 +453,7 @@ rmail-message-subject-p
     (string-match subject (rmail-simplified-subject msg))))
 
 ;;;###autoload
-(defun rmail-summary-by-senders (senders)
+(defun rmail-summary-by-senders (senders &optional keep-filtering)
   "Display a summary of all messages whose \"From\" field matches SENDERS.
 SENDERS is a regular expression.  The default for SENDERS matches the
 sender of the current message."
@@ -402,9 +466,18 @@ rmail-summary-by-senders
 			  (if sender ", default this message's sender" "")
 			  "): ")))
      (list (read-string prompt nil nil sender))))
+  (if keep-filtering
+      (rmail-summary-fill-displayed-messages))
   (rmail-new-summary
    (concat "senders " senders)
-   (list 'rmail-summary-by-senders senders) 'rmail-message-senders-p senders))
+   (list 'rmail-summary-by-senders senders keep-filtering)
+   (if keep-filtering
+       (lambda (msg s)
+	 (and (char-equal (aref rmail-summary-currently-displayed-msgs msg)
+			  ?y)
+	      (rmail-message-senders-p msg s)))
+     'rmail-message-senders-p)
+   senders))
 
 (defun rmail-message-senders-p (msg senders)
   (string-match senders (or (rmail-get-header "From" msg) "")))