;;; message.el --- composing mail and news messages
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010, 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
: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
: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.
A value of nil means let mailer mail back a message to report errors."
:version "23.2"
: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 "23.2"
+ :version "24.1"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'regexp
: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."
: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'."
: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)
(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.
: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.
(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)
+ :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.
(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 Emacs 21, XEmacs 21.4 and 21.5, it is
- ;; unavailable unless sendmail.el is loaded.
+ ;; 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."
(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,
(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)
(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: ")))
(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))
(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 ()
(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)
(?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))
(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-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)))
(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.
;; 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)
;; YANK-ACTION, if non-nil, can be a buffer or a yank action of the
projects / gnus / blobdiff