From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 12 Jun 2000 03:38:09 +0000 (+0000)
Subject: Add new variable mail-abbreviate-mime to control verbosity of MIME
X-Git-Tag: 20090517-FFI~3549
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5a72c9d13e059d2d724d1eb69ad9a27b83901971;p=mit-scheme.git

Add new variable mail-abbreviate-mime to control verbosity of MIME
headers generated.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 1b03489d5..8559e2ae4 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.260 2000/06/12 01:38:24 cph Exp $
+$Id: edwin.pkg,v 1.261 2000/06/12 03:38:09 cph Exp $
 
 Copyright (c) 1989-2000 Massachusetts Institute of Technology
 
@@ -1468,6 +1468,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	  edwin-command$mail-to
 	  edwin-command$mail-yank-original
 	  edwin-mode$mail
+	  edwin-variable$mail-abbreviate-mime
 	  edwin-variable$mail-archive-file-name
 	  edwin-variable$mail-default-reply-to
 	  edwin-variable$mail-from-style
diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index b392dc9ba..0db91a9fe 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: sendmail.scm,v 1.55 2000/06/12 03:29:43 cph Exp $
+;;; $Id: sendmail.scm,v 1.56 2000/06/12 03:37:52 cph Exp $
 ;;;
 ;;; Copyright (c) 1991-2000 Massachusetts Institute of Technology
 ;;;
@@ -162,6 +162,14 @@ The headers are delimited by a string found in mail-header-separator."
   #f
   (lambda (object) (or (false? object) (buffer? object))))
 (variable-permanent-local! (ref-variable-object mail-reply-buffer))
+
+(define-variable mail-abbreviate-mime
+  "If true, sent mail doesn't contain unnecessary MIME headers.
+For example, Content-Type and Content-Transfer-Encoding headers
+  that specify the default are unnecessary.
+If false, sent mail contains full MIME headers."
+  #t
+  boolean?)
 
 (define-command mail
   "Edit a message to be sent.  Argument means resume editing (don't erase).
@@ -804,7 +812,9 @@ the user from the mailer."
       (editor-error "Message contains over-long line in header.")))
 
 (define (copy-mime-message-body start end h-end output-mark)
-  (mail-insert-field-value h-end "Content-Type" "text/plain; charset=us-ascii")
+  (if (not (ref-variable mail-abbreviate-mime start))
+      (mail-insert-field-value h-end
+			       "Content-Type" "text/plain; charset=us-ascii"))
   (let ((b-start (mark-right-inserting-copy output-mark)))
     (if (or (any-non-us-ascii-chars? start end)
 	    (any-lines-too-long? start end 76))
@@ -821,9 +831,10 @@ the user from the mailer."
 				   "quoted-printable"))
 	(begin
 	  (insert-region start end b-start)
-	  (mail-insert-field-value h-end
-				   "Content-Transfer-Encoding"
-				   "7bit")))))
+	  (if (not (ref-variable mail-abbreviate-mime start))
+	      (mail-insert-field-value h-end
+				       "Content-Transfer-Encoding"
+				       "7bit"))))))
 
 (define (any-non-us-ascii-chars? start end)
   (group-find-next-char-in-set (mark-group start)
@@ -856,7 +867,8 @@ the user from the mailer."
      h-end
      "Content-Type"
      (string-append "multipart/mixed; boundary=\"" boundary "\""))
-    (mail-insert-field-value h-end "Content-Transfer-Encoding" "7bit")
+    (if (not (ref-variable mail-abbreviate-mime start))
+	(mail-insert-field-value h-end "Content-Transfer-Encoding" "7bit"))
     (insert-string "This is a multi-part message in MIME format." output-mark)
     (insert-mime-boundary boundary #f output-mark)
     (insert-newline output-mark)
@@ -881,12 +893,10 @@ the user from the mailer."
 		    "/"
 		    (symbol->string subtype)
 		    (mime-parameters->string parameters)))
-    (mail-insert-field-value
-     m
-     "Content-Transfer-Encoding"
-     (if (and (eq? type 'MESSAGE) (eq? subtype 'RFC822))
-	 "7bit"
-	 "base64"))
+    (if (and (eq? type 'MESSAGE) (eq? subtype 'RFC822))
+	(if (not (ref-variable mail-abbreviate-mime m))
+	    (mail-insert-field-value m "Content-Transfer-Encoding" "7bit"))
+	(mail-insert-field-value m "Content-Transfer-Encoding" "base64"))
     (if disposition
 	(mail-insert-field-value m
 				 "Content-Disposition"