X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ae940284fa77a6928f5162b7de859e67bdc7506c..53aff12a2f57ca0830b425a6097d93bb8da637ca:/lisp/mail/sendmail.el diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 6b43a37894..5c0176cea0 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1,7 +1,7 @@ ;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*- ;; Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995, 1996, 1998, 2000, -;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -58,7 +58,7 @@ :type 'file) ;;;###autoload -(defcustom mail-from-style 'angles +(defcustom mail-from-style 'default "Specifies how \"From:\" fields look. If `nil', they contain just the return address like: @@ -67,15 +67,14 @@ If `parens', they look like: king@grassland.com (Elvis Parsley) If `angles', they look like: 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)) + +Otherwise, most addresses look like `angles', but they look like +`parens' if `angles' would need quoting and `parens' would not." + ;; The value `system-default' is now deprecated. + :type '(choice (const :tag "simple" nil) + (const parens) + (const angles) + (const default)) :version "20.3" :group 'sendmail) @@ -121,7 +120,7 @@ so you can remove or alter the BCC field to override the default." ;; bounce message to be delivered anywhere, least of all to the ;; user's mailbox. "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors." +Otherwise, let mailer send back a message to report errors." :type 'boolean :version "23.1" ; changed from nil to t :group 'sendmail) @@ -131,11 +130,16 @@ nil means let mailer mail back a message to report errors." (regexp-opt '("via" "mail-from" "origin" "status" "remailed" "received" "message-id" "summary-line" "to" "subject" "in-reply-to" "return-path" "mail-reply-to" + ;; Should really be rmail-attribute-header and + ;; rmail-keyword-header, but this file does not + ;; require rmail (at run time). + "x-rmail-attributes" "x-rmail-keywords" "mail-followup-to") "\\(?:") ":") "Delete these headers from old message when it's inserted in a reply." :type 'regexp - :group 'sendmail) + :group 'sendmail + :version "23.1") ;; Prevent problems with `window-system' not having the correct value ;; when loaddefs.el is loaded. `custom-reevaluate-setting' needs the @@ -163,10 +167,13 @@ This is used by the default mail-sending commands. See also (function-item feedmail-send-it :tag "Use Feedmail package") (function-item mailclient-send-it :tag "Use Mailclient package") function) + :initialize 'custom-initialize-delay :group 'sendmail) +;;;###autoload(custom-initialize-delay 'send-mail-function nil) + ;;;###autoload -(defcustom mail-header-separator "--text follows this line--" +(defcustom mail-header-separator (purecopy "--text follows this line--") "Line used to separate headers from text in messages being composed." :type 'string :group 'sendmail) @@ -183,7 +190,8 @@ This is used by the default mail-sending commands. See also ;;;###autoload (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 is normally an mbox file, but for backwards compatibility may also +be a Babyl file." :type '(choice file (const nil)) :group 'sendmail) @@ -205,7 +213,7 @@ This variable has no effect unless your system uses sendmail as its mailer." :group 'sendmail) ;;;###autoload -(defcustom mail-personal-alias-file "~/.mailrc" +(defcustom mail-personal-alias-file (purecopy "~/.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. @@ -215,8 +223,7 @@ This file need not actually exist." ;;;###autoload (defcustom mail-setup-hook nil - "Normal hook, run each time a new outgoing mail message is initialized. -The function `mail-setup' runs this hook." + "Normal hook, run each time a new outgoing message is initialized." :type 'hook :options '(fortune-to-signature spook mail-abbrevs-setup) :group 'sendmail) @@ -234,9 +241,9 @@ The alias definitions in the file have this form: "The modification time of your mail alias file when it was last examined.") ;;;###autoload -(defcustom mail-yank-prefix nil +(defcustom mail-yank-prefix "> " "Prefix insert on lines of yanked message being replied to. -nil means use indentation." +If this is nil, use indentation, as specified by `mail-indentation-spaces'." :type '(choice (const nil) string) :group 'sendmail) @@ -247,6 +254,7 @@ Used by `mail-yank-original' via `mail-indent-citation'." :type 'integer :group 'sendmail) +;; FIXME make it really obsolete. (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). @@ -276,14 +284,15 @@ 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.") ;;;###autoload -(defcustom mail-citation-prefix-regexp "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|[ \t]*" +(defcustom mail-citation-prefix-regexp + (purecopy "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \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") + :version "24.1") (defvar mail-abbrevs-loaded nil) (defvar mail-mode-map @@ -308,6 +317,8 @@ The default value matches citations like `foo-bar>' plus whitespace." (define-key map "\C-c\C-c" 'mail-send-and-exit) (define-key map "\C-c\C-s" 'mail-send) (define-key map "\C-c\C-i" 'mail-attach-file) + ;; FIXME add this? "b" = bury buffer. It's in the menu-bar. +;;; (define-key map "\C-c\C-b" 'mail-dont-send) (define-key map [menu-bar mail] (cons "Mail" (make-sparse-keymap "Mail"))) @@ -316,7 +327,7 @@ The default value matches citations like `foo-bar>' plus whitespace." '("Fill Citation" . mail-fill-yanked-message)) (define-key map [menu-bar mail yank] - '("Cite Original" . mail-yank-original)) + '(menu-item "Cite Original" mail-yank-original :enable mail-reply-action)) (define-key map [menu-bar mail signature] '("Insert Signature" . mail-signature)) @@ -343,13 +354,13 @@ The default value matches citations like `foo-bar>' plus whitespace." '("Expand Aliases" . expand-mail-aliases)) (define-key map [menu-bar headers sent-via] - '("Sent Via" . mail-sent-via)) + '("Sent-Via" . mail-sent-via)) (define-key map [menu-bar headers mail-reply-to] - '("Mail Reply To" . mail-mail-reply-to)) + '("Mail-Reply-To" . mail-mail-reply-to)) (define-key map [menu-bar headers mail-followup-to] - '("Mail Followup To" . mail-mail-followup-to)) + '("Mail-Followup-To" . mail-mail-followup-to)) (define-key map [menu-bar headers reply-to] '("Reply-To" . mail-reply-to)) @@ -372,18 +383,11 @@ The default value matches citations like `foo-bar>' plus whitespace." map)) (autoload 'build-mail-aliases "mailalias" - "Read mail aliases from user's personal aliases file and set `mail-aliases'." - nil) - -(autoload 'expand-mail-aliases "mailalias" - "Expand all mail aliases in suitable header fields found between BEG and END. -Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants. -Optional second arg EXCLUDE may be a regular expression defining text to be -removed from alias expansions." - nil) + "Read mail aliases from personal aliases file and set `mail-aliases'. +By default, this is the file specified by `mail-personal-alias-file'." t) ;;;###autoload -(defcustom mail-signature nil +(defcustom mail-signature t "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'. If a string, that string is inserted. @@ -399,16 +403,18 @@ and should insert whatever you want to insert." (put 'mail-signature 'risky-local-variable t) ;;;###autoload -(defcustom mail-signature-file "~/.signature" +(defcustom mail-signature-file (purecopy "~/.signature") "File containing the text inserted at end of mail buffer." :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." +(defcustom mail-default-directory (purecopy "~/") + "Value of `default-directory' for Mail mode buffers. +This directory is used for auto-save files of Mail mode buffers. + +Note that Message mode does not use this variable; it auto-saves +in `message-auto-save-directory'." :type '(directory :tag "Directory") :group 'sendmail :version "22.1") @@ -422,20 +428,22 @@ This directory is used for auto-save files of mail buffers." ;;;###autoload (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." +It can contain newlines, and should end in one. It is inserted +before you edit the message, so you can edit or delete the lines." :type '(choice (const nil) string) :group 'sendmail) +;; FIXME no need for autoload ;;;###autoload (defcustom mail-bury-selects-summary t - "If non-nil, try to show RMAIL summary buffer after returning from mail. + "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 +the Rmail summary buffer before returning, if it exists and this variable is non-nil." :type 'boolean :group 'sendmail) +;; FIXME no need for autoload ;;;###autoload (defcustom mail-send-nonascii 'mime "Specify whether to allow sending non-ASCII characters in mail. @@ -479,8 +487,12 @@ The value should be an expression to test whether the problem will actually occur.") (defvar mail-mode-syntax-table + ;; define-derived-mode will make it inherit from text-mode-syntax-table. (let ((st (make-syntax-table))) - ;; define-derived-mode will make it inherit from text-mode-syntax-table. + ;; FIXME this is probably very obsolete now ("percent hack"). + ;; sending.texi used to say: + ;; Mail mode defines the character `%' as a word separator; this + ;; is helpful for using the word commands to edit mail addresses. (modify-syntax-entry ?% ". " st) st) "Syntax table used while in `mail-mode'.") @@ -537,7 +549,7 @@ actually occur.") (kill-local-variable 'buffer-file-coding-system) ;; This doesn't work for enable-multibyte-characters. ;; (kill-local-variable 'enable-multibyte-characters) - (set-buffer-multibyte default-enable-multibyte-characters) + (set-buffer-multibyte (default-value 'enable-multibyte-characters)) (if current-input-method (inactivate-input-method)) (setq mail-send-actions actions) @@ -592,15 +604,7 @@ actually occur.") 'category 'mail-header-separator) ;; Insert the signature. But remember the beginning of the message. (if to (setq to (point))) - (cond ((eq mail-signature t) - (if (file-exists-p mail-signature-file) - (progn - (insert "\n\n-- \n") - (insert-file-contents mail-signature-file)))) - ((stringp mail-signature) - (insert mail-signature)) - (t - (eval mail-signature))) + (if mail-signature (mail-signature t)) (goto-char (point-max)) (or (bolp) (newline))) (if to (goto-char to)) @@ -609,7 +613,9 @@ actually occur.") (run-hooks 'mail-setup-hook)) (defcustom mail-mode-hook nil - "Hook run by Mail mode." + "Hook run by Mail mode. +When composing a mail, this runs immediately after creating, or +switching to, the `*mail*' buffer. See also `mail-setup-hook'." :group 'sendmail :type 'hook :options '(footnote-mode)) @@ -705,7 +711,7 @@ Leave point at the start of the delimiter line." "Carry out Auto Fill for Mail mode. If within the headers, this makes the new lines into continuation lines." (if (< (point) (mail-header-end)) - (let ((old-line-start (save-excursion (beginning-of-line) (point)))) + (let ((old-line-start (line-beginning-position))) (if (do-auto-fill) (save-excursion (beginning-of-line) @@ -784,7 +790,7 @@ Prefix arg means don't delete this window." (if (display-multi-frame-p) (delete-frame (selected-frame)) ;; The previous frame is where normally they have the - ;; RMAIL buffer displayed. + ;; Rmail buffer displayed. (other-frame -1))) (let (rmail-flag summary-buffer) (and (not arg) @@ -806,15 +812,14 @@ Prefix arg means don't delete this window." (switch-to-buffer newbuf)))))) (defcustom mail-send-hook nil - "Hook run just before sending mail with `mail-send'." + "Hook run just before sending a message." :type 'hook :options '(flyspell-mode-off) :group 'sendmail) ;;;###autoload -(defcustom mail-mailing-lists nil "\ -*List of mailing list addresses the user is subscribed to. - +(defcustom mail-mailing-lists nil +"List of mailing list addresses the user is subscribed to. The variable is used to trigger insertion of the \"Mail-Followup-To\" header when sending a message to a mailing list." :type '(repeat string) @@ -923,7 +928,7 @@ This function uses `mail-envelope-from'." ;;;###autoload (defvar sendmail-coding-system nil "*Coding system for encoding the outgoing mail. -This has higher priority than `default-buffer-file-coding-system' +This has higher priority than the 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'.") @@ -946,7 +951,21 @@ See also the function `select-message-coding-system'.") (if (string-match "[^\0-\177]" fullname) (setq fullname (rfc2047-encode-string fullname) quote-fullname t)) - (cond ((eq mail-from-style 'angles) + (cond ((null mail-from-style) + (insert "From: " login "\n")) + ;; This is deprecated. + ((eq mail-from-style 'system-default) + nil) + ((or (eq mail-from-style 'angles) + (and (not (eq mail-from-style 'parens)) + ;; Use angles if no quoting is needed, or if + ;; parens would need quoting too. + (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) + (let ((tmp (concat fullname nil))) + (while (string-match "([^()]*)" tmp) + (aset tmp (match-beginning 0) ?-) + (aset tmp (1- (match-end 0)) ?-)) + (string-match "[\\()]" tmp))))) (insert "From: " fullname) (let ((fullname-start (+ (point-min) 6)) (fullname-end (point-marker))) @@ -965,7 +984,8 @@ See also the function `select-message-coding-system'.") (replace-match "\\\\\\&" t)) (insert "\"")))) (insert " <" login ">\n")) - ((eq mail-from-style 'parens) + ;; 'parens or default + (t (insert "From: " login " (") (let ((fullname-start (point))) (if quote-fullname @@ -988,12 +1008,7 @@ See also the function `select-message-coding-system'.") fullname-end 1) (replace-match "\\1(\\3)" t) (goto-char fullname-start)))) - (insert ")\n")) - ((null mail-from-style) - (insert "From: " login "\n")) - ((eq mail-from-style 'system-default) - nil) - (t (error "Invalid value for `mail-from-style'"))))) + (insert ")\n"))))) ;; Normally you will not need to modify these options unless you are ;; using some non-genuine substitute for sendmail which does not @@ -1074,23 +1089,23 @@ external program defined by `sendmail-program'." ;; 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)) -;;; (and (re-search-forward "^From:" delimline t) -;;; (progn -;;; (require 'mail-utils) -;;; (not (string-equal -;;; (mail-strip-quoted-names -;;; (save-restriction -;;; (narrow-to-region (point-min) delimline) -;;; (mail-fetch-field "From"))) -;;; (user-login-name)))) -;;; (progn -;;; (forward-line 1) -;;; (insert "Sender: " (user-login-name) "\n"))) + (delete-region (line-beginning-position) + (line-beginning-position 2)))) + ;; Apparently this causes a duplicate Sender. + ;; ;; If the From is different than current user, insert Sender. + ;; (goto-char (point-min)) + ;; (and (re-search-forward "^From:" delimline t) + ;; (progn + ;; (require 'mail-utils) + ;; (not (string-equal + ;; (mail-strip-quoted-names + ;; (save-restriction + ;; (narrow-to-region (point-min) delimline) + ;; (mail-fetch-field "From"))) + ;; (user-login-name)))) + ;; (progn + ;; (forward-line 1) + ;; (insert "Sender: " (user-login-name) "\n"))) ;; Don't send out a blank subject line (goto-char (point-min)) (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) @@ -1105,7 +1120,10 @@ external program defined by `sendmail-program'." (if (not (re-search-forward "^From:" delimline t)) (mail-insert-from-field)) ;; Possibly add a MIME header for the current coding system - (let (charset) + (let (charset where-content-type) + (goto-char (point-min)) + (setq where-content-type + (re-search-forward "^Content-type:" delimline t)) (goto-char (point-min)) (and (eq mail-send-nonascii 'mime) (not (re-search-forward "^MIME-version:" delimline t)) @@ -1114,11 +1132,18 @@ external program defined by `sendmail-program'." 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) - "\nContent-Transfer-Encoding: 8bit\n"))) + (progn + (goto-char delimline) + (insert "MIME-version: 1.0\n" + "Content-type: text/plain; charset=" + (symbol-name charset) + "\nContent-Transfer-Encoding: 8bit\n") + ;; The character set we will actually use + ;; should override any specified in the message itself. + (when where-content-type + (goto-char where-content-type) + (delete-region (point-at-bol) + (progn (forward-line 1) (point))))))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) @@ -1146,9 +1171,9 @@ external program defined by `sendmail-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))) + ;; ;; 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 @@ -1168,8 +1193,13 @@ external program defined by `sendmail-program'." ) ) (exit-value (apply 'call-process-region args))) - (or (null exit-value) (eq 0 exit-value) - (error "Sending...failed with exit value %d" exit-value))) + (cond ((or (null exit-value) (eq 0 exit-value))) + ((numberp exit-value) + (error "Sending...failed with exit value %d" exit-value)) + ((stringp exit-value) + (error "Sending...terminated by signal: %s" exit-value)) + (t + (error "SENDMAIL-SEND-IT -- fall through: %S" exit-value)))) (or fcc-was-found (error "No recipients"))) (if mail-interactive @@ -1184,132 +1214,119 @@ external program defined by `sendmail-program'." (if (bufferp errbuf) (kill-buffer errbuf))))) +(autoload 'rmail-output-to-rmail-buffer "rmailout") + (defun mail-do-fcc (header-end) + "Find and act on any FCC: headers in the current message before HEADER-END. +If a buffer is visiting the FCC file, append to it before +offering to save it, if it was modified initially. If this is an +Rmail buffer, update Rmail as needed. If there is no buffer, +just append to the file, in Babyl format if necessary." (unless (markerp header-end) (error "Value of `header-end' must be a marker")) (let (fcc-list - (rmailbuf (current-buffer)) - (time (current-time)) - (tembuf (generate-new-buffer " rmail output")) - (case-fold-search t)) + (mailbuf (current-buffer)) + (time (current-time))) (save-excursion (goto-char (point-min)) - (while (re-search-forward "^FCC:[ \t]*" header-end t) - (push (buffer-substring (point) - (progn - (end-of-line) - (skip-chars-backward " \t") - (point))) - fcc-list) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - (set-buffer tembuf) - (erase-buffer) - ;; This initial newline is written out if the fcc file already exists. - (insert "\nFrom " (user-login-name) " " - (current-time-string time) "\n") - ;; Insert the time zone before the year. - (forward-char -1) - (forward-word -1) - (require 'mail-utils) - (insert (mail-rfc822-time-zone time) " ") - (goto-char (point-max)) - (insert-buffer-substring rmailbuf) - ;; Make sure messages are separated. - (goto-char (point-max)) - (insert ?\n) - (goto-char 2) - ;; ``Quote'' "^From " as ">From " - ;; (note that this isn't really quoting, as there is no requirement - ;; that "^[>]+From " be quoted in the same transparent way.) - (let ((case-fold-search nil)) - (while (search-forward "\nFrom " nil t) - (forward-char -5) - (insert ?>))) - (dolist (fcc fcc-list) - (let* ((buffer (find-buffer-visiting fcc)) - (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)))) - (if buffer - ;; File is present in a buffer => append to that buffer. - (with-current-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)) - (point-max)))) - (unwind-protect - ;; Code below lifted from rmailout.el - ;; function rmail-output-to-rmail-file: - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - rmail-current-message))) - ;; 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)) - (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" - "Date: " (mail-rfc822-date) "\n") - (insert-buffer-substring curbuf beg2 end) - (insert "\n\C-_") - (goto-char (point-min)) - (widen) - (search-backward "\n\^_") - (narrow-to-region (point) (point-max)) - (rmail-count-new-messages t) - (rmail-show-message msg) - (setq max nil)) - ;; Output file not in rmail mode - ;; => just insert at the end. - (narrow-to-region (point-min) (1+ (buffer-size))) - (goto-char (point-max)) - (insert-buffer-substring curbuf beg end)) - (or buffer-matches-file - (progn - (if (y-or-n-p (format "Save file %s? " - fcc)) - (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 fcc) - ;; 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 fcc)))) - (mail-file-babyl-p fcc)) - ;; If the file is a Babyl file, - ;; convert the message to Babyl format. - (let ((coding-system-for-write - (or rmail-file-coding-system - 'emacs-mule))) - (with-current-buffer (get-buffer-create " mail-temp") - (setq buffer-read-only nil) - (erase-buffer) - (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " - (mail-rfc822-date) "\n") - (insert-buffer-substring curbuf beg2 end) - (insert "\n\C-_") - (write-region (point-min) (point-max) fcc t) - (erase-buffer))) - (write-region - (1+ (point-min)) (point-max) fcc t))) - (and buffer (not dont-write-the-file) - (with-current-buffer buffer - (set-visited-file-modtime)))))) - (kill-buffer tembuf))) + (let ((case-fold-search t)) + (while (re-search-forward "^FCC:[ \t]*" header-end t) + (push (buffer-substring (point) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point))) + fcc-list) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point))))) + (with-temp-buffer + ;; This initial newline is not written out if we create a new + ;; file (see below). + (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n") + ;; Insert the time zone before the year. + (forward-char -1) + (forward-word -1) + (require 'mail-utils) + (insert (mail-rfc822-time-zone time) " ") + (goto-char (point-max)) + (insert-buffer-substring mailbuf) + ;; Make sure messages are separated. + (goto-char (point-max)) + (insert ?\n) + (goto-char 2) + ;; ``Quote'' "^From " as ">From " + ;; (note that this isn't really quoting, as there is no requirement + ;; that "^[>]+From " be quoted in the same transparent way.) + (let ((case-fold-search nil)) + (while (search-forward "\nFrom " nil t) + (forward-char -5) + (insert ?>))) + (dolist (fcc fcc-list) + (let* ((buffer (find-buffer-visiting fcc)) + (curbuf (current-buffer)) + dont-write-the-file + buffer-matches-file + (beg (point-min)) ; the initial blank line + (end (point-max)) + ;; After the ^From line. + (beg2 (save-excursion (goto-char (point-min)) + (forward-line 2) (point)))) + (if buffer + ;; File is present in a buffer => append to that buffer. + (with-current-buffer buffer + (setq buffer-matches-file + (and (not (buffer-modified-p)) + (verify-visited-file-modtime buffer))) + (let ((msg (bound-and-true-p rmail-current-message)) + (buffer-read-only nil)) + ;; If MSG is non-nil, buffer is in Rmail mode. + (if msg + (let ((buff (generate-new-buffer " *mail-do-fcc"))) + (unwind-protect + (progn + (with-current-buffer buff + (insert-buffer-substring curbuf (1+ beg) end)) + (rmail-output-to-rmail-buffer buff msg)) + (kill-buffer buff))) + ;; Output file not in Rmail mode => just insert + ;; at the end. + (save-restriction + (widen) + (goto-char (point-max)) + (insert-buffer-substring curbuf beg end))) + ;; Offer to save the buffer if it was modified + ;; before we started. + (unless buffer-matches-file + (if (y-or-n-p (format "Save file %s? " fcc)) + (save-buffer)) + (setq dont-write-the-file t))))) + ;; Append to the file directly, unless we've already taken + ;; care of it. + (unless dont-write-the-file + (if (and (file-exists-p fcc) + (mail-file-babyl-p fcc)) + ;; If the file is a Babyl file, convert the message to + ;; Babyl format. Even though Rmail no longer uses + ;; Babyl, this code can remain for the time being, on + ;; the off-chance one FCCs to a Babyl file that has + ;; not yet been converted to mbox. + (let ((coding-system-for-write + (or rmail-file-coding-system 'emacs-mule))) + (with-temp-buffer + (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " + (mail-rfc822-date) "\n") + (insert-buffer-substring curbuf beg2 end) + (insert "\n\C-_") + (write-region (point-min) (point-max) fcc t))) + ;; Ensure there is a blank line between messages, but + ;; not at the very start of the file. + (write-region (if (file-exists-p fcc) + (point-min) + (1+ (point-min))) + (point-max) fcc t))) + (and buffer (not dont-write-the-file) + (with-current-buffer buffer + (set-visited-file-modtime))))))))) (defun mail-sent-via () "Make a Sent-via header line from each To or CC header line." @@ -1334,19 +1351,19 @@ external program defined by `sendmail-program'." (insert-before-markers "Sent-via:" to-line)))))) (defun mail-to () - "Move point to end of To-field." + "Move point to end of To field, creating it if necessary." (interactive) (expand-abbrev) (mail-position-on-field "To")) (defun mail-subject () - "Move point to end of Subject-field." + "Move point to end of Subject field, creating it if necessary." (interactive) (expand-abbrev) (mail-position-on-field "Subject")) (defun mail-cc () - "Move point to end of CC-field. Create a CC field if none." + "Move point to end of CC field, creating it if necessary." (interactive) (expand-abbrev) (or (mail-position-on-field "cc" t) @@ -1354,7 +1371,7 @@ external program defined by `sendmail-program'." (insert "\nCC: ")))) (defun mail-bcc () - "Move point to end of BCC-field. Create a BCC field if none." + "Move point to end of BCC field, creating it if necessary." (interactive) (expand-abbrev) (or (mail-position-on-field "bcc" t) @@ -1370,14 +1387,13 @@ external program defined by `sendmail-program'." (insert "\nFCC: " folder)) (defun mail-reply-to () - "Move point to end of Reply-To-field. Create a Reply-To field if none." + "Move point to end of Reply-To field, creating it if necessary." (interactive) (expand-abbrev) (mail-position-on-field "Reply-To")) (defun mail-mail-reply-to () - "Move point to end of Mail-Reply-To field. -Create a Mail-Reply-To field if none." + "Move point to end of Mail-Reply-To field, creating it if necessary." (interactive) (expand-abbrev) (or (mail-position-on-field "mail-reply-to" t) @@ -1385,8 +1401,7 @@ Create a Mail-Reply-To field if none." (insert "\nMail-Reply-To: ")))) (defun mail-mail-followup-to () - "Move point to end of Mail-Followup-To field. -Create a Mail-Followup-To field if none." + "Move point to end of Mail-Followup-To field, creating it if necessary." (interactive) (expand-abbrev) (or (mail-position-on-field "mail-followup-to" t) @@ -1417,20 +1432,34 @@ Create a Mail-Followup-To field if none." (goto-char (mail-text-start))) (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 - (or atpoint - (goto-char (point-max))) - (skip-chars-backward " \t\n") - (end-of-line) - (or atpoint + "Sign letter with signature. +If the variable `mail-signature' is a string, inserts it. +If it is t or nil, inserts the contents of the file `mail-signature-file'. +Otherwise, evals `mail-signature'. +Prefix argument ATPOINT means insert at point rather than the end." + (interactive "*P") + ;; Test for an unreadable file here, before we delete trailing + ;; whitespace, so that we don't modify the buffer needlessly. + (if (and (memq mail-signature '(t nil)) + (not (file-readable-p mail-signature-file))) + (if (called-interactively-p 'interactive) + (message "The signature file `%s' could not be read" + mail-signature-file)) + (save-excursion + (unless atpoint + (goto-char (point-max)) + ;; Delete trailing whitespace and blank lines. + (skip-chars-backward " \t\n") + (end-of-line) (delete-region (point) (point-max))) - (if (stringp mail-signature) - (insert mail-signature) - (insert "\n\n-- \n") - (insert-file-contents (expand-file-name mail-signature-file))))) + (cond ((stringp mail-signature) + (insert mail-signature)) + ((memq mail-signature '(t nil)) + (insert "\n\n-- \n") + (insert-file-contents (expand-file-name mail-signature-file))) + (t + ;; FIXME add condition-case error handling? + (eval mail-signature)))))) (defun mail-fill-yanked-message (&optional justifyp) "Fill the paragraphs of a message yanked into this one. @@ -1462,7 +1491,7 @@ However, if `mail-yank-prefix' is non-nil, insert that prefix on each line." (forward-line 1)))))) (defun mail-yank-original (arg) - "Insert the message being replied to, if any (in rmail). + "Insert the message being replied to, if any (in Rmail). 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. @@ -1472,18 +1501,34 @@ and don't delete any header fields." (interactive "P") (if mail-reply-action (let ((start (point)) - (original mail-reply-action)) + (original mail-reply-action) + (omark (mark t))) (and (consp original) (eq (car original) 'insert-buffer) (setq original (nth 1 original))) (if (consp original) - (apply (car original) (cdr original)) - ;; If the original message is in another window in the same frame, - ;; delete that window to save screen space. - ;; t means don't alter other frames. + (progn + ;; Call yank function, and set the mark if it doesn't. + (apply (car original) (cdr original)) + (if (eq omark (mark t)) + (push-mark (point)))) + ;; If the original message is in another window in the same + ;; frame, delete that window to save space. (delete-windows-on original t) (with-no-warnings ;; We really want this to set mark. - (insert-buffer original)) + (insert-buffer original) + ;; If they yank the original text, the encoding of the + ;; original message is a better default than + ;; the default buffer-file-coding-system. + (and (coding-system-equal + (default-value 'buffer-file-coding-system) + buffer-file-coding-system) + (setq buffer-file-coding-system + (coding-system-change-text-conversion + buffer-file-coding-system + (coding-system-base + (with-current-buffer original + buffer-file-coding-system)))))) (set-text-properties (point) (mark t) nil)) (if (consp arg) nil @@ -1609,7 +1654,8 @@ If the current line has `mail-yank-prefix', insert it on the new line." ;; 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 (add-hook 'same-window-buffer-names (purecopy "*mail*")) +;;;###autoload (add-hook 'same-window-buffer-names (purecopy "*unsent mail*")) ;;;###autoload (defun mail (&optional noerase to subject in-reply-to cc replybuffer actions) @@ -1660,48 +1706,48 @@ The seventh argument ACTIONS is a list of actions to take when the message is sent, we apply FUNCTION to ARGS. This is how Rmail arranges to mark messages `answered'." (interactive "P") -;;; This is commented out because I found it was confusing in practice. -;;; It is easy enough to rename *mail* by hand with rename-buffer -;;; if you want to have multiple mail buffers. -;;; And then you can control which messages to save. --rms. -;;; (let ((index 1) -;;; buffer) -;;; ;; If requested, look for a mail buffer that is modified and go to it. -;;; (if noerase -;;; (progn -;;; (while (and (setq buffer -;;; (get-buffer (if (= 1 index) "*mail*" -;;; (format "*mail*<%d>" index)))) -;;; (not (buffer-modified-p buffer))) -;;; (setq index (1+ index))) -;;; (if buffer (switch-to-buffer buffer) -;;; ;; If none exists, start a new message. -;;; ;; This will never re-use an existing unmodified mail buffer -;;; ;; (since index is not 1 anymore). Perhaps it should. -;;; (setq noerase nil)))) -;;; ;; Unless we found a modified message and are happy, start a new message. -;;; (if (not noerase) -;;; (progn -;;; ;; Look for existing unmodified mail buffer. -;;; (while (and (setq buffer -;;; (get-buffer (if (= 1 index) "*mail*" -;;; (format "*mail*<%d>" index)))) -;;; (buffer-modified-p buffer)) -;;; (setq index (1+ index))) -;;; ;; If none, make a new one. -;;; (or buffer -;;; (setq buffer (generate-new-buffer "*mail*"))) -;;; ;; Go there and initialize it. -;;; (switch-to-buffer buffer) -;;; (erase-buffer) -;;; (setq default-directory (expand-file-name "~/")) -;;; (auto-save-mode auto-save-default) -;;; (mail-mode) -;;; (mail-setup to subject in-reply-to cc replybuffer actions) -;;; (if (and buffer-auto-save-file-name -;;; (file-exists-p buffer-auto-save-file-name)) -;;; (message "Auto save file for draft message exists; consider M-x mail-recover")) -;;; t)) + ;; This is commented out because I found it was confusing in practice. + ;; It is easy enough to rename *mail* by hand with rename-buffer + ;; if you want to have multiple mail buffers. + ;; And then you can control which messages to save. --rms. + ;; (let ((index 1) + ;; buffer) + ;; ;; If requested, look for a mail buffer that is modified and go to it. + ;; (if noerase + ;; (progn + ;; (while (and (setq buffer + ;; (get-buffer (if (= 1 index) "*mail*" + ;; (format "*mail*<%d>" index)))) + ;; (not (buffer-modified-p buffer))) + ;; (setq index (1+ index))) + ;; (if buffer (switch-to-buffer buffer) + ;; ;; If none exists, start a new message. + ;; ;; This will never re-use an existing unmodified mail buffer + ;; ;; (since index is not 1 anymore). Perhaps it should. + ;; (setq noerase nil)))) + ;; ;; Unless we found a modified message and are happy, start a new message. + ;; (if (not noerase) + ;; (progn + ;; ;; Look for existing unmodified mail buffer. + ;; (while (and (setq buffer + ;; (get-buffer (if (= 1 index) "*mail*" + ;; (format "*mail*<%d>" index)))) + ;; (buffer-modified-p buffer)) + ;; (setq index (1+ index))) + ;; ;; If none, make a new one. + ;; (or buffer + ;; (setq buffer (generate-new-buffer "*mail*"))) + ;; ;; Go there and initialize it. + ;; (switch-to-buffer buffer) + ;; (erase-buffer) + ;; (setq default-directory (expand-file-name "~/")) + ;; (auto-save-mode auto-save-default) + ;; (mail-mode) + ;; (mail-setup to subject in-reply-to cc replybuffer actions) + ;; (if (and buffer-auto-save-file-name + ;; (file-exists-p buffer-auto-save-file-name)) + ;; (message "Auto save file for draft message exists; consider M-x mail-recover")) + ;; t)) (if (eq noerase 'new) (pop-to-buffer (generate-new-buffer "*mail*")) @@ -1722,7 +1768,7 @@ The seventh argument ACTIONS is a list of actions to take (mail-mode) ;; Disconnect the buffer from its visited file ;; (in case the user has actually visited a file *mail*). -;;; (set-visited-file-name nil) + ;; (set-visited-file-name nil) (let (initialized) (and (not (and noerase (not (eq noerase 'new)))) @@ -1771,6 +1817,9 @@ The seventh argument ACTIONS is a list of actions to take ;; names are normally ``trivial'', so Dired will set point after ;; all the files, at buffer bottom. We want it on the first ;; file instead. + ;; Require dired so that dired-trivial-filenames does not get + ;; unbound on exit from the let. + (require 'dired) (let ((dired-trivial-filenames t)) (dired-other-window wildcard (concat dired-listing-switches "t"))) (rename-buffer "*Auto-saved Drafts*" t) @@ -1820,7 +1869,7 @@ The seventh argument ACTIONS is a list of actions to take ;; 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)))))))) + (default-value 'buffer-file-coding-system))))))))) (declare-function dired-move-to-filename "dired" (&optional raise-error eol)) (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) @@ -1901,5 +1950,4 @@ you can move to one of them and type C-c C-c to recover that one." (provide 'sendmail) -;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626 ;;; sendmail.el ends here