;;; message.el --- composing mail and news messages
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
;;; Code:
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
- (require 'cl)
- (defvar gnus-message-group-art)
- (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+ (require 'cl))
+
(require 'hashcash)
(require 'canlock)
(require 'mailheader)
(require 'rfc822)
(require 'ecomplete)
+(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
+
+(defvar gnus-message-group-art)
+(defvar gnus-list-identifiers) ; gnus-sum is required where necessary
+(defvar rmail-enable-mime-composing)
(defgroup message '((user-mail-address custom-variable)
(user-full-name custom-variable))
(defcustom message-kill-buffer-query t
"*Non-nil means that killing a modified message buffer has to be confirmed.
This is used by `message-kill-buffer'."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'message-buffers
:type 'boolean)
-(eval-when-compile
- (defvar gnus-local-organization))
+(defvar gnus-local-organization)
(defcustom message-user-organization
(or (and (boundp 'gnus-local-organization)
(stringp gnus-local-organization)
:link '(custom-manual "(message)Canceling News")
:type 'string)
+(defvar smtpmail-default-smtp-server)
+
+(defun message-send-mail-function ()
+ "Return suitable value for the variable `message-send-mail-function'."
+ (cond ((and (require 'sendmail)
+ (boundp 'sendmail-program)
+ sendmail-program
+ (executable-find sendmail-program))
+ 'message-send-mail-with-sendmail)
+ ((and (locate-library "smtpmail")
+ (require 'smtpmail)
+ smtpmail-default-smtp-server)
+ 'message-smtpmail-send-it)
+ ((locate-library "mailclient")
+ 'message-send-mail-with-mailclient)
+ (t
+ (lambda ()
+ (error "Don't know how to send mail. Please customize `message-send-mail-function'")))))
+
;; Useful to set in site-init.el
-(defcustom message-send-mail-function
- (let ((program (if (boundp 'sendmail-program)
- ;; see paths.el
- sendmail-program)))
- (cond
- ((and program
- (string-match "/" program) ;; Skip path
- (file-executable-p program))
- 'message-send-mail-with-sendmail)
- ((and program
- (executable-find program))
- 'message-send-mail-with-sendmail)
- (t
- 'smtpmail-send-it)))
+(defcustom message-send-mail-function (message-send-mail-function)
"Function to call to send the current buffer as mail.
The headers should be delimited by a line whose contents match the
variable `mail-header-separator'.
-Valid values include `message-send-mail-with-sendmail' (the default),
+Valid values include `message-send-mail-with-sendmail'
`message-send-mail-with-mh', `message-send-mail-with-qmail',
-`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
+`message-smtpmail-send-it', `smtpmail-send-it',
+`feedmail-send-it' and `message-send-mail-with-mailclient'. The
+default is system dependent and determined by the function
+`message-send-mail-function'.
See also `send-mail-function'."
:type '(radio (function-item message-send-mail-with-sendmail)
(function-item message-smtpmail-send-it)
(function-item smtpmail-send-it)
(function-item feedmail-send-it)
- (function :tag "Other"))
+ (function-item message-send-mail-with-mailclient
+ :tag "Use Mailclient package")
+ (function :tag "Other"))
:group 'message-sending
+ :version "23.1" ;; No Gnus
+ :initialize 'custom-initialize-default
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(defcustom message-sendmail-extra-arguments nil
"Additional arguments to `sendmail-program'."
;; E.g. '("-a" "account") for msmtp
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:type '(repeat string)
;; :link '(custom-manual "(message)Mail Variables")
:group 'message-sending)
:type '(choice (function)
(repeat string)))
-(eval-when-compile
- (defvar gnus-post-method)
- (defvar gnus-select-method))
+(defvar gnus-post-method)
+(defvar gnus-select-method)
(defcustom message-post-method
(cond ((and (boundp 'gnus-post-method)
(listp gnus-post-method)
(const :tag "Include date" "On %a, %b %d %Y, %n wrote:")
string)
:link '(custom-manual "(message)Insertion Variables")
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'message-insertion)
(defcustom message-yank-prefix "> "
(file-readable-p "/etc/sendmail.cf")
(let ((buffer (get-buffer-create " *temp*")))
(unwind-protect
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(insert-file-contents "/etc/sendmail.cf")
(goto-char (point-min))
(let ((case-fold-search nil))
(defcustom message-dont-reply-to-names
(and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
"*Addresses to prune when doing wide replies.
-This can be a regexp or a list of regexps. Also, a value of nil means
+This can be a regexp or a list of regexps. Also, a value of nil means
exclude your own user name only."
:version "21.1"
:group 'message
(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
"*Whether to generate X-Hashcash: headers.
-If `t', always generate hashcash headers. If `opportunistic',
+If t, always generate hashcash headers. If `opportunistic',
only generate hashcash headers if it can be done without the user
waiting (i.e., only asynchronously).
(defvar message-inserted-headers nil)
;; Byte-compiler warning
-(eval-when-compile
- (defvar gnus-active-hashtb)
- (defvar gnus-read-active-file))
+(defvar gnus-active-hashtb)
+(defvar gnus-read-active-file)
;;; Regexp matching the delimiter of messages in UNIX mail format
;;; (UNIX From lines), minus the initial ^. It should be a copy
"^ *--+ +begin message +--+ *$\\|"
"^ *---+ +Original message follows +---+ *$\\|"
"^ *---+ +Undelivered message follows +---+ *$\\|"
+ "^------ This is a copy of the message, including all the headers. ------ *$\\|"
"^|? *---+ +Message text follows: +---+ *|?$")
"A regexp that matches the separator before the text of a failed message.")
"Evaluate FORMS in the reply buffer, if it exists."
`(when (and message-reply-buffer
(buffer-name message-reply-buffer))
- (save-excursion
- (set-buffer message-reply-buffer)
+ (with-current-buffer message-reply-buffer
,@forms)))
(put 'message-with-reply-buffer 'lisp-indent-function 0)
(kill-region start (point))))
+(autoload 'Info-goto-node "info")
+
(defun message-info (&optional arg)
"Display the Message manual.
-Prefixed with one \\[universal-argument], display the Emacs MIME manual.
-Prefixed with two \\[universal-argument]'s, display the PGG manual."
+Prefixed with one \\[universal-argument], display the Emacs MIME
+manual. With two \\[universal-argument]'s, display the EasyPG or
+PGG manual, depending on the value of `mml2015-use'."
(interactive "p")
- (cond ((eq arg 16) (Info-goto-node "(pgg)Top"))
- ((eq arg 4) (Info-goto-node "(emacs-mime)Top"))
- (t (Info-goto-node "(message)Top"))))
+ (Info-goto-node (format "(%s)Top"
+ (cond ((eq arg 16) mml2015-use)
+ ((eq arg 4) 'emacs-mime)
+ ((and (not (booleanp arg))
+ (symbolp arg))
+ arg)
+ (t
+ 'message)))))
\f
(defvar message-tool-bar-map nil)
-(eval-when-compile
- (defvar facemenu-add-face-function)
- (defvar facemenu-remove-face-function))
+(defvar facemenu-add-face-function)
+(defvar facemenu-remove-face-function)
;;; Forbidden properties
;;
;; solution would be not to use `define-derived-mode', and run
;; `text-mode-hook' ourself at the end of the mode.
;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-19.
+ ;; This kludge is unneeded in Emacs>=21 since define-derived-mode is
+ ;; now careful to run parent hooks after the body. --Stef
(when auto-fill-function
(setq auto-fill-function normal-auto-fill-function)))
(let ((follow-to
(and message-reply-buffer
(buffer-name message-reply-buffer)
- (save-excursion
- (set-buffer message-reply-buffer)
+ (with-current-buffer message-reply-buffer
(message-get-reply-headers t)))))
(save-excursion
(save-restriction
and `low'."
(interactive)
(save-excursion
- (let ((valid '("high" "normal" "low"))
- (new "high")
+ (let ((new "high")
cur)
(save-restriction
(message-narrow-to-headers)
(defun message-buffers ()
"Return a list of active message buffers."
(let (buffers)
- (save-excursion
+ (save-current-buffer
(dolist (buffer (buffer-list t))
(set-buffer buffer)
(when (and (eq major-mode 'message-mode)
(push (buffer-name buffer) buffers))))
(nreverse buffers)))
-(eval-when-compile (defvar mail-citation-hook)) ; Compiler directive
-
(defun message-cite-original-1 (strip-signature)
"Cite an original message.
If STRIP-SIGNATURE is non-nil, strips off the signature from the
"Cite function in the standard Message manner."
(message-cite-original-1 nil))
+(defvar gnus-extract-address-components)
+
+(autoload 'format-spec "format-spec")
+
(defun message-insert-formatted-citation-line (&optional from date)
"Function that inserts a formatted citation line.
(defcustom message-bogus-address-regexp nil ;; "noreply\\|nospam\\|invalid"
"Regexp of potentially bogus mail addresses."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'message-headers
:type 'regexp)
;; Let the user do all of the above.
(run-hooks 'message-header-hook))
(unwind-protect
- (save-excursion
- (set-buffer tembuf)
+ (with-current-buffer tembuf
(erase-buffer)
;; Avoid copying text props (except hard newlines).
(insert (with-current-buffer mailbuf
(unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
(error "Sending...failed with exit value %d" cpr)))
(when message-interactive
- (save-excursion
- (set-buffer errbuf)
+ (with-current-buffer errbuf
(goto-char (point-min))
(while (re-search-forward "\n+ *" nil t)
(replace-match "; "))
(run-hooks 'message-send-mail-hook)
(smtpmail-send-it))
+(defun message-send-mail-with-mailclient ()
+ "Send the prepared message buffer with `mailclient-send-it'.
+This only differs from `smtpmail-send-it' that this command evaluates
+`message-send-mail-hook' just before sending a message."
+ (run-hooks 'message-send-mail-hook)
+ (mailclient-send-it))
+
(defun message-canlock-generate ()
"Return a string that is non-trivial to guess.
Do not use this for anything important, it is cryptographically weak."
(message-check-news-syntax)))
nil
(unwind-protect
- (save-excursion
- (set-buffer tembuf)
+ (with-current-buffer tembuf
(buffer-disable-undo)
(erase-buffer)
;; Avoid copying text props (except hard newlines).
;; Check for control characters.
(message-check 'control-chars
(if (re-search-forward
- (mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
+ (mm-string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
nil t)
(y-or-n-p
"The article contains control characters. Really post? ")
"Return the References header for this message."
(when message-reply-headers
(let ((message-id (mail-header-message-id message-reply-headers))
- (references (mail-header-references message-reply-headers))
- new-references)
+ (references (mail-header-references message-reply-headers)))
(if (or references message-id)
(concat (or references "") (and references " ")
(or message-id ""))
(mapcar 'funcall
message-subscribed-address-functions))))
(save-match-data
- (let ((subscribed-lists nil)
- (list
+ (let ((list
(loop for recipient in recipients
when (loop for regexp in mft-regexps
when (string-match regexp recipient) return t)
between beginning of field and beginning of line."
(interactive "p")
(let ((zrs 'zmacs-region-stays))
- (when (and (interactive-p) (boundp zrs))
+ (when (and (featurep 'xemacs) (interactive-p) (boundp zrs))
(set zrs t)))
(if (and message-beginning-of-line
(message-point-in-header-p))
"Disassociate the message buffer from the drafts directory."
(when message-draft-article
(nndraft-request-expire-articles
- (list message-draft-article) "drafts" nil t)))
+ (list message-draft-article) "nndraft:drafts" nil t)))
(defun message-insert-headers ()
"Generate the headers for the article."
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
+(defun message-alter-recipients-discard-bogus-full-name (addrcell)
+ "Discard mail address in full names.
+When the full name in reply headers contains the mail
+address (e.g. \"foo@bar <foo@bar>\"), discard full name.
+ADDRCELL is a cons cell where the car is the mail address and the
+cdr is the complete address (full name and mail address)."
+ (if (string-match (concat (regexp-quote (car addrcell)) ".*"
+ (regexp-quote (car addrcell)))
+ (cdr addrcell))
+ (cons (car addrcell) (car addrcell))
+ addrcell))
+
+(defcustom message-alter-recipients-function nil
+ "Function called to allow alteration of reply header structures.
+It is called in `message-get-reply-headers' for each recipient.
+The function is called with one parameter, a cons cell ..."
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Discard bogus full name"
+ message-alter-recipients-discard-bogus-full-name)
+ function)
+ :version "23.1" ;; No Gnus
+ :group 'message-headers)
+
(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients extra)
;; Find all relevant headers we need.
(setq recipients
(mapcar
(lambda (addr)
- (cons (downcase (mail-strip-quoted-names addr)) addr))
+ (if message-alter-recipients-function
+ (funcall message-alter-recipients-function
+ (cons (downcase (mail-strip-quoted-names addr))
+ addr))
+ (cons (downcase (mail-strip-quoted-names addr)) addr)))
(message-tokenize-header recipients)))
;; Remove first duplicates. (Why not all duplicates? Is this a bug?)
(let ((s recipients))
(setq subject (funcall func subject))))
subject))))
-(eval-when-compile
- (defvar gnus-article-decoded-p))
+(defvar gnus-article-decoded-p)
;;;###autoload
(rmail-msg-restore-non-pruned-header)))
(message-forward-make-body forward-buffer))
-(eval-when-compile (defvar rmail-enable-mime-composing))
-
;; Fixme: Should have defcustom.
;;;###autoload
(defun message-insinuate-rmail ()
(mapcar #'delete-overlay (overlays-in (point-min) (point-max)))))
;; Support for toolbar
-(eval-when-compile
- (defvar tool-bar-mode))
+(defvar tool-bar-mode)
;; Note: The :set function in the `message-tool-bar*' variables will only
;; affect _new_ message buffers. We might add a function that walks thru all
(const :tag "Retro look" message-tool-bar-retro)
(repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
See `gmm-tool-bar-from-list' for details on the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
(defcustom message-tool-bar-retro
'(;; Old Emacs 21 icon for consistency.
- (message-send-and-exit "gnus/mail_send")
+ (message-send-and-exit "gnus/mail-send")
(message-kill-buffer "close")
(message-dont-send "cancel")
(mml-attach-file "attach" mml-mode-map)
See `gmm-tool-bar-from-list' for details on the format of the list."
:type '(repeat gmm-tool-bar-item)
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
See `gmm-tool-bar-from-list' for the format of the list."
:type 'gmm-tool-bar-zap-list
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
:type '(choice (const nil)
function))
+(declare-function mail-abbrev-in-expansion-header-p "mailabbrev" ())
+
(defun message-tab ()
"Complete names according to `message-completion-alist'.
Execute function specified by `message-tab-body-function' when not in
(if (and show
(setq text (message-flatten-list text)))
(save-window-excursion
- (save-excursion
- (with-output-to-temp-buffer " *MESSAGE information message*"
- (set-buffer " *MESSAGE information message*")
+ (with-output-to-temp-buffer " *MESSAGE information message*"
+ (with-current-buffer " *MESSAGE information message*"
(fundamental-mode) ; for Emacs 20.4+
(mapc 'princ text)
(goto-char (point-min))))
new one, cloning only the locals having a substring matching the
regexp VARSTR."
(let ((oldbuf (current-buffer)))
- (save-excursion
- (set-buffer (generate-new-buffer name))
+ (with-current-buffer (generate-new-buffer name)
(message-clone-locals oldbuf varstr)
(current-buffer))))
(defun message-clone-locals (buffer &optional varstr)
"Clone the local variables from BUFFER to the current buffer."
- (let ((locals (save-excursion
- (set-buffer buffer)
- (buffer-local-variables)))
+ (let ((locals (with-current-buffer buffer (buffer-local-variables)))
(regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address"))
(mapcar
(lambda (local)
message-hidden-headers))
(inhibit-point-motion-hooks t)
(after-change-functions nil)
- (end-of-headers 0))
+ (end-of-headers (point-min)))
(when regexps
(save-excursion
(save-restriction
(setq header (buffer-substring begin (point))
header-len (- (point) begin))
(delete-region begin (point))
- (goto-char (1+ end-of-headers))
+ (goto-char end-of-headers)
(insert header)
(setq end-of-headers
(+ end-of-headers header-len))))))))
- (narrow-to-region (1+ end-of-headers) (point-max))))
+ (narrow-to-region end-of-headers (point-max))))
(defun message-hide-header-p (regexps)
(let ((result nil)
(delete-region start end)
(insert match)))))
+;; To send pre-formatted letters like the example below, you can use
+;; `message-send-form-letter':
+;; --8<---------------cut here---------------start------------->8---
+;; To: alice@invalid.invalid
+;; Subject: Verification of your contact information
+;; From: Contact verification <admin@foo.invalid>
+;; --text follows this line--
+;; Hi Alice,
+;; please verify that your contact information is still valid:
+;; Alice A, A avenue 11, 1111 A town, Austria
+;; ----------next form letter message follows this line----------
+;; To: bob@invalid.invalid
+;; Subject: Verification of your contact information
+;; From: Contact verification <admin@foo.invalid>
+;; --text follows this line--
+;; Hi Bob,
+;; please verify that your contact information is still valid:
+;; Bob, B street 22, 22222 Be town, Belgium
+;; ----------next form letter message follows this line----------
+;; To: charlie@invalid.invalid
+;; Subject: Verification of your contact information
+;; From: Contact verification <admin@foo.invalid>
+;; --text follows this line--
+;; Hi Charlie,
+;; please verify that your contact information is still valid:
+;; Charlie Chaplin, C plaza 33, 33333 C town, Chile
+;; --8<---------------cut here---------------end--------------->8---
+
+;; FIXME: What is the most common term (circular letter, form letter, serial
+;; letter, standard letter) for such kind of letter? See also
+;; <http://en.wikipedia.org/wiki/Form_letter>
+
+;; FIXME: Maybe extent message-mode's font-lock support to recognize
+;; `message-form-letter-separator', i.e. highlight each message like a single
+;; message.
+
+(defcustom message-form-letter-separator
+ "\n----------next form letter message follows this line----------\n"
+ "Separator for `message-send-form-letter'."
+ ;; :group 'message-form-letter
+ :group 'message-various
+ :version "23.1" ;; No Gnus
+ :type 'string)
+
+(defcustom message-send-form-letter-delay 1
+ "Delay in seconds when sending a message with `message-send-form-letter'.
+Only used when `message-send-form-letter' is called with non-nil
+argument `force'."
+ ;; :group 'message-form-letter
+ :group 'message-various
+ :version "23.1" ;; No Gnus
+ :type 'integer)
+
+(defun message-send-form-letter (&optional force)
+ "Sent all form letter messages from current buffer.
+Unless FORCE, prompt before sending.
+
+The messages are separated by `message-form-letter-separator'.
+Header and body are separated by `mail-header-separator'."
+ (interactive "P")
+ (let ((sent 0) (skipped 0)
+ start end text
+ buff
+ to done)
+ (goto-char (point-min))
+ (while (not done)
+ (setq start (point)
+ end (if (search-forward message-form-letter-separator nil t)
+ (- (point) (length message-form-letter-separator) -1)
+ (setq done t)
+ (point-max)))
+ (setq text
+ (buffer-substring-no-properties start end))
+ (setq buff (generate-new-buffer "*mail - form letter*"))
+ (with-current-buffer buff
+ (insert text)
+ (message-mode)
+ (setq to (message-fetch-field "To"))
+ (switch-to-buffer buff)
+ (when force
+ (sit-for message-send-form-letter-delay))
+ (if (or force
+ (y-or-n-p (format "Send message to `%s'? " to)))
+ (progn
+ (setq sent (1+ sent))
+ (message-send-and-exit))
+ (message (format "Message to `%s' skipped." to))
+ (setq skipped (1+ skipped)))
+ (when (buffer-live-p buff)
+ (kill-buffer buff))))
+ (message "%s message(s) sent, %s skipped." sent skipped)))
+
(when (featurep 'xemacs)
(require 'messagexmas)
(message-xmas-redefine))
projects / gnus / blobdiff