;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'canlock)
(require 'mailheader)
(require 'nnheader)
-;; This is apparently necessary even though things are autoloaded:
+;; This is apparently necessary even though things are autoloaded.
+;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
+;; require mailabbrev here.
(if (featurep 'xemacs)
- (require 'mail-abbrevs))
+ (require 'mail-abbrevs)
+ (require 'mailabbrev))
(require 'mail-parse)
(require 'mml)
(require 'rfc822)
(const default))
:group 'message-headers)
-(defcustom message-syntax-checks nil
+(defcustom message-insert-canlock t
+ "Whether to insert a Cancel-Lock header in news postings."
+ :version "21.3"
+ :group 'message-headers
+ :type 'boolean)
+
+(defcustom message-syntax-checks
+ (if message-insert-canlock '((sender . disabled)) nil)
;; Guess this one shouldn't be easy to customize...
"*Controls what syntax checks should not be performed on outgoing posts.
To disable checking of long signatures, for instance, add
`new-text', `quoting-style', `redirected-followup', `signature',
`approved', `sender', `empty', `empty-headers', `message-id', `from',
`subject', `shorten-followup-to', `existing-newsgroups',
-`buffer-file-name', `unchanged', `newsgroups', `reply-to'."
+`buffer-file-name', `unchanged', `newsgroups', `reply-to',
+'continuation-headers', and `long-header-lines'."
:group 'message-news
:type '(repeat sexp)) ; Fixme: improve this
+(defcustom message-required-headers '((optional . References) From)
+ "*Headers to be generated or prompted for when sending a message.
+Also see `message-required-news-headers' and
+`message-required-mail-headers'."
+ :group 'message-news
+ :group 'message-headers
+ :type '(repeat sexp))
+
+(defcustom message-draft-headers '(References From)
+ "*Headers to be generated when saving a draft message."
+ :group 'message-news
+ :group 'message-headers
+ :type '(repeat sexp))
+
(defcustom message-required-news-headers
'(From Newsgroups Subject Date Message-ID
- (optional . Organization) Lines
+ (optional . Organization)
(optional . User-Agent))
"*Headers to be generated or prompted for when posting an article.
RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
:type '(repeat sexp))
(defcustom message-required-mail-headers
- '(From Subject Date (optional . In-Reply-To) Message-ID Lines
+ '(From Subject Date (optional . In-Reply-To) Message-ID
(optional . User-Agent))
"*Headers to be generated or prompted for when mailing a message.
It is recommended that From, Date, To, Subject and Message-ID be
-included. Organization, Lines and User-Agent are optional."
+included. Organization and User-Agent are optional."
:group 'message-mail
:group 'message-headers
:type '(repeat sexp))
:group 'message-headers
:type 'regexp)
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:"
"*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."
:group 'message-interface
:type 'regexp)
-(defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]:[ \t]*\\)*[ \t]*"
+(defcustom message-subject-re-regexp
+ "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
"*Regexp matching \"Re: \" in the subject line."
:group 'message-various
:type 'regexp)
+;;; Start of variables adopted from `message-utils.el'.
+
+(defcustom message-subject-trailing-was-query 'ask
+ ;; should it default to nil or ask?
+ "*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-ask-regexp'. If
+`message-subject-trailing-was-query' is t, always strip the trailing
+old subject. In this case, `message-subject-trailing-was-regexp' is
+used."
+ :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]*.*[\])]+\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+The function `message-strip-subject-trailing-was' uses this regexp if
+`message-subject-trailing-was-query' is set to the symbol `ask'. If
+the variable is t instead of `ask', use
+`message-subject-trailing-was-regexp' instead.
+
+It is okay to create some false positives here, as the user is asked."
+ :group 'message-various
+ :type 'regexp)
+
+(defcustom message-subject-trailing-was-regexp
+ "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
+ "*Regexp matching \"(was: <old subject>)\" in the subject line.
+
+If `message-subject-trailing-was-query' is set to t, the subject is
+matched against `message-subject-trailing-was-regexp' in
+`message-strip-subject-trailing-was'. You should use a regexp creating very
+few false positives here."
+ :group 'message-various
+ :type 'regexp)
+
+;;; marking inserted text
+
+;;;###autoload
+(defcustom message-mark-insert-begin
+ "--8<---------------cut here---------------start------------->8---\n"
+ "How to mark the beginning of some inserted text."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-mark-insert-end
+ "--8<---------------cut here---------------end--------------->8---\n"
+ "How to mark the end of some inserted text."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(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.googgle.com\) respect this header."
+ :type 'string
+ :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."
+ :type 'string
+ :group 'message-various)
+
+;;; Crossposts and Followups
+;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
+;; new suggestions by R. Weikusat <rw at another.de>
+
+(defvar message-cross-post-old-target nil
+ "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."
+ :type 'boolean
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-cross-post-note
+ "Crosspost & Followup-To: "
+ "Note to insert before signature to notify of cross-post and follow-up."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(defcustom message-followup-to-note
+ "Followup-To: "
+ "Note to insert before signature to notify of follow-up only."
+ :type 'string
+ :group 'message-various)
+
+;;;###autoload
+(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'."
+ :type 'function
+ :group 'message-various)
+
+;;; End of variables adopted from `message-utils.el'.
+
;;;###autoload
(defcustom message-signature-separator "^-- *$"
"Regexp matching the signature separator."
:type 'string
:group 'message-various)
-(defcustom message-interactive nil
+(defcustom message-interactive t
"Non-nil means when sending a message wait for and display errors.
nil means let mailer mail back a message to report errors."
:group 'message-sending
:group 'message-forwarding
:type 'boolean)
-(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:"
+(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:type 'regexp)
(defcustom message-cite-prefix-regexp
(if (string-match "[[:digit:]]" "1") ;; support POSIX?
- "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>»|:}+]\\)+"
+ "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
(let ((old-table (syntax-table))
non-word-constituents)
(if (string-match "\\w" ".") "" ".")))
(set-syntax-table old-table)
(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."
:group 'message-insertion
:type 'regexp)
Valid values include `message-send-mail-with-sendmail' (the default),
`message-send-mail-with-mh', `message-send-mail-with-qmail',
-`smtpmail-send-it' and `feedmail-send-it'.
+`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
See also `send-mail-function'."
:type '(radio (function-item message-send-mail-with-sendmail)
(function-item message-send-mail-with-mh)
(function-item message-send-mail-with-qmail)
+ (function-item message-smtpmail-send-it)
(function-item smtpmail-send-it)
(function-item feedmail-send-it)
(function :tag "Other"))
(defcustom message-qmail-inject-args nil
"Arguments passed to qmail-inject programs.
-This should be a list of strings, one string for each argument.
+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
might set this variable to '(\"-f\" \"you@some.where\")."
:group 'message-sending
- :type '(repeat string))
+ :type '(choice (function)
+ (repeat string)))
(defvar message-cater-to-broken-inn t
"Non-nil means Gnus should not fold the `References' header.
"*If non-nil, generate all required headers before composing.
The variables `message-required-news-headers' and
`message-required-mail-headers' specify which headers to generate.
+This can also be a list of headers that should be generated before
+composing.
Note that the variable `message-deletable-headers' specifies headers which
are to be deleted and then re-generated before sending, so this variable
will not have a visible effect for those headers."
:group 'message-headers
- :type 'boolean)
+ :type '(choice (const :tag "None" nil)
+ (const :tag "All" t)
+ (repeat (sexp :tag "Header"))))
(defcustom message-setup-hook nil
"Normal hook, run each time a new outgoing message is initialized.
:type 'function
:group 'message-insertion)
-(defvar message-abbrevs-loaded nil)
-
;;;###autoload
(defcustom message-signature t
"*String to be inserted at the end of the message buffer.
:type '(choice file (const :tags "None" nil))
:group 'message-insertion)
+;;;###autoload
+(defcustom message-signature-insert-empty-line t
+ "*If non-nil, insert an empty line before the signature separator."
+ :type 'boolean
+ :group 'message-insertion)
+
(defcustom message-distribution-function nil
"*Function called to return a Distribution header."
:group 'message-news
:group 'message-buffers
:type '(choice directory (const :tag "Don't auto-save" nil)))
-(defcustom message-buffer-naming-style 'unique
- "*The way new message buffers are named.
-Valid valued are `unique' and `unsent'."
- :version "21.1"
- :group 'message-buffers
- :type '(choice (const :tag "unique" unique)
- (const :tag "unsent" unsent)))
-
(defcustom message-default-charset
(and (not (mm-multibyte-p)) 'iso-8859-1)
"Default charset used in non-MULE Emacsen.
"*A list of GNKSA feet you are allowed to shoot.
Gnus gives you all the opportunity you could possibly want for
shooting yourself in the foot. Also, Gnus allows you to shoot the
-feet of Good Net-Keeping Seal of Approval. The following are foot
+feet of Good Net-Keeping Seal of Approval. The following are foot
candidates:
`empty-article' Allow you to post an empty article;
`quoted-text-only' Allow you to post quoted text only;
-`multiple-copies' Allow you to post multiple copies.")
-;; `cancel-messages' Allow you to cancel or supersede others' messages.
+`multiple-copies' Allow you to post multiple copies;
+`cancel-messages' Allow you to cancel or supersede messages from
+ your other email addresses.")
(defsubst message-gnksa-enable-p (feature)
(or (not (listp message-shoot-gnksa-feet))
"Face used for displaying MML."
:group 'message-faces)
+(defun message-font-lock-make-header-matcher (regexp)
+ (let ((form
+ `(lambda (limit)
+ (let ((start (point)))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "$")
+ nil t)
+ (setq limit (min limit (match-beginning 0))))
+ (goto-char start))
+ (and (< start limit)
+ (re-search-forward ,regexp limit t))))))
+ (if (featurep 'bytecomp)
+ (byte-compile form)
+ form)))
+
(defvar message-font-lock-keywords
(let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
- `((,(concat "^\\([Tt]o:\\)" content)
+ `((,(message-font-lock-make-header-matcher
+ (concat "^\\([Tt]o:\\)" content))
(1 'message-header-name-face)
(2 'message-header-to-face nil t))
- (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content)
+ (,(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))
- (,(concat "^\\([Ss]ubject:\\)" content)
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([Ss]ubject:\\)" content))
(1 'message-header-name-face)
(2 'message-header-subject-face nil t))
- (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content)
+ (,(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))
- (,(concat "^\\([A-Z][^: \n\t]+:\\)" content)
+ (,(message-font-lock-make-header-matcher
+ (concat "^\\([A-Z][^: \n\t]+:\\)" content))
(1 'message-header-name-face)
(2 'message-header-other-face nil t))
- (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content)
+ (,(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))
,@(if (and mail-header-separator
`((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
1 'message-separator-face))
nil)
- (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
+ ((lambda (limit)
+ (re-search-forward (concat "^\\("
+ message-cite-prefix-regexp
+ "\\).*")
+ limit t))
(0 'message-cited-text-face))
- ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\).*>"
+ ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
(0 'message-mml-face))))
"Additional expressions to highlight in Message mode.")
+
;; XEmacs does it like this. For Emacs, we have to set the
;; `font-lock-defaults' buffer-local variable.
(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
(unbold-region b e)
(ununderline-region b e))))
"Alist of mail and news faces for facemenu.
-The cdr of ech entry is a function for applying the face to a region.")
+The cdr of each entry is a function for applying the face to a region.")
(defcustom message-send-hook nil
- "Hook run before sending messages."
+ "Hook run before sending messages.
+This hook is run quite early when sending."
:group 'message-various
:options '(ispell-message)
:type 'hook)
(defcustom message-send-mail-hook nil
- "Hook run before sending mail messages."
+ "Hook run before sending mail messages.
+This hook is run very late -- just before the message is sent as
+mail."
:group 'message-various
:type 'hook)
(defcustom message-send-news-hook nil
- "Hook run before sending news messages."
+ "Hook run before sending news messages.
+This hook is run very late -- just before the message is sent as
+news."
:group 'message-various
:type 'hook)
(defvar message-draft-coding-system
mm-auto-save-coding-system
- "Coding system to compose mail.")
+ "*Coding system to compose mail.
+If you'd like to make it possible to share draft files between XEmacs
+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
"The limitation of messages sent as message/partial.
:type '(choice (const :tag "Always use primary" nil)
regexp))
+(defcustom message-hierarchical-addresses nil
+ "A list of hierarchical mail address definitions.
+
+Inside each entry, the first address is the \"top\" address, and
+subsequent addresses are subaddresses; this is used to indicate that
+mail sent to the first address will automatically be delivered to the
+subaddresses. So if the first address appears in the recipient list
+for a message, the subaddresses will be removed (if present) before
+the mail is sent. All addresses in this structure should be
+downcased."
+ :group 'message-headers
+ :type '(repeat (repeat string)))
+
(defcustom message-mail-user-agent nil
"Like `mail-user-agent'.
Except if it is nil, use Gnus native MUA; if it is t, use
recipients?\" before a wide reply to multiple recipients. If&nb
projects / gnus / blobdiff