X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/0eafc06c5e9ca35302687c69e72c674d85e37636..bf247b6ed0b5e96845e785302bdaa97fcf6a8b84:/lisp/mail/sendmail.el diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index e3992b3e18..8cf30f295d 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1,6 +1,6 @@ ;;; 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 @@ -35,6 +35,8 @@ (require 'rmail) (require 'mailalias)) +(autoload 'rfc2047-encode-string "rfc2047") + (defgroup sendmail nil "Mail sending commands for Emacs." :prefix "mail-" @@ -65,14 +67,30 @@ controlled by a separate variable, `mail-specify-envelope-from'." ;;;###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. @@ -96,10 +114,18 @@ nil means let mailer mail back a message to report errors." ;; 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--" "\ @@ -159,8 +185,8 @@ The function `mail-setup' runs this hook." (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") @@ -237,7 +263,7 @@ If a string, that string is inserted. 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")) @@ -249,6 +275,15 @@ and should insert whatever you want to insert." :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.") @@ -281,6 +316,16 @@ for the recipient, who may not know how to decode them properly." :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 @@ -305,13 +350,12 @@ for the recipient, who may not know how to decode them properly." 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 @@ -337,20 +381,17 @@ actually occur.") (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) (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 @@ -359,11 +400,14 @@ actually occur.") (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) @@ -438,58 +482,56 @@ actually occur.") :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 () @@ -541,7 +583,7 @@ If within the headers, this makes the new lines into continuation lines." (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 @@ -576,7 +618,7 @@ If within the headers, this makes the new lines into continuation lines." (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) @@ -588,6 +630,7 @@ If within the headers, this makes the new lines into continuation lines." (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) @@ -651,27 +694,32 @@ If within the headers, this makes the new lines into continuation lines." ;; 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)) @@ -710,8 +758,7 @@ the user from the mailer." (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)) @@ -743,6 +790,14 @@ the user from the mailer." (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)) ;; This does the real work of sending a message via sendmail. ;; It is called via the variable send-mail-function. @@ -767,25 +822,36 @@ of outgoing mails regardless of the current language environment. 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) @@ -804,23 +870,23 @@ See also the function `select-message-coding-system'.") (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)) @@ -851,8 +917,8 @@ See also the function `select-message-coding-system'.") (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) @@ -891,7 +957,7 @@ See also the function `select-message-coding-system'.") ;; ... 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) @@ -909,7 +975,7 @@ See also the function `select-message-coding-system'.") (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) @@ -938,17 +1004,13 @@ See also the function `select-message-coding-system'.") \\|^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))) @@ -961,15 +1023,21 @@ See also the function `select-message-coding-system'.") ;; 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"))) @@ -992,6 +1060,8 @@ See also the function `select-message-coding-system'.") (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) @@ -1054,6 +1124,8 @@ See also the function `select-message-coding-system'.") ;; 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)) @@ -1171,8 +1243,8 @@ See also the function `select-message-coding-system'.") (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")) @@ -1200,8 +1272,8 @@ See also the function `select-message-coding-system'.") (expand-abbrev) (goto-char (mail-text-start))) -(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 @@ -1211,8 +1283,10 @@ Prefix arg means put contents at point." (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. @@ -1273,21 +1347,23 @@ and don't delete any header fields." ;; 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. @@ -1356,6 +1432,13 @@ and don't delete any header fields." (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)) + (defun mail-attach-file (&optional file) "Insert a file at the end of the buffer, with separator lines around it." @@ -1469,10 +1552,11 @@ The seventh argument ACTIONS is a list of actions to take ;;; (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)) @@ -1505,22 +1589,123 @@ The seventh argument ACTIONS is a list of actions to take (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 + ;; "##" 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) @@ -1550,4 +1735,5 @@ The seventh argument ACTIONS is a list of actions to take (provide 'sendmail) +;;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626 ;;; sendmail.el ends here