X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9a97e0735fd645e6863d91afb901cf85d2347a25..177cd3b9f4881410dcd5ef9e8fc706421e63c109:/lisp/mail/sendmail.el diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 4e2ce685ca..932f52204c 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1,6 +1,7 @@ -;;; 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 @@ -28,6 +29,14 @@ ;; 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-" @@ -43,12 +52,45 @@ If `parens', they look like: king@grassland.com (Elvis Parsley) If `angles', they look like: Elvis Parsley -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. @@ -72,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--" "\ @@ -129,13 +179,14 @@ This file need not actually exist." "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") @@ -164,15 +215,31 @@ It is semi-obsolete and mail agents should no longer use it.") (defcustom mail-citation-hook nil "*Hook for modifying a citation just inserted in the mail buffer. -Each hook function can find the citation between (point) and (mark t). -And each hook function should leave point and mark around the citation -text as modified. +Each hook function can find the citation between (point) and (mark t), +and should leave point and mark around the citation text as modified. +The hook functions can find the header of the cited message +in the variable `mail-citation-header', whether or not this is included +in the cited portion of the message. If this hook is entirely empty (nil), a default action is taken instead of no action." :type 'hook :group 'sendmail) +(defvar mail-citation-header nil + "While running `mail-citation-hook', this variable holds the message header. +This enables the hook functions to see the whole message header +regardless of what part of it (if any) is included in the cited text.") + +(defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*" + "*Regular expression to match a citation prefix plus whitespace. +It should match whatever sort of citation prefixes you want to handle, +with whitespace before and after; it should also match just whitespace. +The default value matches citations like `foo-bar>' plus whitespace." + :type 'regexp + :group 'sendmail + :version "20.3") + (defvar mail-abbrevs-loaded nil) (defvar mail-mode-map nil) @@ -196,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")) @@ -208,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 "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.") @@ -229,17 +305,27 @@ is non-nil." :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 @@ -264,18 +350,17 @@ 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 (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) @@ -296,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 @@ -318,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) @@ -337,19 +422,28 @@ actually occur.") (let ((fill-prefix "\t") (address-start (point))) (insert to "\n") - (fill-region-as-paragraph address-start (point-max))) + (fill-region-as-paragraph address-start (point-max)) + (goto-char (point-max)) + (unless (bolp) + (newline))) (newline)) (if cc (let ((fill-prefix "\t") (address-start (progn (insert "CC: ") (point)))) (insert cc "\n") - (fill-region-as-paragraph address-start (point-max)))) + (fill-region-as-paragraph address-start (point-max)) + (goto-char (point-max)) + (unless (bolp) + (newline)))) (if in-reply-to - (let ((fill-prefix "\t") + (let ((fill-prefix "\t") (fill-column 78) (address-start (point))) (insert "In-reply-to: " in-reply-to "\n") - (fill-region-as-paragraph address-start (point-max)))) + (fill-region-as-paragraph address-start (point-max)) + (goto-char (point-max)) + (unless (bolp) + (newline)))) (insert "Subject: " (or subject "") "\n") (if mail-default-headers (insert mail-default-headers)) @@ -382,67 +476,80 @@ actually occur.") (set-buffer-modified-p nil)) (run-hooks 'mail-setup-hook)) +(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]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-regexp)) + (concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|" + adaptive-fill-regexp)) (make-local-variable 'adaptive-fill-first-line-regexp) (setq adaptive-fill-first-line-regexp - (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" adaptive-fill-first-line-regexp)) + (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]*[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 () "Return the buffer location of the end of headers, as a number." - (save-excursion - (rfc822-goto-eoh) - (point))) + (save-restriction + (widen) + (save-excursion + (rfc822-goto-eoh) + (point)))) (defun mail-text-start () "Return the buffer location of the start of text, as a number." - (save-excursion - (rfc822-goto-eoh) - (forward-line 1) - (point))) + (save-restriction + (widen) + (save-excursion + (rfc822-goto-eoh) + (forward-line 1) + (point)))) (defun mail-sendmail-delimit-header () "Set up whatever header delimiter convention sendmail will use. @@ -476,11 +583,11 @@ 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) - (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]") @@ -511,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) @@ -523,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) @@ -586,20 +694,20 @@ 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)) @@ -626,6 +734,12 @@ Prefix arg means don't delete this window." (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 @@ -639,8 +753,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 (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)) @@ -667,44 +780,72 @@ the user from the mailer." (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)) ;; 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. @@ -724,23 +865,23 @@ the user from the mailer." (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)) @@ -771,8 +912,8 @@ the user from the mailer." (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) @@ -811,14 +952,32 @@ the user from the mailer." ;; ... 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)) @@ -839,38 +998,42 @@ the user from the mailer." (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 @@ -892,6 +1055,8 @@ the user from the mailer." (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) @@ -954,6 +1119,8 @@ the user from the mailer." ;; 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)) @@ -984,6 +1151,10 @@ the user from the mailer." ;; 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. @@ -1013,7 +1184,7 @@ the user from the mailer." (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)) @@ -1067,8 +1238,8 @@ the user from the mailer." (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")) @@ -1096,8 +1267,8 @@ the user from the mailer." (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 @@ -1107,8 +1278,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. @@ -1119,7 +1292,7 @@ Numeric argument means justify as well." (fill-individual-paragraphs (point) (point-max) justifyp - t))) + mail-citation-prefix-regexp))) (defun mail-indent-citation () "Modify text just inserted from a message to be cited. @@ -1159,18 +1332,33 @@ and don't delete any header fields." ;; 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) (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) mail-indentation-spaces)) + ;; Avoid error in Transient Mark mode + ;; on account of mark's being inactive. (mark-even-if-inactive t)) - (if mail-citation-hook - (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. @@ -1208,11 +1396,17 @@ and don't delete any header fields." (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))) + (start (point)) + ;; Avoid error in Transient Mark mode + ;; on account of mark's being inactive. + (mark-even-if-inactive t)) ;; Insert the citation text. (insert (with-current-buffer buffer - (buffer-substring (point) (mark)))) + (buffer-substring-no-properties (point) (mark)))) (push-mark start) ;; Indent or otherwise annotate the citation text. (if (consp arg) @@ -1220,10 +1414,26 @@ and don't delete any header fields." (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) mail-indentation-spaces))) (if mail-citation-hook - (run-hooks 'mail-citation-hook) + ;; Bind mail-citation-hook to the original message's header. + (let ((mail-citation-header + (with-current-buffer buffer + (buffer-substring-no-properties + (point-min) + (save-excursion + (goto-char (point-min)) + (rfc822-goto-eoh) + (point)))))) + (run-hooks 'mail-citation-hook)) (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." @@ -1337,11 +1547,15 @@ 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 "~/"))) - (auto-save-mode auto-save-default) + ;; 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)) + (auto-save-mode auto-save-default)) (mail-mode) ;; Disconnect the buffer from its visited file ;; (in case the user has actually visited a file *mail*). @@ -1370,22 +1584,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) @@ -1415,4 +1730,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