;;; message.el --- composing mail and news messages
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 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/
:group 'message-interface
:type 'regexp)
-(defcustom message-from-style 'default
+(defcustom message-from-style mail-from-style
+;; Default to the value of `mail-from-style', available in all Emacsen
+;; that Gnus supports.
"*Specifies how \"From\" headers look.
If nil, they contain just the return address like:
Otherwise, most addresses look like `angles', but they look like
`parens' if `angles' would need quoting and `parens' would not."
+ :version "23.2"
:type '(choice (const :tag "simple" nil)
(const parens)
(const angles)
:link '(custom-manual "(message)Various Commands")
:group 'message-various)
-(defcustom message-interactive t
+(defcustom message-interactive mail-interactive
+;; Default to the value of `mail-interactive', available in all Emacsen
+;; that Gnus supports.
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors."
+ :version "23.2"
:group 'message-sending
:group 'message-mail
:link '(custom-manual "(message)Sending Variables")
:type 'boolean)
+(defcustom message-confirm-send nil
+ "When non-nil, ask for confirmation when sending a message."
+ :group 'message-sending
+ :group 'message-mail
+ :version "23.1" ;; No Gnus
+ :link '(custom-manual "(message)Sending Variables")
+ :type 'boolean)
+
(defcustom message-generate-new-buffers 'unique
"*Say whether to create a new message buffer to compose a message.
Valid values include:
:type 'regexp)
(defcustom message-cite-prefix-regexp
- (if (string-match "[[:digit:]]" "1")
- ;; Support POSIX? XEmacs 21.5.27 doesn't.
- "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+"
- ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
- (let (non-word-constituents)
- (with-syntax-table text-mode-syntax-table
- (setq non-word-constituents
- (concat
- (if (string-match "\\w" "_") "" "_")
- (if (string-match "\\w" ".") "" "."))))
- (if (equal non-word-constituents "")
- "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+"
- (concat "\\([ \t]*\\(\\w\\|["
- non-word-constituents
- "]\\)+>+\\|[ \t]*[]>|}]\\)+"))))
+ ;; Default to the value of `mail-citation-prefix-regexp' if available.
+ ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (cond ((boundp 'mail-citation-prefix-regexp)
+ mail-citation-prefix-regexp)
+ ((string-match "[[:digit:]]" "1")
+ ;; Support POSIX? XEmacs 21.5.27 doesn't.
+ "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+")
+ (t
+ ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
+ (let (non-word-constituents)
+ (with-syntax-table text-mode-syntax-table
+ (setq non-word-constituents
+ (concat
+ (if (string-match "\\w" "_") "" "_")
+ (if (string-match "\\w" ".") "" "."))))
+ (if (equal non-word-constituents "")
+ "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+"
+ (concat "\\([ \t]*\\(\\w\\|["
+ non-word-constituents
+ "]\\)+>+\\|[ \t]*[]>|}]\\)+")))))
"*Regexp matching the longest possible citation prefix on a line."
- :version "22.1"
+ :version "23.2"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'regexp
: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)
:link '(custom-manual "(message)Mail Variables")
:type 'boolean)
-(defcustom message-sendmail-envelope-from nil
+(defcustom message-sendmail-envelope-from
+ ;; Default to the value of `mail-envelope-from' if available.
+ ;; Note: as for Emacsen that Gnus supports, except for SXEmacs, it is
+ ;; unavailable unless sendmail.el is loaded.
+ (if (boundp 'mail-envelope-from) mail-envelope-from)
"*Envelope-from when sending mail with sendmail.
If this is nil, use `user-mail-address'. If it is the symbol
`header', use the From: header of the message."
- :version "22.1"
+ :version "23.2"
:type '(choice (string :tag "From name")
(const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
:version "23.1" ;; No Gnus
:group 'message-insertion)
-(defcustom message-yank-prefix "> "
+(defcustom message-yank-prefix
+ ;; Default to the value of `mail-yank-prefix' if available.
+ ;; Note: as for Emacs 21, it is unavailable unless sendmail.el is loaded.
+ (if (boundp 'mail-yank-prefix) mail-yank-prefix "> ")
"*Prefix inserted on the lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
See also `message-yank-cited-prefix' and `message-yank-empty-prefix'."
+ :version "23.2"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-(defcustom message-indentation-spaces 3
+(defcustom message-indentation-spaces
+ ;; Default to the value of `mail-indentation-spaces' if available.
+ ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (if (boundp 'mail-indentation-spaces) mail-indentation-spaces 3)
"*Number of spaces to insert at the beginning of each cited line.
Used by `message-yank-original' via `message-yank-cite'."
+ :version "23.2"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-(defcustom message-signature t
+(defcustom message-signature mail-signature
+ ;; Default to the value of `mail-signature', available in all Emacsen
+ ;; that Gnus supports.
"*String to be inserted at the end of the message buffer.
If t, the `message-signature-file' file will be inserted instead.
If a function, the result from the function will be used instead.
If a form, the result from the form will be used instead."
+ :version "23.2"
:type 'sexp
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
-(defcustom message-signature-file "~/.signature"
+(defcustom message-signature-file
+ ;; Default to the value of `mail-signature-file' if available.
+ ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (if (boundp 'mail-signature-file) mail-signature-file "~/.signature")
"*Name of file containing the text inserted at end of message buffer.
Ignored if the named file doesn't exist.
If nil, don't insert a signature.
If a path is specified, the value of `message-signature-directory' is ignored,
even if set."
+ :version "23.2"
:type '(choice file (const :tags "None" nil))
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(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.
:valid-regexp "^\\'"
:error "All header lines must be newline terminated")
-(defcustom message-default-headers ""
+(defcustom message-default-headers
+ ;; Default to the value of `mail-default-headers' if available.
+ ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (if (boundp 'mail-default-headers) mail-default-headers "")
"*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."
+ :version "23.2"
:group 'message-headers
: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
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-to-face 'face-alias 'message-header-to)
+(put 'message-header-to-face 'obsolete-face "22.1")
(defface message-header-cc
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-cc-face 'face-alias 'message-header-cc)
+(put 'message-header-cc-face 'obsolete-face "22.1")
(defface message-header-subject
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-subject-face 'face-alias 'message-header-subject)
+(put 'message-header-subject-face 'obsolete-face "22.1")
(defface message-header-newsgroups
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
+(put 'message-header-newsgroups-face 'obsolete-face "22.1")
(defface message-header-other
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-other-face 'face-alias 'message-header-other)
+(put 'message-header-other-face 'obsolete-face "22.1")
(defface message-header-name
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-name-face 'face-alias 'message-header-name)
+(put 'message-header-name-face 'obsolete-face "22.1")
(defface message-header-xheader
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-xheader-face 'face-alias 'message-header-xheader)
+(put 'message-header-xheader-face 'obsolete-face "22.1")
(defface message-separator
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-separator-face 'face-alias 'message-separator)
+(put 'message-separator-face 'obsolete-face "22.1")
(defface message-cited-text
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-cited-text-face 'face-alias 'message-cited-text)
+(put 'message-cited-text-face 'obsolete-face "22.1")
(defface message-mml
'((((class color)
:group 'message-faces)
;; backward-compatibility alias
(put 'message-mml-face 'face-alias 'message-mml)
+(put 'message-mml-face 'obsolete-face "22.1")
(defun message-font-lock-make-header-matcher (regexp)
(let ((form
:group 'message-headers
:type 'regexp)
-(eval-and-compile
- (autoload 'gnus-alive-p "gnus-util")
- (autoload 'gnus-delay-article "gnus-delay")
- (autoload 'gnus-extract-address-components "gnus-util")
- (autoload 'gnus-find-method-for-group "gnus")
- (autoload 'gnus-group-decoded-name "gnus-group")
- (autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'gnus-group-name-decode "gnus-group")
- (autoload 'gnus-groups-from-server "gnus")
- (autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'gnus-open-server "gnus-int")
- (autoload 'gnus-output-to-mail "gnus-util")
- (autoload 'gnus-output-to-rmail "gnus-util")
- (autoload 'gnus-request-post "gnus-int")
- (autoload 'gnus-select-frame-set-input-focus "gnus-util")
- (autoload 'gnus-server-string "gnus")
- (autoload 'idna-to-ascii "idna")
- (autoload 'message-setup-toolbar "messagexmas")
- (autoload 'mh-new-draft-name "mh-comp")
- (autoload 'mh-send-letter "mh-comp")
- (autoload 'nndraft-request-associate-buffer "nndraft")
- (autoload 'nndraft-request-expire-articles "nndraft")
- (autoload 'nnvirtual-find-group-art "nnvirtual")
- (autoload 'rmail-dont-reply-to "mail-utils")
- (autoload 'rmail-msg-is-pruned "rmail")
- (autoload 'rmail-msg-restore-non-pruned-header "rmail")
- (autoload 'rmail-output "rmailout"))
+(autoload 'gnus-alive-p "gnus-util")
+(autoload 'gnus-delay-article "gnus-delay")
+(autoload 'gnus-extract-address-components "gnus-util")
+(autoload 'gnus-find-method-for-group "gnus")
+(autoload 'gnus-group-decoded-name "gnus-group")
+(autoload 'gnus-group-name-charset "gnus-group")
+(autoload 'gnus-group-name-decode "gnus-group")
+(autoload 'gnus-groups-from-server "gnus")
+(autoload 'gnus-make-local-hook "gnus-util")
+(autoload 'gnus-open-server "gnus-int")
+(autoload 'gnus-output-to-mail "gnus-util")
+(autoload 'gnus-output-to-rmail "gnus-util")
+(autoload 'gnus-request-post "gnus-int")
+(autoload 'gnus-select-frame-set-input-focus "gnus-util")
+(autoload 'gnus-server-string "gnus")
+(autoload 'idna-to-ascii "idna")
+(autoload 'message-setup-toolbar "messagexmas")
+(autoload 'mh-new-draft-name "mh-comp")
+(autoload 'mh-send-letter "mh-comp")
+(autoload 'nndraft-request-associate-buffer "nndraft")
+(autoload 'nndraft-request-expire-articles "nndraft")
+(autoload 'nnvirtual-find-group-art "nnvirtual")
+(autoload 'rmail-dont-reply-to "mail-utils")
+(autoload 'rmail-msg-is-pruned "rmail")
+(autoload 'rmail-output "rmailout")
\f
(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)))
(point-max)))
(goto-char (point-min)))
+;; FIXME: clarify diffference: message-narrow-to-head,
+;; message-narrow-to-headers-or-head, message-narrow-to-headers
(defun message-narrow-to-head ()
"Narrow the buffer to the head of the message.
Point is left at the beginning of the narrowed-to region."
manual. With two \\[universal-argument]'s, display the EasyPG or
PGG manual, depending on the value of `mml2015-use'."
(interactive "p")
- ;; Why not `info', which is in loaddefs.el?
+ ;; Don't use `info' because support for `(filename)nodename' is not
+ ;; available in XEmacs < 21.5.12.
(Info-goto-node (format "(%s)Top"
(cond ((eq arg 16)
(require 'mml2015)
;;; 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)))
(>= i ?a)))
(push i lst)
(push (condition-case nil
- (progn (format-time-string (format "%%%c" i)
- replydate))
- (format ">%c<" i))
+ (format-time-string (format "%%%c" i) replydate)
+ (error (format ">%c<" i)))
lst))
(setq i (1+ i)))
(reverse lst)))
(put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
(run-hooks 'message-send-hook)
+ (when message-confirm-send
+ (or (y-or-n-p "Send message? ")
+ (keyboard-quit)))
(message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
(and (mm-multibyte-p)
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
+ ;; Emacs 23, Bug#1770:
+ eight-bit
control-1))
(not (get-text-property
(point) 'untranslated-utf-8))))
(or (< (mm-char-int char) 128)
(and (mm-multibyte-p)
;; FIXME: Wrong for Emacs 23 (unicode) and for
- ;; things like undecable utf-8. Should at least
- ;; use find-coding-systems-region.
+ ;; things like undecodable utf-8 (in Emacs 21?).
+ ;; Should at least use find-coding-systems-region.
+ ;; -- fx
(memq (char-charset char)
'(eight-bit-control eight-bit-graphic
+ ;; Emacs 23, Bug#1770:
+ eight-bit
control-1))
(not (get-text-property
(point) 'untranslated-utf-8)))))
(not (y-or-n-p
(format
"Address `%s' might be bogus. Continue? " bog)))
- (error "Bogus address."))))))))
+ (error "Bogus address"))))))))
(custom-add-option 'message-setup-hook 'message-check-recipients)
(end-of-line)
(insert (format " (%d/%d)" n total))
(widen)
- (mm-with-unibyte-current-buffer
- (funcall (or message-send-mail-real-function
- message-send-mail-function))))
+ (funcall (or message-send-mail-real-function
+ message-send-mail-function)))
(setq n (+ n 1))
(setq p (pop plist))
(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
(message-fetch-field
"content-transfer-encoding")))))))
(message-insert-courtesy-copy))
+ ;; Let's make sure we encoded all the body.
+ (assert (save-excursion
+ (goto-char (point-min))
+ (not (re-search-forward "[^\000-\377]" nil t))))
+ (mm-disable-multibyte)
(if (or (not message-send-mail-partially-limit)
(< (buffer-size) message-send-mail-partially-limit)
(not (message-y-or-n-p
If you always want Gnus to send messages in one piece, set
`message-send-mail-partially-limit' to nil.
")))
- (mm-with-unibyte-current-buffer
+ (progn
(message "Sending via mail...")
(funcall (or message-send-mail-real-function
message-send-mail-function)))
(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")
;; since some systems have broken sendmails.
;; But some systems are more broken with -f, so
;; we'll let users override this.
- (if (null message-sendmail-f-is-evil)
- (list "-f" (message-sendmail-envelope-from)))
+ (and (null message-sendmail-f-is-evil)
+ (list "-f" (message-sendmail-envelope-from)))
;; These mean "report errors by mail"
;; and "deliver in background".
(if (null message-interactive) '("-oem" "-odb"))
(list resend-to-addresses)
'("-t"))))))
(unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
+ (if errbuf (pop-to-buffer errbuf))
(error "Sending...failed with exit value %d" cpr)))
(when message-interactive
(with-current-buffer errbuf
(apply
'call-process-region (point-min) (point-max)
message-qmail-inject-program nil nil nil
- ;; qmail-inject's default behaviour is to look for addresses on the
+ ;; qmail-inject's default behavior is to look for addresses on the
;; command line; if there're none, it scans the headers.
;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
;;
(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)
"Denied posting -- the From looks strange: \"%s\"." from)
nil)
((let ((addresses (rfc822-addresses from)))
- (while (and addresses
+ ;; `rfc822-addresses' returns a string if parsing fails.
+ (while (and (consp addresses)
(not (eq (string-to-char (car addresses)) ?\()))
(setq addresses (cdr addresses)))
addresses)
nil)))
;; Check the length of the signature.
(message-check 'signature
- (goto-char (point-max))
- (if (not (re-search-backward message-signature-separator nil t))
- t
- (if (>= (count-lines (1+ (point-at-eol)) (point-max)) 5)
- (if (message-gnksa-enable-p 'signature)
- (y-or-n-p
- (format "Signature is excessively long (%d lines). Really post? "
- (count-lines (1+ (point-at-eol)) (point-max))))
- (message "Denied posting -- Excessive signature.")
- nil)
- t)))
+ (let (sig-start sig-end)
+ (goto-char (point-max))
+ (if (not (re-search-backward message-signature-separator nil t))
+ t
+ (setq sig-start (1+ (point-at-eol)))
+ (setq sig-end
+ (if (re-search-forward
+ "<#/?\\(multipart\\|part\\|external\\|mml\\)" nil t)
+ (- (point-at-bol) 1)
+ (point-max)))
+ (if (>= (count-lines sig-start sig-end) 5)
+ (if (message-gnksa-enable-p 'signature)
+ (y-or-n-p
+ (format "Signature is excessively long (%d lines). Really post? "
+ (count-lines sig-start sig-end)))
+ (message "Denied posting -- Excessive signature.")
+ nil)
+ t))))
;; Ensure that text follows last quoted portion.
(message-check 'quoting-style
(goto-char (point-max))
(if (and message-fcc-handler-function
(not (eq message-fcc-handler-function 'rmail-output)))
(funcall message-fcc-handler-function file)
+ ;; FIXME this option, rmail-output (also used if
+ ;; message-fcc-handler-function is nil) is not
+ ;; documented anywhere AFAICS. It should work in Emacs
+ ;; 23; I suspect it does not work in Emacs 22.
+ ;; FIXME I don't see the need for the two different cases here.
+ ;; mail-use-rfc822 makes no difference (in Emacs 23),and
+ ;; the third argument just controls \"Wrote file\" message.
(if (and (file-readable-p file) (mail-file-babyl-p file))
(rmail-output file 1 nil t)
(let ((mail-use-rfc822 t))
(* 25 25)))
(let ((tm (current-time)))
(concat
- (if (or (memq system-type '(ms-dos emx vax-vms))
+ (if (or (memq system-type '(ms-dos emx))
;; message-number-base36 doesn't handle bigints.
(floatp (user-uid)))
(let ((user (downcase (user-login-name))))
(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
(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
(mapcar 'downcase
(mapcar
- 'car (mail-header-parse-addresses field))))))
- (setq ace (if (string-match "\\`[[:ascii:]]+\\'" rhs)
+ 'cadr
+ (mail-extract-address-components field t))))))
+ ;; Note that `rhs' will be "" if the address does not have
+ ;; the domain part, i.e., if it is a local user's address.
+ (setq ace (if (string-match "\\`[[:ascii:]]*\\'" rhs)
rhs
(downcase (idna-to-ascii rhs))))
(when (and (not (equal rhs ace))
(when message-use-idna
(save-excursion
(save-restriction
- (message-narrow-to-head)
+ ;; `message-narrow-to-head' that recognizes only the first empty
+ ;; line as the message header separator used to be used here.
+ ;; However, since there is the "--text follows this line--" line
+ ;; normally, it failed in narrowing to the headers and potentially
+ ;; caused the IDNA encoding on lines that look like headers in
+ ;; the message body.
+ (message-narrow-to-headers-or-head)
(message-idna-to-ascii-rhs-1 "From")
(message-idna-to-ascii-rhs-1 "To")
(message-idna-to-ascii-rhs-1 "Reply-To")
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
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
+
+ ;; If Gnus were alive, draft messages would be saved in the drafts folder.
+ ;; But Gnus is not alive, so arrange to save the draft message in a
+ ;; regular file in message-auto-save-directory. Append a unique
+ ;; time-based suffix to the filename to allow multiple drafts to be saved
+ ;; simultaneously without overwriting each other (which mimics the
+ ;; functionality of the Gnus drafts folder).
(setq buffer-file-name (expand-file-name
+ (concat
(if (memq system-type
'(ms-dos ms-windows windows-nt
cygwin cygwin32 win32 w32
mswindows))
"message"
"*message*")
+ (format-time-string "-%Y%m%d-%H%M%S"))
message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
(clear-visited-file-modtime)
"Disassociate the message buffer from the drafts directory."
(when message-draft-article
(nndraft-request-expire-articles
- (list message-draft-article) "nndraft:drafts" nil t)))
+ (list message-draft-article) "drafts" nil t)))
(defun message-insert-headers ()
"Generate the headers for the article."
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))
(interactive)
(let ((file-name (make-auto-save-file-name)))
(cond ((save-window-excursion
- (if (not (eq system-type 'vax-vms))
- (with-output-to-temp-buffer "*Directory*"
- (with-current-buffer standard-output
- (fundamental-mode)) ; for Emacs 20.4+
- (buffer-disable-undo standard-output)
- (let ((default-directory "/"))
- (call-process
- "ls" nil standard-output nil "-l" file-name))))
+ (with-output-to-temp-buffer "*Directory*"
+ (with-current-buffer standard-output
+ (fundamental-mode)) ; for Emacs 20.4+
+ (buffer-disable-undo standard-output)
+ (let ((default-directory "/"))
+ (call-process
+ "ls" nil standard-output nil "-l" file-name)))
(yes-or-no-p (format "Recover auto save file %s? " file-name)))
(let ((buffer-read-only nil))
(erase-buffer)
(message-forward-make-body-digest-mime forward-buffer)
(message-forward-make-body-digest-plain forward-buffer)))
-(eval-and-compile
- (autoload 'mm-uu-dissect-text-parts "mm-uu")
- (autoload 'mm-uu-dissect "mm-uu"))
+(autoload 'mm-uu-dissect-text-parts "mm-uu")
+(autoload 'mm-uu-dissect "mm-uu")
(defun message-signed-or-encrypted-p (&optional dont-emulate-mime handles)
"Say whether the current buffer contains signed or encrypted message.
(message-forward-make-body-plain forward-buffer)))
(message-position-point))
+(declare-function rmail-toggle-header "rmail" (&optional arg))
+
;;;###autoload
(defun message-forward-rmail-make-body (forward-buffer)
(save-window-excursion
(set-buffer forward-buffer)
(if (rmail-msg-is-pruned)
- (rmail-msg-restore-non-pruned-header)))
+ (if (fboundp 'rmail-msg-restore-non-pruned-header)
+ (rmail-msg-restore-non-pruned-header) ; Emacs 22
+ (rmail-toggle-header 0)))) ; Emacs 23
(message-forward-make-body forward-buffer))
;; Fixme: Should have defcustom.
(defun message-exchange-point-and-mark ()
"Exchange point and mark, but don't activate region if it was inactive."
- (unless (prog1
- (message-mark-active-p)
- (exchange-point-and-mark))
- (setq mark-active nil)))
+ (goto-char (prog1 (mark t)
+ (set-marker (mark-marker) (point)))))
(defalias 'message-make-overlay 'make-overlay)
(defalias 'message-delete-overlay 'delete-overlay)
(point))
(skip-chars-backward "^, \t\n") (point))))
(completion-ignore-case t)
- (string (buffer-substring b (progn (skip-chars-forward "^,\t\n ")
- (point))))
- (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
- (completions (all-completions string hashtb))
- comp)
- (delete-region b (point))
- (cond
- ((= (length completions) 1)
- (if (string= (car completions) string)
- (progn
- (insert string)
- (message "Only matching group"))
- (insert (car completions))))
- ((and (setq comp (try-completion string hashtb))
- (not (string= comp string)))
- (insert comp))
- (t
- (insert string)
- (if (not comp)
- (message "No matching groups")
- (save-selected-window
- (pop-to-buffer "*Completions*")
- (buffer-disable-undo)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (message-display-completion-list (sort completions 'string<)
- string))
- (setq buffer-read-only nil)
- (goto-char (point-min))
- (delete-region (point) (progn (forward-line 3) (point))))))))))
+ (e (progn (skip-chars-forward "^,\t\n ") (point)))
+ (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)))
+ (message-completion-in-region e b hashtb)))
+
+(defalias 'message-completion-in-region
+ (if (fboundp 'completion-in-region)
+ 'completion-in-region
+ (lambda (e b hashtb)
+ (let* ((string (buffer-substring b e))
+ (completions (all-completions string hashtb))
+ comp)
+ (delete-region b (point))
+ (cond
+ ((= (length completions) 1)
+ (if (string= (car completions) string)
+ (progn
+ (insert string)
+ (message "Only matching group"))
+ (insert (car completions))))
+ ((and (setq comp (try-completion string hashtb))
+ (not (string= comp string)))
+ (insert comp))
+ (t
+ (insert string)
+ (if (not comp)
+ (message "No matching groups")
+ (save-selected-window
+ (pop-to-buffer "*Completions*")
+ (buffer-disable-undo)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (let ((standard-output (current-buffer)))
+ (message-display-completion-list (sort completions 'string<)
+ string))
+ (setq buffer-read-only nil)
+ (goto-char (point-min))
+ (delete-region (point)
+ (progn (forward-line 3) (point))))))))))))
(defun message-expand-name ()
(cond ((and (memq 'eudc message-expand-name-databases)
(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