;;; message.el --- composing mail and news messages
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
(eval-when-compile
(require 'cl))
-(require 'hashcash)
-(require 'canlock)
(require 'mailheader)
(require 'gmm-utils)
-(require 'nnheader)
+(require 'mail-utils)
+;; Only for the trivial macros mail-header-from, mail-header-date
+;; mail-header-references, mail-header-subject, mail-header-id
+(eval-when-compile (require 'nnheader))
;; This is apparently necessary even though things are autoloaded.
;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
;; require mailabbrev here.
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
-(require 'ecomplete)
(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
: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)
(executable-find sendmail-program))
'message-send-mail-with-sendmail)
((and (locate-library "smtpmail")
- (require 'smtpmail)
+ (boundp 'smtpmail-default-smtp-server)
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'")))))
+ (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 (message-send-mail-function)
+(defcustom message-send-mail-function
+ (cond ((eq send-mail-function 'smtpmail-send-it) 'message-smtpmail-send-it)
+ ((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it)
+ ((eq send-mail-function 'mailclient-send-it)
+ 'message-send-mail-with-mailclient)
+ (t (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'.
:tag "Use Mailclient package")
(function :tag "Other"))
:group 'message-sending
- :version "23.1" ;; No Gnus
+ :version "23.2"
:initialize 'custom-initialize-default
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(string :tag "name")
(sexp :tag "none" :format "%t" t)))
+;; This can be the name of a buffer, or a cons cell (FUNCTION . ARGS)
+;; for yanking the original buffer.
(defvar message-reply-buffer nil)
(defvar message-reply-headers nil
"The headers of the current replied article.
:link '(custom-manual "(message)Message Headers")
:type 'message-header-lines)
-(defcustom message-default-mail-headers ""
+(defcustom message-default-mail-headers
+ ;; Ease the transition from mail-mode to message-mode. See bugs#4431, 5555.
+ (concat (if (and (boundp 'mail-default-reply-to)
+ (stringp mail-default-reply-to))
+ (format "Reply-to: %s\n" mail-default-reply-to)
+ "")
+ (if (and (boundp 'mail-self-blind)
+ mail-self-blind)
+ (format "BCC: %s\n" user-mail-address)
+ "")
+ (if (and (boundp 'mail-archive-file-name)
+ (stringp mail-archive-file-name))
+ (format "FCC: %s\n" mail-archive-file-name)
+ ""))
"*A string of header lines to be inserted in outgoing mails."
+ :version "23.2"
:group 'message-headers
:group 'message-mail
:link '(custom-manual "(message)Mail Headers")
:type '(repeat function))
(defcustom message-auto-save-directory
- (file-name-as-directory (nnheader-concat message-directory "drafts"))
+ (file-name-as-directory (expand-file-name "drafts" message-directory))
"*Directory where Message auto-saves buffers if Gnus isn't running.
If nil, Message won't auto-save."
:group 'message-buffers
(setq paren nil))))
(nreverse elems)))))
+(autoload 'nnheader-insert-file-contents "nnheader")
+
(defun message-mail-file-mbox-p (file)
"Say whether FILE looks like a Unix mbox file."
(when (and (file-exists-p file)
(defmacro message-with-reply-buffer (&rest forms)
"Evaluate FORMS in the reply buffer, if it exists."
- `(when (and message-reply-buffer
+ `(when (and (bufferp message-reply-buffer)
(buffer-name message-reply-buffer))
(with-current-buffer message-reply-buffer
,@forms)))
;;; Forbidden properties
;;
;; We use `after-change-functions' to keep special text properties
-;; that interfer with the normal function of message mode out of the
+;; that interfere with the normal function of message mode out of the
;; buffer.
(defcustom message-strip-special-text-properties t
"Widen the reply to include maximum recipients."
(interactive)
(let ((follow-to
- (and message-reply-buffer
+ (and (bufferp message-reply-buffer)
(buffer-name message-reply-buffer)
(with-current-buffer message-reply-buffer
(message-get-reply-headers t)))))
;; if message-signature-file contains a path.
(not (file-name-directory
message-signature-file)))
- (nnheader-concat message-signature-directory
- message-signature-file)
+ (expand-file-name message-signature-file
+ message-signature-directory)
message-signature-file))
(file-exists-p signature-file))))
(when signature
(point-max)))
(delete-region (message-goto-body) (point-max)))
(set (make-local-variable 'message-cite-reply-above) nil)))
- (delete-windows-on message-reply-buffer t)
+ (if (bufferp message-reply-buffer)
+ (delete-windows-on message-reply-buffer t))
(push-mark (save-excursion
- (insert-buffer-substring message-reply-buffer)
+ (cond
+ ((bufferp message-reply-buffer)
+ (insert-buffer-substring message-reply-buffer))
+ ((and (consp message-reply-buffer)
+ (functionp (car message-reply-buffer)))
+ (apply (car message-reply-buffer)
+ (cdr message-reply-buffer))))
(unless (bolp)
(insert ?\n))
(point)))
(erase-buffer)))
(kill-buffer tembuf))))
+(declare-function hashcash-wait-async "hashcash" (&optional buffer))
+
(defun message-send-mail (&optional arg)
(require 'mail-utils)
(let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
(news (message-news-p))
(mailbuf (current-buffer))
(message-this-is-mail t)
+ ;; gnus-setup-posting-charset is autoloaded in mml.el (FIXME
+ ;; maybe it should not be), which this file requires. Hence
+ ;; the fboundp test is always true. Loading it from gnus-msg
+ ;; loads many Gnus files (Bug#5642). If
+ ;; gnus-group-posting-charset-alist hasn't been customized,
+ ;; this is just going to return nil anyway. FIXME it would
+ ;; be good to improve this further, because even if g-g-p-c-a
+ ;; has been customized, that is likely to just be for news.
+ ;; Eg either move the definition from gnus-msg, or separate out
+ ;; the mail and news parts.
(message-posting-charset
- (if (fboundp 'gnus-setup-posting-charset)
+ (if (and (fboundp 'gnus-setup-posting-charset)
+ (boundp 'gnus-group-posting-charset-alist))
(gnus-setup-posting-charset nil)
message-posting-charset))
(headers message-required-mail-headers))
(when (and message-generate-hashcash
(not (eq message-generate-hashcash 'opportunistic)))
(message "Generating hashcash...")
+ (require 'hashcash)
;; Wait for calculations already started to finish...
(hashcash-wait-async)
;; ...and do calculations not already done. mail-add-payment
(defun message-send-mail-with-sendmail ()
"Send off the prepared buffer with sendmail."
+ (require 'sendmail)
(let ((errbuf (if message-interactive
(message-generate-new-buffer-clone-locals
" sendmail errors")
(defun message-smtpmail-send-it ()
"Send the prepared message buffer with `smtpmail-send-it'.
-This only differs from `smtpmail-send-it' that this command evaluates
-`message-send-mail-hook' just before sending a message. It is useful
-if your ISP requires the POP-before-SMTP authentication. See the Gnus
-manual for details."
+The only difference from `smtpmail-send-it' is that this command
+evaluates `message-send-mail-hook' just before sending a message.
+It is useful if your ISP requires the POP-before-SMTP
+authentication. See the Gnus manual for details."
(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."
+The only difference from `mailclient-send-it' is that this
+command evaluates `message-send-mail-hook' just before sending a message."
(run-hooks 'message-send-mail-hook)
(mailclient-send-it))
(prin1-to-string (recent-keys))
(prin1-to-string (garbage-collect))))))
+(defvar canlock-password)
+(defvar canlock-password-for-verify)
+
(defun message-canlock-password ()
"The password used by message for cancel locks.
This is the value of `canlock-password', if that option is non-nil.
Otherwise, generate and save a value for `canlock-password' first."
+ (require 'canlock)
(unless canlock-password
(customize-save-variable 'canlock-password (message-canlock-generate))
(setq canlock-password-for-verify canlock-password))
(message-canlock-password)
(canlock-insert-header)))
+(autoload 'nnheader-get-report "nnheader")
+
+(declare-function gnus-setup-posting-charset "gnus-msg" (group))
+
(defun message-send-news (&optional arg)
+ (require 'gnus-msg)
(let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
(case-fold-search nil)
(method (if (functionp message-post-method)
(defun message-make-references ()
"Return the References header for this message."
(when message-reply-headers
- (let ((message-id (mail-header-message-id message-reply-headers))
+ (let ((message-id (mail-header-id message-reply-headers))
(references (mail-header-references message-reply-headers)))
(if (or references message-id)
(concat (or references "") (and references " ")
(when message-reply-headers
(let ((from (mail-header-from message-reply-headers))
(date (mail-header-date message-reply-headers))
- (msg-id (mail-header-message-id message-reply-headers)))
+ (msg-id (mail-header-id message-reply-headers)))
(when from
(let ((name (mail-extract-address-components from)))
(concat
nil
mua)))
-(defun message-setup (headers &optional replybuffer actions
+;; YANK-ACTION, if non-nil, can be a buffer or a yank action of the
+;; form (FUNCTION . ARGS).
+(defun message-setup (headers &optional yank-action actions
continue switch-function)
(let ((mua (message-mail-user-agent))
- subject to field yank-action)
+ subject to field)
(if (not (and message-this-is-mail mua))
- (message-setup-1 headers replybuffer actions)
- (if replybuffer
- (setq yank-action (list 'insert-buffer replybuffer)))
+ (message-setup-1 headers yank-action actions)
(setq headers (copy-sequence headers))
(setq field (assq 'Subject headers))
(when field
(format "%s" (car item))
(cdr item)))
headers)
- continue switch-function yank-action actions)))))
+ continue switch-function
+ (if (bufferp yank-action)
+ (list 'insert-buffer yank-action)
+ yank-action)
+ actions)))))
(defun message-headers-to-generate (headers included-headers excluded-headers)
"Return a list that includes all headers from HEADERS.
(push header result)))
(nreverse result)))
-(defun message-setup-1 (headers &optional replybuffer actions)
+(defun message-setup-1 (headers &optional yank-action actions)
(dolist (action actions)
(condition-case nil
(add-to-list 'message-send-actions
`(apply ',(car action) ',(cdr action)))))
- (setq message-reply-buffer replybuffer)
+ (setq message-reply-buffer
+ (if (and (consp yank-action)
+ (eq (car yank-action) 'insert-buffer))
+ (nth 1 yank-action)
+ yank-action))
(goto-char (point-min))
;; Insert all the headers.
(mail-header-format
to continue editing a message already being composed. SWITCH-FUNCTION
is a function used to switch to and display the mail buffer."
(interactive)
- (let ((message-this-is-mail t) replybuffer)
+ (let ((message-this-is-mail t))
(unless (message-mail-user-agent)
(message-pop-to-buffer
;; Search for the existing message buffer if `continue' is non-nil.
message-generate-new-buffers)))
(message-buffer-name "mail" to))
switch-function))
- ;; FIXME: message-mail should do something if YANK-ACTION is not
- ;; insert-buffer.
- (and (consp yank-action) (eq (car yank-action) 'insert-buffer)
- (setq replybuffer (nth 1 yank-action)))
(message-setup
(nconc
`((To . ,(or to "")) (Subject . ,(or subject "")))
(when other-headers other-headers))
- replybuffer send-actions continue switch-function)
+ yank-action send-actions continue switch-function)
;; FIXME: Should return nil if failure.
t))
(not result)
result)))
+(declare-function ecomplete-add-item "ecomplete" (type key text))
+(declare-function ecomplete-save "ecomplete" ())
+
(defun message-put-addresses-in-ecomplete ()
+ (require 'ecomplete)
(dolist (header '("to" "cc" "from" "reply-to"))
(let ((value (message-field-value header)))
(dolist (string (mail-header-parse-addresses value 'raw))
string))))
(ecomplete-save))
+(autoload 'ecomplete-display-matches "ecomplete")
+
(defun message-display-abbrev (&optional choose)
"Display the next possible abbrev for the text before point."
(interactive (list t))
HCoop / bpt / emacs.git / blobdiff