Implement imail-kept-headers, as an alternative to imail-ignored-headers.

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 0711759ae620e9baa7799a9bce9bc124ca50706d..6dc5e20ddd17c46f95109c11245847abbad590d1 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.28 2000/05/03 19:29:44 cph Exp $
+;;; $Id: imail-top.scm,v 1.29 2000/05/04 17:29:36 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -50,6 +50,13 @@ It is useful to set this variable in the site customisation file."
   "info-"
   string?)
 
+(define-variable imail-kept-headers
+  "A regular expression matching header fields one wants to see.
+This variable overrides imail-ignored-headers; to use imail-ignored-headers,
+set imail-kept-headers to #F."
+  (string-append "^" (regexp-group "date" "from" "to" "cc" "subject") "$")
+  string-or-false?)
+
 (define-variable imail-ignored-headers
   "A regular expression matching header fields one would rather not see."
   (regexp-group "via" "mail-from" "origin" "status" "received"
@@ -495,13 +502,22 @@ With prefix argument N moves backward N messages with these flags."
 
 (define (maybe-reformat-headers message buffer)
   (let ((headers
-        (let ((headers (message-header-fields message))
-              (regexp (ref-variable imail-ignored-headers buffer)))
-          (if regexp
-              (list-transform-negative headers
-                (lambda (header)
-                  (re-string-match regexp (header-field-name header) #t)))
-              headers)))
+        (let ((headers (message-header-fields message)))
+          (cond ((ref-variable imail-kept-headers buffer)
+                 => (lambda (regexp)
+                      (list-transform-positive headers
+                        (lambda (header)
+                          (re-string-match regexp
+                                           (header-field-name header)
+                                           #t)))))
+                ((ref-variable imail-ignored-headers buffer)
+                 => (lambda (regexp)
+                      (list-transform-negative headers
+                        (lambda (header)
+                          (re-string-match regexp
+                                           (header-field-name header)
+                                           #t)))))
+                (else headers))))
        (filter (ref-variable imail-message-filter buffer)))
     (if filter
        (map (lambda (n.v)