From 88908387dec6e06923c7f7807310e1b3ac527f59 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 4 May 2000 17:29:36 +0000
Subject: [PATCH] Implement imail-kept-headers, as an alternative to
 imail-ignored-headers.

---
 v7/src/imail/imail-top.scm | 32 ++++++++++++++++++++++++--------
 1 file changed, 24 insertions(+), 8 deletions(-)

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 0711759ae..6dc5e20dd 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.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)
-- 
2.25.1