;;; 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.
+;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
;;; Code:
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(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-buffers
:type '(choice function (const nil)))
+(defcustom message-cite-style nil
+ "The overall style to be used when yanking cited text.
+Values are either `traditional' (cited text first),
+`top-post' (cited text at the bottom), or nil (don't override the
+individual message variables)."
+ :version "24.1"
+ :group 'message-various
+ :type '(choice (const :tag "None" :value nil)
+ (const :tag "Traditional" :value traditional)
+ (const :tag "Top-post" :value top-post)))
+
(defcustom message-fcc-handler-function 'message-output
"*A function called to save outgoing articles.
This function will be called with the name of the file to store the
:type 'regexp)
(defcustom message-from-style 'default
- "*Specifies how \"From\" headers look.
+ ;; In Emacs 24.1 this defaults to the value of `mail-from-style'
+ ;; that defaults to:
+ ;; `angles' in Emacs 22.1~23.1, XEmacs 21.4, 21.5, and SXEmacs 22.1;
+ ;; `system-default' in Emacs 23.2, and 24.1
+ "Specifies how \"From\" headers look.
If nil, they contain just the return address like:
king@grassland.com
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)Message Headers")
:type '(repeat sexp))
+(defcustom message-prune-recipient-rules nil
+ "Rules for how to prune the list of recipients when doing wide replies.
+This is a list of regexps and regexp matches."
+ :version "24.1"
+ :group 'message-mail
+ :group 'message-headers
+ :link '(custom-manual "(message)Wide Reply")
+ :type '(repeat regexp))
+
(defcustom message-deletable-headers '(Message-ID Date Lines)
"Headers to be deleted if they already exist and were generated by message previously."
:group 'message-headers
regexp))
(defcustom message-ignored-mail-headers
- "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
+ "^\\([GF]cc\\|Resent-Fcc\\|Xref\\|X-Draft-From\\|X-Gnus-Agent-Meta-Information\\):"
"*Regexp of headers to be removed unconditionally before mailing."
:group 'message-mail
:group 'message-headers
:link '(custom-manual "(message)Mail Headers")
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:\\|^Injection-Date:\\|^Injection-Info:"
"*Header lines matching this regexp will be deleted before posting.
It's best to delete old Path and Date headers before posting to avoid
any confusion."
;;; Start of variables adopted from `message-utils.el'.
-(defcustom message-subject-trailing-was-query 'ask
+(defcustom message-subject-trailing-was-query t
"*What to do with trailing \"(was: <old subject>)\" in subject lines.
If nil, leave the subject unchanged. If it is the symbol `ask', query
the user what do do. In this case, the subject is matched against
`message-subject-trailing-was-query' is t, always strip the trailing
old subject. In this case, `message-subject-trailing-was-regexp' is
used."
- :version "22.1"
+ :version "24.1"
:type '(choice (const :tag "never" nil)
(const :tag "always strip" t)
(const ask))
:group 'message-various)
(defcustom message-subject-trailing-was-ask-regexp
- "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
+ "[ \t]*\\([[(]+[Ww][Aa][Ss]:?[ \t]*.*[])]+\\)"
"*Regexp matching \"(was: <old subject>)\" in the subject line.
The function `message-strip-subject-trailing-was' uses this regexp if
:group 'message-various)
(defcustom message-interactive t
+ ;; In Emacs 24.1 this defaults to the value of `mail-interactive'
+ ;; that defaults to:
+ ;; `nil' in Emacs 22.1~22.3, XEmacs 21.4, 21.5, and SXEmacs 22.1;
+ ;; `t' in Emacs 23.1~24.1
"Non-nil means when sending a message wait for and display errors.
-nil means let mailer mail back a message to report errors."
+A value of 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")
:link '(custom-manual "(message)Sending Variables")
:type 'boolean)
-(defcustom message-generate-new-buffers 'unique
+(defcustom message-generate-new-buffers 'unsent
"*Say whether to create a new message buffer to compose a message.
Valid values include:
If this is a function, call that function with three parameters:
The type, the To address and the group name (any of these may be nil).
The function should return the new buffer name."
+ :version "24.1"
:group 'message-buffers
:link '(custom-manual "(message)Message Buffers")
:type '(choice (const nil)
:group 'message-buffers
:type 'boolean)
-(defvar gnus-local-organization)
(defcustom message-user-organization
- (or (and (boundp 'gnus-local-organization)
- (stringp gnus-local-organization)
- gnus-local-organization)
- (getenv "ORGANIZATION")
- t)
- "*String to be used as an Organization header.
+ (or (getenv "ORGANIZATION") t)
+ "String to be used as an Organization header.
If t, use `message-user-organization-file'."
:group 'message-headers
:type '(choice string
:type 'regexp)
(defcustom message-cite-prefix-regexp
+ ;; In Emacs 24.1 this defaults to the value of
+ ;; `mail-citation-prefix-regexp'; the default value varies according
+ ;; to the Emacs version. In XEmacs 21.4 and 21.5, sendmail.el
+ ;; provides it.
(if (string-match "[[:digit:]]" "1")
;; Support POSIX? XEmacs 21.5.27 doesn't.
- "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+"
+ "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|]\\)+"
;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
(let (non-word-constituents)
(with-syntax-table text-mode-syntax-table
(if (string-match "\\w" "_") "" "_")
(if (string-match "\\w" ".") "" "."))))
(if (equal non-word-constituents "")
- "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+"
+ "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|]\\)+"
(concat "\\([ \t]*\\(\\w\\|["
non-word-constituents
- "]\\)+>+\\|[ \t]*[]>|}]\\)+"))))
+ "]\\)+>+\\|[ \t]*[]>|]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
- :version "22.1"
+ :version "24.1"
: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)
:type 'boolean)
(defcustom message-sendmail-envelope-from nil
+ ;; In Emacs 24.1 this defaults to the value of `mail-envelope-from'
+ ;; if it is available, or defaults to nil. sendmail.el provides it;
+ ;; the default value is nil in all (X)Emacsen that Gnus supports.
"*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))
(defcustom message-qmail-inject-args nil
"Arguments passed to qmail-inject programs.
-This should be a list of strings, one string for each argument. It
-may also be a function.
+This should be a list of strings, one string for each argument.
+It may also be a function.
For e.g., if you wish to set the envelope sender address so that bounces
go to the right place or to deal with listserv's usage of that address, you
;; create a dependence to `gnus.el'.
:type 'sexp)
-;; FIXME: This should be a temporary workaround until someone implements a
-;; proper solution. If a crash happens while replying, the auto-save file
-;; will *not* have a `References:' header if `message-generate-headers-first'
-;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
-(defcustom message-generate-headers-first '(references)
+(defcustom message-generate-headers-first nil
"Which headers should be generated before starting to compose a message.
If t, generate all required headers. This can also be a list of headers to
generate. The variables `message-required-news-headers' and
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "None" nil)
- (const :tag "References" '(references))
(const :tag "All" t)
(repeat (sexp :tag "Header"))))
:group 'message-insertion)
(defcustom message-yank-prefix "> "
+ ;; In Emacs 24.1 this defaults to the value of `mail-yank-prefix'
+ ;; that defaults to:
+ ;; `nil' in Emacs 22.1~23.1;
+ ;; "> " in Emacs 23.2, 24.1, XEmacs 21.4, 21.5, and SXEmacs 22.1
"*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)
:group 'message-insertion)
(defcustom message-indentation-spaces 3
+ ;; In Emacs 24.1 this defaults to the value of
+ ;; `mail-indentation-spaces' that defaults to `3' in Emacs 22.1~24.1,
+ ;; and SXEmacs 22.1. In XEmacs 21.4 and 21.5, sendmail.el provides
+ ;; it; the defalut value is `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)
:group 'message-insertion)
(defcustom message-signature t
+ ;; In Emacs 24.1 this defaults to the value of `mail-signature' that
+ ;; defaults to:
+ ;; `nil' in Emacs 22.1~23.1, XEmacs 21.4, 21.5, and SXEmacs 22.1;
+ ;; `t' in Emacs 23.2, and 24.1
"*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"
+ ;; In Emacs 24.1 this defaults to the value of `mail-signature-file'
+ ;; that defaults to "~/.signature" in Emacs 22.1~24.1, and SXEmacs
+ ;; 22.1. In XEmacs 21.4 and 21.5, sendmail.el provides it;
+ ;; the defalut value is "~/.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.
(defvar message-checksum nil)
(defvar message-send-actions nil
"A list of actions to be performed upon successful sending of a message.")
+(defvar message-return-action nil
+ "Action to return to the caller after sending or postphoning a message.")
(defvar message-exit-actions nil
"A list of actions to be performed upon exiting after sending a message.")
(defvar message-kill-actions nil
:error "All header lines must be newline terminated")
(defcustom message-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."
+ "Header lines to be inserted in outgoing messages.
+This can be set to a string containing or a function returning
+header lines to be inserted before you edit the message, so you
+can edit or delete these lines. If set to a function, it is
+called and its result is inserted."
+ :version "23.2"
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
- :type 'message-header-lines)
-
-(defcustom message-default-mail-headers ""
+ :type '(choice
+ (message-header-lines :tag "String")
+ (function :tag "Function")))
+
+(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))
+ ;; Use the value of `mail-default-headers' if available.
+ ;; Note: as for XEmacs 21.4 and 21.5, it is unavailable
+ ;; unless sendmail.el is loaded.
+ (if (boundp 'mail-default-headers)
+ mail-default-headers))
"*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")
(if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
system-configuration)
(file-readable-p "/etc/sendmail.cf")
- (let ((buffer (get-buffer-create " *temp*")))
- (unwind-protect
- (with-current-buffer buffer
- (insert-file-contents "/etc/sendmail.cf")
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (re-search-forward "^OR\\>" nil t)))
- (kill-buffer buffer))))
+ (with-temp-buffer
+ (insert-file-contents "/etc/sendmail.cf")
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (re-search-forward "^OR\\>" nil t))))
;; According to RFC822, "The field-name must be composed of printable
;; ASCII characters (i. e., characters that have decimal values between
;; 33 and 126, except colon)", i. e., any chars except ctl chars,
: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
and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
-(defcustom message-send-mail-partially-limit 1000000
+(defcustom message-send-mail-partially-limit nil
"The limitation of messages sent as message/partial.
The lower bound of message size in characters, beyond which the message
should be sent in several parts. If it is nil, the size is unlimited."
- :version "21.1"
+ :version "24.1"
:group 'message-buffers
:link '(custom-manual "(message)Mail Variables")
:type '(choice (const :tag "unlimited" nil)
(const :tag "Never" nil)
(const :tag "Always" t)))
-(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
+(defcustom message-generate-hashcash (if (executable-find "hashcash") 'opportunistic)
"*Whether to generate X-Hashcash: headers.
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).
You must have the \"hashcash\" binary installed, see `hashcash-path'."
+ :version "24.1"
:group 'message-headers
:link '(custom-manual "(message)Mail Headers")
:type '(choice (const :tag "Always" t)
(defvar message-mime-part nil)
(defvar message-posting-charset nil)
(defvar message-inserted-headers nil)
+(defvar message-inhibit-ecomplete nil)
;; Byte-compiler warning
(defvar gnus-active-hashtb)
(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)))
(defun message-change-subject (new-subject)
"Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
- ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
(interactive
(list
(read-from-minibuffer "New subject: ")))
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)
(define-key message-mode-map "\C-a" 'message-beginning-of-line)
(define-key message-mode-map "\t" 'message-tab)
- (define-key message-mode-map "\M-;" 'comment-region)
(define-key message-mode-map "\M-n" 'message-display-abbrev))
;;; 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
(inhibit-read-only t))
(remove-text-properties begin end message-forbidden-properties))))
+(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
+
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
"Major mode for editing mail and news to be sent.
(set (make-local-variable 'message-reply-buffer) nil)
(set (make-local-variable 'message-inserted-headers) nil)
(set (make-local-variable 'message-send-actions) nil)
+ (set (make-local-variable 'message-return-action) nil)
(set (make-local-variable 'message-exit-actions) nil)
(set (make-local-variable 'message-kill-actions) nil)
(set (make-local-variable 'message-postpone-actions) nil)
(mail-aliases-setup))))
((message-mail-alias-type-p 'ecomplete)
(ecomplete-setup)))
+ (add-hook 'completion-at-point-functions 'message-completion-function nil t)
(unless buffer-file-name
(message-set-auto-save-file-name))
(unless (buffer-base-buffer)
(interactive)
(message-position-on-field "Summary" "Subject"))
-(defun message-goto-body (&optional interactivep)
+(eval-when-compile
+ (defmacro message-called-interactively-p (kind)
+ (condition-case nil
+ (progn
+ (eval '(called-interactively-p 'any))
+ ;; Emacs >=23.2
+ `(called-interactively-p ,kind))
+ ;; Emacs <23.2
+ (wrong-number-of-arguments '(called-interactively-p))
+ ;; XEmacs
+ (void-function '(interactive-p)))))
+
+(defun message-goto-body ()
"Move point to the beginning of the message body."
- (interactive (list t))
- (when (and interactivep
+ (interactive)
+ (when (and (message-called-interactively-p 'any)
(looking-at "[ \t]*\n"))
(expand-abbrev))
(goto-char (point-min))
(defun message-in-body-p ()
"Return t if point is in the message body."
- (let ((body (save-excursion (message-goto-body) (point))))
+ (let ((body (save-excursion (message-goto-body))))
(>= (point) body)))
(defun message-goto-eoh ()
"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)))))
(defun message-kill-to-signature (&optional arg)
"Kill all text up to the signature.
-If a numberic argument or prefix arg is given, leave that number
+If a numeric argument or prefix arg is given, leave that number
of lines before the signature intact."
(interactive "P")
(save-excursion
;; 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)))
(actions message-exit-actions))
(when (and (message-send arg)
(buffer-name buf))
+ (message-bury buf)
(if message-kill-buffer-on-exit
- (kill-buffer buf)
- (bury-buffer buf)
- (when (eq buf (current-buffer))
- (message-bury buf)))
+ (kill-buffer buf))
(message-do-actions actions)
t)))
"Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
- (if (and (window-dedicated-p (selected-window))
- (not (null (delq (selected-frame) (visible-frame-list)))))
- (delete-frame (selected-frame))
+ (if message-return-action
+ (apply (car message-return-action) (cdr message-return-action))
(switch-to-buffer newbuf))))
(defun message-send (&optional arg)
(run-hooks 'message-sent-hook))
(message "Sending...done")
;; Do ecomplete address snarfing.
- (when (message-mail-alias-type-p 'ecomplete)
+ (when (and (message-mail-alias-type-p 'ecomplete)
+ (not message-inhibit-ecomplete))
(message-put-addresses-in-ecomplete))
;; Mark the buffer as unmodified and delete auto-save.
(set-buffer-modified-p nil)
(nreverse regions)))
(defcustom message-bogus-addresses
- ;; '("noreply" "nospam" "invalid")
'("noreply" "nospam" "invalid" "@@" "[^[:ascii:]].*@" "[ \t]")
"List of regexps of potentially bogus mail addresses.
See `message-check-recipients' how to setup checking.
(?r ,(format
"Replace non-printable characters with \"%s\" and send"
message-replacement-char))
- (?i "Ignore non-printable characters and send")
+ (?s "Send as is without removing anything")
(?e "Continue editing"))))
(if (eq choice ?e)
(error "Non-printable characters"))
;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"?
(let (found)
(mapc (lambda (address)
- (setq address (cadr address))
+ (setq address (or (cadr address) ""))
(when
- (or (not
+ (or (string= "" address)
+ (not
(or
(not (string-match "@" address))
(string-match
"\\|")
message-bogus-addresses)))
(string-match re address))))
- (push address found)))
+ (push address found)))
;;
(mail-extract-address-components recipients t))
found))
(and bog
(not (y-or-n-p
(format
- "Address `%s' might be bogus. Continue? " bog)))
+ "Address `%s'%s might be bogus. Continue? "
+ bog
+ ;; If the encoded version of the email address
+ ;; is different from the unencoded version,
+ ;; then we likely have invisible characters or
+ ;; the like. Display the encoded version,
+ ;; too.
+ (let ((encoded (rfc2047-encode-string bog)))
+ (if (string= encoded bog)
+ ""
+ (format " (%s)" encoded))))))
(error "Bogus address"))))))))
(custom-add-option 'message-setup-hook 'message-check-recipients)
(tembuf (message-generate-new-buffer-clone-locals " message temp"))
(curbuf (current-buffer))
(id (message-make-message-id)) (n 1)
- plist total header required-mail-headers)
+ plist total header)
(while (not (eobp))
(if (< (point-max) (+ p message-send-mail-partially-limit))
(goto-char (point-max))
(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
(save-restriction
(message-narrow-to-headers)
(and news
+ (not (message-fetch-field "List-Post"))
+ (not (message-fetch-field "List-ID"))
(or (message-fetch-field "cc")
(message-fetch-field "bcc")
(message-fetch-field "to"))
(string= "base64"
(message-fetch-field
"content-transfer-encoding")))))))
- (message-insert-courtesy-copy))
+ (message-insert-courtesy-copy
+ (with-current-buffer mailbuf
+ message-courtesy-message)))
;; Let's make sure we encoded all the body.
(assert (save-excursion
(goto-char (point-min))
(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"))
;; should never happen
(t (error "qmail-inject reported unknown failure"))))
+(defvar mh-previous-window-config)
+
(defun message-send-mail-with-mh ()
"Send the prepared message buffer with mh."
(let ((mh-previous-window-config nil)
(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)
t))
;; Check long header lines.
(message-check 'long-header-lines
- (let ((start (point))
- (header nil)
+ (let ((header nil)
(length 0)
found)
(while (and (not found)
(setq found t
length (- (point) (match-beginning 0)))
(setq header (match-string-no-properties 1)))
- (setq start (match-beginning 0))
(forward-line 1))
(if found
(y-or-n-p (format "Your %s header is too long (%d). Really post? "
"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)
(defun message-output (filename)
"Append this article to Unix/babyl mail file FILENAME."
- (if (and (file-readable-p filename)
- (mail-file-babyl-p filename))
+ (if (or (and (file-readable-p filename)
+ (mail-file-babyl-p filename))
+ ;; gnus-output-to-mail does the wrong thing with live, mbox
+ ;; Rmail buffers in Emacs 23.
+ ;; http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255
+ (let ((buff (find-buffer-visiting filename)))
+ (and buff (with-current-buffer buff
+ (eq major-mode 'rmail-mode)))))
(gnus-output-to-rmail filename t)
(gnus-output-to-mail filename t)))
(* 25 25)))
(let ((tm (current-time)))
(concat
- (if (or (memq system-type '(ms-dos emx))
+ (if (or (eq system-type 'ms-dos)
;; 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
(defun message-idna-to-ascii-rhs-1 (header)
"Interactively potentially IDNA encode domain names in HEADER."
(let ((field (message-fetch-field header))
- rhs ace address)
+ ace)
(when field
(dolist (rhs
(mm-delete-duplicates
(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
(mapcar 'downcase
(mapcar
- 'cadr
+ (lambda (elem)
+ (or (cadr elem)
+ ""))
(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.
(message-idna-to-ascii-rhs-1 "Mail-Followup-To")
(message-idna-to-ascii-rhs-1 "Cc")))))
+(defvar Date)
+(defvar Message-ID)
+(defvar Organization)
+(defvar From)
+(defvar Path)
+(defvar Subject)
+(defvar Newsgroups)
+(defvar In-Reply-To)
+(defvar References)
+(defvar To)
+(defvar Distribution)
+(defvar Lines)
+(defvar User-Agent)
+(defvar Expires)
+
(defun message-generate-headers (headers)
"Prepare article HEADERS.
Headers already prepared in the buffer are not modified."
(if formatter
(funcall formatter header value)
(insert header-string ": " value))
+ (push header-string message-inserted-headers)
(goto-char (message-fill-field))
;; We check whether the value was ended by a
;; newline. If not, we insert one.
;; Check for IDNA
(message-idna-to-ascii-rhs))))
-(defun message-insert-courtesy-copy ()
+(defun message-insert-courtesy-copy (message)
"Insert a courtesy message in mail copies of combined messages."
(let (newsgroups)
(save-excursion
(goto-char (point-max))
(insert "Posted-To: " newsgroups "\n")))
(forward-line 1)
- (when message-courtesy-message
+ (when message
(cond
- ((string-match "%s" message-courtesy-message)
- (insert (format message-courtesy-message newsgroups)))
+ ((string-match "%s" message)
+ (insert (format message newsgroups)))
(t
- (insert message-courtesy-message)))))))
+ (insert message)))))))
;;;
;;; Setting up a message buffer
When sending via news, also check that the REFERENCES are less
than 988 characters long, and if they are not, trim them until
they are."
+ ;; 21 is the number suggested by USEAGE.
(let ((maxcount 21)
(count 0)
(cut 2)
nil
mua)))
-(defun message-setup (headers &optional replybuffer actions
- continue switch-function)
+;; 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 return-action)
(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 return-action)
(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 return-action)
(dolist (action actions)
(condition-case nil
(add-to-list 'message-send-actions
`(apply ',(car action) ',(cdr action)))))
- (setq message-reply-buffer replybuffer)
+ (setq message-return-action return-action)
+ (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
headers)
(delete-region (point) (progn (forward-line -1) (point)))
(when message-default-headers
- (insert message-default-headers)
+ (insert
+ (if (functionp message-default-headers)
+ (funcall message-default-headers)
+ message-default-headers))
(or (bolp) (insert ?\n)))
- (insert mail-header-separator "\n")
+ (insert (propertize (concat mail-header-separator "\n")
+ 'read-only t 'rear-nonsticky t 'intangible t))
(forward-line -1)
- (when (message-news-p)
- (when message-default-news-headers
- (insert message-default-news-headers)
- (or (bolp) (insert ?\n)))
- (when message-generate-headers-first
+ ;; If a crash happens while replying, the auto-save file would *not* have a
+ ;; `References:' header if `message-generate-headers-first' was nil.
+ ;; Therefore, always generate it first.
+ (let ((message-generate-headers-first
+ (append message-generate-headers-first '(References))))
+ (when (message-news-p)
+ (when message-default-news-headers
+ (insert message-default-news-headers)
+ (or (bolp) (insert ?\n)))
(message-generate-headers
(message-headers-to-generate
- (append message-required-news-headers
- message-required-headers)
- message-generate-headers-first
- '(Lines Subject)))))
- (when (message-mail-p)
- (when message-default-mail-headers
- (insert message-default-mail-headers)
- (or (bolp) (insert ?\n)))
- (when message-generate-headers-first
+ (append message-required-news-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject))))
+ (when (message-mail-p)
+ (when message-default-mail-headers
+ (insert message-default-mail-headers)
+ (or (bolp) (insert ?\n)))
(message-generate-headers
(message-headers-to-generate
- (append message-required-mail-headers
- message-required-headers)
- message-generate-headers-first
- '(Lines Subject)))))
+ (append message-required-mail-headers
+ message-required-headers)
+ message-generate-headers-first
+ '(Lines Subject)))))
(run-hooks 'message-signature-setup-hook)
(message-insert-signature)
(save-restriction
(setq buffer-file-name (expand-file-name
(concat
(if (memq system-type
- '(ms-dos ms-windows windows-nt
- cygwin cygwin32 win32 w32
- mswindows))
+ '(ms-dos windows-nt cygwin))
"message"
"*message*")
(format-time-string "-%Y%m%d-%H%M%S"))
;;;
;;;###autoload
-(defun message-mail (&optional to subject
- other-headers continue switch-function
- yank-action send-actions)
+(defun message-mail (&optional to subject other-headers continue
+ switch-function yank-action send-actions
+ return-action &rest ignored)
"Start editing a mail message to be sent.
OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
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)
- ;; FIXME: Should return nil if failure.
- t))
+ ;; C-h f compose-mail says that headers should be specified as
+ ;; (string . value); however all the rest of message expects
+ ;; headers to be symbols, not strings (eg message-header-format-alist).
+ ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
+ ;; We need to convert any string input, eg from rmail-start-mail.
+ (dolist (h other-headers other-headers)
+ (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
+ yank-action send-actions continue switch-function
+ return-action)))
;;;###autoload
(defun message-news (&optional newsgroups subject)
(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.
+ ;; Find all relevant headers we need.
(save-restriction
(message-narrow-to-headers-or-head)
;; Gmane renames "To". Look at "Original-To", too, if it is present in
(save-match-data
;; Build (textual) list of new recipient addresses.
(cond
+ (to-address
+ (setq recipients (concat ", " to-address))
+ ;; If the author explicitly asked for a copy, we don't deny it to them.
+ (if mct (setq recipients (concat recipients ", " mct))))
((not wide)
(setq recipients (concat ", " author)))
(address-headers
You may customize the variable `message-use-mail-followup-to', if you
want to get rid of this query permanently.")))
(setq recipients (concat ", " mft)))
- (to-address
- (setq recipients (concat ", " to-address))
- ;; If the author explicitly asked for a copy, we don't deny it to them.
- (if mct (setq recipients (concat recipients ", " mct))))
(t
(setq recipients (if never-mct "" (concat ", " author)))
(if to (setq recipients (concat recipients ", " to)))
(if recip
(setq recipients (delq recip recipients))))))))
+ (setq recipients (message-prune-recipients recipients))
+
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
(push (cons 'Cc recipients) follow-to)))
follow-to))
+(defun message-prune-recipients (recipients)
+ (dolist (rule message-prune-recipient-rules)
+ (let ((match (car rule))
+ dup-match
+ address)
+ (dolist (recipient recipients)
+ (setq address (car recipient))
+ (when (string-match match address)
+ (setq dup-match (replace-match (cadr rule) nil nil address))
+ (dolist (recipient recipients)
+ ;; Don't delete the address that triggered this.
+ (when (and (not (eq address (car recipient)))
+ (string-match dup-match (car recipient)))
+ (setq recipients (delq recipient recipients))))))))
+ recipients)
+
(defcustom message-simplify-subject-functions
'(message-strip-list-identifiers
message-strip-subject-re
(interactive)
(require 'gnus-sum) ; for gnus-list-identifiers
(let ((cur (current-buffer))
- from subject date reply-to to cc
+ from subject date
references message-id follow-to
(inhibit-point-motion-hooks t)
(message-this-is-mail t)
(defun message-forward-make-body-plain (forward-buffer)
(insert
"\n-------------------- Start of forwarded message --------------------\n")
- (let ((b (point)) e)
- (insert
- (with-temp-buffer
- (mm-disable-multibyte)
- (insert
- (with-current-buffer forward-buffer
- (mm-with-unibyte-current-buffer (buffer-string))))
- (mm-enable-multibyte)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (buffer-string)))
+ (let ((b (point))
+ (contents (with-current-buffer forward-buffer (buffer-string)))
+ e)
+ (unless (featurep 'xemacs)
+ (unless (mm-multibyte-string-p contents)
+ (error "Attempt to insert unibyte string from the buffer \"%s\"\
+ to the multibyte buffer \"%s\""
+ (if (bufferp forward-buffer)
+ (buffer-name forward-buffer)
+ forward-buffer)
+ (buffer-name))))
+ (insert (mm-with-multibyte-buffer
+ (insert contents)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string)))
+ (unless (bolp) (insert "\n"))
(setq e (point))
(insert
- "\n-------------------- End of forwarded message --------------------\n")
+ "-------------------- End of forwarded message --------------------\n")
(message-remove-ignored-headers b e)))
(defun message-remove-ignored-headers (b e)
(insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
(let ((b (point)) e)
(if (not message-forward-decoded-p)
- (insert
- (with-temp-buffer
- (mm-disable-multibyte)
- (insert
- (with-current-buffer forward-buffer
- (mm-with-unibyte-current-buffer (buffer-string))))
- (mm-enable-multibyte)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (buffer-string)))
+ (let ((contents (with-current-buffer forward-buffer (buffer-string))))
+ (unless (featurep 'xemacs)
+ (unless (mm-multibyte-string-p contents)
+ (error "Attempt to insert unibyte string from the buffer \"%s\"\
+ to the multibyte buffer \"%s\""
+ (if (bufferp forward-buffer)
+ (buffer-name forward-buffer)
+ forward-buffer)
+ (buffer-name))))
+ (insert (mm-with-multibyte-buffer
+ (insert contents)
+ (mime-to-mml)
+ (goto-char (point-min))
+ (when (looking-at "From ")
+ (replace-match "X-From-Line: "))
+ (buffer-string))))
(save-restriction
(narrow-to-region (point) (point))
(mml-insert-buffer forward-buffer)
(defun message-forward-make-body-digest-plain (forward-buffer)
(insert
"\n-------------------- Start of forwarded message --------------------\n")
- (let ((b (point)) e)
- (mml-insert-buffer forward-buffer)
- (setq e (point))
- (insert
- "\n-------------------- End of forwarded message --------------------\n")))
+ (mml-insert-buffer forward-buffer)
+ (insert
+ "\n-------------------- End of forwarded message --------------------\n"))
(defun message-forward-make-body-digest-mime (forward-buffer)
(insert "\n<#multipart type=digest>\n")
(setq rmail-insert-mime-forwarded-message-function
'message-forward-rmail-make-body))
+(defvar message-inhibit-body-encoding nil)
+
;;;###autoload
(defun message-resend (address)
"Resend the current article to ADDRESS."
(when (looking-at "From ")
(replace-match "X-From-Line: "))
;; Send it.
- (let ((message-inhibit-body-encoding t)
+ (let ((message-inhibit-body-encoding
+ ;; Don't do any further encoding if it looks like the
+ ;; message has already been encoded.
+ (let ((case-fold-search t))
+ (re-search-forward "^mime-version:" nil t)))
+ (message-inhibit-ecomplete t)
message-required-mail-headers
message-generate-hashcash
rfc2047-encode-encoded-words)
(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)
(defcustom message-tool-bar-gnome
'((ispell-message "spell" nil
+ :vert-only t
:visible (or (not (boundp 'flyspell-mode))
(not flyspell-mode)))
(flyspell-buffer "spell" t
+ :vert-only t
:visible (and (boundp 'flyspell-mode)
flyspell-mode)
:help "Flyspell whole buffer")
- (gmm-ignore "separator")
- (message-send-and-exit "mail/send")
+ (message-send-and-exit "mail/send" t :label "Send")
(message-dont-send "mail/save-draft")
- (message-kill-buffer "close") ;; stock_cancel
- (mml-attach-file "attach" mml-mode-map)
+ (mml-attach-file "attach" mml-mode-map :vert-only t)
(mml-preview "mail/preview" mml-mode-map)
(mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
(message-insert-importance-high "important" nil :visible nil)
(message-insert-importance-low "unimportant" nil :visible nil)
- (message-insert-disposition-notification-to "receipt" nil :visible nil)
- (gmm-customize-mode "preferences" t :help "Edit mode preferences")
- (message-info "help" t :help "Message manual"))
+ (message-insert-disposition-notification-to "receipt" nil :visible nil))
"List of items for the message tool bar (GNOME style).
See `gmm-tool-bar-from-list' for details on the format of the list."
:type '(alist :key-type regexp :value-type function))
(defcustom message-expand-name-databases
- (list 'bbdb 'eudc)
+ '(bbdb eudc)
"List of databases to try for name completion (`message-expand-name').
Each element is a symbol and can be `bbdb' or `eudc'."
:group 'message
Execute function specified by `message-tab-body-function' when not in
those headers."
(interactive)
+ (cond
+ ((if (and (boundp 'completion-fail-discreetly)
+ (fboundp 'completion-at-point))
+ (let ((completion-fail-discreetly t)) (completion-at-point))
+ (funcall (or (message-completion-function) #'ignore)))
+ ;; Completion was performed; nothing else to do.
+ nil)
+ (message-tab-body-function (funcall message-tab-body-function))
+ (t (funcall (or (lookup-key text-mode-map "\t")
+ (lookup-key global-map "\t")
+ 'indent-relative)))))
+
+(defvar mail-abbrev-mode-regexp)
+
+(defun message-completion-function ()
(let ((alist message-completion-alist))
(while (and alist
(let ((mail-abbrev-mode-regexp (caar alist)))
(not (mail-abbrev-in-expansion-header-p))))
(setq alist (cdr alist)))
- (funcall (or (cdar alist) message-tab-body-function
- (lookup-key text-mode-map "\t")
- (lookup-key global-map "\t")
- 'indent-relative))))
+ (cdar alist)))
(eval-and-compile
(condition-case nil
(eudc-expand-inline))
((and (memq 'bbdb message-expand-name-databases)
(fboundp 'bbdb-complete-name))
- (bbdb-complete-name))
+ (let ((starttick (buffer-modified-tick)))
+ (or (bbdb-complete-name)
+ ;; Apparently, bbdb-complete-name can return nil even when
+ ;; completion took place. So let's double check the buffer was
+ ;; not modified.
+ (/= starttick (buffer-modified-tick)))))
(t
(expand-abbrev))))
;;; MIME functions
;;;
-(defvar message-inhibit-body-encoding nil)
-
(defun message-encode-message-body ()
(unless message-inhibit-body-encoding
(let ((mail-parse-charset (or mail-parse-charset
(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))
;; coding: iso-8859-1
;; End:
-;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
;;; message.el ends here
projects / gnus / blobdiff