Commit 25ca2e61 authored by Chong Yidong's avatar Chong Yidong

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.
parent b2948a87
...@@ -621,6 +621,11 @@ Notifications API. It requires D-Bus for communication. ...@@ -621,6 +621,11 @@ Notifications API. It requires D-Bus for communication.
* Incompatible Lisp Changes in Emacs 24.1 * Incompatible Lisp Changes in Emacs 24.1
** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and
passes it to the mail user agent function. This argument specifies an
action for returning to the caller after finishing with the mail.
This is currently used by Rmail to delete a mail window.
** For mouse click input events in the text area, the Y pixel ** For mouse click input events in the text area, the Y pixel
coordinate in the POSITION list now counts from the top of the text coordinate in the POSITION list now counts from the top of the text
area, excluding any header line. Previously, it counted from the top area, excluding any header line. Previously, it counted from the top
......
2011-01-13 Chong Yidong <cyd@stupidchicken.com>
* 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.
* 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.
* mail/rmail.el (rmail-mail-return): New function.
(rmail-start-mail): Pass it to compose-mail.
2011-01-12 Chong Yidong <cyd@stupidchicken.com> 2011-01-12 Chong Yidong <cyd@stupidchicken.com>
* menu-bar.el (menu-bar-custom-menu): Tweak Mule and Customize * menu-bar.el (menu-bar-custom-menu): Tweak Mule and Customize
......
2011-01-13 Chong Yidong <cyd@stupidchicken.com>
* message.el (message-tool-bar-gnome): Tweak tool-bar items. Add
:vert-only tags.
(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.
* gnus-msg.el (gnus-msg-mail): New arg RETURN-ACTION. Pass it to
message-mail.
2011-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org> 2011-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-convert-partial-article): Protect against * nnimap.el (nnimap-convert-partial-article): Protect against
......
...@@ -477,7 +477,7 @@ Thank you for your help in stamping out bugs. ...@@ -477,7 +477,7 @@ Thank you for your help in stamping out bugs.
;;;###autoload ;;;###autoload
(defun gnus-msg-mail (&optional to subject other-headers continue (defun gnus-msg-mail (&optional to subject other-headers continue
switch-action yank-action send-actions) switch-action yank-action send-actions return-action)
"Start editing a mail message to be sent. "Start editing a mail message to be sent.
Like `message-mail', but with Gnus paraphernalia, particularly the Like `message-mail', but with Gnus paraphernalia, particularly the
Gcc: header for archiving purposes." Gcc: header for archiving purposes."
...@@ -486,7 +486,7 @@ Gcc: header for archiving purposes." ...@@ -486,7 +486,7 @@ Gcc: header for archiving purposes."
mail-buf) mail-buf)
(gnus-setup-message 'message (gnus-setup-message 'message
(message-mail to subject other-headers continue (message-mail to subject other-headers continue
nil yank-action send-actions)) nil yank-action send-actions return-action))
(when switch-action (when switch-action
(setq mail-buf (current-buffer)) (setq mail-buf (current-buffer))
(switch-to-buffer buf) (switch-to-buffer buf)
......
...@@ -1120,6 +1120,8 @@ It is a vector of the following headers: ...@@ -1120,6 +1120,8 @@ It is a vector of the following headers:
(defvar message-checksum nil) (defvar message-checksum nil)
(defvar message-send-actions nil (defvar message-send-actions nil
"A list of actions to be performed upon successful sending of a message.") "A list of actions to be performed upon successful sending of a message.")
(defvar message-return-action nil
"Action to return to the caller after sending or postphoning a message.")
(defvar message-exit-actions nil (defvar message-exit-actions nil
"A list of actions to be performed upon exiting after sending a message.") "A list of actions to be performed upon exiting after sending a message.")
(defvar message-kill-actions nil (defvar message-kill-actions nil
...@@ -2863,6 +2865,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." ...@@ -2863,6 +2865,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(set (make-local-variable 'message-reply-buffer) nil) (set (make-local-variable 'message-reply-buffer) nil)
(set (make-local-variable 'message-inserted-headers) nil) (set (make-local-variable 'message-inserted-headers) nil)
(set (make-local-variable 'message-send-actions) nil) (set (make-local-variable 'message-send-actions) nil)
(set (make-local-variable 'message-return-action) nil)
(set (make-local-variable 'message-exit-actions) nil) (set (make-local-variable 'message-exit-actions) nil)
(set (make-local-variable 'message-kill-actions) nil) (set (make-local-variable 'message-kill-actions) nil)
(set (make-local-variable 'message-postpone-actions) nil) (set (make-local-variable 'message-postpone-actions) nil)
...@@ -3955,11 +3958,9 @@ The text will also be indented the normal way." ...@@ -3955,11 +3958,9 @@ The text will also be indented the normal way."
(actions message-exit-actions)) (actions message-exit-actions))
(when (and (message-send arg) (when (and (message-send arg)
(buffer-name buf)) (buffer-name buf))
(message-bury buf)
(if message-kill-buffer-on-exit (if message-kill-buffer-on-exit
(kill-buffer buf) (kill-buffer buf))
(bury-buffer buf)
(when (eq buf (current-buffer))
(message-bury buf)))
(message-do-actions actions) (message-do-actions actions)
t))) t)))
...@@ -4009,9 +4010,8 @@ Instead, just auto-save the buffer and then bury it." ...@@ -4009,9 +4010,8 @@ Instead, just auto-save the buffer and then bury it."
"Bury this mail BUFFER." "Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer))) (let ((newbuf (other-buffer buffer)))
(bury-buffer buffer) (bury-buffer buffer)
(if (and (window-dedicated-p (selected-window)) (if message-return-action
(not (null (delq (selected-frame) (visible-frame-list))))) (apply (car message-return-action) (cdr message-return-action))
(delete-frame (selected-frame))
(switch-to-buffer newbuf)))) (switch-to-buffer newbuf))))
(defun message-send (&optional arg) (defun message-send (&optional arg)
...@@ -6304,11 +6304,11 @@ between beginning of field and beginning of line." ...@@ -6304,11 +6304,11 @@ between beginning of field and beginning of line."
;; YANK-ACTION, if non-nil, can be a buffer or a yank action of the ;; YANK-ACTION, if non-nil, can be a buffer or a yank action of the
;; form (FUNCTION . ARGS). ;; form (FUNCTION . ARGS).
(defun message-setup (headers &optional yank-action actions (defun message-setup (headers &optional yank-action actions
continue switch-function) continue switch-function return-action)
(let ((mua (message-mail-user-agent)) (let ((mua (message-mail-user-agent))
subject to field) subject to field)
(if (not (and message-this-is-mail mua)) (if (not (and message-this-is-mail mua))
(message-setup-1 headers yank-action actions) (message-setup-1 headers yank-action actions return-action)
(setq headers (copy-sequence headers)) (setq headers (copy-sequence headers))
(setq field (assq 'Subject headers)) (setq field (assq 'Subject headers))
(when field (when field
...@@ -6356,11 +6356,12 @@ are not included." ...@@ -6356,11 +6356,12 @@ are not included."
(push header result))) (push header result)))
(nreverse result))) (nreverse result)))
(defun message-setup-1 (headers &optional yank-action actions) (defun message-setup-1 (headers &optional yank-action actions return-action)
(dolist (action actions) (dolist (action actions)
(condition-case nil (condition-case nil
(add-to-list 'message-send-actions (add-to-list 'message-send-actions
`(apply ',(car action) ',(cdr action))))) `(apply ',(car action) ',(cdr action)))))
(setq message-return-action return-action)
(setq message-reply-buffer (setq message-reply-buffer
(if (and (consp yank-action) (if (and (consp yank-action)
(eq (car yank-action) 'insert-buffer)) (eq (car yank-action) 'insert-buffer))
...@@ -6489,9 +6490,9 @@ are not included." ...@@ -6489,9 +6490,9 @@ are not included."
;;; ;;;
;;;###autoload ;;;###autoload
(defun message-mail (&optional to subject (defun message-mail (&optional to subject other-headers continue
other-headers continue switch-function switch-function yank-action send-actions
yank-action send-actions) return-action &rest ignored)
"Start editing a mail message to be sent. "Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
to continue editing a message already being composed. SWITCH-FUNCTION to continue editing a message already being composed. SWITCH-FUNCTION
...@@ -6512,7 +6513,8 @@ is a function used to switch to and display the mail buffer." ...@@ -6512,7 +6513,8 @@ is a function used to switch to and display the mail buffer."
(nconc (nconc
`((To . ,(or to "")) (Subject . ,(or subject ""))) `((To . ,(or to "")) (Subject . ,(or subject "")))
(when other-headers other-headers)) (when other-headers other-headers))
yank-action send-actions continue switch-function) yank-action send-actions continue switch-function
return-action)
;; FIXME: Should return nil if failure. ;; FIXME: Should return nil if failure.
t)) t))
...@@ -7642,24 +7644,22 @@ Pre-defined symbols include `message-tool-bar-gnome' and ...@@ -7642,24 +7644,22 @@ Pre-defined symbols include `message-tool-bar-gnome' and
(defcustom message-tool-bar-gnome (defcustom message-tool-bar-gnome
'((ispell-message "spell" nil '((ispell-message "spell" nil
:vert-only t
:visible (or (not (boundp 'flyspell-mode)) :visible (or (not (boundp 'flyspell-mode))
(not flyspell-mode))) (not flyspell-mode)))
(flyspell-buffer "spell" t (flyspell-buffer "spell" t
:vert-only t
:visible (and (boundp 'flyspell-mode) :visible (and (boundp 'flyspell-mode)
flyspell-mode) flyspell-mode)
:help "Flyspell whole buffer") :help "Flyspell whole buffer")
(gmm-ignore "separator") (message-send-and-exit "mail/send" t :label "Send")
(message-send-and-exit "mail/send")
(message-dont-send "mail/save-draft") (message-dont-send "mail/save-draft")
(message-kill-buffer "close") ;; stock_cancel (mml-attach-file "attach" mml-mode-map :vert-only t)
(mml-attach-file "attach" mml-mode-map)
(mml-preview "mail/preview" mml-mode-map) (mml-preview "mail/preview" mml-mode-map)
(mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil) (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
(message-insert-importance-high "important" nil :visible nil) (message-insert-importance-high "important" nil :visible nil)
(message-insert-importance-low "unimportant" nil :visible nil) (message-insert-importance-low "unimportant" nil :visible nil)
(message-insert-disposition-notification-to "receipt" nil :visible nil) (message-insert-disposition-notification-to "receipt" nil :visible nil))
(gmm-customize-mode "preferences" t :help "Edit mode preferences")
(message-info "help" t :help "Message manual"))
"List of items for the message tool bar (GNOME style). "List of items for the message tool bar (GNOME style).
See `gmm-tool-bar-from-list' for details on the format of the list." See `gmm-tool-bar-from-list' for details on the format of the list."
......
...@@ -3441,30 +3441,62 @@ does not pop any summary buffer." ...@@ -3441,30 +3441,62 @@ does not pop any summary buffer."
;;;; *** Rmail Mailing Commands *** ;;;; *** Rmail Mailing Commands ***
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc (defun rmail-start-mail (&optional noerase to subject in-reply-to cc
replybuffer sendactions same-window others) replybuffer sendactions same-window
(let (yank-action) other-headers)
(let ((switch-function
(cond (same-window nil)
(rmail-mail-new-frame 'switch-to-buffer-other-frame)
(t 'switch-to-buffer-other-window)))
yank-action)
(if replybuffer (if replybuffer
;; The function used here must behave like insert-buffer wrt ;; The function used here must behave like insert-buffer wrt
;; point and mark (see doc of sc-cite-original). ;; point and mark (see doc of sc-cite-original).
(setq yank-action (list 'insert-buffer replybuffer))) (setq yank-action (list 'insert-buffer replybuffer)))
(setq others (cons (cons "cc" cc) others)) (push (cons "cc" cc) other-headers)
(setq others (cons (cons "in-reply-to" in-reply-to) others)) (push (cons "in-reply-to" in-reply-to) other-headers)
(if same-window (prog1
(compose-mail to subject others (compose-mail to subject other-headers noerase
noerase nil switch-function yank-action sendactions
yank-action sendactions) '(rmail-mail-return))
(if rmail-mail-new-frame (if (eq switch-function 'switch-to-buffer-other-frame)
(prog1 ;; This is not a standard frame parameter; nothing except
(compose-mail to subject others ;; sendmail.el looks at it.
noerase 'switch-to-buffer-other-frame (modify-frame-parameters (selected-frame)
yank-action sendactions) '((mail-dedicated-frame . t)))))))
;; This is not a standard frame parameter;
;; nothing except sendmail.el looks at it. (defun rmail-mail-return ()
(modify-frame-parameters (selected-frame) (cond
'((mail-dedicated-frame . t)))) ;; If there is only one visible frame with no special handling,
(compose-mail to subject others ;; consider deleting the mail window to return to Rmail.
noerase 'switch-to-buffer-other-window ((or (null (delq (selected-frame) (visible-frame-list)))
yank-action sendactions))))) (not (or (window-dedicated-p (frame-selected-window))
(and pop-up-frames (one-window-p))
(cdr (assq 'mail-dedicated-frame
(frame-parameters))))))
(let (rmail-flag summary-buffer)
(and (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 (boundp 'mail-bury-selects-summary)
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)))))
;; If the frame was probably made for this buffer, the user
;; probably wants to delete it now.
((display-multi-frame-p)
(delete-frame (selected-frame)))
;; The previous frame is where normally they have the Rmail buffer
;; displayed.
(t (other-frame -1))))
(defun rmail-mail () (defun rmail-mail ()
"Send mail in another window. "Send mail in another window.
......
...@@ -419,8 +419,7 @@ in `message-auto-save-directory'." ...@@ -419,8 +419,7 @@ in `message-auto-save-directory'."
(defvar mail-reply-action nil) (defvar mail-reply-action nil)
(defvar mail-send-actions nil (defvar mail-send-actions nil
"A list of actions to be performed upon successful sending of a message.") "A list of actions to be performed upon successful sending of a message.")
(put 'mail-reply-action 'permanent-local t) (defvar mail-return-action nil)
(put 'mail-send-actions 'permanent-local t)
;;;###autoload ;;;###autoload
(defcustom mail-default-headers nil (defcustom mail-default-headers nil
...@@ -521,7 +520,46 @@ by Emacs.)") ...@@ -521,7 +520,46 @@ by Emacs.)")
(setq mail-alias-modtime modtime (setq mail-alias-modtime modtime
mail-aliases t))))) 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 (or mail-default-reply-to
(setq mail-default-reply-to (getenv "REPLYTO"))) (setq mail-default-reply-to (getenv "REPLYTO")))
(sendmail-sync-aliases) (sendmail-sync-aliases)
...@@ -537,8 +575,12 @@ by Emacs.)") ...@@ -537,8 +575,12 @@ by Emacs.)")
(set-buffer-multibyte (default-value 'enable-multibyte-characters)) (set-buffer-multibyte (default-value 'enable-multibyte-characters))
(if current-input-method (if current-input-method
(inactivate-input-method)) (inactivate-input-method))
;; Local variables for Mail mode.
(setq mail-send-actions actions) (setq mail-send-actions actions)
(setq mail-reply-action replybuffer) (setq mail-reply-action replybuffer)
(setq mail-return-action return-action)
(goto-char (point-min)) (goto-char (point-min))
(if mail-setup-with-from (if mail-setup-with-from
(mail-insert-from-field)) (mail-insert-from-field))
...@@ -629,6 +671,7 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and ...@@ -629,6 +671,7 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
`mail-mode-hook' (in that order)." `mail-mode-hook' (in that order)."
(make-local-variable 'mail-reply-action) (make-local-variable 'mail-reply-action)
(make-local-variable 'mail-send-actions) (make-local-variable 'mail-send-actions)
(make-local-variable 'mail-return-action)
(setq buffer-offer-save t) (setq buffer-offer-save t)
(make-local-variable 'font-lock-defaults) (make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(mail-font-lock-keywords t t)) (setq font-lock-defaults '(mail-font-lock-keywords t t))
...@@ -762,39 +805,9 @@ Prefix arg means don't delete this window." ...@@ -762,39 +805,9 @@ Prefix arg means don't delete this window."
"Bury this mail buffer." "Bury this mail buffer."
(let ((newbuf (other-buffer (current-buffer)))) (let ((newbuf (other-buffer (current-buffer))))
(bury-buffer (current-buffer)) (bury-buffer (current-buffer))
(if (and (or nil (if (and (null arg) mail-return-action)
;; In this case, we need to go to a different frame. (apply (car mail-return-action) (cdr mail-return-action))
(window-dedicated-p (frame-selected-window)) (switch-to-buffer newbuf))))
;; 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))))))
(defcustom mail-send-hook nil (defcustom mail-send-hook nil
"Hook run just before sending a message." "Hook run just before sending a message."
...@@ -1643,7 +1656,8 @@ If the current line has `mail-yank-prefix', insert it on the new line." ...@@ -1643,7 +1656,8 @@ If the current line has `mail-yank-prefix', insert it on the new line."
;;;###autoload (add-hook 'same-window-buffer-names (purecopy "*unsent mail*")) ;;;###autoload (add-hook 'same-window-buffer-names (purecopy "*unsent mail*"))
;;;###autoload ;;;###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). "Edit a message to be sent. Prefix arg means resume editing (don't erase).
When this function returns, the buffer `*mail*' is selected. When this function returns, the buffer `*mail*' is selected.
The value is t if the message was newly initialized; otherwise, nil. The value is t if the message was newly initialized; otherwise, nil.
...@@ -1691,49 +1705,6 @@ The seventh argument ACTIONS is a list of actions to take ...@@ -1691,49 +1705,6 @@ The seventh argument ACTIONS is a list of actions to take
when the message is sent, we apply FUNCTION to ARGS. when the message is sent, we apply FUNCTION to ARGS.
This is how Rmail arranges to mark messages `answered'." This is how Rmail arranges to mark messages `answered'."
(interactive "P") (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) (if (eq noerase 'new)
(pop-to-buffer (generate-new-buffer "*mail*")) (pop-to-buffer (generate-new-buffer "*mail*"))
(and noerase (and noerase
...@@ -1772,7 +1743,8 @@ The seventh argument ACTIONS is a list of actions to take ...@@ -1772,7 +1743,8 @@ The seventh argument ACTIONS is a list of actions to take
t)) t))
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (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))) (setq initialized t)))
(if (and buffer-auto-save-file-name (if (and buffer-auto-save-file-name
(file-exists-p buffer-auto-save-file-name)) (file-exists-p buffer-auto-save-file-name))
......
2011-01-13 Chong Yidong <cyd@stupidchicken.com>
* mh-comp.el (mh-user-agent-compose): New arg RETURN-ACTION.
2010-11-07 Glenn Morris <rgm@gnu.org> 2010-11-07 Glenn Morris <rgm@gnu.org>
* mh-seq.el (mh-read-msg-list): Use point-at-eol. * mh-seq.el (mh-read-msg-list): Use point-at-eol.
......
...@@ -199,7 +199,8 @@ applications should use `mh-user-agent-compose'." ...@@ -199,7 +199,8 @@ applications should use `mh-user-agent-compose'."
;;;###autoload ;;;###autoload
(defun mh-user-agent-compose (&optional to subject other-headers continue (defun mh-user-agent-compose (&optional to subject other-headers continue
switch-function yank-action switch-function yank-action
send-actions) send-actions return-action
&rest ignored)
"Set up mail composition draft with the MH mail system. "Set up mail composition draft with the MH mail system.
This is the `mail-user-agent' entry point to MH-E. This function This is the `mail-user-agent' entry point to MH-E. This function
conforms to the contract specified by `define-mail-user-agent' conforms to the contract specified by `define-mail-user-agent'
...@@ -213,8 +214,8 @@ OTHER-HEADERS is an alist specifying additional header fields. ...@@ -213,8 +214,8 @@ OTHER-HEADERS is an alist specifying additional header fields.
Elements look like (HEADER . VALUE) where both HEADER and VALUE Elements look like (HEADER . VALUE) where both HEADER and VALUE
are strings. are strings.
CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and
ignored." RETURN-ACTION are ignored."
(mh-find-path) (mh-find-path)
(let ((mh-error-if-no-draft t)) (let ((mh-error-if-no-draft t))
(mh-send to "" subject) (mh-send to "" subject)
......
...@@ -5712,10 +5712,6 @@ appears to have customizations applying to the old default, ...@@ -5712,10 +5712,6 @@ appears to have customizations applying to the old default,
:version "23.2" :version "23.2"
:group 'mail) :group 'mail)
(define-mail-user-agent 'sendmail-user-agent
'sendmail-user-agent-compose
'mail-send-and-exit)
(defun rfc822-goto-eoh () (defun rfc822-goto-eoh ()
;; Go to header delimiter line in a mail message, following RFC822 rules ;; Go to header delimiter line in a mail message, following RFC822 rules
(goto-char (point-min)) (goto-char (point-min))
...@@ -5723,37 +5719,9 @@ appears to have customizations applying to the old default, ...@@ -5723,37 +5719,9 @@ appears to have customizations applying to the old default,
"^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move) "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
(goto-char (match-beginning 0)))) (goto-char (match-beginning 0))))
(defun sendmail-user-agent-compose (&optional to subject other-headers continue
switch-function yank-action
send-actions)
(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)
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"))