diff lisp/mail/sendmail.el @ 112199:6c6130ccdefd

New arg RETURN-ACTION for compose-mail, and related functions. * lisp/mail/sendmail.el (mail-return-action): New var. (mail-mode): Make it buffer-local. (mail-bury): Obey it. Move special Rmail window handling to rmail-mail-return. (mail, mail-setup): New arg RETURN-ACTION. (sendmail-user-agent-compose): Move from simple.el. * lisp/simple.el (sendmail-user-agent-compose): Move to sendmail.el. (compose-mail): New arg RETURN-ACTION. (compose-mail-other-window, compose-mail-other-frame): Likewise. * lisp/gnus/gnus-msg.el (gnus-msg-mail): New arg RETURN-ACTION. Pass it to message-mail. * lisp/gnus/message.el (message-mail): New arg RETURN-ACTION. (message-return-action): New var. (message-bury): Use it. (message-mode): Make it buffer-local. (message-send-and-exit): Always call message-bury. (message-tool-bar-gnome): Tweak tool-bar items. Add :vert-only tags. * lisp/mail/rmail.el (rmail-mail-return): New function. (rmail-start-mail): Pass it to compose-mail. * lisp/mh-e/mh-comp.el (mh-user-agent-compose): New arg RETURN-ACTION.

--- a/lisp/mail/sendmail.el	Wed Jan 12 14:10:00 2011 -0500
+++ b/lisp/mail/sendmail.el	Wed Jan 12 23:23:41 2011 -0500
@@ -419,8 +419,7 @@
 (defvar mail-reply-action nil)
 (defvar mail-send-actions nil
   "A list of actions to be performed upon successful sending of a message.")
-(put 'mail-reply-action 'permanent-local t)
-(put 'mail-send-actions 'permanent-local t)
+(defvar mail-return-action nil)
 
 ;;;###autoload
 (defcustom mail-default-headers nil
@@ -521,7 +520,46 @@
 	  (setq mail-alias-modtime modtime
 		mail-aliases t)))))
 
-(defun mail-setup (to subject in-reply-to cc replybuffer actions)
+
+;;;###autoload
+(define-mail-user-agent 'sendmail-user-agent
+  'sendmail-user-agent-compose
+  'mail-send-and-exit)
+
+;;;###autoload
+(defun sendmail-user-agent-compose (&optional to subject other-headers
+				    continue switch-function yank-action
+				    send-actions return-action
+				    &rest ignored)
+  (if switch-function
+      (let ((special-display-buffer-names nil)
+	    (special-display-regexps nil)
+	    (same-window-buffer-names nil)
+	    (same-window-regexps nil))
+	(funcall switch-function "*mail*")))
+  (let ((cc (cdr (assoc-string "cc" other-headers t)))
+	(in-reply-to (cdr (assoc-string "in-reply-to" other-headers t)))
+	(body (cdr (assoc-string "body" other-headers t))))
+    (or (mail continue to subject in-reply-to cc yank-action
+	      send-actions return-action)
+	continue
+	(error "Message aborted"))
+    (save-excursion
+      (rfc822-goto-eoh)
+      (while other-headers
+	(unless (member-ignore-case (car (car other-headers))
+				    '("in-reply-to" "cc" "body"))
+	  (insert (car (car other-headers)) ": "
+		  (cdr (car other-headers))
+		  (if use-hard-newlines hard-newline "\n")))
+	(setq other-headers (cdr other-headers)))
+      (when body
+	(forward-line 1)
+	(insert body))
+      t)))
+
+(defun mail-setup (to subject in-reply-to cc replybuffer
+		   actions return-action)
   (or mail-default-reply-to
       (setq mail-default-reply-to (getenv "REPLYTO")))
   (sendmail-sync-aliases)
@@ -537,8 +575,12 @@
   (set-buffer-multibyte (default-value 'enable-multibyte-characters))
   (if current-input-method
       (inactivate-input-method))
+
+  ;; Local variables for Mail mode.
   (setq mail-send-actions actions)
   (setq mail-reply-action replybuffer)
+  (setq mail-return-action return-action)
+
   (goto-char (point-min))
   (if mail-setup-with-from
       (mail-insert-from-field))
@@ -629,6 +671,7 @@
 `mail-mode-hook' (in that order)."
   (make-local-variable 'mail-reply-action)
   (make-local-variable 'mail-send-actions)
+  (make-local-variable 'mail-return-action)
   (setq buffer-offer-save t)
   (make-local-variable 'font-lock-defaults)
   (setq font-lock-defaults '(mail-font-lock-keywords t t))
@@ -762,39 +805,9 @@
   "Bury this mail buffer."
   (let ((newbuf (other-buffer (current-buffer))))
     (bury-buffer (current-buffer))
-    (if (and (or nil
-		 ;; In this case, we need to go to a different frame.
-		 (window-dedicated-p (frame-selected-window))
-		 ;; In this mode of operation, the frame was probably
-		 ;; made for this buffer, so the user probably wants
-		 ;; to delete it now.
-		 (and pop-up-frames (one-window-p))
-		 (cdr (assq 'mail-dedicated-frame (frame-parameters))))
-	     (not (null (delq (selected-frame) (visible-frame-list)))))
-	(progn
-	  (if (display-multi-frame-p)
-	      (delete-frame (selected-frame))
-	    ;; The previous frame is where normally they have the
-	    ;; Rmail buffer displayed.
-	    (other-frame -1)))
-      (let (rmail-flag summary-buffer)
-	(and (not arg)
-	     (not (one-window-p))
-	     (with-current-buffer
-                 (window-buffer (next-window (selected-window) 'not))
-	       (setq rmail-flag (eq major-mode 'rmail-mode))
-	       (setq summary-buffer
-		     (and mail-bury-selects-summary
-			  (boundp 'rmail-summary-buffer)
-			  rmail-summary-buffer
-			  (buffer-name rmail-summary-buffer)
-			  (not (get-buffer-window rmail-summary-buffer))
-			  rmail-summary-buffer))))
-	(if rmail-flag
-	    ;; If the Rmail buffer has a summary, show that.
-	    (if summary-buffer (switch-to-buffer summary-buffer)
-	      (delete-window))
-	  (switch-to-buffer newbuf))))))
+    (if (and (null arg) mail-return-action)
+	(apply (car mail-return-action) (cdr mail-return-action))
+      (switch-to-buffer newbuf))))
 
 (defcustom mail-send-hook nil
   "Hook run just before sending a message."
@@ -1643,7 +1656,8 @@
 ;;;###autoload (add-hook 'same-window-buffer-names (purecopy "*unsent mail*"))
 
 ;;;###autoload
-(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
+(defun mail (&optional noerase to subject in-reply-to cc replybuffer
+		       actions return-action)
   "Edit a message to be sent.  Prefix arg means resume editing (don't erase).
 When this function returns, the buffer `*mail*' is selected.
 The value is t if the message was newly initialized; otherwise, nil.
@@ -1691,49 +1705,6 @@
  when the message is sent, we apply FUNCTION to ARGS.
  This is how Rmail arranges to mark messages `answered'."
   (interactive "P")
- ;; This is commented out because I found it was confusing in practice.
- ;; It is easy enough to rename *mail* by hand with rename-buffer
- ;; if you want to have multiple mail buffers.
- ;; And then you can control which messages to save. --rms.
- ;; (let ((index 1)
- ;;        buffer)
- ;;   ;; If requested, look for a mail buffer that is modified and go to it.
- ;;   (if noerase
- ;;        (progn
- ;;          (while (and (setq buffer
- ;;        		    (get-buffer (if (= 1 index) "*mail*"
- ;;        				  (format "*mail*<%d>" index))))
- ;;        	      (not (buffer-modified-p buffer)))
- ;;            (setq index (1+ index)))
- ;;          (if buffer (switch-to-buffer buffer)
- ;;            ;; If none exists, start a new message.
- ;;            ;; This will never re-use an existing unmodified mail buffer
- ;;            ;; (since index is not 1 anymore).  Perhaps it should.
- ;;            (setq noerase nil))))
- ;;   ;; Unless we found a modified message and are happy, start a new message.
- ;;   (if (not noerase)
- ;;        (progn
- ;;          ;; Look for existing unmodified mail buffer.
- ;;          (while (and (setq buffer
- ;;        		    (get-buffer (if (= 1 index) "*mail*"
- ;;        				  (format "*mail*<%d>" index))))
- ;;        	      (buffer-modified-p buffer))
- ;;            (setq index (1+ index)))
- ;;          ;; If none, make a new one.
- ;;          (or buffer
- ;;              (setq buffer (generate-new-buffer "*mail*")))
- ;;          ;; Go there and initialize it.
- ;;          (switch-to-buffer buffer)
- ;;          (erase-buffer)
- ;;         (setq default-directory (expand-file-name "~/"))
- ;;         (auto-save-mode auto-save-default)
- ;;         (mail-mode)
- ;;         (mail-setup to subject in-reply-to cc replybuffer actions)
- ;;          (if (and buffer-auto-save-file-name
- ;;        	   (file-exists-p buffer-auto-save-file-name))
- ;;              (message "Auto save file for draft message exists; consider M-x mail-recover"))
- ;;         t))
-
   (if (eq noerase 'new)
       (pop-to-buffer (generate-new-buffer "*mail*"))
     (and noerase
@@ -1772,7 +1743,8 @@
 	     t))
 	 (let ((inhibit-read-only t))
 	   (erase-buffer)
-	   (mail-setup to subject in-reply-to cc replybuffer actions)
+	   (mail-setup to subject in-reply-to cc replybuffer actions
+		       return-action)
 	   (setq initialized t)))
     (if (and buffer-auto-save-file-name
 	     (file-exists-p buffer-auto-save-file-name))