From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 12 Jun 2000 04:04:51 +0000 (+0000)
Subject: Implement variable imail-forward-all-headers.
X-Git-Tag: 20090517-FFI~3548
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5cabfc4d94f2cc79cede1121b5cc67270f2e3733;p=mit-scheme.git

Implement variable imail-forward-all-headers.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index a99125592..6044baf2a 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.148 2000/06/12 00:57:50 cph Exp $
+;;; $Id: imail-top.scm,v 1.149 2000/06/12 04:04:51 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -137,6 +137,12 @@ If set to 'FILL, the paragraphs are filled rather than wrapped.
 Otherwise, the text is left as is."
   #t
   (lambda (x) (or (boolean? x) (eq? x 'FILL))))
+
+(define-variable imail-forward-all-headers
+  "If true, forwarded email messages will contain all header fields.
+Otherwise, only the header fields normally shown by IMAIL are sent."
+  #f
+  boolean?)
 
 (define-command imail
   "Read and edit incoming mail.
@@ -439,6 +445,7 @@ variable's documentation (using \\[describe-variable]) for details:
     imail-delete-after-output
     imail-dont-reply-to-names
     imail-expunge-confirmation
+    imail-forward-all-headers
     imail-ignored-headers
     imail-kept-headers
     imail-message-filter
@@ -1760,11 +1767,15 @@ see the documentation of `imail-resend'."
 	  "]")))
      #f
      (lambda (mail-buffer)
-       (add-buffer-mime-attachment! mail-buffer
-				    'MESSAGE 'RFC822 '() '(INLINE)
-				    (map header-field->mail-header
-					 (message-header-fields message))
-				    (message-body message))
+       (add-buffer-mime-attachment!
+	mail-buffer
+	'MESSAGE 'RFC822 '() '(INLINE)
+	(map header-field->mail-header
+	     (let ((headers (message-header-fields message)))
+	       (if (ref-variable imail-forward-all-headers mail-buffer)
+		   headers
+		   (maybe-reformat-headers headers mail-buffer))))
+	(message-body message))
        (if (window-has-no-neighbors? (current-window))
 	   (select-buffer mail-buffer)
 	   (select-buffer-other-window mail-buffer))
diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index f527c5e9a..45765eee3 100644
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.54 2000/06/10 20:17:55 cph Exp $
+;;; $Id: imail.pkg,v 1.55 2000/06/12 04:04:46 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -254,6 +254,7 @@
 	  edwin-variable$imail-delete-after-output
 	  edwin-variable$imail-dont-reply-to-names
 	  edwin-variable$imail-expunge-confirmation
+	  edwin-variable$imail-forward-all-headers
 	  edwin-variable$imail-ignored-headers
 	  edwin-variable$imail-kept-headers
 	  edwin-variable$imail-message-filter