From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 3 Dec 2001 18:13:08 +0000 (+0000)
Subject: Change imail-forward to (by default) ask whether to forward all
X-Git-Tag: 20090517-FFI~2410
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f3223c051386490e31506039d8c06ba0de367397;p=mit-scheme.git

Change imail-forward to (by default) ask whether to forward all
headers.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index fd5caca83..bb0542113 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.278 2001/11/06 04:45:13 cph Exp $
+;;; $Id: imail-top.scm,v 1.279 2001/12/03 18:12:58 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -147,8 +147,8 @@ Otherwise, the text is left as is."
 (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?)
+  'ASK
+  (lambda (x) (or (boolean? x) (eq? x 'ASK))))
 
 (define-variable imail-forward-using-mime
   "If true, forwarded email messages are sent as MIME attachments.
@@ -1189,7 +1189,11 @@ With negative argument, forward the message with all headers;
        (let ((raw?
 	      (if (< (command-argument-numeric-value argument) 0)
 		  #t
-		  (ref-variable imail-forward-all-headers mail-buffer))))
+		  (let ((all?
+			 (ref-variable imail-forward-all-headers mail-buffer)))
+		    (if (eq? all? 'ASK)
+			(prompt-for-confirmation? "Forward all header fields")
+			all?)))))
 	 (if (ref-variable imail-forward-using-mime mail-buffer)
 	     (add-buffer-mime-attachment!
 	      mail-buffer
diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm
index 5c6bba46b..6c3152e04 100644
--- a/v7/src/imail/load.scm
+++ b/v7/src/imail/load.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: load.scm,v 1.36 2001/11/11 06:05:54 cph Exp $
+;;; $Id: load.scm,v 1.37 2001/12/03 18:13:08 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -28,4 +28,4 @@
   (lambda ()
     (fluid-let ((*allow-package-redefinition?* #t))
       (load-package-set "imail"))))
-(add-subsystem-identification! "IMAIL" '(1 16))
\ No newline at end of file
+(add-subsystem-identification! "IMAIL" '(1 17))
\ No newline at end of file