-;;; sendmail.el --- mail sending commands for Emacs.
+;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 03, 2004
+;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: mail
;; documented in the Emacs user's manual.
;;; Code:
+(eval-when-compile
+ ;; Necessary to avoid recursive `require's.
+ (provide 'sendmail)
+ (require 'rmail)
+ (require 'mailalias))
+
+(autoload 'rfc2047-encode-string "rfc2047")
+
(defgroup sendmail nil
"Mail sending commands for Emacs."
:prefix "mail-"
king@grassland.com (Elvis Parsley)
If `angles', they look like:
Elvis Parsley <king@grassland.com>
-If `system-default', Rmail allows the system to insert its default From field."
+If `system-default', allows the mailer to insert its default From field
+derived from the envelope-from address.
+
+In old versions of Emacs, the `system-default' setting also caused
+Emacs to pass the proper email address from `user-mail-address'
+to the mailer to specify the envelope-from address. But that is now
+controlled by a separate variable, `mail-specify-envelope-from'."
:type '(choice (const nil) (const parens) (const angles)
(const system-default))
:version "20.3"
:group 'sendmail)
+;;;###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
+the variable `mail-envelope-from', with `user-mail-address' as fallback.
+
+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--" "\
"Normal hook, run each time a new outgoing mail message is initialized.
The function `mail-setup' runs this hook."
:type 'hook
+ :options '(fortune-to-signature spook mail-abbrevs-setup)
:group 'sendmail)
(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 "21.4")
+
(defvar mail-reply-action nil)
(defvar mail-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
:type 'boolean
:group 'sendmail)
-;; I find that this happens so often, for innocent reasons,
-;; that it is not acceptable to bother the user about it -- rms.
-(defcustom mail-send-nonascii t
+(defcustom mail-send-nonascii 'mime
"*Specify whether to allow sending non-ASCII characters in mail.
If t, that means do allow it. nil means don't allow it.
`query' means ask the user each time.
+`mime' means add an appropriate MIME header if none already present.
+The default is `mime'.
Including non-ASCII characters in a mail message can be problematical
for the recipient, who may not know how to decode them properly."
- :type '(choice (const t) (const nil) (const query))
+ :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 "21.4")
+
;; 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
(let* ((cite-chars "[>|}]")
- (cite-prefix "A-Za-z")
+ (cite-prefix "[:alpha:]")
(cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
(list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face)
'("^\\(B?CC\\|Reply-to\\):" . font-lock-keyword-face)
(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)
(set-buffer-modified-p nil))
(run-hooks 'mail-setup-hook))
\f
+(defcustom mail-mode-hook nil
+ "Hook run by Mail mode."
+ :group 'sendmail
+ :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]*[-a-z0-9A-Z]*>+[ \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]*[-a-z0-9A-Z]*>+[ \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)
- "$\\|[ \t]*\\([-|#;>*]+ *\\|(?[0-9]+[.)] *\\)*$"
- "\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
- "-- $\\|---+$\\|"
- page-delimiter))
- (setq paragraph-separate paragraph-start)
- (run-hooks 'text-mode-hook 'mail-mode-hook))
+ (setq paragraph-separate (concat (regexp-quote mail-header-separator)
+ "$\\|\t*\\([-|#;>* ]\\|(?[0-9]+[.)]\\)+$"
+ "\\|[ \t]*[[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|"
+ "--\\( \\|-+\\)$\\|"
+ 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)
- (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
- (setq beg (point))
+ (let (beg end fieldname)
+ (when (prog1 (re-search-backward "^[-a-zA-Z]+:" nil 'yes)
+ (setq beg (point)))
(setq fieldname
- (downcase (buffer-substring beg (1- (match-end 0)))))
+ (downcase (buffer-substring beg (1- (match-end 0))))))
(forward-line 1)
;; Find continuation lines and get rid of their continuation markers.
(while (looking-at "[ \t]")
(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))
(delete-window))
(switch-to-buffer newbuf))))))
+(defcustom mail-send-hook nil
+ "Hook run just before sending mail with `mail-send'."
+ :type 'hook
+ :options '(flyspell-mode-off)
+ :group 'sendmail)
+
(defun mail-send ()
"Send the message in the current buffer.
If `mail-interactive' is non-nil, wait for success indication
(y-or-n-p "Message already sent; resend? ")))
(let ((inhibit-read-only t)
(opoint (point)))
- (when (and enable-multibyte-characters
- (not (eq mail-send-nonascii t)))
+ (unless (memq mail-send-nonascii '(t mime))
(goto-char (point-min))
(skip-chars-forward "\0-\177")
(or (= (point) (point-max))
(error))
(setq mail-send-actions (cdr mail-send-actions)))
(message "Sending...done")
- ;; If buffer has no file, mark it as unmodified and delete autosave.
+ ;; If buffer has no file, mark it as unmodified and delete auto-save.
(if (not buffer-file-name)
(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.
;;;###autoload
(defvar sendmail-coding-system nil
- "Coding system to encode the outgoing mail.")
+ "*Coding system for encoding the outgoing mail.
+This has higher priority than `default-buffer-file-coding-system'
+and `default-sendmail-coding-system',
+but lower priority than the local value of `buffer-file-coding-system'.
+See also the function `select-message-coding-system'.")
+
+;;;###autoload
+(defvar default-sendmail-coding-system 'iso-latin-1
+ "Default coding system for encoding the outgoing mail.
+This variable is used only when `sendmail-coding-system' is nil.
+
+This variable is set/changed by the command set-language-environment.
+User should not set this variable manually,
+instead use sendmail-coding-system to get a constant encoding
+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)
- resend-to-addresses
+ (selected-coding (select-message-coding-system))
+;;; resend-to-addresses
delimline
fcc-was-found
(mailbuf (current-buffer))
- (sendmail-coding-system
- (if (local-variable-p 'buffer-file-coding-system)
- buffer-file-coding-system
- (or sendmail-coding-system
- default-buffer-file-coding-system
- 'iso-latin-1))))
- (if (fboundp select-safe-coding-system-function)
- (setq sendmail-coding-system
- (funcall select-safe-coding-system-function
- (point-min) (point-max) sendmail-coding-system)))
+ (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)
(goto-char (point-max))
;; require one newline at the end.
(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)
(goto-char fullname-start))))
(insert ")\n"))
((null mail-from-style)
- (insert "From: " login "\n")))))
+ (insert "From: " login "\n"))
+ ((eq mail-from-style 'system-default)
+ nil)
+ (t (error "Invalid value for `mail-from-style'")))))
+ ;; Possibly add a MIME header for the current coding system
+ (let (charset)
+ (goto-char (point-min))
+ (and (eq mail-send-nonascii 'mime)
+ (not (re-search-forward "^MIME-version:" delimline t))
+ (progn (skip-chars-forward "\0-\177")
+ (/= (point) (point-max)))
+ selected-coding
+ (setq charset
+ (coding-system-get selected-coding :mime-charset))
+ (goto-char delimline)
+ (insert "MIME-version: 1.0\n"
+ "Content-type: text/plain; charset="
+ (symbol-name charset) "\n"
+ "Content-Transfer-Encoding: 8bit\n")))
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
(re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\
\\|^resent-cc:\\|^resent-bcc:"
delimline t))
- (let ((default-directory "/")
- (coding-system-for-write sendmail-coding-system))
- (apply 'call-process-region
- (append (list (point-min) (point-max)
- (if (boundp 'sendmail-program)
- sendmail-program
- "/usr/lib/sendmail")
- nil errbuf nil "-oi")
- ;; Always specify who from,
- ;; since some systems have broken sendmails.
- ;; unless user has said no.
- (if (memq mail-from-style '(angles parens nil))
- (list "-f" (user-login-name)))
-;;; ;; Don't say "from root" if running under su.
-;;; (and (equal (user-real-login-name) "root")
-;;; (list "-f" (user-login-name)))
- (and mail-alias-file
- (list (concat "-oA" mail-alias-file)))
- (if mail-interactive
- ;; These mean "report errors to terminal"
- ;; and "deliver interactively"
- '("-oep" "-odi")
- ;; 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")))))
+ (let* ((default-directory "/")
+ (coding-system-for-write selected-coding)
+ (args
+ (append (list (point-min) (point-max)
+ program
+ nil errbuf nil "-oi")
+ (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)))
+ (and mail-alias-file
+ (list (concat "-oA" mail-alias-file)))
+ (if mail-interactive
+ ;; These mean "report errors to terminal"
+ ;; and "deliver interactively"
+ '("-oep" "-odi")
+ ;; 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")
+;;; )
+ (if mail-use-dsn
+ (list "-N" (mapconcat 'symbol-name
+ mail-use-dsn ",")))
+ )
+ )
+ (exit-value (apply 'call-process-region args)))
+ (or (null exit-value) (eq 0 exit-value)
+ (error "Sending...failed with exit value %d" exit-value)))
(or fcc-was-found
(error "No recipients")))
(if mail-interactive
(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))
;; unless we've already taken care of it.
(unless dont-write-the-file
(if (and (file-exists-p (car fcc-list))
+ ;; Check that the file isn't empty. We don't
+ ;; want to insert a newline at the start of an
+ ;; empty file.
+ (not (zerop (nth 7 (file-attributes (car fcc-list)))))
(mail-file-babyl-p (car fcc-list)))
;; If the file is a Babyl file,
;; convert the message to Babyl format.
(interactive)
(save-excursion
;; put a marker at the end of the header
- (let ((end (make-marker (mail-header-end)))
+ (let ((end (copy-marker (mail-header-end)))
(case-fold-search t)
to-line)
(goto-char (point-min))
(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.
;; delete that window to save screen space.
;; t means don't alter other frames.
(delete-windows-on original t)
- (insert-buffer original))
+ (insert-buffer original)
+ (set-text-properties (point) (mark t) nil))
(if (consp arg)
nil
(goto-char start)
;; 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-hook 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.
(interactive "P")
(and (consp mail-reply-action)
(eq (car mail-reply-action) 'insert-buffer)
+ (with-current-buffer (nth 1 mail-reply-action)
+ (or (mark t)
+ (error "No mark set: %S" (current-buffer))))
(let ((buffer (nth 1 mail-reply-action))
(start (point))
;; Avoid error in Transient Mark mode
(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 'utf-8-emacs-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 'utf-8-emacs-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 utf-8-emacs, 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 'utf-8-emacs-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