X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/00365e9831c50e1ab61584f35ddb42814c8a1ddd..6e66e4c6fc350fe8cb85d4cc35d9ca567df56548:/lisp/mail/sendmail.el diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 9ad63d6973..e4da1dcddb 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1,6 +1,6 @@ ;;; sendmail.el --- mail sending commands for Emacs. -;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96 Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 1998 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail @@ -28,9 +28,13 @@ ;; documented in the Emacs user's manual. ;;; Code: +(defgroup sendmail nil + "Mail sending commands for Emacs." + :prefix "mail-" + :group 'mail) ;;;###autoload -(defvar mail-from-style 'angles "\ +(defcustom mail-from-style 'angles "\ *Specifies how \"From:\" fields look. If `nil', they contain just the return address like: @@ -38,33 +42,63 @@ If `nil', they contain just the return address like: If `parens', they look like: king@grassland.com (Elvis Parsley) If `angles', they look like: - Elvis Parsley ") + Elvis Parsley +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 -(defvar mail-self-blind nil "\ +(defcustom mail-specify-envelope-from t + "*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'. + +On most systems, specifying the envelope-from address +is a privileged operation." + :version "21.1" + :type 'boolean + :group 'sendmail) + +;;;###autoload +(defcustom mail-self-blind nil "\ *Non-nil means insert BCC to self in messages to be sent. This is done when the message is initialized, -so you can remove or alter the BCC field to override the default.") +so you can remove or alter the BCC field to override the default." + :type 'boolean + :group 'sendmail) ;;;###autoload -(defvar mail-interactive nil "\ +(defcustom mail-interactive nil "\ *Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") +nil means let mailer mail back a message to report errors." + :type 'boolean + :group 'sendmail) ;;;###autoload -(defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ -*Delete these headers from old message when it's inserted in a reply.") +(defcustom mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\ +*Delete these headers from old message when it's inserted in a reply." + :type 'regexp + :group 'sendmail) ;; 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. -The headers should be delimited by a line whose contents -match the variable `mail-header-separator'.") +The headers should be delimited by a line which is +not a valid RFC822 header or continuation line.") ;;;###autoload -(defvar mail-header-separator "--text follows this line--" "\ -*Line used to separate headers from text in messages being composed.") +(defcustom mail-header-separator "--text follows this line--" "\ +*Line used to separate headers from text in messages being composed." + :type 'string + :group 'sendmail) ;; Set up mail-header-separator for use as a category text property. (put 'mail-header-separator 'rear-nonsticky '(category)) @@ -76,33 +110,43 @@ match the variable `mail-header-separator'.") ;;;(put 'mail-header-separator 'read-only t) ;;;###autoload -(defvar mail-archive-file-name nil "\ +(defcustom mail-archive-file-name nil "\ *Name of file to write all outgoing messages in, or nil for none. -This can be an inbox file or an Rmail file.") +This can be an inbox file or an Rmail file." + :type '(choice file (const nil)) + :group 'sendmail) ;;;###autoload -(defvar mail-default-reply-to nil +(defcustom mail-default-reply-to nil "*Address to insert as default Reply-to field of outgoing messages. If nil, it will be initialized from the REPLYTO environment variable -when you first send mail.") +when you first send mail." + :type '(choice (const nil) string) + :group 'sendmail) ;;;###autoload -(defvar mail-alias-file nil +(defcustom mail-alias-file nil "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'. This file defines aliases to be expanded by the mailer; this is a different feature from that of defining aliases in `.mailrc' to be expanded in Emacs. -This variable has no effect unless your system uses sendmail as its mailer.") +This variable has no effect unless your system uses sendmail as its mailer." + :type '(choice (const nil) file) + :group 'sendmail) ;;;###autoload -(defvar mail-personal-alias-file "~/.mailrc" +(defcustom mail-personal-alias-file "~/.mailrc" "*If non-nil, the name of the user's personal mail alias file. This file typically should be in same format as the `.mailrc' file used by the `Mail' or `mailx' program. -This file need not actually exist.") +This file need not actually exist." + :type '(choice (const nil) file) + :group 'sendmail) -(defvar mail-setup-hook nil +(defcustom mail-setup-hook nil "Normal hook, run each time a new outgoing mail message is initialized. -The function `mail-setup' runs this hook.") +The function `mail-setup' runs this hook." + :type 'hook + :group 'sendmail) (defvar mail-aliases t "Alist of mail address aliases, @@ -115,12 +159,17 @@ The alias definitions in the file have this form: (defvar mail-alias-modtime nil "The modification time of your mail alias file when it was last examined.") -(defvar mail-yank-prefix nil +(defcustom mail-yank-prefix nil "*Prefix insert on lines of yanked message being replied to. -nil means use indentation.") -(defvar mail-indentation-spaces 3 +nil means use indentation." + :type '(choice (const nil) string) + :group 'sendmail) + +(defcustom mail-indentation-spaces 3 "*Number of spaces to insert at the beginning of each cited line. -Used by `mail-yank-original' via `mail-yank-cite'.") +Used by `mail-yank-original' via `mail-indent-citation'." + :type 'integer + :group 'sendmail) (defvar mail-yank-hooks nil "Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between (point) and (mark t). @@ -130,14 +179,32 @@ text as modified. This is a normal hook, misnamed for historical reasons. It is semi-obsolete and mail agents should no longer use it.") -(defvar mail-citation-hook nil +(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.") +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) @@ -154,12 +221,25 @@ removed from alias expansions." nil) ;;;###autoload -(defvar mail-signature nil +(defcustom mail-signature nil "*Text inserted at end of mail buffer when a message is initialized. -If t, it means to insert the contents of the file `mail-signature-file'.") - -(defvar mail-signature-file "~/.signature" - "*File containing the text inserted at end of mail buffer.") +If t, it means to insert the contents of the file `mail-signature-file'. +If a string, that string is inserted. + (To make a proper signature, the string should begin with \\n\\n-- \\n, + 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) + (const :tag "Use `.signature' file" t) + (string :tag "String to insert") + (sexp :tag "Expression to evaluate")) + :group 'sendmail) +(put 'mail-signature 'risky-local-variable t) + +(defcustom mail-signature-file "~/.signature" + "*File containing the text inserted at end of mail buffer." + :type 'file + :group 'sendmail) (defvar mail-reply-action nil) (defvar mail-send-actions nil @@ -167,16 +247,31 @@ If t, it means to insert the contents of the file `mail-signature-file'.") (put 'mail-reply-action 'permanent-local t) (put 'mail-send-actions 'permanent-local t) -(defvar mail-default-headers nil +(defcustom mail-default-headers nil "*A string containing header lines, to be inserted in outgoing messages. It is inserted before you edit the message, -so you can edit or delete these lines.") +so you can edit or delete these lines." + :type '(choice (const nil) string) + :group 'sendmail) -(defvar mail-bury-selects-summary t +(defcustom mail-bury-selects-summary t "*If non-nil, try to show RMAIL summary buffer after returning from mail. The functions \\[mail-send-on-exit] or \\[mail-dont-send] select the RMAIL summary buffer before returning, if it exists and this variable -is non-nil.") +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 + "*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. +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)) + :group 'sendmail) ;; Note: could use /usr/ucb/mail instead of sendmail; ;; options -t, and -v if not interactive. @@ -215,26 +310,33 @@ actually occur.") (let* ((cite-chars "[>|}]") (cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) - (list '("^To:" . font-lock-function-name-face) - '("^B?CC:\\|^Reply-to:" . font-lock-keyword-face) + (list '("^\\(To\\|Newsgroups\\):" . font-lock-function-name-face) + '("^\\(B?CC\\|Reply-to\\):" . font-lock-keyword-face) '("^\\(Subject:\\)[ \t]*\\(.+\\)?" (1 font-lock-comment-face) (2 font-lock-type-face nil t)) ;; Use EVAL to delay in case `mail-header-separator' gets changed. - '(eval cons (concat "^" (regexp-quote mail-header-separator) "$") - 'font-lock-comment-face) + '(eval . + (let ((separator (if (zerop (length mail-header-separator)) + " \\`\\' " + (regexp-quote mail-header-separator)))) + (cons (concat "^" separator "$") 'font-lock-warning-face))) ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. `(,cite-chars (,(concat "\\=[ \t]*" - "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" - cite-chars ".*") + "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" + "\\(" cite-chars "[ \t]*\\)\\)+" + "\\(.*\\)") (beginning-of-line) (end-of-line) - (0 font-lock-reference-face))) + (2 font-lock-constant-face nil t) + (4 font-lock-comment-face nil t))) '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*" . font-lock-string-face)))) "Additional expressions to highlight in Mail mode.") -(defvar mail-send-hook nil - "Normal hook run before sending mail, 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)))) @@ -251,6 +353,11 @@ actually occur.") (setq mail-aliases nil) (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) + (if current-input-method + (inactivate-input-method)) (setq mail-send-actions actions) (setq mail-reply-action replybuffer) (goto-char (point-min)) @@ -263,19 +370,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)) @@ -297,8 +413,10 @@ actually occur.") (progn (insert "\n\n-- \n") (insert-file-contents mail-signature-file)))) - (mail-signature - (insert mail-signature))) + ((stringp mail-signature) + (insert mail-signature)) + (t + (eval mail-signature))) (goto-char (point-max)) (or (bolp) (newline))) (if to (goto-char to)) @@ -310,16 +428,16 @@ actually occur.") (defun mail-mode () "Major mode for editing mail to be sent. Like Text Mode but with these additional commands: -C-c C-s mail-send (send the message) C-c C-c mail-send-and-exit -C-c C-f move to a header field (and create it if there isn't): - C-c C-f C-t move to To: C-c C-f C-s move to Subject: - C-c C-f C-c move to CC: C-c C-f C-b move to BCC: - C-c C-f C-f move to FCC: -C-c C-t mail-text (move to beginning of message text). -C-c C-w mail-signature (insert `mail-signature-file' file). -C-c C-y mail-yank-original (insert current message, in Rmail). -C-c C-q mail-fill-yanked-message (fill what was yanked). -C-c C-v mail-sent-via (add a Sent-via field for each To or CC)." +\\[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-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) (make-local-variable 'mail-reply-action) @@ -336,46 +454,79 @@ C-c C-v mail-sent-via (add a Sent-via field for each To or CC)." (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) + (make-local-variable 'adaptive-fill-regexp) + (setq adaptive-fill-regexp + (concat "[ \t]*\\([-|#;>*]+ *\\|(?[0-9]+[.)] *\\)+" + "\\|[ \t]*[-a-z0-9A-Z]*>+[ \t]*" + "\\|[ \t]*")) + (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]*")) ;; `-- ' 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]*[-_][-_][-_]+$\\|-- $\\|-----\\|" - paragraph-start)) - (setq paragraph-separate (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[-_][-_][-_]+$\\|-- $\\|-----\\|" - paragraph-separate)) + "$\\|\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)) + +(defun mail-header-end () + "Return the buffer location of the end of headers, as a number." + (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-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. +Concretely: replace the first blank line in the header with the separator." + (rfc822-goto-eoh) + (insert mail-header-separator) + (point)) + +(defun mail-sendmail-undelimit-header () + "Remove header separator to put the message in correct form for sendmail. +Leave point at the start of the delimiter line." + (rfc822-goto-eoh) + (delete-region (point) (progn (end-of-line) (point)))) + (defun mail-mode-auto-fill () "Carry out Auto Fill for Mail mode. If within the headers, this makes the new lines into continuation lines." - (if (< (point) - (save-excursion - (goto-char (point-min)) - (if (search-forward mail-header-separator nil t) - (point) - 0))) + (if (< (point) (mail-header-end)) (let ((old-line-start (save-excursion (beginning-of-line) (point)))) (if (do-auto-fill) (save-excursion (beginning-of-line) (while (not (eq (point) old-line-start)) - (insert " ") + ;; Use insert-before-markers in case we're inserting + ;; before the saved value of point (which is common). + (insert-before-markers " ") (forward-line -1)) t))) (do-auto-fill))) (defun mail-mode-fill-paragraph (arg) ;; Do something special only if within the headers. - (if (< (point) - (save-excursion - (goto-char (point-min)) - (if (search-forward mail-header-separator nil t) - (point) - 0))) + (if (< (point) (mail-header-end)) (let (beg end fieldname) (re-search-backward "^[-a-zA-Z]+:" nil 'yes) (setq beg (point)) @@ -422,11 +573,13 @@ If within the headers, this makes the new lines into continuation lines." (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-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 "\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) (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit) - (define-key mail-mode-map "\C-c\C-s" 'mail-send)) + (define-key mail-mode-map "\C-c\C-s" 'mail-send) + (define-key mail-mode-map "\C-c\C-i" 'mail-attach-file)) (define-key mail-mode-map [menu-bar mail] (cons "Mail" (make-sparse-keymap "Mail"))) @@ -440,6 +593,9 @@ If within the headers, this makes the new lines into continuation lines." (define-key mail-mode-map [menu-bar mail signature] '("Insert Signature" . mail-signature)) +(define-key mail-mode-map [menu-bar mail mail-sep] + '("--")) + (define-key mail-mode-map [menu-bar mail cancel] '("Cancel" . mail-dont-send)) @@ -452,14 +608,17 @@ If within the headers, this makes the new lines into continuation lines." (define-key mail-mode-map [menu-bar headers] (cons "Headers" (make-sparse-keymap "Move to Header"))) -(define-key mail-mode-map [menu-bar headers reply-to] - '("Reply-To" . mail-reply-to)) +(define-key mail-mode-map [menu-bar headers text] + '("Text" . mail-text)) + +(define-key mail-mode-map [menu-bar headers expand-aliases] + '("Expand Aliases" . expand-mail-aliases)) (define-key mail-mode-map [menu-bar headers sent-via] '("Sent Via" . mail-sent-via)) -(define-key mail-mode-map [menu-bar headers text] - '("Text" . mail-text)) +(define-key mail-mode-map [menu-bar headers reply-to] + '("Reply-To" . mail-reply-to)) (define-key mail-mode-map [menu-bar headers bcc] '("Bcc" . mail-bcc)) @@ -496,7 +655,7 @@ Prefix arg means don't delete this window." (let ((newbuf (other-buffer (current-buffer)))) (bury-buffer (current-buffer)) (if (and (or (window-dedicated-p (frame-selected-window)) - (assq 'mail-dedicated-frame (frame-parameters))) + (cdr (assq 'mail-dedicated-frame (frame-parameters)))) (not (null (delq (selected-frame) (visible-frame-list))))) (delete-frame (selected-frame)) (let (rmail-flag summary-buffer) @@ -529,7 +688,25 @@ the user from the mailer." (y-or-n-p "Send buffer contents as mail message? ") (or (buffer-modified-p) (y-or-n-p "Message already sent; resend? "))) - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (opoint (point))) + (when (and enable-multibyte-characters + (not (eq mail-send-nonascii t))) + (goto-char (point-min)) + (skip-chars-forward "\0-\177") + (or (= (point) (point-max)) + (if (eq mail-send-nonascii 'query) + (or (y-or-n-p "Message contains non-ASCII characters; send anyway? ") + (error "Aborted")) + (error "Message contains non-ASCII characters")))) + ;; Complain about any invalid line. + (goto-char (point-min)) + (while (< (point) (mail-header-end)) + (unless (looking-at "[ \t]\\|.*:\\|$") + (push-mark opoint) + (error "Invalid header line (maybe a continuation line lacks initial whitespace)")) + (forward-line 1)) + (goto-char opoint) (run-hooks 'mail-send-hook) (message "Sending...") (funcall send-mail-function) @@ -541,7 +718,7 @@ 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) @@ -550,6 +727,25 @@ the user from the mailer." ;; 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 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 () (require 'mail-utils) (let ((errbuf (if mail-interactive @@ -571,20 +767,18 @@ the user from the mailer." (or (= (preceding-char) ?\n) (insert ?\n)) ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) + (goto-char (mail-header-end)) + (delete-region (point) (progn (end-of-line) (point))) (setq delimline (point-marker)) (sendmail-sync-aliases) (if mail-aliases (expand-mail-aliases (point-min) delimline)) (goto-char (point-min)) - ;; ignore any blank lines in the header + ;; Ignore any blank lines in the header (while (and (re-search-forward "\n\n\n*" delimline t) (< (point) delimline)) (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) @@ -592,7 +786,9 @@ the user from the mailer." (save-restriction (narrow-to-region (point) (save-excursion - (end-of-line) + (forward-line 1) + (while (looking-at "^[ \t]") + (forward-line 1)) (point))) (append (mail-parse-comma-list) resend-to-addresses))) @@ -629,7 +825,11 @@ the user from the mailer." (goto-char (point-min)) (if (not (re-search-forward "^From:" delimline t)) (let* ((login user-mail-address) - (fullname (user-full-name))) + (fullname (user-full-name)) + (quote-fullname nil)) + (if (string-match "[\200-\377]" fullname) + (setq fullname (mail-quote-printable fullname t) + quote-fullname t)) (cond ((eq mail-from-style 'angles) (insert "From: " fullname) (let ((fullname-start (+ (point-min) 6)) @@ -637,8 +837,9 @@ the user from the mailer." (goto-char fullname-start) ;; Look for a character that cannot appear unquoted ;; according to RFC 822. - (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" - fullname-end 1) + (if (or (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" + fullname-end 1) + quote-fullname) (progn ;; Quote fullname, escaping specials. (goto-char fullname-start) @@ -651,7 +852,11 @@ the user from the mailer." ((eq mail-from-style 'parens) (insert "From: " login " (") (let ((fullname-start (point))) + (if quote-fullname + (insert "\"")) (insert fullname) + (if quote-fullname + (insert "\"")) (let ((fullname-end (point-marker))) (goto-char fullname-start) ;; RFC 822 says \ and nonmatching parentheses @@ -669,7 +874,10 @@ the user from the mailer." (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'"))))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) @@ -689,32 +897,39 @@ the user from the mailer." (if (let ((case-fold-search t)) (re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\ \\|^resent-cc:\\|^resent-bcc:" - delimline t) - (let ((default-directory "/")) - (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. - (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))) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null mail-interactive) '("-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"))))) + delimline t)) + (let* ((default-directory "/") + (coding-system-for-write (select-message-coding-system)) + (args + (append (list (point-min) (point-max) + (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail") + nil errbuf nil "-oi") + (and mail-specify-envelope-from + (list "-f" user-mail-address)) +;;; ;; 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")))) + (exit-value (apply 'call-process-region args))) + (or (null exit-value) (zerop exit-value) + (error "Sending...failed with exit value %d" exit-value))) (or fcc-was-found (error "No recipients"))) (if mail-interactive @@ -773,6 +988,8 @@ the user from the mailer." (while fcc-list (let* ((buffer (find-buffer-visiting (car fcc-list))) (curbuf (current-buffer)) + dont-write-the-file + buffer-matches-file (beg (point-min)) (end (point-max)) (beg2 (save-excursion (goto-char (point-min)) (forward-line 2) (point)))) @@ -780,6 +997,9 @@ the user from the mailer." ;; File is present in a buffer => append to that buffer. (save-excursion (set-buffer buffer) + (setq buffer-matches-file + (and (not (buffer-modified-p)) + (verify-visited-file-modtime buffer))) ;; Keep the end of the accessible portion at the same place ;; unless it is the end of the buffer. (let ((max (if (/= (1+ (buffer-size)) (point-max)) @@ -811,25 +1031,39 @@ the user from the mailer." ;; => just insert at the end. (narrow-to-region (point-min) (1+ (buffer-size))) (goto-char (point-max)) - (insert-buffer-substring curbuf beg end))) - (if max (narrow-to-region (point-min) max))))) - ;; Else append to the file directly. + (insert-buffer-substring curbuf beg end)) + (or buffer-matches-file + (progn + (if (y-or-n-p (format "Save file %s? " + (car fcc-list))) + (save-buffer)) + (setq dont-write-the-file t)))) + (if max (narrow-to-region (point-min) max)))))) + ;; Append to the file directly, + ;; unless we've already taken care of it. + (unless dont-write-the-file (if (and (file-exists-p (car fcc-list)) (mail-file-babyl-p (car fcc-list))) ;; If the file is a Babyl file, ;; convert the message to Babyl format. - (save-excursion - (set-buffer (get-buffer-create " mail-temp")) - (setq buffer-read-only nil) - (erase-buffer) - (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" - "Date: " (mail-rfc822-date) "\n") - (insert-buffer-substring curbuf beg2 end) - (insert "\n\C-_") - (write-region (point-min) (point-max) (car fcc-list) t) - (erase-buffer)) + (let ((coding-system-for-write + (or rmail-file-coding-system + 'emacs-mule))) + (save-excursion + (set-buffer (get-buffer-create " mail-temp")) + (setq buffer-read-only nil) + (erase-buffer) + (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" + "Date: " (mail-rfc822-date) "\n") + (insert-buffer-substring curbuf beg2 end) + (insert "\n\C-_") + (write-region (point-min) (point-max) (car fcc-list) t) + (erase-buffer))) (write-region - (1+ (point-min)) (point-max) (car fcc-list) t)))) + (1+ (point-min)) (point-max) (car fcc-list) t))) + (and buffer (not dont-write-the-file) + (with-current-buffer buffer + (set-visited-file-modtime)))) (setq fcc-list (cdr fcc-list)))) (kill-buffer tembuf))) @@ -837,12 +1071,8 @@ the user from the mailer." "Make a Sent-via header line from each To or CC header line." (interactive) (save-excursion - (goto-char (point-min)) - ;; find the header-separator - (search-forward (concat "\n" mail-header-separator "\n")) - (forward-line -1) ;; put a marker at the end of the header - (let ((end (point-marker)) + (let ((end (copy-marker (mail-header-end))) (case-fold-search t) to-line) (goto-char (point-min)) @@ -905,9 +1135,7 @@ the user from the mailer." (defun mail-position-on-field (field &optional soft) (let (end (case-fold-search t)) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (setq end (match-beginning 0)) + (setq end (mail-header-end)) (goto-char (point-min)) (if (re-search-forward (concat "^" (regexp-quote field) ":") end t) (progn @@ -925,8 +1153,7 @@ the user from the mailer." "Move point to beginning of message text." (interactive) (expand-abbrev) - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n"))) + (goto-char (mail-text-start))) (defun mail-signature (atpoint) "Sign letter with contents of the file `mail-signature-file'. @@ -947,12 +1174,11 @@ Prefix arg means put contents at point." Numeric argument means justify as well." (interactive "P") (save-excursion - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t) + (goto-char (mail-text-start)) (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. @@ -961,13 +1187,14 @@ When this function returns, the region is again around the modified text. Normally, indent each nonblank line `mail-indentation-spaces' spaces. However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." - (let ((start (point))) - (mail-yank-clear-headers start (mark t)) - (if (null mail-yank-prefix) - (indent-rigidly start (mark t) mail-indentation-spaces) - (save-excursion - (goto-char start) - (while (< (point) (mark t)) + (mail-yank-clear-headers (region-beginning) (region-end)) + (if (null mail-yank-prefix) + (indent-rigidly (region-beginning) (region-end) + mail-indentation-spaces) + (save-excursion + (let ((end (set-marker (make-marker) (region-end)))) + (goto-char (region-beginning)) + (while (< (point) end) (insert mail-yank-prefix) (forward-line 1)))))) @@ -991,14 +1218,28 @@ 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))) + 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) + ;; 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))))) @@ -1010,6 +1251,9 @@ and don't delete any header fields." (if (not (eolp)) (insert ?\n))))) (defun mail-yank-clear-headers (start end) + (if (< end start) + (let (temp) + (setq temp start start end end temp))) (if mail-yank-ignored-headers (save-excursion (goto-char start) @@ -1024,8 +1268,74 @@ and don't delete any header fields." (progn (re-search-forward "\n[^ \t]") (forward-char -1) (point))))))))) + +(defun mail-yank-region (arg) + "Insert the selected region from the message being replied to. +Puts point after the text and mark before. +Normally, indents each nonblank line ARG spaces (default 3). +However, if `mail-yank-prefix' is non-nil, insert that prefix on each line. + +Just \\[universal-argument] as argument means don't indent, insert no prefix, +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)) + ;; 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-no-properties (point) (mark)))) + (push-mark start) + ;; Indent or otherwise annotate the citation text. + (if (consp arg) + nil + (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg) + mail-indentation-spaces))) + (if 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)))))))) -;; Put these last, to reduce chance of lossage from quitting in middle of loading the file. +(defun mail-attach-file (&optional file) + "Insert a file at the end of the buffer, with separator lines around it." + (interactive "fAttach file: ") + (save-excursion + (goto-char (point-max)) + (or (bolp) (newline)) + (newline) + (let ((start (point)) + middle) + (insert (format "===File %s===" file)) + (insert-char ?= (max 0 (- 60 (current-column)))) + (newline) + (setq middle (point)) + (insert "============================================================\n") + (push-mark) + (goto-char middle) + (insert-file-contents file) + (or (bolp) (newline)) + (goto-char start)))) + +;; Put these commands last, to reduce chance of lossage from quitting +;; in middle of loading the file. + +;;;###autoload (add-hook 'same-window-buffer-names "*mail*") ;;;###autoload (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions) @@ -1118,15 +1428,29 @@ The seventh argument ACTIONS is a list of actions to take ;; 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) + ;; 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*). ; (set-visited-file-name nil) (let (initialized) (and (not noerase) - (or (not (buffer-modified-p)) - (y-or-n-p "Unsent message being composed; erase it? ")) + (if buffer-file-name + (if (buffer-modified-p) + (when (y-or-n-p "Buffer has unsaved changes; reinitialize it and discard them? ") + (if (y-or-n-p "Disconnect buffer from visited file? ") + (set-visited-file-name nil)) + t) + (when (y-or-n-p "Reinitialize buffer, and disconnect it from the visited file? ") + (set-visited-file-name nil) + t)) + ;; A non-file-visiting buffer. + (if (buffer-modified-p) + (y-or-n-p "Unsent message being composed; erase it? ") + t)) (let ((inhibit-read-only t)) (erase-buffer) (mail-setup to subject in-reply-to cc replybuffer actions) @@ -1177,14 +1501,6 @@ The seventh argument ACTIONS is a list of actions to take (pop-to-buffer "*mail*")) (mail noerase to subject in-reply-to cc replybuffer sendactions)) -;;; Do not execute these when sendmail.el is loaded, -;;; only in loaddefs.el. -;;;###autoload (define-key ctl-x-map "m" 'mail) -;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window) -;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame) - -;;;###autoload (add-hook 'same-window-buffer-names "*mail*") - ;;; Do not add anything but external entries on this page. (provide 'sendmail)