;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 03, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(require 'rmail)
(require 'mailalias))
+(autoload 'rfc2047-encode-string "rfc2047")
+
(defgroup sendmail nil
"Mail sending commands for Emacs."
:prefix "mail-"
;;;###autoload
(defcustom mail-specify-envelope-from nil
"*If non-nil, specify the envelope-from address when sending mail.
-The value used to specify it is whatever is found in `user-mail-address'.
+The value used to specify it is whatever is found in
+the variable `mail-envelope-from', with `user-mail-address' as fallback.
-On most systems, specifying the envelope-from address
-is a privileged operation."
+On most systems, specifying the envelope-from address is a
+privileged operation. This variable affects sendmail and
+smtpmail -- if you use feedmail to send mail, see instead the
+variable `feedmail-deduce-envelope-from'."
:version "21.1"
:type 'boolean
:group 'sendmail)
+(defcustom mail-envelope-from nil
+ "*If non-nil, designate the envelope-from address when sending mail.
+This only has an effect if `mail-specify-envelope-from' is non-nil.
+The value should be either a string, or the symbol `header' (in
+which case the contents of the \"From\" header of the message
+being sent is used), or nil (in which case the value of
+`user-mail-address' is used)."
+ :version "21.1"
+ :type '(choice (string :tag "From-name")
+ (const :tag "Use From: header from message" header)
+ (const :tag "Use `user-mail-address'" nil))
+ :group 'sendmail)
+
;;;###autoload
(defcustom mail-self-blind nil "\
*Non-nil means insert BCC to self in messages to be sent.
;; Useful to set in site-init.el
;;;###autoload
-(defvar send-mail-function 'sendmail-send-it "\
-Function to call to send the current buffer as mail.
+(defcustom send-mail-function 'sendmail-send-it
+ "Function to call to send the current buffer as mail.
The headers should be delimited by a line which is
-not a valid RFC822 header or continuation line.")
+not a valid RFC822 header or continuation line,
+that matches the variable `mail-header-separator'.
+This is used by the default mail-sending commands. See also
+`message-send-mail-function' for use with the Message package."
+ :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package")
+ (function-item smtpmail-send-it :tag "Use SMTPmail package")
+ (function-item feedmail-send-it :tag "Use Feedmail package")
+ function)
+ :group 'sendmail)
;;;###autoload
(defcustom mail-header-separator "--text follows this line--" "\
(defvar mail-aliases t
"Alist of mail address aliases,
or t meaning should be initialized from your mail aliases file.
-\(The file's name is normally `~/.mailrc', but your MAILRC environment
-variable can override that name.)
+\(The file's name is normally `~/.mailrc', but `mail-personal-alias-file'
+can specify a different file name.)
The alias definitions in the file have this form:
alias ALIAS MEANING")
which is the standard way to delimit a signature in a message.)
Otherwise, it should be an expression; it is evaluated
and should insert whatever you want to insert."
- :type '(choice (const "None" nil)
+ :type '(choice (const :tag "None" nil)
(const :tag "Use `.signature' file" t)
(string :tag "String to insert")
(sexp :tag "Expression to evaluate"))
:type 'file
:group 'sendmail)
+;;;###autoload
+(defcustom mail-default-directory "~/"
+ "*Directory for mail buffers.
+Value of `default-directory' for mail buffers.
+This directory is used for auto-save files of mail buffers."
+ :type '(directory :tag "Directory")
+ :group 'sendmail
+ :version "22.1")
+
(defvar mail-reply-action nil)
(defvar mail-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
:type '(choice (const t) (const nil) (const query) (const mime))
:group 'sendmail)
+(defcustom mail-use-dsn nil
+ "*Ask MTA for notification of failed, delayed or successful delivery.
+Note that only some MTAs (currently only recent versions of Sendmail)
+support Delivery Status Notification."
+ :group 'sendmail
+ :type '(repeat (radio (const :tag "Failure" failure)
+ (const :tag "Delay" delay)
+ (const :tag "Success" success)))
+ :version "22.1")
+
;; Note: could use /usr/ucb/mail instead of sendmail;
;; options -t, and -v if not interactive.
(defvar mail-mailer-swallows-blank-line
The value should be an expression to test whether the problem will
actually occur.")
-(defvar mail-mode-syntax-table nil
- "Syntax table used while in mail mode.")
-
-(if (not mail-mode-syntax-table)
- (progn
- (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
- (modify-syntax-entry ?% ". " mail-mode-syntax-table)))
+(defvar mail-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ ;; define-derived-mode will make it inherit from text-mode-syntax-table.
+ (modify-syntax-entry ?% ". " st)
+ st)
+ "Syntax table used while in `mail-mode'.")
(defvar mail-font-lock-keywords
(eval-when-compile
(beginning-of-line) (end-of-line)
(2 font-lock-constant-face nil t)
(4 font-lock-comment-face nil t)))
- '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
+ '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*\\(\n[ \t]+.*\\)*$"
. font-lock-string-face))))
"Additional expressions to highlight in Mail mode.")
-(defcustom mail-send-hook nil
- "Normal hook run before sending mail, in Mail mode."
- :type 'hook
- :group 'sendmail)
\f
(defun sendmail-sync-aliases ()
- (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
- (or (equal mail-alias-modtime modtime)
- (setq mail-alias-modtime modtime
- mail-aliases t))))
+ (when mail-personal-alias-file
+ (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
+ (or (equal mail-alias-modtime modtime)
+ (setq mail-alias-modtime modtime
+ mail-aliases t)))))
(defun mail-setup (to subject in-reply-to cc replybuffer actions)
(or mail-default-reply-to
(if (eq mail-aliases t)
(progn
(setq mail-aliases nil)
- (if (file-exists-p mail-personal-alias-file)
- (build-mail-aliases))))
+ (when mail-personal-alias-file
+ (if (file-exists-p mail-personal-alias-file)
+ (build-mail-aliases)))))
;; Don't leave this around from a previous message.
(kill-local-variable 'buffer-file-coding-system)
- (kill-local-variable 'enable-multibyte-characters)
+ ;; This doesn't work for enable-multibyte-characters.
+ ;; (kill-local-variable 'enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
(if current-input-method
(inactivate-input-method))
(setq mail-send-actions actions)
:type 'hook
:options '(footnote-mode))
+(defvar mail-mode-abbrev-table text-mode-abbrev-table)
;;;###autoload
-(defun mail-mode ()
+(define-derived-mode mail-mode text-mode "Mail"
"Major mode for editing mail to be sent.
Like Text Mode but with these additional commands:
\\[mail-send] mail-send (send the message) \\[mail-send-and-exit] mail-send-and-exit
Here are commands that move to a header field (and create it if there isn't):
\\[mail-to] move to To: \\[mail-subject] move to Subject:
\\[mail-cc] move to CC: \\[mail-bcc] move to BCC:
- \\[mail-fcc] move to FCC:
+ \\[mail-fcc] move to FCC: \\[mail-reply-to] move to Reply-To:
\\[mail-text] mail-text (move to beginning of message text).
\\[mail-signature] mail-signature (insert `mail-signature-file' file).
\\[mail-yank-original] mail-yank-original (insert current message, in Rmail).
\\[mail-fill-yanked-message] mail-fill-yanked-message (fill what was yanked).
-\\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC)."
- (interactive)
- (kill-all-local-variables)
+\\[mail-sent-via] mail-sent-via (add a Sent-via field for each To or CC).
+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)
- (set-syntax-table mail-mode-syntax-table)
- (use-local-map mail-mode-map)
- (setq local-abbrev-table text-mode-abbrev-table)
- (setq major-mode 'mail-mode)
- (setq mode-name "Mail")
(setq buffer-offer-save t)
(make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(mail-font-lock-keywords t))
+ (setq font-lock-defaults '(mail-font-lock-keywords t t))
(make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
(make-local-variable 'normal-auto-fill-function)
(setq normal-auto-fill-function 'mail-mode-auto-fill)
(make-local-variable 'fill-paragraph-function)
(setq fill-paragraph-function 'mail-mode-fill-paragraph)
+ ;; Allow using comment commands to add/remove quoting (this only does
+ ;; anything if mail-yank-prefix is set to a non-nil value).
+ (set (make-local-variable 'comment-start) mail-yank-prefix)
+ (if mail-yank-prefix
+ (set (make-local-variable 'comment-start-skip)
+ (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
(make-local-variable 'adaptive-fill-regexp)
(setq adaptive-fill-regexp
- (concat "[ \t]*\\([-|#;>*]+ *\\|(?[0-9]+[.)] *\\)+"
- "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"
- "\\|[ \t]*"))
+ (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
+ adaptive-fill-regexp))
(make-local-variable 'adaptive-fill-first-line-regexp)
(setq adaptive-fill-first-line-regexp
- (concat adaptive-fill-first-line-regexp
- "\\|[ \t]*[-[:alnum:]]*>+[ \t]*"))
+ (concat "[ \t]*[-[:alnum:]]*>+[ \t]*\\|"
+ adaptive-fill-first-line-regexp))
;; `-- ' precedes the signature. `-----' appears at the start of the
;; lines that delimit forwarded messages.
;; Lines containing just >= 3 dashes, perhaps after whitespace,
;; are also sometimes used and should be separators.
- (setq paragraph-start (concat (regexp-quote mail-header-separator)
+ (setq paragraph-separate (concat (regexp-quote mail-header-separator)
"$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
"\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
- "-- $\\|---+$\\|"
- page-delimiter))
- (setq paragraph-separate paragraph-start)
- (run-hooks 'text-mode-hook 'mail-mode-hook))
+ "--\\( \\|-+\\)$\\|"
+ page-delimiter)))
(defun mail-header-end ()
(defun mail-mode-fill-paragraph (arg)
;; Do something special only if within the headers.
(if (< (point) (mail-header-end))
- (let (beg end fieldname)
+ (let (beg end fieldname)
(when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
(setq beg (point)))
(setq fieldname
(if mail-mode-map
nil
- (setq mail-mode-map (nconc (make-sparse-keymap) text-mode-map))
+ (setq mail-mode-map (make-sparse-keymap))
(define-key mail-mode-map "\M-\t" 'mail-complete)
(define-key mail-mode-map "\C-c?" 'describe-mode)
(define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
(define-key mail-mode-map "\C-c\C-t" 'mail-text)
(define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
(define-key mail-mode-map "\C-c\C-r" 'mail-yank-region)
+ (define-key mail-mode-map [remap split-line] 'mail-split-line)
(define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
(define-key mail-mode-map "\C-c\C-w" 'mail-signature)
(define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
\f
;; User-level commands for sending.
-(defun mail-send-and-exit (arg)
+(defun mail-send-and-exit (&optional arg)
"Send message like `mail-send', then, if no errors, exit from mail buffer.
Prefix arg means don't delete this window."
(interactive "P")
(mail-send)
(mail-bury arg))
-(defun mail-dont-send (arg)
+(defun mail-dont-send (&optional arg)
"Don't send the message you have been editing.
Prefix arg means don't delete this window."
(interactive "P")
(mail-bury arg))
-(defun mail-bury (arg)
+(defun mail-bury (&optional arg)
"Bury this mail buffer."
(let ((newbuf (other-buffer (current-buffer))))
(bury-buffer (current-buffer))
(if (and (or (window-dedicated-p (frame-selected-window))
(cdr (assq 'mail-dedicated-frame (frame-parameters))))
(not (null (delq (selected-frame) (visible-frame-list)))))
- (delete-frame (selected-frame))
+ (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))
(y-or-n-p "Message already sent; resend? ")))
(let ((inhibit-read-only t)
(opoint (point)))
- (when (and enable-multibyte-characters
- (not (memq mail-send-nonascii '(t mime))))
+ (unless (memq mail-send-nonascii '(t mime))
(goto-char (point-min))
(skip-chars-forward "\0-\177")
(or (= (point) (point-max))
(progn
(set-buffer-modified-p nil)
(delete-auto-save-file-if-necessary t))))))
+
+(defun mail-envelope-from ()
+ "Return the envelope mail address to use when sending mail.
+This function uses `mail-envelope-from'."
+ (if (eq mail-envelope-from 'header)
+ (nth 1 (mail-extract-address-components
+ (mail-fetch-field "From")))
+ mail-envelope-from))
\f
;; This does the real work of sending a message via sendmail.
;; It is called via the variable send-mail-function.
See also the function `select-message-coding-system'.")
(defun sendmail-send-it ()
+ "Send the current mail buffer using the Sendmail package.
+This is a suitable value for `send-mail-function'. It sends using the
+external program defined by `sendmail-program'."
(require 'mail-utils)
(let ((errbuf (if mail-interactive
(generate-new-buffer " sendmail errors")
0))
(tembuf (generate-new-buffer " sendmail temp"))
+ (multibyte enable-multibyte-characters)
(case-fold-search nil)
- (coding (and (local-variable-p 'buffer-file-coding-system)
- buffer-file-coding-system))
- selected-coding
- resend-to-addresses
+ (selected-coding (select-message-coding-system))
+;;; resend-to-addresses
delimline
fcc-was-found
- (mailbuf (current-buffer)))
+ (mailbuf (current-buffer))
+ (program (if (boundp 'sendmail-program)
+ sendmail-program
+ "/usr/lib/sendmail"))
+ ;; Examine these variables now, so that
+ ;; local binding in the mail buffer will take effect.
+ (envelope-from
+ (and mail-specify-envelope-from
+ (or (mail-envelope-from) user-mail-address))))
(unwind-protect
(save-excursion
(set-buffer tembuf)
(erase-buffer)
+ (unless multibyte
+ (set-buffer-multibyte nil))
(insert-buffer-substring mailbuf)
- (set-buffer-file-coding-system coding)
(goto-char (point-max))
;; require one newline at the end.
(or (= (preceding-char) ?\n)
(replace-match "\n"))
(goto-char (point-min))
(let ((case-fold-search t))
- (goto-char (point-min))
- (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t)
- (setq resend-to-addresses
- (save-restriction
- (narrow-to-region (point)
- (save-excursion
- (forward-line 1)
- (while (looking-at "^[ \t]")
- (forward-line 1))
- (point)))
- (append (mail-parse-comma-list)
- resend-to-addresses)))
- ;; Delete Resent-BCC ourselves
- (if (save-excursion (beginning-of-line)
- (looking-at "resent-bcc"))
- (delete-region (save-excursion (beginning-of-line) (point))
- (save-excursion (end-of-line) (1+ (point))))))
+;;; (goto-char (point-min))
+;;; (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t)
+;;; (setq resend-to-addresses
+;;; (save-restriction
+;;; (narrow-to-region (point)
+;;; (save-excursion
+;;; (forward-line 1)
+;;; (while (looking-at "^[ \t]")
+;;; (forward-line 1))
+;;; (point)))
+;;; (append (mail-parse-comma-list)
+;;; resend-to-addresses)))
+;;; ;; Delete Resent-BCC ourselves
+;;; (if (save-excursion (beginning-of-line)
+;;; (looking-at "resent-bcc"))
+;;; (delete-region (save-excursion (beginning-of-line) (point))
+;;; (save-excursion (end-of-line) (1+ (point))))))
;;; Apparently this causes a duplicate Sender.
;;; ;; If the From is different than current user, insert Sender.
;;; (goto-char (point-min))
(let* ((login user-mail-address)
(fullname (user-full-name))
(quote-fullname nil))
- (if (string-match "[\200-\377]" fullname)
- (setq fullname (mail-quote-printable fullname t)
+ (if (string-match "[^\0-\177]" fullname)
+ (setq fullname (rfc2047-encode-string fullname)
quote-fullname t))
(cond ((eq mail-from-style 'angles)
(insert "From: " fullname)
;; ... then undo escaping of matching parentheses,
;; including matching nested parentheses.
(goto-char fullname-start)
- (while (re-search-forward
+ (while (re-search-forward
"\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
fullname-end 1)
(replace-match "\\1(\\3)" t)
(not (re-search-forward "^MIME-version:" delimline t))
(progn (skip-chars-forward "\0-\177")
(/= (point) (point-max)))
- (setq selected-coding (select-message-coding-system))
+ selected-coding
(setq charset
(coding-system-get selected-coding 'mime-charset))
(goto-char delimline)
\\|^resent-cc:\\|^resent-bcc:"
delimline t))
(let* ((default-directory "/")
- (coding-system-for-write
- (or selected-coding
- (select-message-coding-system)))
- (args
+ (coding-system-for-write selected-coding)
+ (args
(append (list (point-min) (point-max)
- (if (boundp 'sendmail-program)
- sendmail-program
- "/usr/lib/sendmail")
+ program
nil errbuf nil "-oi")
- (and mail-specify-envelope-from
- (list "-f" user-mail-address))
+ (and envelope-from
+ (list "-f" envelope-from))
;;; ;; Don't say "from root" if running under su.
;;; (and (equal (user-real-login-name) "root")
;;; (list "-f" (user-login-name)))
;; These mean "report errors by mail"
;; and "deliver in background".
'("-oem" "-odb"))
- ;; Get the addresses from the message
- ;; unless this is a resend.
- ;; We must not do that for a resend
- ;; because we would find the original addresses.
- ;; For a resend, include the specific addresses.
- (or resend-to-addresses
- '("-t"))))
+;;; ;; Get the addresses from the message
+;;; ;; unless this is a resend.
+;;; ;; We must not do that for a resend
+;;; ;; because we would find the original addresses.
+;;; ;; For a resend, include the specific addresses.
+;;; (or resend-to-addresses
+ '("-t")
+;;; )
+ (if mail-use-dsn
+ (list "-N" (mapconcat 'symbol-name
+ mail-use-dsn ",")))
+ )
+ )
(exit-value (apply 'call-process-region args)))
- (or (null exit-value) (zerop exit-value)
+ (or (null exit-value) (eq 0 exit-value)
(error "Sending...failed with exit value %d" exit-value)))
(or fcc-was-found
(error "No recipients")))
(time (current-time))
(tembuf (generate-new-buffer " rmail output"))
(case-fold-search t))
+ (unless (markerp header-end)
+ (error "Value of `header-end' must be a marker"))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^FCC:[ \t]*" header-end t)
;; If MSG is non-nil, buffer is in RMAIL mode.
(if msg
(progn
+ ;; Append to an ordinary buffer as a
+ ;; Unix mail message.
(rmail-maybe-set-message-counters)
(widen)
(narrow-to-region (point-max) (point-max))
(mail-position-on-field "to"))
(insert "\nFCC: " folder))
-(defun mail-reply-to ()
- "Move point to end of Reply-To-field."
+(defun mail-reply-to ()
+ "Move point to end of Reply-To-field. Create a Reply-To field if none."
(interactive)
(expand-abbrev)
(mail-position-on-field "Reply-To"))
(expand-abbrev)
(goto-char (mail-text-start)))
\f
-(defun mail-signature (atpoint)
- "Sign letter with contents of the file `mail-signature-file'.
+(defun mail-signature (&optional atpoint)
+ "Sign letter with signature based on `mail-signature-file'.
Prefix arg means put contents at point."
(interactive "P")
(save-excursion
(end-of-line)
(or atpoint
(delete-region (point) (point-max)))
- (insert "\n\n-- \n")
- (insert-file-contents (expand-file-name mail-signature-file))))
+ (if (stringp mail-signature)
+ (insert mail-signature)
+ (insert "\n\n-- \n")
+ (insert-file-contents (expand-file-name mail-signature-file)))))
(defun mail-fill-yanked-message (&optional justifyp)
"Fill the paragraphs of a message yanked into this one.
;; Avoid error in Transient Mark mode
;; on account of mark's being inactive.
(mark-even-if-inactive t))
- (if mail-citation-hook
- ;; Bind mail-citation-header to the inserted message's header.
- (let ((mail-citation-header
- (buffer-substring-no-properties
- start
- (save-excursion
- (save-restriction
- (narrow-to-region start (point-max))
- (goto-char start)
- (rfc822-goto-eoh)
- (point))))))
- (run-hooks 'mail-citation-hook))
- (if mail-yank-hooks
- (run-hooks 'mail-yank-hooks)
- (mail-indent-citation)))))
+ (cond (mail-citation-hook
+ ;; Bind mail-citation-header to the inserted
+ ;; message's header.
+ (let ((mail-citation-header
+ (buffer-substring-no-properties
+ start
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point-max))
+ (goto-char start)
+ (rfc822-goto-eoh)
+ (point))))))
+ (run-hooks 'mail-citation-hook)))
+ (mail-yank-hooks
+ (run-hooks 'mail-yank-hooks))
+ (t
+ (mail-indent-citation)))))
;; This is like exchange-point-and-mark, but doesn't activate the mark.
;; It is cleaner to avoid activation, even though the command
;; loop would deactivate the mark because we inserted text.
(if mail-yank-hooks
(run-hooks 'mail-yank-hooks)
(mail-indent-citation))))))))
+
+(defun mail-split-line ()
+ "Split current line, moving portion beyond point vertically down.
+If the current line has `mail-yank-prefix', insert it on the new line."
+ (interactive "*")
+ (split-line mail-yank-prefix))
+
\f
(defun mail-attach-file (&optional file)
"Insert a file at the end of the buffer, with separator lines around it."
;;; (message "Auto save file for draft message exists; consider M-x mail-recover"))
;;; t))
(pop-to-buffer "*mail*")
- ;; Put the auto-save file in the home dir
- ;; to avoid any danger that it can't be written.
- (if (file-exists-p (expand-file-name "~/"))
- (setq default-directory (expand-file-name "~/")))
+ ;; Avoid danger that the auto-save file can't be written.
+ (let ((dir (expand-file-name
+ (file-name-as-directory mail-default-directory))))
+ (if (file-exists-p dir)
+ (setq default-directory dir)))
;; Only call auto-save-mode if necessary, to avoid changing auto-save file.
(if (or (and auto-save-default (not buffer-auto-save-file-name))
(and (not auto-save-default) buffer-auto-save-file-name))
(message "Auto save file for draft message exists; consider M-x mail-recover"))
initialized))
+(defun mail-recover-1 ()
+ "Pop up a list of auto-saved draft messages so you can recover one of them."
+ (interactive)
+ (let ((file-name (make-auto-save-file-name))
+ (ls-lisp-support-shell-wildcards t)
+ non-random-len wildcard)
+ ;; Remove the random part from the auto-save-file-name, and
+ ;; create a wildcard which matches possible candidates.
+ ;; Note: this knows that make-auto-save-file-name appends
+ ;; "#<RANDOM-STUFF>#" to the buffer name, where RANDOM-STUFF
+ ;; is the result of (make-temp-name "").
+ (setq non-random-len
+ (- (length file-name) (length (make-temp-name "")) 1))
+ (setq wildcard (concat (substring file-name 0 non-random-len) "*"))
+ (if (null (file-expand-wildcards wildcard))
+ (message "There are no auto-saved drafts to recover")
+ ;; Bind dired-trivial-filenames to t because all auto-save file
+ ;; names are normally ``trivial'', so Dired will set point after
+ ;; all the files, at buffer bottom. We want it on the first
+ ;; file instead.
+ (let ((dired-trivial-filenames t))
+ (dired-other-window wildcard (concat dired-listing-switches "t")))
+ (rename-buffer "*Auto-saved Drafts*" t)
+ (save-excursion
+ (goto-char (point-min))
+ (or (looking-at " Move to the draft file you want to recover,")
+ (let ((inhibit-read-only t))
+ ;; Each line starts with a space so that Font Lock mode
+ ;; won't highlight the first character.
+ (insert "\
+ Move to the draft file you want to recover, then type C-c C-c
+ to recover text of message whose composition was interrupted.
+ To browse text of a draft, type v on the draft file's line.
+
+ You can also delete some of these files;
+ type d on a line to mark that file for deletion.
+
+ List of possible auto-save files for recovery:
+
+"))))
+ (use-local-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map (current-local-map))
+ map))
+ (define-key (current-local-map) "v"
+ (lambda ()
+ (interactive)
+ (let ((coding-system-for-read 'emacs-mule-unix))
+ (dired-view-file))))
+ (define-key (current-local-map) "\C-c\C-c"
+ (lambda ()
+ (interactive)
+ (let ((fname (dired-get-filename))
+ ;; Auto-saved files are written in the internal
+ ;; representation, so they should be read accordingly.
+ (coding-system-for-read 'emacs-mule-unix))
+ (switch-to-buffer-other-window "*mail*")
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (insert-file-contents fname nil)
+ ;; insert-file-contents will set buffer-file-coding-system
+ ;; to emacs-mule, which is probably not what they want to
+ ;; use for sending the message. But we don't know what
+ ;; was its value before the buffer was killed or Emacs
+ ;; crashed. We therefore reset buffer-file-coding-system
+ ;; to the default value, so that either the default does
+ ;; TRT, or the user will get prompted for the right
+ ;; encoding when they send the message.
+ (setq buffer-file-coding-system
+ default-buffer-file-coding-system))))))))
+
(defun mail-recover ()
- "Reread contents of current buffer from its last auto-save file."
+ "Recover interrupted mail composition from auto-save files.
+
+If the mail buffer has a current valid auto-save file,
+the command recovers that file. Otherwise, it displays a
+buffer showing the existing auto-saved draft messages;
+you can move to one of them and type C-c C-c to recover that one."
(interactive)
- (let ((file-name (make-auto-save-file-name)))
- (cond ((save-window-excursion
- (if (not (eq system-type 'vax-vms))
- (with-output-to-temp-buffer "*Directory*"
- (buffer-disable-undo standard-output)
- (let ((default-directory "/"))
- (call-process
- "ls" nil standard-output nil "-l" file-name))))
- (yes-or-no-p (format "Recover auto save file %s? " file-name)))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (insert-file-contents file-name nil)))
- (t (error "mail-recover cancelled")))))
+ ;; In case they invoke us from some random buffer...
+ (switch-to-buffer "*mail*")
+ ;; If *mail* didn't exist, set its directory, so that auto-saved
+ ;; drafts will be found.
+ (let ((dir (expand-file-name
+ (file-name-as-directory mail-default-directory))))
+ (if (file-exists-p dir)
+ (setq default-directory dir)))
+ (or (eq major-mode 'mail-mode)
+ (mail-mode))
+ (let ((file-name buffer-auto-save-file-name))
+ (cond ((and file-name (file-exists-p file-name))
+ (let ((dispbuf
+ ;; This used to invoke `ls' via call-process, but
+ ;; dired-noselect is more portable to systems where
+ ;; `ls' is not a standard program (it will use
+ ;; ls-lisp instead).
+ (dired-noselect file-name
+ (concat dired-listing-switches "t"))))
+ (save-selected-window
+ (select-window (display-buffer dispbuf t))
+ (goto-char (point-min))
+ (forward-line 2)
+ (dired-move-to-filename)
+ (setq dispbuf (rename-buffer "*Directory*" t)))
+ (if (not (yes-or-no-p
+ (format "Recover mail draft from auto save file %s? "
+ file-name)))
+ (error "mail-recover cancelled")
+ (let ((buffer-read-only nil)
+ (buffer-coding buffer-file-coding-system)
+ ;; Auto-save files are written in internal
+ ;; representation of non-ASCII characters.
+ (coding-system-for-read 'emacs-mule-unix))
+ (erase-buffer)
+ (insert-file-contents file-name nil)
+ (setq buffer-file-coding-system buffer-coding)))))
+ (t (mail-recover-1)))))
;;;###autoload
(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
(provide 'sendmail)
+;;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626
;;; sendmail.el ends here
HCoop / bpt / emacs.git / blobdiff