;;; 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
-(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.
(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))
nil)
;;;###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 "~/"
+(defcustom mail-default-directory (purecopy "~/")
"Directory for mail buffers.
Value of `default-directory' for mail buffers.
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.
: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))
(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
(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)
+ (beginning-of-line)
+ (delete-region (point)
+ (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))
)
)
(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
(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.
(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
(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
;; 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))