;;; 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
: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:
king@grassland.com (Elvis Parsley)
If `angles', they look like:
Elvis Parsley <king@grassland.com>
-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)
;; 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)
(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
(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)
;;;###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)
: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.
;;;###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)
"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)
: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).
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
(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")))
'("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))
'("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))
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.
(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")
;;;###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.
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'.")
(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)
'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))
(run-hooks 'mail-setup-hook))
\f
(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))
"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)
(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)
(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)
;;;###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'.")
(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)))
(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
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
;; 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)
(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))
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))
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
)
)
(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
(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."
(insert-before-markers "Sent-via:" to-line))))))
\f
(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)
(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)
(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)
(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)
(goto-char (mail-text-start)))
\f
(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.
(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.
(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
;; 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)
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*"))
(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))))
;; 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)
;; 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))
(provide 'sendmail)
-;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626
;;; sendmail.el ends here
HCoop / bpt / emacs.git / blobdiff