;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; Free Software Foundation, Inc.
+
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: mail, news
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(put 'user-full-name 'custom-type 'string)
(defgroup message-various nil
- "Various Message Variables"
+ "Various Message Variables."
:link '(custom-manual "(message)Various Message Variables")
:group 'message)
(defgroup message-buffers nil
- "Message Buffers"
+ "Message Buffers."
:link '(custom-manual "(message)Message Buffers")
:group 'message)
(defgroup message-sending nil
- "Message Sending"
+ "Message Sending."
:link '(custom-manual "(message)Sending Variables")
:group 'message)
(defgroup message-interface nil
- "Message Interface"
+ "Message Interface."
:link '(custom-manual "(message)Interface")
:group 'message)
(defgroup message-forwarding nil
- "Message Forwarding"
+ "Message Forwarding."
:link '(custom-manual "(message)Forwarding")
:group 'message-interface)
(defgroup message-insertion nil
- "Message Insertion"
+ "Message Insertion."
:link '(custom-manual "(message)Insertion")
:group 'message)
(defgroup message-headers nil
- "Message Headers"
+ "Message Headers."
:link '(custom-manual "(message)Message Headers")
:group 'message)
(defgroup message-news nil
- "Composing News Messages"
+ "Composing News Messages."
:group 'message)
(defgroup message-mail nil
- "Composing Mail Messages"
+ "Composing Mail Messages."
:group 'message)
(defgroup message-faces nil
(defcustom message-fcc-externalize-attachments nil
"If non-nil, attachments are included as external parts in Fcc copies."
- :version "21.4"
+ :version "22.1"
:type 'boolean
:group 'message-sending)
the article has been posted to will be inserted there.
If this variable is nil, no such courtesy message will be added."
:group 'message-sending
- :type '(radio (string :format "%t: %v\n" :size 0) (const nil)))
+ :type '(radio string (const nil)))
(defcustom message-ignored-bounced-headers
"^\\(Received\\|Return-Path\\|Delivered-To\\):"
(defcustom message-insert-canlock t
"Whether to insert a Cancel-Lock header in news postings."
- :version "21.4"
+ :version "22.1"
:group 'message-headers
:type 'boolean)
"*Headers to be generated or prompted for when sending a message.
Also see `message-required-news-headers' and
`message-required-mail-headers'."
- :version "21.4"
+ :version "22.1"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
(defcustom message-draft-headers '(References From)
"*Headers to be generated when saving a draft message."
- :version "21.4"
+ :version "22.1"
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
- :type 'regexp)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
(defcustom message-ignored-mail-headers
"^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
any confusion."
:group 'message-interface
:link '(custom-manual "(message)Superseding")
- :type 'regexp)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
(defcustom message-subject-re-regexp
"^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
`message-subject-trailing-was-query' is t, always strip the trailing
old subject. In this case, `message-subject-trailing-was-regexp' is
used."
- :version "21.4"
+ :version "22.1"
:type '(choice (const :tag "never" nil)
(const :tag "always strip" t)
(const ask))
`message-subject-trailing-was-regexp' instead.
It is okay to create some false positives here, as the user is asked."
- :version "21.4"
+ :version "22.1"
:group 'message-various
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
matched against `message-subject-trailing-was-regexp' in
`message-strip-subject-trailing-was'. You should use a regexp creating very
few false positives here."
- :version "21.4"
+ :version "22.1"
:group 'message-various
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
-;; Fixme: Why are all these things autoloaded?
-
;;; marking inserted text
-;;;###autoload
(defcustom message-mark-insert-begin
"--8<---------------cut here---------------start------------->8---\n"
"How to mark the beginning of some inserted text."
- :version "21.4"
+ :version "22.1"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
-;;;###autoload
(defcustom message-mark-insert-end
"--8<---------------cut here---------------end--------------->8---\n"
"How to mark the end of some inserted text."
- :version "21.4"
+ :version "22.1"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-various)
-;;;###autoload
-(defcustom message-archive-header
- "X-No-Archive: Yes\n"
+(defcustom message-archive-header "X-No-Archive: Yes\n"
"Header to insert when you don't want your article to be archived.
Archives \(such as groups.google.com\) respect this header."
- :version "21.4"
+ :version "22.1"
:type 'string
:link '(custom-manual "(message)Header Commands")
:group 'message-various)
-;;;###autoload
(defcustom message-archive-note
"X-No-Archive: Yes - save http://groups.google.com/"
"Note to insert why you wouldn't want this posting archived.
If nil, don't insert any text in the body."
- :version "21.4"
- :type '(radio (string :format "%t: %v\n" :size 0)
- (const nil))
+ :version "22.1"
+ :type '(radio string (const nil))
:link '(custom-manual "(message)Header Commands")
:group 'message-various)
"Old target for cross-posts or follow-ups.")
(make-variable-buffer-local 'message-cross-post-old-target)
-;;;###autoload
(defcustom message-cross-post-default t
"When non-nil `message-cross-post-followup-to' will perform a crosspost.
If nil, `message-cross-post-followup-to' will only do a followup. Note that
you can explicitly override this setting by calling
`message-cross-post-followup-to' with a prefix."
- :version "21.4"
+ :version "22.1"
:type 'boolean
:group 'message-various)
-;;;###autoload
-(defcustom message-cross-post-note
- "Crosspost & Followup-To: "
+(defcustom message-cross-post-note "Crosspost & Followup-To: "
"Note to insert before signature to notify of cross-post and follow-up."
- :version "21.4"
+ :version "22.1"
:type 'string
:group 'message-various)
-;;;###autoload
-(defcustom message-followup-to-note
- "Followup-To: "
+(defcustom message-followup-to-note "Followup-To: "
"Note to insert before signature to notify of follow-up only."
- :version "21.4"
+ :version "22.1"
:type 'string
:group 'message-various)
-;;;###autoload
-(defcustom message-cross-post-note-function
- 'message-cross-post-insert-note
+(defcustom message-cross-post-note-function 'message-cross-post-insert-note
"Function to use to insert note about Crosspost or Followup-To.
The function will be called with four arguments. The function should not only
insert a note, but also ensure old notes are deleted. See the documentation
for `message-cross-post-insert-note'."
- :version "21.4"
+ :version "22.1"
:type 'function
:group 'message-various)
:link '(custom-manual "(message)Message Buffers")
:type 'boolean)
+(defcustom message-kill-buffer-query t
+ "*Non-nil means that killing a modified message buffer has to be confirmed.
+This is used by `message-kill-buffer'."
+ :version "23.0" ;; No Gnus
+ :group 'message-buffers
+ :type 'boolean)
+
(eval-when-compile
(defvar gnus-local-organization))
(defcustom message-user-organization
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:link '(custom-manual "(message)Resending")
- :type 'regexp)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
+ regexp))
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"*All headers that match this regexp will be deleted when forwarding a message."
:version "21.1"
:group 'message-forwarding
- :type '(choice (const :tag "None" nil)
+ :type '(repeat :value-to-internal (lambda (widget value)
+ (custom-split-regexp-maybe value))
+ :match (lambda (widget value)
+ (or (stringp value)
+ (widget-editable-list-match widget value)))
regexp))
(defcustom message-ignored-cited-headers "."
non-word-constituents
"]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
"*Regexp matching the longest possible citation prefix on a line."
+ :version "22.1"
:group 'message-insertion
:link '(custom-manual "(message)Insertion Variables")
:type 'regexp)
;; Useful to set in site-init.el
;;;###autoload
-(defcustom message-send-mail-function 'message-send-mail-with-sendmail
+(defcustom message-send-mail-function
+ (let ((program (if (boundp 'sendmail-program)
+ ;; see paths.el
+ sendmail-program)))
+ (cond
+ ((and program
+ (string-match "/" program) ;; Skip path
+ (file-executable-p program))
+ 'message-send-mail-with-sendmail)
+ ((and program
+ (executable-find program))
+ 'message-send-mail-with-sendmail)
+ (t
+ 'smtpmail-send-it)))
"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'.
:link '(custom-manual "(message)Followup")
:type '(choice function (const nil)))
+(defcustom message-extra-wide-headers nil
+ "If non-nil, a list of additional address headers.
+These are used when composing a wide reply."
+ :group 'message-sending
+ :type '(repeat string))
+
(defcustom message-use-followup-to 'ask
"*Specifies what to do with Followup-To header.
If nil, always ignore the header. If it is t, use its value, but
If nil, always ignore the header. If it is the symbol `ask', always
query the user whether to use the value. If it is the symbol `use',
always use the value."
- :version "21.4"
+ :version "22.1"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(choice (const :tag "ignore" nil)
regular expressions to match lists. These functions can be used in
conjunction with `message-subscribed-regexps' and
`message-subscribed-addresses'."
- :version "21.4"
+ :version "22.1"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat sexp))
"*A file containing addresses the user is subscribed to.
If nil, do not look at any files to determine list subscriptions. If
non-nil, each line of this file should be a mailing list address."
- :version "21.4"
+ :version "22.1"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
- :type '(radio (file :format "%t: %v\n" :size 0)
- (const nil)))
+ :type '(radio file (const nil)))
(defcustom message-subscribed-addresses nil
"*Specifies a list of addresses the user is subscribed to.
If nil, do not use any predefined list subscriptions. This list of
addresses can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-regexps'."
- :version "21.4"
+ :version "22.1"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat string))
If nil, do not use any predefined list subscriptions. This list of
regular expressions can be used in conjunction with
`message-subscribed-address-functions' and `message-subscribed-addresses'."
- :version "21.4"
+ :version "22.1"
:group 'message-interface
:link '(custom-manual "(message)Mailing Lists")
:type '(repeat regexp))
If it is the symbol `always', the posting is allowed. If it is the
symbol `never', the posting is not allowed. If it is the symbol
`ask', you are prompted."
- :version "21.4"
+ :version "22.1"
:group 'message-interface
:link '(custom-manual "(message)Message Headers")
:type '(choice (const always)
"*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"
:type '(choice (string :tag "From name")
(const :tag "Use From: header from message" header)
(const :tag "Use `user-mail-address'" nil))
(let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
(set-keymap-parent map minibuffer-local-map)
map)
- "Keymap for `message-read-from-minibuffer'.")
+ "Keymap for `message-read-from-minibuffer'."
+ :version "22.1"
+ :group 'message-various)
;;;###autoload
(defcustom message-citation-line-function 'message-insert-citation-line
(defcustom message-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'."
+See also `message-yank-cited-prefix' and `message-yank-empty-prefix'."
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(defcustom message-yank-cited-prefix ">"
- "*Prefix inserted on cited or empty lines of yanked messages.
+ "*Prefix inserted on cited lines of yanked messages.
Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
-See also `message-yank-prefix'."
- :version "21.4"
+See also `message-yank-prefix' and `message-yank-empty-prefix'."
+ :version "22.1"
+ :type 'string
+ :link '(custom-manual "(message)Insertion Variables")
+ :group 'message-insertion)
+
+(defcustom message-yank-empty-prefix ">"
+ "*Prefix inserted on empty lines of yanked messages.
+See also `message-yank-prefix' and `message-yank-cited-prefix'."
+ :version "22.1"
:type 'string
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
"*Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
-Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
+Note that these functions use `mail-citation-hook' if that is non-nil."
:type '(radio (function-item message-cite-original)
(function-item message-cite-original-without-signature)
(function-item sc-cite-original)
;;;###autoload
(defcustom message-signature-insert-empty-line t
"*If non-nil, insert an empty line before the signature separator."
- :version "21.4"
+ :version "22.1"
:type 'boolean
:link '(custom-manual "(message)Insertion Variables")
:group 'message-insertion)
(or (not (listp message-shoot-gnksa-feet))
(memq feature message-shoot-gnksa-feet)))
-(defcustom message-hidden-headers nil
+(defcustom message-hidden-headers "^References:"
"Regexp of headers to be hidden when composing new messages.
This can also be a list of regexps to match headers. Or a list
starting with `not' and followed by regexps."
- :version "21.4"
+ :version "22.1"
:group 'message
:link '(custom-manual "(message)Message Headers")
- :type '(repeat regexp))
+ :type '(choice
+ :format "%{%t%}: %[Value Type%] %v"
+ (regexp :menu-tag "regexp" :format "regexp\n%t: %v")
+ (repeat :menu-tag "(regexp ...)" :format "(regexp ...)\n%v%i"
+ (regexp :format "%t: %v"))
+ (cons :menu-tag "(not regexp ...)" :format "(not regexp ...)\n%v"
+ (const not)
+ (repeat :format "%v%i"
+ (regexp :format "%t: %v")))))
(defcustom message-cite-articles-with-x-no-archive t
"If non-nil, cite text from articles that has X-No-Archive set."
table)
"Syntax table used while in Message mode.")
-(defface message-header-to-face
+(defface message-header-to
'((((class color)
(background dark))
(:foreground "green2" :bold t))
(:bold t :italic t)))
"Face used for displaying From headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-to-face 'face-alias 'message-header-to)
-(defface message-header-cc-face
+(defface message-header-cc
'((((class color)
(background dark))
(:foreground "green4" :bold t))
(:bold t)))
"Face used for displaying Cc headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-cc-face 'face-alias 'message-header-cc)
-(defface message-header-subject-face
+(defface message-header-subject
'((((class color)
(background dark))
(:foreground "green3"))
(:bold t)))
"Face used for displaying subject headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-subject-face 'face-alias 'message-header-subject)
-(defface message-header-newsgroups-face
+(defface message-header-newsgroups
'((((class color)
(background dark))
(:foreground "yellow" :bold t :italic t))
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
-(defface message-header-other-face
+(defface message-header-other
'((((class color)
(background dark))
(:foreground "#b00000"))
(:bold t :italic t)))
"Face used for displaying newsgroups headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-other-face 'face-alias 'message-header-other)
-(defface message-header-name-face
+(defface message-header-name
'((((class color)
(background dark))
(:foreground "DarkGreen"))
(:bold t)))
"Face used for displaying header names."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-name-face 'face-alias 'message-header-name)
-(defface message-header-xheader-face
+(defface message-header-xheader
'((((class color)
(background dark))
(:foreground "blue"))
(:bold t)))
"Face used for displaying X-Header headers."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-header-xheader-face 'face-alias 'message-header-xheader)
-(defface message-separator-face
+(defface message-separator
'((((class color)
(background dark))
(:foreground "blue3"))
(:bold t)))
"Face used for displaying the separator."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-separator-face 'face-alias 'message-separator)
-(defface message-cited-text-face
+(defface message-cited-text
'((((class color)
(background dark))
(:foreground "red"))
(:bold t)))
"Face used for displaying cited text names."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-cited-text-face 'face-alias 'message-cited-text)
-(defface message-mml-face
+(defface message-mml
'((((class color)
(background dark))
(:foreground "ForestGreen"))
(:bold t)))
"Face used for displaying MML."
:group 'message-faces)
+;; backward-compatibility alias
+(put 'message-mml-face 'face-alias 'message-mml)
(defun message-font-lock-make-header-matcher (regexp)
(let ((form
(let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
`((,(message-font-lock-make-header-matcher
(concat "^\\([Tt]o:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-to-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-to nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-cc-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-cc nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\([Ss]ubject:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-subject-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-subject nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-newsgroups-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-newsgroups nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\([A-Z][^: \n\t]+:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-other-face nil t))
+ (1 'message-header-name)
+ (2 'message-header-other nil t))
(,(message-font-lock-make-header-matcher
(concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
- (1 'message-header-name-face)
- (2 'message-header-name-face))
+ (1 'message-header-name)
+ (2 'message-header-name))
,@(if (and mail-header-separator
(not (equal mail-header-separator "")))
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
- 1 'message-separator-face))
+ 1 'message-separator))
nil)
((lambda (limit)
(re-search-forward (concat "^\\("
message-cite-prefix-regexp
"\\).*")
limit t))
- (0 'message-cited-text-face))
+ (0 'message-cited-text))
("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
- (0 'message-mml-face))))
+ (0 'message-mml))))
"Additional expressions to highlight in Message mode.")
(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
(defvar message-face-alist
- '((bold . bold-region)
+ '((bold . message-bold-region)
(underline . underline-region)
(default . (lambda (b e)
- (unbold-region b e)
+ (message-unbold-region b e)
(ununderline-region b e))))
"Alist of mail and news faces for facemenu.
The cdr of each entry is a function for applying the face to a region.")
(integer 1000000)))
(defcustom message-alternative-emails nil
- "A regexp to match the alternative email addresses.
-The first matched address (not primary one) is used in the From field."
+ "*Regexp matching alternative email addresses.
+The first address in the To, Cc or From headers of the original
+article matching this variable is used as the From field of
+outgoing messages.
+
+This variable has precedence over posting styles and anything that runs
+off `message-setup-hook'."
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(choice (const :tag "Always use primary" nil)
for a message, the subaddresses will be removed (if present) before
the mail is sent. All addresses in this structure should be
downcased."
- :version "21.4"
+ :version "22.1"
:group 'message-headers
:type '(repeat (repeat string)))
"Like `mail-user-agent'.
Except if it is nil, use Gnus native MUA; if it is t, use
`mail-user-agent'."
- :version "21.4"
+ :version "22.1"
:type '(radio (const :tag "Gnus native"
:format "%t\n"
nil)
recipients?\" before a wide reply to multiple recipients. If the user
answers yes, reply to all recipients as usual. If the user answers
no, only reply back to the author."
- :version "21.4"
+ :version "22.1"
:group 'message-headers
:link '(custom-manual "(message)Wide Reply")
:type 'boolean)
(defcustom message-user-fqdn nil
- "*Domain part of Messsage-Ids."
+ "*Domain part of Message-Ids."
+ :version "22.1"
:group 'message-headers
:link '(custom-manual "(message)News Headers")
:type '(radio (const :format "%v " nil)
- (string :format "FQDN: %v\n" :size 0)))
+ (string :format "FQDN: %v")))
(defcustom message-use-idna (and (condition-case nil (require 'idna)
(file-error))
(mm-coding-system-p 'utf-8)
(executable-find idna-program)
- 'ask)
- "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
- :version "21.4"
+ (string= (idna-to-ascii "räksmörgås")
+ "xn--rksmrgs-5wao1o")
+ t)
+ "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
+GNU Libidn, and in particular the elisp package \"idna.el\" and
+the external program \"idn\", must be installed for this
+functionality to work."
+ :version "22.1"
:group 'message-headers
:link '(custom-manual "(message)IDNA")
:type '(choice (const :tag "Ask" ask)
"Alist of header names/filler functions.")
(defvar message-header-format-alist
- `((Newsgroups)
+ `((From)
+ (Newsgroups)
(To)
(Cc)
(Subject)
"\\)")
"Regular expression that matches a valid FQDN."
;; see also: gnus-button-valid-fqdn-regexp
- :version "21.4"
+ :version "22.1"
:group 'message-headers
:type 'regexp)
(autoload 'gnus-request-post "gnus-int")
(autoload 'gnus-server-string "gnus")
(autoload 'idna-to-ascii "idna")
+ (autoload 'gmm-tool-bar-from-list "gmm-utils")
(autoload 'message-setup-toolbar "messagexmas")
(autoload 'mh-new-draft-name "mh-comp")
(autoload 'mh-send-letter "mh-comp")
(if (not header)
nil
(let ((regexp (format "[%s]+" (or separator ",")))
- (beg (point-min))
(first t)
- quoted elems paren)
+ beg quoted elems paren)
(with-temp-buffer
(mm-enable-multibyte)
+ (setq beg (point-min))
(insert header)
(goto-char (point-min))
(while (not (eobp))
;;; Start of functions adopted from `message-utils.el'.
(defun message-strip-subject-trailing-was (subject)
- "Remove trailing \"(
Was: <old subject>)\" from SUBJECT lines.
+ "Remove trailing \"(
was: <old subject>)\" from SUBJECT lines.
Leading \"Re: \" is not stripped by this function. Use the function
`message-strip-subject-re' for this."
(let* ((query message-subject-trailing-was-query)
;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
-;;;###autoload
(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>
" (was: "
old-subject ")\n")))))))))
-;;;###autoload
-(defun message-mark-inserted-region (beg end)
+(defun message-mark-inserted-region (beg end &optional verbatim)
"Mark some region in the current article with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
- (interactive "r")
+See `message-mark-insert-begin' and `message-mark-insert-end'.
+If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
+ (interactive "r\nP")
(save-excursion
;; add to the end of the region first, otherwise end would be invalid
(goto-char end)
- (insert message-mark-insert-end)
+ (insert (if verbatim "#v-\n" message-mark-insert-end))
(goto-char beg)
- (insert message-mark-insert-begin)))
+ (insert (if verbatim "#v+\n" message-mark-insert-begin))))
-;;;###autoload
-(defun message-mark-insert-file (file)
+(defun message-mark-insert-file (file &optional verbatim)
"Insert FILE at point, marking it with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
- (interactive "fFile to insert: ")
+See `message-mark-insert-begin' and `message-mark-insert-end'.
+If VERBATIM, use slrn style verbatim marks (\"#v+\" and \"#v-\")."
+ (interactive "fFile to insert: \nP")
;; reverse insertion to get correct result.
(let ((p (point)))
- (insert message-mark-insert-end)
+ (insert (if verbatim "#v-\n" message-mark-insert-end))
(goto-char p)
(insert-file-contents file)
(goto-char p)
- (insert message-mark-insert-begin)))
+ (insert (if verbatim "#v+\n" message-mark-insert-begin))))
-;;;###autoload
(defun message-add-archive-header ()
"Insert \"X-No-Archive: Yes\" in the header and a note in the body.
The note can be customized using `message-archive-note'. When called with a
(message-add-header message-archive-header)
(message-sort-headers)))
-;;;###autoload
(defun message-cross-post-followup-to-header (target-group)
"Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
(insert (concat "\nFollowup-To: " target-group)))
(setq message-cross-post-old-target target-group))
-;;;###autoload
(defun message-cross-post-insert-note (target-group cross-post in-old
old-groups)
"Insert a in message body note about a set Followup or Crosspost.
(insert (concat message-followup-to-note target-group "\n"))
(insert (concat message-cross-post-note target-group "\n")))))
-;;;###autoload
(defun message-cross-post-followup-to (target-group)
"Crossposts message and set Followup-To to TARGET-GROUP.
With prefix-argument just set Follow-Up, don't cross-post."
;;; Reduce To: to Cc: or Bcc: header
-;;;###autoload
(defun message-reduce-to-to-cc ()
"Replace contents of To: header with contents of Cc: or Bcc: header."
(interactive)
(message-skip-to-next-address)
(kill-region start (point))))
+
+(defun message-info (&optional arg)
+ "Display the Message manual.
+
+Prefixed with one \\[universal-argument], display the Emacs MIME manual.
+Prefixed with two \\[universal-argument]'s, display the PGG manual."
+ (interactive "p")
+ (cond ((eq arg 16) (Info-goto-node "(pgg)Top"))
+ ((eq arg 4) (Info-goto-node "(emacs-mime)Top"))
+ (t (Info-goto-node "(message)Top"))))
+
\f
;;;
(define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
(define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
(define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
+ (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires)
(define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
(define-key message-mode-map "\C-c\M-n"
'(:help "Ask, then arrange to send message at that time"))]
["Kill Message" message-kill-buffer
,@(if (featurep 'xemacs) '(t)
- '(:help "Delete this message without sending"))]))
+ '(:help "Delete this message without sending"))]
+ "----"
+ ["Message manual" message-info
+ ,@(if (featurep 'xemacs) '(t)
+ '(:help "Display the Message manual"))]))
(easy-menu-define
message-mode-field-menu message-mode-map ""
;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
["Crosspost / Followup-To..." message-cross-post-followup-to t]
["Distribution" message-goto-distribution t]
- ["X-No-Archive:" message-add-archive-header t ]
+ ["Expires" message-insert-expires t ]
+ ["X-No-Archive" message-add-archive-header t ]
"----"
;; (typical) mailing-lists stuff
["Fetch To" message-insert-to
"----"
["Sort Headers" message-sort-headers t]
["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
+ ;; We hide `message-hidden-headers' by narrowing the buffer.
+ ["Show Hidden Headers" widen t]
["Goto Body" message-goto-body t]
["Goto Signature" message-goto-signature t]))
packages requires these properties to be present in order to work.
If you use one of these packages, turn this option off, and hope the
message composition doesn't break too bad."
- :version "21.4"
+ :version "22.1"
:group 'message-various
:link '(custom-manual "(message)Various Message Variables")
:type 'boolean)
;; fontified: is used by font-lock.
;; syntax-table, local-map: I dunno.
;; We need to add XEmacs names to the list.
- "Property list of with properties.forbidden in message buffers.
+ "Property list of with properties forbidden in message buffers.
The values of the properties are ignored, only the property names are used.")
(defun message-tamago-not-in-use-p (pos)
See also `message-forbidden-properties'."
(when (and message-strip-special-text-properties
(message-tamago-not-in-use-p begin))
- (dolist (from-to (message-text-with-property 'message-hidden
- begin end t))
- (remove-text-properties (car from-to) (cdr from-to)
- message-forbidden-properties))))
+ (let ((buffer-read-only nil)
+ (inhibit-read-only t))
+ (remove-text-properties begin end message-forbidden-properties))))
;;;###autoload
(define-derived-mode message-mode text-mode "Message"
C-c C-f C-o move to From (\"Originator\")
C-c C-f C-f move to Followup-To
C-c C-f C-m move to Mail-Followup-To
+ C-c C-f C-e move to Expires
C-c C-f C-i cycle through Importance values
C-c C-f s change subject and append \"(was: <Old Subject>)\"
C-c C-f x crossposting with FollowUp-To header and note in body
(set (make-local-variable 'font-lock-defaults)
'(message-font-lock-keywords t))
(if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) (message-tool-bar-map))))
+ (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))
(easy-menu-add message-mode-menu message-mode-map)
(easy-menu-add message-mode-field-menu message-mode-map)
(gnus-make-local-hook 'after-change-functions)
(message-goto-body)
(forward-line -1))
+(defun message-in-body-p ()
+ "Return t if point is in the message body."
+ (let ((body (save-excursion (message-goto-body) (point))))
+ (>= (point) body)))
+
(defun message-goto-signature ()
"Move point to the beginning of the message signature.
If there is no signature in the article, go to the end and
E.g., if this list contains a member list with elements `Cc' and `To',
then `message-carefully-insert-headers' will not insert a `To' header
when the message is already `Cc'ed to the recipient."
- :version "21.4"
+ :version "22.1"
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
"Kill all text up to the signature.
If a numberic argument or prefix arg is given, leave that number
of lines before the signature intact."
- (interactive "p")
+ (interactive "P")
(save-excursion
(save-restriction
(let ((point (point)))
(end-of-line -1)))
(unless (= point (point))
(kill-region point (point))
- (insert "\n"))))))
+ (unless (bolp)
+ (insert "\n")))))))
(defun message-newline-and-reformat (&optional arg not-break)
"Insert four newlines, and then reformat if inside quoted text.
Prefix arg means justify as well."
(interactive (list (if current-prefix-arg 'full)))
- (let (quoted point beg end leading-space bolp)
+ (let (quoted point beg end leading-space bolp fill-paragraph-function)
(setq point (point))
(beginning-of-line)
(setq beg (point))
(if point (goto-char point)))))
(defun message-fill-paragraph (&optional arg)
- "Like `fill-paragraph'."
+ "Message specific function to fill a paragraph.
+This function is used as the value of `fill-paragraph-function' in
+Message buffers and is not meant to be called directly."
(interactive (list (if current-prefix-arg 'full)))
(if (if (boundp 'filladapt-mode) filladapt-mode)
nil
(save-excursion
(goto-char start)
(while (< (point) (mark t))
- (if (or (looking-at ">") (looking-at "^$"))
- (insert message-yank-cited-prefix)
- (insert message-yank-prefix))
+ (cond ((looking-at ">")
+ (insert message-yank-cited-prefix))
+ ((looking-at "^$")
+ (insert message-yank-empty-prefix))
+ (t
+ (insert message-yank-prefix)))
(forward-line 1))))
(goto-char start)))
(when (and message-reply-buffer
message-cite-function)
(delete-windows-on message-reply-buffer t)
- (insert-buffer message-reply-buffer)
+ (push-mark (save-excursion
+ (insert-buffer-substring message-reply-buffer)
+ (point)))
(unless arg
(funcall message-cite-function))
(message-exchange-point-and-mark)
(push (buffer-name buffer) buffers))))
(nreverse buffers)))
-(defun message-cite-original-without-signature ()
- "Cite function in the standard Message manner."
- (let* ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function))))
- ;; This function may be called by `gnus-summary-yank-message' and
- ;; may insert a different article from the original. So, we will
- ;; modify the value of `message-reply-headers' with that article.
- (message-reply-headers
- (save-restriction
- (narrow-to-region start end)
- (message-narrow-to-head-1)
- (vector 0
- (or (message-fetch-field "subject") "none")
- (message-fetch-field "from")
- (message-fetch-field "date")
- (message-fetch-field "message-id" t)
- (message-fetch-field "references")
- 0 0 ""))))
- (mml-quote-region start end)
- ;; Allow undoing.
- (undo-boundary)
- (goto-char end)
- (when (re-search-backward message-signature-separator start t)
- ;; Also peel off any blank lines before the signature.
- (forward-line -1)
- (while (looking-at "^[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (delete-region (point) end)
- (unless (search-backward "\n\n" start t)
- ;; Insert a blank line if it is peeled off.
- (insert "\n")))
- (goto-char start)
- (mapc 'funcall functions)
- (when message-citation-line-function
- (unless (bolp)
- (insert "\n"))
- (funcall message-citation-line-function))))
+(eval-when-compile (defvar mail-citation-hook)) ; Compiler directive
-(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
-(defun message-cite-original ()
- "Cite function in the standard Message manner."
+(defun message-cite-original-1 (strip-signature)
+ "Cite an original message.
+If STRIP-SIGNATURE is non-nil, strips off the signature from the
+original message.
+
+This function uses `mail-citation-hook' if that is non-nil."
(if (and (boundp 'mail-citation-hook)
mail-citation-hook)
(run-hooks 'mail-citation-hook)
(message-fetch-field "references")
0 0 ""))))
(mml-quote-region start end)
+ (when strip-signature
+ ;; Allow undoing.
+ (undo-boundary)
+ (goto-char end)
+ (when (re-search-backward message-signature-separator start t)
+ ;; Also peel off any blank lines before the signature.
+ (forward-line -1)
+ (while (looking-at "^[ \t]*$")
+ (forward-line -1))
+ (forward-line 1)
+ (delete-region (point) end)
+ (unless (search-backward "\n\n" start t)
+ ;; Insert a blank line if it is peeled off.
+ (insert "\n"))))
(goto-char start)
(mapc 'funcall functions)
(when message-citation-line-function
(insert "> [Quoted text removed due to X-No-Archive]\n")
(forward-line -1)))))
+(defun message-cite-original ()
+ "Cite function in the standard Message manner."
+ (message-cite-original-1 nil))
+
+(defun message-cite-original-without-signature ()
+ "Cite function in the standard Message manner.
+This function strips off the signature from the original message."
+ (message-cite-original-1 t))
+
(defun message-insert-citation-line ()
"Insert a simple citation line."
(when message-reply-headers
- (insert (mail-header-from message-reply-headers) " writes:\n\n")))
+ (insert (mail-header-from message-reply-headers) " writes:")
+ (newline)
+ (newline)))
(defun message-position-on-field (header &rest afters)
(let ((case-fold-search t))
"Kill the current buffer."
(interactive)
(when (or (not (buffer-modified-p))
+ (not message-kill-buffer-query)
(yes-or-no-p "Message modified; kill anyway? "))
(let ((actions message-kill-actions)
(draft-article message-draft-article)
(file-exists-p auto-save-file-name))
(and file-name
(file-exists-p file-name)))
- (yes-or-no-p (format "Remove the backup file%s? "
- (if modified " too" ""))))
+ (progn
+ ;; If the message buffer has lived in a dedicated window,
+ ;; `kill-buffer' has killed the frame. Thus the
+ ;; `yes-or-no-p' may show up in a lowered frame. Make sure
+ ;; that the user can see the question by raising the
+ ;; current frame:
+ (raise-frame)
+ (yes-or-no-p (format "Remove the backup file%s? "
+ (if modified " too" "")))))
(ignore-errors
(delete-file auto-save-file-name))
(let ((message-draft-article draft-article))
"Bury this mail BUFFER."
(let ((newbuf (other-buffer buffer)))
(bury-buffer buffer)
- (if (and (fboundp 'frame-parameters)
- (cdr (assq 'dedicated (frame-parameters)))
+ (if (and (window-dedicated-p (selected-window))
(not (null (delq (selected-frame) (visible-frame-list)))))
(delete-frame (selected-frame))
(switch-to-buffer newbuf))))
(unless (bolp)
(insert "\n"))
;; Make the hidden headers visible.
- (dolist (from-to (message-text-with-property 'message-hidden))
- (add-text-properties (car from-to) (cdr from-to)
- '(invisible nil intangible nil)))
+ (widen)
+ ;; Sort headers before sending the message.
+ (message-sort-headers)
;; Make invisible text visible.
;; It doesn't seem as if this is useful, since the invisible property
;; is clobbered by an after-change hook anyhow.
(when (let ((char (char-after)))
(or (< (mm-char-int char) 128)
(and (mm-multibyte-p)
- ;; Fixme: Wrong for Emacs 22 and for things
+ ;; Fixme: Wrong for Emacs 23 and for things
;; like undecable utf-8. Should at least
;; use find-coding-systems-region.
(memq (char-charset char)
message-posting-charset))
(headers message-required-mail-headers))
(when message-generate-hashcash
- (save-restriction
- (message-narrow-to-headers)
- (message-remove-header "X-Hashcash"))
(message "Generating hashcash...")
+ ;; Wait for calculations already started to finish...
+ (hashcash-wait-async)
+ ;; ...and do calculations not already done. mail-add-payment
+ ;; will leave existing X-Hashcash headers alone.
(mail-add-payment)
(message "Generating hashcash...done"))
(save-restriction
(zerop
(length
(setq to (completing-read
- "Followups to (default: no Followup-To header) "
+ "Followups to (default no Followup-To header): "
(mapcar #'list
(cons "poster"
(message-tokenize-header
nil))))
;; Check for control characters.
(message-check 'control-chars
- (if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
+ (if (re-search-forward
+ (mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
+ nil t)
(y-or-n-p
"The article contains control characters. Really post? ")
t))
(let ((system-time-locale "C"))
(format-time-string "%a, %d %b %Y %T %z" now)))
+(defun message-insert-expires (days)
+ "Insert the Expires header. Expiry in DAYS days."
+ (interactive "NExpire article in how many days? ")
+ (save-excursion
+ (message-position-on-field "Expires" "X-Draft-From")
+ (insert (message-make-expires-date days))))
+
+(defun message-make-expires-date (days)
+ "Make date string for the Expires header. Expiry in DAYS days.
+
+In posting styles use `(\"Expires\" (make-expires-date 30))'."
+ (let* ((cur (decode-time (current-time)))
+ (nday (+ days (nth 3 cur))))
+ (setf (nth 3 cur) nday)
+ (message-make-date (apply 'encode-time cur))))
+
(defun message-make-message-id ()
"Make a unique Message-ID."
(concat "<" (message-unique-id)
(let ((field (message-fetch-field header))
rhs ace address)
(when field
- (dolist (address (mail-header-parse-addresses field))
- (setq address (car address)
- rhs (downcase (or (cadr (split-string address "@")) ""))
- ace (downcase (idna-to-ascii rhs)))
+ (dolist (rhs
+ (mm-delete-duplicates
+ (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
+ (mapcar 'downcase
+ (mapcar
+ 'car (mail-header-parse-addresses field))))))
+ (setq ace (downcase (idna-to-ascii rhs)))
(when (and (not (equal rhs ace))
(or (not (eq message-use-idna 'ask))
- (y-or-n-p (format "Replace %s with %s? " rhs ace))))
+ (y-or-n-p (format "Replace %s with %s in %s:? "
+ rhs ace header))))
(goto-char (point-min))
(while (re-search-forward (concat "^" header ":") nil t)
(message-narrow-to-field)
(message-narrow-to-head)
(message-idna-to-ascii-rhs-1 "From")
(message-idna-to-ascii-rhs-1 "To")
+ (message-idna-to-ascii-rhs-1 "Reply-To")
+ (message-idna-to-ascii-rhs-1 "Mail-Reply-To")
+ (message-idna-to-ascii-rhs-1 "Mail-Followup-To")
(message-idna-to-ascii-rhs-1 "Cc")))))
(defun message-generate-headers (headers)
;; The element is a symbol. We insert the value
;; of this symbol, if any.
(symbol-value header))
- ((not (message-check-element header))
+ ((not (message-check-element
+ (intern (downcase (symbol-name header)))))
;; We couldn't generate a value for this header,
;; so we just ask the user.
(read-from-minibuffer
;; totally and insert the new value.
(delete-region (point) (point-at-eol))
;; If the header is optional, and the header was
- ;; empty, we con't insert it anyway.
+ ;; empty, we can't insert it anyway.
(unless optionalp
(push header-string message-inserted-headers)
(insert value)
If the current line has `message-yank-prefix', insert it on the new line."
(interactive "*")
(condition-case nil
- (split-line message-yank-prefix) ;; Emacs 21.3.50+ supports arg.
+ (split-line message-yank-prefix) ;; Emacs 22.1+ supports arg.
(error
(split-line))))
(insert "\n\t"))
(setq last (1+ (point))))
(setq last (1+ (point)))))))
-
+
(defun message-fill-field-general ()
(let ((begin (point))
(fill-column 78)
(defcustom message-beginning-of-line t
"Whether \\<message-mode-map>\\[message-beginning-of-line]\
goes to beginning of header values."
- :version "21.4"
+ :version "22.1"
:group 'message-buffers
:link '(custom-manual "(message)Movement")
:type 'boolean)
is nil.
If point is in the message header and on a (non-continued) header
-line, move point to the beginning of the header value. If point
-is already there, move point to beginning of line. Therefore,
-repeated calls will toggle point between beginning of field and
-beginning of line."
+line, move point to the beginning of the header value or the beginning of line,
+whichever is closer. If point is already at beginning of line, move point to
+beginning of header value. Therefore, repeated calls will toggle point
+between beginning of field and beginning of line."
(interactive "p")
(let ((zrs 'zmacs-region-stays))
(when (and (interactive-p) (boundp zrs))
(bol (progn (beginning-of-line n) (point)))
(eol (point-at-eol))
(eoh (re-search-forward ": *" eol t)))
- (if (or (not eoh) (equal here eoh))
- (goto-char bol)
- (goto-char eoh)))
+ (goto-char
+ (if (and eoh (or (< eoh here) (= bol here)))
+ eoh bol)))
(beginning-of-line n)))
(defun message-buffer-name (type &optional to group)
(when message-default-mail-headers
(insert message-default-mail-headers)
(or (bolp) (insert ?\n)))
- (save-restriction
- (message-narrow-to-headers)
- (if message-alternative-emails
- (message-use-alternative-email-as-from)))
(when message-generate-headers-first
(message-generate-headers
(message-headers-to-generate
(run-hooks 'message-header-setup-hook))
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
+ (when message-generate-hashcash
+ ;; Generate hashcash headers for recipients already known
+ (mail-add-payment-async))
(run-hooks 'message-setup-hook)
+ ;; Do this last to give it precedence over posting styles, etc.
+ (when (message-mail-p)
+ (save-restriction
+ (message-narrow-to-headers)
+ (if message-alternative-emails
+ (message-use-alternative-email-as-from))))
(message-position-point)
(undo-boundary))
(Subject . ,(or subject ""))))))
(defun message-get-reply-headers (wide &optional to-address address-headers)
- (let (follow-to mct never-mct to cc author mft recipients)
+ (let (follow-to mct never-mct to cc author mft recipients extra)
;; Find all relevant headers we need.
(save-restriction
(message-narrow-to-headers-or-head)
return t)
(message-fetch-field "original-to")))
cc (message-fetch-field "cc")
+ extra (when message-extra-wide-headers
+ (mapconcat 'identity
+ (mapcar 'message-fetch-field
+ message-extra-wide-headers)
+ ", "))
mct (message-fetch-field "mail-copies-to")
author (or (message-fetch-field "mail-reply-to")
(message-fetch-field "reply-to")
fragmented and very difficult to follow.
Also, some source/announcement lists are not intended for discussion;
-responses here are directed to other addresses.")))
+responses here are directed to other addresses.
+
+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 mct (setq recipients (concat recipients ", " mct))))
(t
(setq recipients (if never-mct "" (concat ", " author)))
- (if to (setq recipients (concat recipients ", " to)))
- (if cc (setq recipients (concat recipients ", " cc)))
+ (if to (setq recipients (concat recipients ", " to)))
+ (if cc (setq recipients (concat recipients ", " cc)))
+ (if extra (setq recipients (concat recipients ", " extra)))
(if mct (setq recipients (concat recipients ", " mct)))))
(if (>= (length recipients) 2)
;; Strip the leading ", ".
`Followup-To: poster' sends your response via e-mail instead of news.
A typical situation where `Followup-To: poster' is used is when the poster
-does not read the newsgroup, so he wouldn't see any replies sent to it."))
+does not read the newsgroup, so he wouldn't see any replies sent to it.
+
+You may customize the variable `message-use-followup-to', if you
+want to get rid of this query permanently."))
(progn
(setq message-this-is-news nil)
(cons 'To (or mrt reply-to from "")))
be fragmented and very difficult to follow.
Also, some source/announcement newsgroups are not intended for discussion;
-responses here are directed to other newsgroups."))
+responses here are directed to other newsgroups.
+
+You may customize the variable `message-use-followup-to', if you
+want to get rid of this query permanently."))
(cons 'Newsgroups followup-to)
(cons 'Newsgroups newsgroups))))))
(posted-to
(defun message-is-yours-p ()
"Non-nil means current article is yours.
-If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles
+If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
are yours except those that have Cancel-Lock header not belonging to you.
-Instead of shooting GNKSA feet, you should modify 'message-alternative-emails'
+Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
regexp to match all of yours addresses."
;; Canlock-logic as suggested by Per Abrahamsen
;; <abraham@dina.kvl.dk>
(prefix
(if group
(gnus-group-decoded-name group)
- (or (and from (car (gnus-extract-address-components from)))
+ (or (and from (or
+ (car (gnus-extract-address-components from))
+ (cadr (gnus-extract-address-components from))))
"(nowhere)"))))
(concat "["
(if message-forward-decoded-p
(setq e (point))
(insert
"\n-------------------- End of forwarded message --------------------\n")
- (when (and (not current-prefix-arg)
- message-forward-ignored-headers)
+ (when message-forward-ignored-headers
(save-restriction
(narrow-to-region b e)
(goto-char b)
(goto-char (point-max))))
(setq e (point))
(insert "<#/mml>\n")
- (when (and (not current-prefix-arg)
+ (when (and (not message-forward-decoded-p)
message-forward-ignored-headers)
(save-restriction
(narrow-to-region b e)
;; This code should be moved to underline.el (from which it is stolen).
;;;###autoload
-(defun bold-region (start end)
+(defun message-bold-region (start end)
"Bold all nonblank characters in the region.
Works by overstriking characters.
Called from program, takes two arguments START and END
(forward-char 1)))))
;;;###autoload
-(defun unbold-region (start end)
+(defun message-unbold-region (start end)
"Remove all boldness (overstruck characters) in the region.
Called from program, takes two arguments START and END
which specify the range to operate on."
(defvar tool-bar-map)
(defvar tool-bar-mode))
-(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props)
- ;; We need to make tool bar entries in local keymaps with
- ;; `tool-bar-local-item-from-menu' in Emacs > 21.3
- (if (fboundp 'tool-bar-local-item-from-menu)
- ;; This is for Emacs 21.3
- (tool-bar-local-item-from-menu command icon in-map from-map props)
- (tool-bar-add-item-from-menu command icon from-map props)))
-
-(defun message-tool-bar-map ()
- (or message-tool-bar-map
- (setq message-tool-bar-map
- (and
- (condition-case nil (require 'tool-bar) (error nil))
- (fboundp 'tool-bar-add-item-from-menu)
- tool-bar-mode
- (let ((tool-bar-map (copy-keymap tool-bar-map))
- (load-path (mm-image-load-path)))
- ;; Zap some items which aren't so relevant and take
- ;; up space.
- (dolist (key '(print-buffer kill-buffer save-buffer
- write-file dired open-file))
- (define-key tool-bar-map (vector key) nil))
- (message-tool-bar-local-item-from-menu
- 'message-send-and-exit "mail_send" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-kill-buffer "close" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-dont-send "cancel" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'mml-attach-file "attach" tool-bar-map mml-mode-map)
- (message-tool-bar-local-item-from-menu
- 'ispell-message "spell" tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'mml-preview "preview"
- tool-bar-map mml-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-insert-importance-high "important"
- tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-insert-importance-low "unimportant"
- tool-bar-map message-mode-map)
- (message-tool-bar-local-item-from-menu
- 'message-insert-disposition-notification-to "receipt"
- tool-bar-map message-mode-map)
- tool-bar-map)))))
+;; Note: The :set function in the `message-tool-bar*' variables will only
+;; affect _new_ message buffers. We might add a function that walks thru all
+;; message-mode buffers and force the update.
+(defun message-tool-bar-update (&optional symbol value)
+ "Update message mode toolbar.
+Setter function for custom variables."
+ (if symbol
+ ;; When used as ":set" function:
+ (progn
+ (set-default symbol value)
+ (setq-default message-tool-bar-map nil))
+ (message-make-tool-bar t)))
+
+;; The default will be changed when the new icons have been checked in:
+(defcustom message-tool-bar 'message-tool-bar-retro
+ "Specifies the message mode tool bar.
+
+It can be either a list or a symbol refering to a list. See
+`gmm-tool-bar-from-list' for the format of the list. The
+default key map is `message-mode-map'.
+
+Pre-defined symbols include `message-tool-bar-gnome' and
+`message-tool-bar-retro'."
+ :type '(repeat gmm-tool-bar-list-item)
+ :type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
+ (const :tag "Retro look" message-tool-bar-retro)
+ (repeat :tag "User defined list" gmm-tool-bar-item)
+ (symbol))
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+;; The new icons are not yet committed, see
+;; http://thread.gmane.org/gmane.emacs.gnus.general/61719
+(defcustom message-tool-bar-gnome
+ '((gmm-ignore "separator")
+ (message-send-and-exit "send")
+ (message-dont-send "save-draft")
+ (message-kill-buffer "close") ;; stock_cancel
+ (mml-attach-file "attach" mml-mode-map)
+ (ispell-message "spell" nil :visible (not flyspell-mode))
+ (flyspell-buffer "spell" t :visible flyspell-mode
+ :help "Flyspell whole buffer")
+ ;; We should have a mail-preview icon with an envelope like the one in
+ ;; stock_mail-reply.
+ (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)
+ (message-info "help" t :help "Message manual"))
+ "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 '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+(defcustom message-tool-bar-retro
+ '((message-send-and-exit "mail/send")
+ (message-kill-buffer "close")
+ (message-dont-send "cancel")
+ (mml-attach-file "attach" mml-mode-map)
+ (ispell-message "spell")
+ (mml-preview "preview" mml-mode-map)
+ (message-insert-importance-high "important")
+ (message-insert-importance-low "unimportant")
+ (message-insert-disposition-notification-to "receipt"))
+ "List of items for the message tool bar (retro style).
+
+See `gmm-tool-bar-from-list' for details on the format of the list."
+ :type '(repeat gmm-tool-bar-item)
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+(defcustom message-tool-bar-zap-list
+ '(new-file open-file dired kill-buffer write-file
+ print-buffer customize help)
+ "List of icon items from the global tool bar.
+These items are not displayed on the message mode tool bar.
+
+See `gmm-tool-bar-from-list' for the format of the list."
+ :type 'gmm-tool-bar-zap-list
+ :version "23.0" ;; No Gnus
+ :initialize 'custom-initialize-default
+ :set 'message-tool-bar-update
+ :group 'message)
+
+(defun message-make-tool-bar (&optional force)
+ "Make a message mode tool bar from `message-tool-bar-list'.
+When FORCE, rebuild the tool bar."
+ (when (or (not message-tool-bar-map) force)
+ (setq message-tool-bar-map
+ (when (default-value 'tool-bar-mode)
+ (let ((load-path (mm-image-load-path)))
+ (gmm-tool-bar-from-list message-tool-bar
+ message-tool-bar-zap-list
+ 'message-mode-map)))))
+ message-tool-bar-map)
;;; Group name completion.
'("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
. message-expand-name))
"Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
+ :version "22.1"
:group 'message
:type '(alist :key-type regexp :value-type function))
(defcustom message-tab-body-function nil
"*Function to execute when `message-tab' (TAB) is executed in the body.
If nil, the function bound in `text-mode-map' or `global-map' is executed."
- :version "21.4"
+ :version "22.1"
:group 'message
:link '(custom-manual "(message)Various Commands")
- :type 'function)
+ :type '(choice (const nil)
+ function))
(defun message-tab ()
"Complete names according to `message-completion-alist'.
(lookup-key global-map "\t")
'indent-relative))))
+(eval-and-compile
+ (condition-case nil
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (eval '(display-completion-list nil "")))
+ (defalias 'message-display-completion-list 'display-completion-list))
+ (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
+ (defun message-display-completion-list (completions &optional ignore)
+ "Display the list of completions, COMPLETIONS, using `standard-output'."
+ (display-completion-list completions)))))
+
(defun message-expand-group ()
"Expand the group name under point."
(let* ((b (save-excursion
(let ((buffer-read-only nil))
(erase-buffer)
(let ((standard-output (current-buffer)))
- (display-completion-list (sort completions 'string<)))
+ (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))))))))))
(read-string prompt initial-contents))))
(defun message-use-alternative-email-as-from ()
+ "Set From field of the outgoing message to the first matching
+address in `message-alternative-emails', looking at To, Cc and
+From headers in the original article."
(require 'mail-utils)
- (let* ((fields '("To" "Cc"))
+ (let* ((fields '("To" "Cc" "From"))
(emails
(split-string
(mail-strip-quoted-names
emails nil))
(pop emails))
(unless (or (not email) (equal email user-mail-address))
+ (message-remove-header "From")
(goto-char (point-max))
- (insert "From: " email "\n"))))
+ (insert "From: " (let ((user-mail-address email)) (message-make-from))
+ "\n"))))
(defun message-options-get (symbol)
(cdr (assq symbol message-options)))
(list message-hidden-headers)
message-hidden-headers))
(inhibit-point-motion-hooks t)
- (after-change-functions nil))
+ (after-change-functions nil)
+ (end-of-headers 0))
(when regexps
(save-excursion
(save-restriction
(while (not (eobp))
(if (not (message-hide-header-p regexps))
(message-next-header)
- (let ((begin (point)))
+ (let ((begin (point))
+ header header-len)
(message-next-header)
- (add-text-properties
- begin (point)
- '(invisible t message-hidden t))))))))))
+ (setq header (buffer-substring begin (point))
+ header-len (- (point) begin))
+ (delete-region begin (point))
+ (goto-char (1+ end-of-headers))
+ (insert header)
+ (setq end-of-headers
+ (+ end-of-headers header-len))))))))
+ (narrow-to-region (1+ end-of-headers) (point-max))))
(defun message-hide-header-p (regexps)
(let ((result nil)
;; coding: iso-8859-1
;; End:
-;;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
+;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
;;; message.el ends here
projects / gnus / blobdiff