;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; End of variables adopted from `message-utils.el'.
-(defcustom message-signature-separator "^-- *$"
- "Regexp matching the signature separator."
- :type 'regexp
+(defcustom message-signature-separator "^-- $"
+ "Regexp matching the signature separator.
+This variable is used to strip off the signature from quoted text
+when `message-cite-function' is
+`message-cite-original-without-signature'. Most useful values
+are \"^-- $\" (strict) and \"^-- *$\" (loose; allow missing
+whitespace)."
+ :type '(choice (const :tag "strict" "^-- $")
+ (const :tag "loose" "^-- *$")
+ regexp)
+ :version "22.3" ;; Gnus 5.10.12 (changed default)
:link '(custom-manual "(message)Various Message Variables")
:group 'message-various)
(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
+ :version "23.1" ;; No Gnus
:group 'message-buffers
:type 'boolean)
:link '(custom-manual "(message)Forwarding")
:type 'boolean)
-(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
+(defcustom message-ignored-resent-headers
+ ;; `Delivered-To' needs to be removed because some mailers use it to
+ ;; detect loops, so if you resend a message to an address that ultimately
+ ;; comes back to you (e.g. a mailing-list to which you subscribe, in which
+ ;; case you may be removed from the list on the grounds that mail to you
+ ;; bounced with a "mailing loop" error).
+ "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:"
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:link '(custom-manual "(message)Resending")
`message-send-mail-with-mh', `message-send-mail-with-qmail',
`message-smtpmail-send-it', `smtpmail-send-it',
`feedmail-send-it' and `message-send-mail-with-mailclient'. The
-default is system dependent.
+default is system dependent and determined by the function
+`message-send-mail-function'.
See also `send-mail-function'."
:type '(radio (function-item message-send-mail-with-sendmail)
(function-item message-smtpmail-send-it)
(function-item smtpmail-send-it)
(function-item feedmail-send-it)
- (function :tag "Other")
(function-item message-send-mail-with-mailclient
:tag "Use Mailclient package")
(function :tag "Other"))
:group 'message-sending
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:link '(custom-manual "(message)Mail Variables")
:group 'message-mail)
(defcustom message-sendmail-extra-arguments nil
"Additional arguments to `sendmail-program'."
;; E.g. '("-a" "account") for msmtp
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:type '(repeat string)
;; :link '(custom-manual "(message)Mail Variables")
:group 'message-sending)
(const :tag "Include date" "On %a, %b %d %Y, %n wrote:")
string)
:link '(custom-manual "(message)Insertion Variables")
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'message-insertion)
(defcustom message-yank-prefix "> "
:link '(custom-manual "(message)Insertion Variables")
:type 'integer)
-(defcustom message-cite-function 'message-cite-original
+(defcustom message-cite-function 'message-cite-original-without-signature
"*Function for citing an original message.
Predefined functions include `message-cite-original' and
`message-cite-original-without-signature'.
(function-item sc-cite-original)
(function :tag "Other"))
:link '(custom-manual "(message)Insertion Variables")
+ :version "22.3" ;; Gnus 5.10.12 (changed default)
:group 'message-insertion)
(defcustom message-indent-citation-function 'message-indent-citation
(autoload 'Info-goto-node "info")
+(defvar mml2015-use)
(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."
+Prefixed with one \\[universal-argument], display the Emacs MIME
+manual. With two \\[universal-argument]'s, display the EasyPG or
+PGG manual, depending on the value of `mml2015-use'."
(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"))))
+ ;; Why not `info', which is in loaddefs.el?
+ (Info-goto-node (format "(%s)Top"
+ (cond ((eq arg 16)
+ (require 'mml2015)
+ mml2015-use)
+ ((eq arg 4) 'emacs-mime)
+ ;; `booleanp' only available in Emacs 22+
+ ((and (not (memq arg '(nil t)))
+ (symbolp arg))
+ arg)
+ (t
+ 'message)))))
\f
(defcustom message-bogus-address-regexp nil ;; "noreply\\|nospam\\|invalid"
"Regexp of potentially bogus mail addresses."
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:group 'message-headers
- :type 'regexp)
+ :type '(choice (const :tag "None" nil)
+ (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)
+ (const "noreply\\|nospam\\|invalid")
+ regexp))
(defun message-fix-before-sending ()
"Do various things to make the message nice before sending it."
(forward-char)
(skip-chars-forward mm-7bit-chars)))))
(message-check 'bogus-recipient
- ;; Warn before composing or sending a mail to an invalid address.
+ ;; Warn before sending a mail to an invalid address.
(message-check-recipients)))
(defun message-bogus-recipient-p (recipients)
"Address `%s' might be bogus. Continue? " bog)))
(error "Bogus address."))))))))
+(custom-add-option 'message-setup-hook 'message-check-recipients)
+
(defun message-add-action (action &rest types)
"Add ACTION to be performed when doing an exit of type TYPES."
(while types
;; Check the length of the signature.
(message-check 'signature
(goto-char (point-max))
- (if (> (count-lines (point) (point-max)) 5)
- (y-or-n-p
- (format
- "Your .sig is %d lines; it should be max 4. Really post? "
- (1- (count-lines (point) (point-max)))))
- t))
+ (if (not (re-search-backward message-signature-separator nil t))
+ t
+ (if (>= (count-lines (1+ (point-at-eol)) (point-max)) 5)
+ (if (message-gnksa-enable-p 'signature)
+ (y-or-n-p
+ (format "Signature is excessively long (%d lines). Really post? "
+ (count-lines (1+ (point-at-eol)) (point-max))))
+ (message "Denied posting -- Excessive signature.")
+ nil)
+ t)))
;; Ensure that text follows last quoted portion.
(message-check 'quoting-style
(goto-char (point-max))
;; Quote a string containing non-ASCII characters.
;; It will make the RFC2047 encoder cause an error
;; if there are special characters.
- (let ((default-enable-multibyte-characters t))
- (with-temp-buffer
- (insert (car name))
- (goto-char (point-min))
- (while (search-forward "\"" nil t)
- (when (prog2
- (backward-char)
- (zerop (% (skip-chars-backward "\\\\") 2))
- (goto-char (match-beginning 0)))
- (insert "\\"))
- (forward-char))
- ;; Those quotes will be removed by the RFC2047 encoder.
- (concat "\"" (buffer-string) "\"")))
+ (mm-with-multibyte-buffer
+ (insert (car name))
+ (goto-char (point-min))
+ (while (search-forward "\"" nil t)
+ (when (prog2
+ (backward-char)
+ (zerop (% (skip-chars-backward "\\\\") 2))
+ (goto-char (match-beginning 0)))
+ (insert "\\"))
+ (forward-char))
+ ;; Those quotes will be removed by the RFC2047 encoder.
+ (concat "\"" (buffer-string) "\""))
(car name))
(nth 1 name))
"'s message of \""
(with-temp-buffer
(insert references)
(goto-char (point-min))
- ;; Cons a list of valid references.
- (while (re-search-forward "<[^>]+>" nil t)
+ ;; Cons a list of valid references. GNKSA says we must not include MIDs
+ ;; with whitespace or missing brackets (7.a "Does not propagate broken
+ ;; Message-IDs in original References").
+ (while (re-search-forward "<[^ <]+@[^ <]+>" nil t)
(push (match-string 0) refs))
(setq refs (nreverse refs)
count (length refs)))
(save-restriction
(message-narrow-to-headers)
(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))
+ ;; Gnus posting styles are applied via buffer-local `message-setup-hook'
+ ;; values.
(run-hooks 'message-setup-hook)
;; Do this last to give it precedence over posting styles, etc.
(when (message-mail-p)
(if message-alternative-emails
(message-use-alternative-email-as-from))))
(message-position-point)
+ ;; Allow correct handling of `message-checksum' in `message-yank-original':
+ (set-buffer-modified-p nil)
(undo-boundary))
(defun message-set-auto-save-file-name ()
"Disassociate the message buffer from the drafts directory."
(when message-draft-article
(nndraft-request-expire-articles
- (list message-draft-article) "drafts" nil t)))
+ (list message-draft-article) "nndraft:drafts" nil t)))
(defun message-insert-headers ()
"Generate the headers for the article."
(message-setup `((Newsgroups . ,(or newsgroups ""))
(Subject . ,(or subject ""))))))
+(defun message-alter-recipients-discard-bogus-full-name (addrcell)
+ "Discard mail address in full names.
+When the full name in reply headers contains the mail
+address (e.g. \"foo@bar <foo@bar>\"), discard full name.
+ADDRCELL is a cons cell where the car is the mail address and the
+cdr is the complete address (full name and mail address)."
+ (if (string-match (concat (regexp-quote (car addrcell)) ".*"
+ (regexp-quote (car addrcell)))
+ (cdr addrcell))
+ (cons (car addrcell) (car addrcell))
+ addrcell))
+
+(defcustom message-alter-recipients-function nil
+ "Function called to allow alteration of reply header structures.
+It is called in `message-get-reply-headers' for each recipient.
+The function is called with one parameter, a cons cell ..."
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Discard bogus full name"
+ message-alter-recipients-discard-bogus-full-name)
+ function)
+ :version "23.1" ;; No Gnus
+ :group 'message-headers)
+
(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients extra)
;; Find all relevant headers we need.
(setq recipients
(mapcar
(lambda (addr)
- (cons (downcase (mail-strip-quoted-names addr)) addr))
+ (if message-alter-recipients-function
+ (funcall message-alter-recipients-function
+ (cons (downcase (mail-strip-quoted-names addr))
+ addr))
+ (cons (downcase (mail-strip-quoted-names addr)) addr)))
(message-tokenize-header recipients)))
;; Remove first duplicates. (Why not all duplicates? Is this a bug?)
(let ((s recipients))
(const :tag "Retro look" message-tool-bar-retro)
(repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
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
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
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
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
See `gmm-tool-bar-from-list' for the format of the list."
:type 'gmm-tool-bar-zap-list
- :version "23.0" ;; No Gnus
+ :version "23.1" ;; No Gnus
:initialize 'custom-initialize-default
:set 'message-tool-bar-update
:group 'message)
(delete-region start end)
(insert match)))))
+;; To send pre-formatted letters like the example below, you can use
+;; `message-send-form-letter':
+;; --8<---------------cut here---------------start------------->8---
+;; To: alice@invalid.invalid
+;; Subject: Verification of your contact information
+;; From: Contact verification <admin@foo.invalid>
+;; --text follows this line--
+;; Hi Alice,
+;; please verify that your contact information is still valid:
+;; Alice A, A avenue 11, 1111 A town, Austria
+;; ----------next form letter message follows this line----------
+;; To: bob@invalid.invalid
+;; Subject: Verification of your contact information
+;; From: Contact verification <admin@foo.invalid>
+;; --text follows this line--
+;; Hi Bob,
+;; please verify that your contact information is still valid:
+;; Bob, B street 22, 22222 Be town, Belgium
+;; ----------next form letter message follows this line----------
+;; To: charlie@invalid.invalid
+;; Subject: Verification of your contact information
+;; From: Contact verification <admin@foo.invalid>
+;; --text follows this line--
+;; Hi Charlie,
+;; please verify that your contact information is still valid:
+;; Charlie Chaplin, C plaza 33, 33333 C town, Chile
+;; --8<---------------cut here---------------end--------------->8---
+
+;; FIXME: What is the most common term (circular letter, form letter, serial
+;; letter, standard letter) for such kind of letter? See also
+;; <http://en.wikipedia.org/wiki/Form_letter>
+
+;; FIXME: Maybe extent message-mode's font-lock support to recognize
+;; `message-form-letter-separator', i.e. highlight each message like a single
+;; message.
+
+(defcustom message-form-letter-separator
+ "\n----------next form letter message follows this line----------\n"
+ "Separator for `message-send-form-letter'."
+ ;; :group 'message-form-letter
+ :group 'message-various
+ :version "23.1" ;; No Gnus
+ :type 'string)
+
+(defcustom message-send-form-letter-delay 1
+ "Delay in seconds when sending a message with `message-send-form-letter'.
+Only used when `message-send-form-letter' is called with non-nil
+argument `force'."
+ ;; :group 'message-form-letter
+ :group 'message-various
+ :version "23.1" ;; No Gnus
+ :type 'integer)
+
+(defun message-send-form-letter (&optional force)
+ "Sent all form letter messages from current buffer.
+Unless FORCE, prompt before sending.
+
+The messages are separated by `message-form-letter-separator'.
+Header and body are separated by `mail-header-separator'."
+ (interactive "P")
+ (let ((sent 0) (skipped 0)
+ start end text
+ buff
+ to done)
+ (goto-char (point-min))
+ (while (not done)
+ (setq start (point)
+ end (if (search-forward message-form-letter-separator nil t)
+ (- (point) (length message-form-letter-separator) -1)
+ (setq done t)
+ (point-max)))
+ (setq text
+ (buffer-substring-no-properties start end))
+ (setq buff (generate-new-buffer "*mail - form letter*"))
+ (with-current-buffer buff
+ (insert text)
+ (message-mode)
+ (setq to (message-fetch-field "To"))
+ (switch-to-buffer buff)
+ (when force
+ (sit-for message-send-form-letter-delay))
+ (if (or force
+ (y-or-n-p (format "Send message to `%s'? " to)))
+ (progn
+ (setq sent (1+ sent))
+ (message-send-and-exit))
+ (message (format "Message to `%s' skipped." to))
+ (setq skipped (1+ skipped)))
+ (when (buffer-live-p buff)
+ (kill-buffer buff))))
+ (message "%s message(s) sent, %s skipped." sent skipped)))
+
+(defun message-replace-header (header new-value &optional after force)
+ "Remove HEADER and insert the NEW-VALUE.
+If AFTER, insert after this header. If FORCE, insert new field
+even if NEW-VALUE is empty."
+ ;; Similar to `nnheader-replace-header' but for message buffers.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (message-remove-header header))
+ (when (or force (> (length new-value) 0))
+ (if after
+ (message-position-on-field header after)
+ (message-position-on-field header))
+ (insert new-value))))
+
+(defcustom message-recipients-without-full-name
+ (list "ding@gnus.org"
+ "bugs@gnus.org"
+ "emacs-devel@gnu.org"
+ "emacs-pretest-bug@gnu.org"
+ "bug-gnu-emacs@gnu.org")
+ "Mail addresses that have no full name.
+Used in `message-simplify-recipients'."
+ ;; Maybe the addresses could be extracted from
+ ;; `gnus-parameter-to-list-alist'?
+ :type '(choice (const :tag "None" nil)
+ (repeat string))
+ :version "23.1" ;; No Gnus
+ :group 'message-headers)
+
+(defun message-simplify-recipients ()
+ (interactive)
+ (dolist (hdr '("Cc" "To"))
+ (message-replace-header
+ hdr
+ (mapconcat
+ (lambda (addrcomp)
+ (if (and message-recipients-without-full-name
+ (string-match
+ (regexp-opt message-recipients-without-full-name)
+ (cadr addrcomp)))
+ (cadr addrcomp)
+ (if (car addrcomp)
+ (message-make-from (car addrcomp) (cadr addrcomp))
+ (cadr addrcomp))))
+ (when (message-fetch-field hdr)
+ (mail-extract-address-components
+ (message-fetch-field hdr) t))
+ ", "))))
+
(when (featurep 'xemacs)
(require 'messagexmas)
(message-xmas-redefine))
projects / gnus / blobdiff