Implement M-x imail-summary-by-regexp and M-x imail-summary-by-topic.

Latter doesn't support WHOLE-MESSAGE option of Emacs because that
would be dreadfully inefficient using IMAP.

diff --git a/v7/src/imail/imail-summary.scm b/v7/src/imail/imail-summary.scm
index 4024405779bc45c4129fb4556adf75b162c75460..2e5e1c7e6e5f06cc41a41f095ef1803db6a909f3 100644 (file)
--- a/v7/src/imail/imail-summary.scm
+++ b/v7/src/imail/imail-summary.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-summary.scm,v 1.17 2000/06/11 04:01:38 cph Exp $
+;;; $Id: imail-summary.scm,v 1.18 2000/06/15 01:57:41 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -43,16 +43,15 @@ If false, the message buffer is updated but not popped up."
   "Width of the subject field, in characters."
   35
   exact-nonnegative-integer?)
-
+\f
 (define-command imail-summary
   "Display a summary of the selected folder, one line per message."
   ()
   (lambda () (imail-summary "All" #f)))
 
 (define-command imail-summary-by-flags
-  "Display a summary of the selected folder, one line per message.
-Only messages marked with one of the given flags are shown.
-The flags are specified as a comma-separated list of names."
+  "Display a summary of all messages with one or more FLAGS.
+FLAGS should be a string containing the desired labels, separated by commas."
   (lambda ()
     (list (imail-prompt-for-flags "Flags to summarize by")))
   (lambda (flags-string)
@@ -64,11 +63,10 @@ The flags are specified as a comma-separated list of names."
                           (flags-member? flag flags))))))))
 
 (define-command imail-summary-by-recipients
-  "Display a summary of the selected folder, one line per message.
-Only messages addressed to one of the given recipients are shown.
-Normally checks the To, From and CC fields of headers;
- but if prefix arg given, only look in the To and From fields.
-The recipients are specified as a comma-separated list of names."
+  "Display a summary of all messages with the given RECIPIENTS.
+Normally checks the To, From and Cc fields of headers;
+but if prefix arg is given, only look in the To and From fields.
+RECIPIENTS is a string of regexps separated by commas."
   "sRecipients to summarize by\nP"
   (lambda (recipients-string primary-only?)
     (imail-summary
@@ -86,6 +84,38 @@ The recipients are specified as a comma-separated list of names."
               (try (get-first-header-field-value m "to" #f))
               (and (not primary-only?)
                    (try (get-first-header-field-value m "cc" #f))))))))))
+
+(define-command imail-summary-by-regexp
+  "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),
+Edwin will list the header line in the summary."
+  "sRegexp to summarize by"
+  (lambda (regexp)
+    (imail-summary
+     (string-append "Regular expression " recipients-string)
+     (lambda (m)
+       (re-string-search-forward regexp
+                                (header-fields->string
+                                 (message-header-fields m))
+                                #t)))))
+
+(define-command imail-summary-by-topic
+  "Display a summary of all messages with the given SUBJECT.
+Checks the Subject field of headers.
+SUBJECT is a string of regexps separated by commas."
+  "sTopics to summarize by"
+  (lambda (regexps-string)
+    (imail-summary
+     (string-append "About " regexps-string)
+     (let ((regexp
+           (apply regexp-group
+                  (map re-quote-string
+                       (burst-comma-list-string recipients-string)))))
+       (lambda (m)
+        (let ((s (get-first-header-field-value m "subject" #f)))
+          (and s
+               (re-string-search-forward regexp s #t))))))))
 \f
 (define (imail-summary description predicate)
   (let* ((folder (selected-folder))

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 9658090c406f9d4d3d4fdd5f4491ffcbc3fcfee0..20a073db61a9ccd3bbab316b51d63b1db308525b 100644 (file)
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.155 2000/06/15 01:37:50 cph Exp $
+;;; $Id: imail-top.scm,v 1.156 2000/06/15 01:58:02 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -559,6 +559,8 @@ Instead, these commands are available:
 (define-key 'imail #\c-m-f     'imail-summary-by-flags)
 (define-key 'imail #\c-m-h     'imail-summary)
 (define-key 'imail #\c-m-r     'imail-summary-by-recipients)
+(define-key 'imail #\c-m-s     'imail-summary-by-regexp)
+(define-key 'imail #\c-m-t     'imail-summary-by-topic)
 
 ;; These commands have no equivalent in RMAIL.
 (define-key 'imail #\C         'imail-copy-folder)
@@ -570,15 +572,15 @@ Instead, these commands are available:
 ;;(define-key 'imail #\b               'imail-bury)
 ;;(define-key 'imail #\m-m     'imail-retry-failure)
 ;;(define-key 'imail #\w               'imail-output-body-to-file)
-;;(define-key 'imail '(#\c-c #\c-s #\c-d) 'imail-sort-by-date)
-;;(define-key 'imail '(#\c-c #\c-s #\c-s) 'imail-sort-by-subject)
-;;(define-key 'imail '(#\c-c #\c-s #\c-a) 'imail-sort-by-author)
-;;(define-key 'imail '(#\c-c #\c-s #\c-r) 'imail-sort-by-recipient)
-;;(define-key 'imail '(#\c-c #\c-s #\c-c) 'imail-sort-by-correspondent)
-;;(define-key 'imail '(#\c-c #\c-s #\c-l) 'imail-sort-by-lines)
-;;(define-key 'imail '(#\c-c #\c-s #\c-k) 'imail-sort-by-keywords)
-;;(define-key 'imail '(#\c-c #\c-n) 'imail-next-same-subject)
-;;(define-key 'imail '(#\c-c #\c-p) 'imail-previous-same-subject)
+;;(define-key 'imail '(#\c-c #\c-s #\c-d)      'imail-sort-by-date)
+;;(define-key 'imail '(#\c-c #\c-s #\c-s)      'imail-sort-by-subject)
+;;(define-key 'imail '(#\c-c #\c-s #\c-a)      'imail-sort-by-author)
+;;(define-key 'imail '(#\c-c #\c-s #\c-r)      'imail-sort-by-recipient)
+;;(define-key 'imail '(#\c-c #\c-s #\c-c)      'imail-sort-by-correspondent)
+;;(define-key 'imail '(#\c-c #\c-s #\c-l)      'imail-sort-by-lines)
+;;(define-key 'imail '(#\c-c #\c-s #\c-k)      'imail-sort-by-keywords)
+;;(define-key 'imail '(#\c-c #\c-n)    'imail-next-same-subject)
+;;(define-key 'imail '(#\c-c #\c-p)    'imail-previous-same-subject)
 \f
 (define (imail-revert-buffer buffer dont-use-auto-save? dont-confirm?)
   dont-use-auto-save?

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index 8d73bc3385bd6791b68471d5c6706091e4b798a9..1ae6402903d080a22744f051fb0d18caae20c934 100644 (file)
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.57 2000/06/14 20:16:37 cph Exp $
+;;; $Id: imail.pkg,v 1.58 2000/06/15 01:57:48 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -237,6 +237,8 @@
          edwin-command$imail-summary
          edwin-command$imail-summary-by-flags
          edwin-command$imail-summary-by-recipients
+         edwin-command$imail-summary-by-regexp
+         edwin-command$imail-summary-by-topic
          edwin-command$imail-summary-quit
          edwin-command$imail-summary-select-message
          edwin-command$imail-toggle-message