From: Chris Hanson Date: Thu, 15 Jun 2000 01:58:02 +0000 (+0000) Subject: Implement M-x imail-summary-by-regexp and M-x imail-summary-by-topic. X-Git-Tag: 20090517-FFI~3533 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ef190fafccbe28b3834943283dcffab56f90b7f6;p=mit-scheme.git 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 402440577..2e5e1c7e6 100644 --- 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?) - + (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)))))))) (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 9658090c4..20a073db6 100644 --- 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) (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 8d73bc338..1ae640290 100644 --- 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