From 0d011a924a0b94341db84fa501d7f32d1816489f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 24 Jan 1992 00:34:28 +0000
Subject: [PATCH] Change SENDMAIL-SEND-IT to run sendmail in the background
 when MAIL-INTERACTIVE is false.  This returns control to the user as soon as
 the process is started and the message is successfully written to it.

---
 v7/src/edwin/sendmail.scm | 103 +++++++++++++++++++++-----------------
 1 file changed, 57 insertions(+), 46 deletions(-)

diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index aa86501cf..f7a368b0b 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.12 1991/11/04 20:51:55 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sendmail.scm,v 1.13 1992/01/24 00:34:28 cph Exp $
 ;;;
-;;;	Copyright (c) 1991 Massachusetts Institute of Technology
+;;;	Copyright (c) 1991-92 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -443,52 +443,63 @@ Numeric argument means justify as well."
 	(temp-buffer (temporary-buffer " sendmail temp"))
 	(mail-buffer (current-buffer))
 	(user-name (unix/current-user-name)))
-    (with-selected-buffer temp-buffer
-      (lambda ()
-	(let ((start (buffer-start temp-buffer))
-	      (end (buffer-end temp-buffer)))
-	  (insert-region (buffer-start mail-buffer)
-			 (buffer-end mail-buffer)
-			 start)
-	  (if (not (line-start? end))
-	      (insert-char #\newline end))
-	  (mail-match-header-separator start end)
-	  (let ((header-end (mark-left-inserting-copy (delete-match))))
-	    ;; Delete any blank lines in the header.
-	    (do ((start start (replace-match "\n")))
-		((not (re-search-forward "\n\n+" start header-end false))))
-	    (expand-mail-aliases start header-end)
-	    (if (re-search-forward "^FCC:" start header-end true)
-		(mail-do-fcc temp-buffer header-end))
-	    ;; If there is a From and no Sender, put in a Sender.
-	    (if (and (re-search-forward "^From:" start header-end true)
-		     (not
-		      (re-search-forward "^Sender:" start header-end true)))
-		(begin
-		  (insert-string "\nSender: " header-end)
-		  (insert-string user-name header-end)))
-	    ;; Don't send out a blank subject line.
-	    (if (re-search-forward "^Subject:[ \t]*\n" start header-end true)
-		(delete-match)))
-	  (apply run-synchronous-process
-		 (make-region start end)
-		 (and error-buffer (buffer-end error-buffer))
-		 false
-		 false
-		 (ref-variable sendmail-program)
-		 "-oi" "-t"
-		 ;; Always specify who from, since some systems have
-		 ;; broken sendmails.
-		 "-f" user-name
-		 (if error-buffer
-		     '()
-		     ;; These mean "report errors by mail"
-		     ;; and "deliver in background".
-		     '("-oem" "-odb")))
-	  (if error-buffer
+    (let ((start (buffer-start temp-buffer))
+	  (end (buffer-end temp-buffer)))
+      (insert-region (buffer-start mail-buffer)
+		     (buffer-end mail-buffer)
+		     start)
+      (if (not (line-start? end))
+	  (insert-char #\newline end))
+      (mail-match-header-separator start end)
+      (let ((header-end (mark-left-inserting-copy (delete-match))))
+	;; Delete any blank lines in the header.
+	(do ((start start (replace-match "\n")))
+	    ((not (re-search-forward "\n\n+" start header-end false))))
+	(expand-mail-aliases start header-end)
+	(if (re-search-forward "^FCC:" start header-end true)
+	    (mail-do-fcc temp-buffer header-end))
+	;; If there is a From and no Sender, put in a Sender.
+	(if (and (re-search-forward "^From:" start header-end true)
+		 (not
+		  (re-search-forward "^Sender:" start header-end true)))
+	    (begin
+	      (insert-string "\nSender: " header-end)
+	      (insert-string user-name header-end)))
+	;; Don't send out a blank subject line.
+	(if (re-search-forward "^Subject:[ \t]*\n" start header-end true)
+	    (delete-match)))
+      (let ((program (ref-variable sendmail-program)))
+	(if error-buffer
+	    (begin
+	      (run-synchronous-process (make-region start end)
+				       (buffer-end error-buffer)
+				       false
+				       false
+				       program
+				       "-oi" "-t"
+				       ;; Always specify who from,
+				       ;; since some systems have
+				       ;; broken sendmails.
+				       "-f" user-name)
 	      (let ((end (buffer-end error-buffer)))
 		(do ((start (buffer-start error-buffer) (replace-match "; ")))
-		    ((not (re-search-forward "\n+ *" start end false)))))))))
+		    ((not (re-search-forward "\n+ *" start end false))))))
+	    ;; If we aren't going to look at the errors, run the
+	    ;; program in the background so control returns to the
+	    ;; user as soon as possible.
+	    (let ((process
+		   (start-pipe-subprocess
+		    program
+		    (vector (os/filename-non-directory program)
+			    "-oi" "-t"
+			    (string-append "-f" user-name)
+			    ;; These mean "report errors by mail" and
+			    ;; "deliver in background".
+			    "-oem" "-odb")
+		    false)))
+	      (channel-write-string-block (subprocess-output-channel process)
+					  (extract-string start end))
+	      (subprocess-delete process)))))
     (kill-buffer temp-buffer)
     (if error-buffer
 	(let ((errors
-- 
2.25.1