* 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.
\f
* 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
;;;###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."
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)
(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
(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)
(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)))
"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)
;; 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
(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))
;;;
;;;###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
(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))
(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."
;;;; *** 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.
(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
(setq mail-alias-modtime modtime
mail-aliases t)))))
-(defun mail-setup (to subject in-reply-to cc replybuffer actions)
+\f
+;;;###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)
(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))
`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))
"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."
;;;###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.
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
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.
;;;###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'
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)
: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))
"^\\([:\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'.
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))
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))
+
\f
(defvar set-variable-value-history nil
"History of values entered with `set-variable'.
projects / emacs.git / commitdiff