Change MAKE-MAIL-BUFFER to return the buffer it makes. If an old
authorChris Hanson <org/chris-hanson/cph>
Fri, 5 May 1995 06:53:05 +0000 (06:53 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 5 May 1995 06:53:05 +0000 (06:53 +0000)
buffer exists and the user wants to keep it, return #F instead.  Also
make the SELECTOR argument optional, and allow it to be #F meaning
that the buffer will not be selected but just returned (the default).
Change the MAIL-SETUP-HOOK variable so that it is invoked with the
mail buffer as an argument.

v7/src/edwin/sendmail.scm

index 0248f238b095ca31f210536c7da65e4c7c96b4ac..d88d7a622700ceafffa2aafd9fc12b5142487604 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: sendmail.scm,v 1.24 1995/04/30 06:54:22 cph Exp $
+;;;    $Id: sendmail.scm,v 1.25 1995/05/05 06:53:05 cph Exp $
 ;;;
 ;;;    Copyright (c) 1991-95 Massachusetts Institute of Technology
 ;;;
@@ -179,41 +179,47 @@ is inserted."
                          'KEEP-PREVIOUS-MAIL
                          'QUERY-DISCARD-PREVIOUS-MAIL))))
 
-(define (make-mail-buffer headers reply-buffer select-buffer
-                         #!optional previous-mail-handling buffer-name mode)
-  (let ((buffer-name
-        (or (and (not (default-object? buffer-name))
-                 buffer-name)
-            "*mail*")))
+(define (make-mail-buffer headers reply-buffer #!optional
+                         selector handle-previous buffer-name mode)
+  (let ((selector (if (default-object? selector) #f selector))
+       (handle-previous
+        (if (default-object? handle-previous)
+            'QUERY-DISCARD-PREVIOUS-MAIL
+            handle-previous))
+       (buffer-name
+        (if (or (default-object? buffer-name) (not buffer-name))
+            "*mail*"
+            buffer-name))
+       (mode (if (default-object? mode) #f mode)))
     (let ((buffer (find-buffer buffer-name))
          (continue
           (lambda (select?)
             (let ((buffer (find-or-create-buffer buffer-name)))
-              (if select? (select-buffer buffer))
               (buffer-reset! buffer)
               (set-buffer-default-directory! buffer
                                              (default-homedir-pathname))
               (setup-buffer-auto-save! buffer)
-              (mail-setup buffer headers reply-buffer
-                          (and (not (default-object? mode)) mode))))))
-      (if buffer
-         (case (if (default-object? previous-mail-handling)
-                   'QUERY-DISCARD-PREVIOUS-MAIL
-                   previous-mail-handling)
-           ((KEEP-PREVIOUS-MAIL)
-            (select-buffer buffer))
-           ((DISCARD-PREVIOUS-MAIL)
+              (mail-setup buffer headers reply-buffer mode)
+              (if (and select? selector) (selector buffer))
+              buffer))))
+      (cond ((or (not buffer)
+                (not (buffer-modified? buffer))
+                (eq? handle-previous 'DISCARD-PREVIOUS-MAIL))
             (continue #t))
-           ((QUERY-DISCARD-PREVIOUS-MAIL)
-            (select-buffer buffer)
-            (if (or (not (buffer-modified? buffer))
-                    (prompt-for-confirmation?
-                     "Unsent message being composed; erase it"))
-                (continue #f)))
+           ((eq? handle-previous 'QUERY-DISCARD-PREVIOUS-MAIL)
+            (if selector (selector buffer))
+            (if (cleanup-pop-up-buffers
+                 (lambda ()
+                   (if (not selector) (pop-up-buffer buffer))
+                   (prompt-for-confirmation?
+                    "Unsent message being composed; erase it")))
+                (continue #f)
+                #f))
+           ((eq? handle-previous 'KEEP-PREVIOUS-MAIL)
+            (if selector (selector buffer))
+            #f)
            (else
-            (error:bad-range-argument previous-mail-handling
-                                      'MAKE-MAIL-BUFFER)))
-         (continue #t)))))
+            (error:bad-range-argument handle-previous 'MAKE-MAIL-BUFFER))))))
 \f
 (define (mail-setup buffer headers reply-buffer #!optional mode)
   (guarantee-mail-aliases)
@@ -291,12 +297,13 @@ is inserted."
                 (given-header? "subject")
                 (given-header? "in-reply-to")))
        (buffer-not-modified! buffer)))
-  (event-distributor/invoke! (ref-variable mail-setup-hook buffer)))
-
+  (event-distributor/invoke! (ref-variable mail-setup-hook buffer) buffer))
+\f
 (define-variable mail-setup-hook
-  "An event distributor invoked immediately after a mail buffer is initialized."
+  "An event distributor invoked immediately after a mail buffer is initialized.
+The mail buffer is passed as an argument; it is not necessarily selected."
   (make-event-distributor))
-\f
+
 (define-major-mode mail text "Mail"
   "Major mode for editing mail to be sent.
 Separate names of recipients (in To: and CC: fields) with commas.