From 4a429438a7058dd6c5fa333ceeac053dafdb10df Mon Sep 17 00:00:00 2001
From: "Brian A. LaMacchia" <edu/mit/csail/zurich/bal>
Date: Wed, 28 Aug 1991 15:55:18 +0000
Subject: [PATCH] Added mail-header-function variable and modified mail-setup.

---
 v7/src/edwin/sendmail.scm | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index e77dfb90d..64f359ff8 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.9 1991/05/08 22:47:55 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.10 1991/08/28 15:55:18 bal Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -68,6 +68,26 @@ so you can remove or alter the BCC field to override the default."
   false
   string-or-false?)
 
+(define-variable mail-header-function
+  "A function of one argument, POINT (the current point), which
+inserts additional header lines into a mail message.  By default,
+this function inserts the header line \"X-Scheme-Mailer: Edwin\"
+followed by the version number of Edwin.  The function is called
+immediately after the Reply-to: header is inserted, if any.  If this
+variable is false, it is ignored."  
+  (lambda (point)
+    (insert-string "X-Scheme-Mailer:" point)
+    (for-each-system!
+     (lambda (system)
+       (if (string=? "Edwin"
+		     (system/name system))
+	   (begin
+	     (insert-string " " point)
+	     (insert-string 
+	      (system/identification-string system)
+	      point)))))
+    (insert-newline point)))
+
 (define-variable mail-header-separator
   "Line used to separate headers from text in messages being composed."
   "--text follows this line--"
@@ -177,6 +197,9 @@ is inserted."
 	    (insert-string "Reply-to: " point)
 	    (insert-string mail-default-reply-to point)
 	    (insert-newline point))))
+    (let ((mail-header-function (ref-variable mail-header-function)))
+      (if mail-header-function
+	  (mail-header-function point)))
     (if (ref-variable mail-self-blind)
 	(begin
 	  (insert-string "BCC: " point)
-- 
2.25.1