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.
* 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
coordinate in the POSITION list now counts from the top of the text
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>
* 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>
* nnimap.el (nnimap-convert-partial-article): Protect against
......
......@@ -477,7 +477,7 @@ Thank you for your help in stamping out bugs.
;;;###autoload
(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.
Like `message-mail', but with Gnus paraphernalia, particularly the
Gcc: header for archiving purposes."
......@@ -486,7 +486,7 @@ Gcc: header for archiving purposes."
mail-buf)
(gnus-setup-message 'message
(message-mail to subject other-headers continue
nil yank-action send-actions))
nil yank-action send-actions return-action))
(when switch-action
(setq mail-buf (current-buffer))
(switch-to-buffer buf)
......
......@@ -1120,6 +1120,8 @@ It is a vector of the following headers:
(defvar message-checksum nil)
(defvar message-send-actions nil
"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
"A list of actions to be performed upon exiting after sending a message.")
(defvar message-kill-actions nil
......@@ -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-inserted-headers) 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-kill-actions) nil)
(set (make-local-variable 'message-postpone-actions) nil)
......@@ -3955,11 +3958,9 @@ The text will also be indented the normal way."
(actions message-exit-actions))
(when (and (message-send arg)
(buffer-name buf))
(message-bury buf)
(if message-kill-buffer-on-exit
(kill-buffer buf)
(bury-buffer buf)
(when (eq buf (current-buffer))
(message-bury buf)))
(kill-buffer buf))
(message-do-actions actions)
t)))
......@@ -4009,9 +4010,8 @@ Instead, just auto-save the buffer and then bury it."
"Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
(if (and (window-dedicated-p (selected-window))
(not (null (delq (selected-frame) (visible-frame-list)))))
(delete-frame (selected-frame))
(if message-return-action
(apply (car message-return-action) (cdr message-return-action))
(switch-to-buffer newbuf))))
(defun message-send (&optional arg)
......@@ -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
;; form (FUNCTION . ARGS).
(defun message-setup (headers &optional yank-action actions
continue switch-function)
continue switch-function return-action)
(let ((mua (message-mail-user-agent))
subject to field)
(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 field (assq 'Subject headers))
(when field
......@@ -6356,11 +6356,12 @@ are not included."
(push header 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)
(condition-case nil
(add-to-list 'message-send-actions
`(apply ',(car action) ',(cdr action)))))
(setq message-return-action return-action)
(setq message-reply-buffer
(if (and (consp yank-action)
(eq (car yank-action) 'insert-buffer))
......@@ -6489,9 +6490,9 @@ are not included."
;;;
;;;###autoload
(defun message-mail (&optional to subject
other-headers continue switch-function
yank-action send-actions)
(defun message-mail (&optional to subject other-headers continue
switch-function yank-action send-actions
return-action &rest ignored)
"Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
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."
(nconc
`((To . ,(or to "")) (Subject . ,(or subject "")))
(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.
t))
......@@ -7642,24 +7644,22 @@ Pre-defined symbols include `message-tool-bar-gnome' and
(defcustom message-tool-bar-gnome
'((ispell-message "spell" nil
:vert-only t
:visible (or (not (boundp 'flyspell-mode))
(not flyspell-mode)))
(flyspell-buffer "spell" t
:vert-only t
:visible (and (boundp 'flyspell-mode)
flyspell-mode)
:help "Flyspell whole buffer")
(gmm-ignore "separator")
(message-send-and-exit "mail/send")
(message-send-and-exit "mail/send" t :label "Send")
(message-dont-send "mail/save-draft")
(message-kill-buffer "close") ;; stock_cancel
(mml-attach-file "attach" mml-mode-map)
(mml-attach-file "attach" mml-mode-map :vert-only t)
(mml-preview "mail/preview" mml-mode-map)
(mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
(message-insert-importance-high "important" nil :visible nil)
(message-insert-importance-low "unimportant" 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"))
(message-insert-disposition-notification-to "receipt" nil :visible nil))
"List of items for the message tool bar (GNOME style).
See `gmm-tool-bar-from-list' for details on the format of the list."
......
......@@ -3441,30 +3441,62 @@ does not pop any summary buffer."
;;;; *** Rmail Mailing Commands ***
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc
replybuffer sendactions same-window others)
(let (yank-action)
replybuffer sendactions same-window
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
;; The function used here must behave like insert-buffer wrt
;; point and mark (see doc of sc-cite-original).
(setq yank-action (list 'insert-buffer replybuffer)))
(setq others (cons (cons "cc" cc) others))
(setq others (cons (cons "in-reply-to" in-reply-to) others))
(if same-window
(compose-mail to subject others
noerase nil
yank-action sendactions)
(if rmail-mail-new-frame
(prog1
(compose-mail to subject others
noerase 'switch-to-buffer-other-frame
yank-action sendactions)
;; This is not a standard frame parameter;
;; nothing except sendmail.el looks at it.
(modify-frame-parameters (selected-frame)
'((mail-dedicated-frame . t))))
(compose-mail to subject others
noerase 'switch-to-buffer-other-window
yank-action sendactions)))))
(push (cons "cc" cc) other-headers)
(push (cons "in-reply-to" in-reply-to) other-headers)
(prog1
(compose-mail to subject other-headers noerase
switch-function yank-action sendactions
'(rmail-mail-return))
(if (eq switch-function 'switch-to-buffer-other-frame)
;; This is not a standard frame parameter; nothing except
;; sendmail.el looks at it.
(modify-frame-parameters (selected-frame)
'((mail-dedicated-frame . t)))))))
(defun rmail-mail-return ()
(cond
;; If there is only one visible frame with no special handling,
;; consider deleting the mail window to return to Rmail.
((or (null (delq (selected-frame) (visible-frame-list)))
(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 ()
"Send mail in another window.
......
......@@ -419,8 +419,7 @@ in `message-auto-save-directory'."
(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 @@ by Emacs.)")
(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 @@ by Emacs.)")
(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 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
`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 @@ Prefix arg means don't delete this window."
"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 @@ 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
(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 @@ The seventh argument ACTIONS is a list of actions to take
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 @@ The seventh argument ACTIONS is a list of actions to take
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))
......
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>
* mh-seq.el (mh-read-msg-list): Use point-at-eol.
......
......@@ -199,7 +199,8 @@ applications should use `mh-user-agent-compose'."
;;;###autoload
(defun mh-user-agent-compose (&optional to subject other-headers continue
switch-function yank-action
send-actions)
send-actions return-action
&rest ignored)
"Set up mail composition draft with the MH mail system.
This is the `mail-user-agent' entry point to MH-E. This function
conforms to the contract specified by `define-mail-user-agent'
......@@ -213,8 +214,8 @@ OTHER-HEADERS is an alist specifying additional header fields.
Elements look like (HEADER . VALUE) where both HEADER and VALUE
are strings.
CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are
ignored."
CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and
RETURN-ACTION are ignored."
(mh-find-path)
(let ((mh-error-if-no-draft t))
(mh-send to "" subject)
......
......@@ -5712,10 +5712,6 @@ appears to have customizations applying to the old default,
:version "23.2"
:group 'mail)
(define-mail-user-agent 'sendmail-user-agent
'sendmail-user-agent-compose
'mail-send-and-exit)
(defun rfc822-goto-eoh ()
;; Go to header delimiter line in a mail message, following RFC822 rules
(goto-char (point-min))
......@@ -5723,37 +5719,9 @@ appears to have customizations applying to the old default,
"^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
(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"))
(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 compose-mail (&optional to subject other-headers continue
switch-function yank-action send-actions)
switch-function yank-action send-actions
return-action)
"Start composing a mail message to send.
This uses the user's chosen mail composition package
as selected with the variable `mail-user-agent'.
......@@ -5778,7 +5746,12 @@ FUNCTION to ARGS, to insert the raw text of the original message.
original text has been inserted in this way.)
SEND-ACTIONS is a list of actions to call when the message is sent.
Each action has the form (FUNCTION . ARGS)."
Each action has the form (FUNCTION . ARGS).
RETURN-ACTION, if non-nil, is an action for returning to the
caller. It has the form (FUNCTION . ARGS). The function is
called after the mail has been sent or put aside, and the mail
buffer buried."
(interactive
(list nil nil nil current-prefix-arg))
......@@ -5808,25 +5781,27 @@ To disable this warning, set `compose-mail-user-agent-warnings' to nil."
warn-vars " "))))))
(let ((function (get mail-user-agent 'composefunc)))
(funcall function to subject other-headers continue
switch-function yank-action send-actions)))
(funcall function to subject other-headers continue switch-function
yank-action send-actions return-action)))
(defun compose-mail-other-window (&optional to subject other-headers continue
yank-action send-actions)
yank-action send-actions
return-action)
"Like \\[compose-mail], but edit the outgoing message in another window."
(interactive
(list nil nil nil current-prefix-arg))
(interactive (list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
'switch-to-buffer-other-window yank-action send-actions))
'switch-to-buffer-other-window yank-action send-actions
return-action))
(defun compose-mail-other-frame (&optional to subject other-headers continue
yank-action send-actions)
yank-action send-actions
return-action)
"Like \\[compose-mail], but edit the outgoing message in another frame."
(interactive
(list nil nil nil current-prefix-arg))
(interactive (list nil nil nil current-prefix-arg))
(compose-mail to subject other-headers continue
'switch-to-buffer-other-frame yank-action send-actions))
'switch-to-buffer-other-frame yank-action send-actions
return-action))
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment