;; 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)
:link '(custom-manual "(message)Sending Variables")
:type 'boolean)
+(defcustom message-confirm-send nil
+ "When non-nil, ask for confirmation when sending a message."
+ :group 'message-sending
+ :group 'message-mail
+ :version "23.1" ;; No Gnus
+ :link '(custom-manual "(message)Sending Variables")
+ :type 'boolean)
+
(defcustom message-generate-new-buffers 'unique
"*Say whether to create a new message buffer to compose a message.
Valid values include:
: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")
: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
:group 'message-headers
:type 'regexp)
-(eval-and-compile
- (autoload 'gnus-alive-p "gnus-util")
- (autoload 'gnus-delay-article "gnus-delay")
- (autoload 'gnus-extract-address-components "gnus-util")
- (autoload 'gnus-find-method-for-group "gnus")
- (autoload 'gnus-group-decoded-name "gnus-group")
- (autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'gnus-group-name-decode "gnus-group")
- (autoload 'gnus-groups-from-server "gnus")
- (autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'gnus-open-server "gnus-int")
- (autoload 'gnus-output-to-mail "gnus-util")
- (autoload 'gnus-output-to-rmail "gnus-util")
- (autoload 'gnus-request-post "gnus-int")
- (autoload 'gnus-select-frame-set-input-focus "gnus-util")
- (autoload 'gnus-server-string "gnus")
- (autoload 'idna-to-ascii "idna")
- (autoload 'message-setup-toolbar "messagexmas")
- (autoload 'mh-new-draft-name "mh-comp")
- (autoload 'mh-send-letter "mh-comp")
- (autoload 'nndraft-request-associate-buffer "nndraft")
- (autoload 'nndraft-request-expire-articles "nndraft")
- (autoload 'nnvirtual-find-group-art "nnvirtual")
- (autoload 'rmail-dont-reply-to "mail-utils")
- (autoload 'rmail-msg-is-pruned "rmail")
- (autoload 'rmail-msg-restore-non-pruned-header "rmail")
- (autoload 'rmail-output "rmailout"))
+(autoload 'gnus-alive-p "gnus-util")
+(autoload 'gnus-delay-article "gnus-delay")
+(autoload 'gnus-extract-address-components "gnus-util")
+(autoload 'gnus-find-method-for-group "gnus")
+(autoload 'gnus-group-decoded-name "gnus-group")
+(autoload 'gnus-group-name-charset "gnus-group")
+(autoload 'gnus-group-name-decode "gnus-group")
+(autoload 'gnus-groups-from-server "gnus")
+(autoload 'gnus-make-local-hook "gnus-util")
+(autoload 'gnus-open-server "gnus-int")
+(autoload 'gnus-output-to-mail "gnus-util")
+(autoload 'gnus-output-to-rmail "gnus-util")
+(autoload 'gnus-request-post "gnus-int")
+(autoload 'gnus-select-frame-set-input-focus "gnus-util")
+(autoload 'gnus-server-string "gnus")
+(autoload 'idna-to-ascii "idna")
+(autoload 'message-setup-toolbar "messagexmas")
+(autoload 'mh-new-draft-name "mh-comp")
+(autoload 'mh-send-letter "mh-comp")
+(autoload 'nndraft-request-associate-buffer "nndraft")
+(autoload 'nndraft-request-expire-articles "nndraft")
+(autoload 'nnvirtual-find-group-art "nnvirtual")
+(autoload 'rmail-dont-reply-to "mail-utils")
+(autoload 'rmail-msg-is-pruned "rmail")
+(autoload 'rmail-msg-restore-non-pruned-header "rmail")
+(autoload 'rmail-output "rmailout")
\f
(autoload 'Info-goto-node "info")
+(defvar mml2015-use)
(defun message-info (&optional arg)
"Display the Message manual.
manual. With two \\[universal-argument]'s, display the EasyPG or
PGG manual, depending on the value of `mml2015-use'."
(interactive "p")
+ ;; Why not `info', which is in loaddefs.el?
(Info-goto-node (format "(%s)Top"
- (cond ((eq arg 16) mml2015-use)
+ (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)))
(put-text-property (point-min) (point-max) 'read-only nil))
(message-fix-before-sending)
(run-hooks 'message-send-hook)
+ (when message-confirm-send
+ (or (y-or-n-p "Send message? ")
+ (keyboard-quit)))
(message message-sending-message)
(let ((alist message-send-method-alist)
(success t)
(setq start next)))
(nreverse regions)))
-(defcustom message-bogus-address-regexp nil ;; "noreply\\|nospam\\|invalid"
- "Regexp of potentially bogus mail addresses."
+(defcustom message-bogus-addresses
+ ;; '("noreply" "nospam" "invalid")
+ '("noreply" "nospam" "invalid" "@@" "[^[:ascii:]].*@" "[ \t]")
+ "List of regexps of potentially bogus mail addresses.
+See `message-check-recipients' how to setup checking.
+
+This list should make it possible to catch typos or warn about
+spam-trap addresses. It doesn't aim to verify strict RFC
+conformance."
:version "23.1" ;; No Gnus
:group 'message-headers
- :type 'regexp)
+ :type '(choice
+ (const :tag "None" nil)
+ (list
+ (set :inline t
+ (const "noreply")
+ (const "nospam")
+ (const "invalid")
+ (const :tag "duplicate @" "@@")
+ (const :tag "non-ascii local part" "[^[:ascii:]].*@")
+ ;; Already caught by `message-valid-fqdn-regexp'
+ ;; (const :tag "`_' in domain part" "@.*_")
+ (const :tag "whitespace" "[ \t]"))
+ (repeat :inline t
+ :tag "Other"
+ (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)
RECIPIENTS is a mail header. Return a list of potentially bogus
addresses. If none is found, return nil.
-An addresses might be bogus if the domain part is not fully
-qualified, see `message-valid-fqdn-regexp', or if it matches
-`message-bogus-address-regexp'."
+An address might be bogus if the domain part is not fully
+qualified, see `message-valid-fqdn-regexp', or if there's a
+matching entry in `message-bogus-addresses'."
;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"?
(let (found)
(mapc (lambda (address)
(string-match
(concat ".@.*\\("
message-valid-fqdn-regexp "\\)\\'") address)))
- (and (stringp message-bogus-address-regexp)
- (string-match message-bogus-address-regexp address)))
- (push address found)))
+ (and message-bogus-addresses
+ (let ((re
+ (if (listp message-bogus-addresses)
+ (mapconcat 'identity
+ message-bogus-addresses
+ "\\|")
+ message-bogus-addresses)))
+ (string-match re address))))
+ (push address found)))
;;
(mail-extract-address-components recipients t))
found))
"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
(list resend-to-addresses)
'("-t"))))))
(unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
+ (if errbuf (pop-to-buffer errbuf))
(error "Sending...failed with exit value %d" cpr)))
(when message-interactive
(with-current-buffer errbuf
(apply
'call-process-region (point-min) (point-max)
message-qmail-inject-program nil nil nil
- ;; qmail-inject's default behaviour is to look for addresses on the
+ ;; qmail-inject's default behavior is to look for addresses on the
;; command line; if there're none, it scans the headers.
;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
;;
(* 25 25)))
(let ((tm (current-time)))
(concat
- (if (or (memq system-type '(ms-dos emx vax-vms))
+ (if (or (memq system-type '(ms-dos emx))
;; message-number-base36 doesn't handle bigints.
(floatp (user-uid)))
(let ((user (downcase (user-login-name))))
;; 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 \""
(mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
(mapcar 'downcase
(mapcar
- 'car (mail-header-parse-addresses field))))))
+ 'cadr
+ (mail-extract-address-components field t))))))
(setq ace (if (string-match "\\`[[:ascii:]]+\\'" rhs)
rhs
(downcase (idna-to-ascii rhs))))
(if (gnus-alive-p)
(setq message-draft-article
(nndraft-request-associate-buffer "drafts"))
+
+ ;; If Gnus were alive, draft messages would be saved in the drafts folder.
+ ;; But Gnus is not alive, so arrange to save the draft message in a
+ ;; regular file in message-auto-save-directory. Append a unique
+ ;; time-based suffix to the filename to allow multiple drafts to be saved
+ ;; simultaneously without overwriting each other (which mimics the
+ ;; functionality of the Gnus drafts folder).
(setq buffer-file-name (expand-file-name
+ (concat
(if (memq system-type
'(ms-dos ms-windows windows-nt
cygwin cygwin32 win32 w32
mswindows))
"message"
"*message*")
+ (format-time-string "-%Y%m%d-%H%M%S"))
message-auto-save-directory))
(setq buffer-auto-save-file-name (make-auto-save-file-name)))
(clear-visited-file-modtime)
"Disassociate the message buffer from the drafts directory."
(when message-draft-article
(nndraft-request-expire-articles
- (list message-draft-article) "nndraft:drafts" nil t)))
+ (list message-draft-article) "drafts" nil t)))
(defun message-insert-headers ()
"Generate the headers for the article."
(interactive)
(let ((file-name (make-auto-save-file-name)))
(cond ((save-window-excursion
- (if (not (eq system-type 'vax-vms))
- (with-output-to-temp-buffer "*Directory*"
- (with-current-buffer standard-output
- (fundamental-mode)) ; for Emacs 20.4+
- (buffer-disable-undo standard-output)
- (let ((default-directory "/"))
- (call-process
- "ls" nil standard-output nil "-l" file-name))))
+ (with-output-to-temp-buffer "*Directory*"
+ (with-current-buffer standard-output
+ (fundamental-mode)) ; for Emacs 20.4+
+ (buffer-disable-undo standard-output)
+ (let ((default-directory "/"))
+ (call-process
+ "ls" nil standard-output nil "-l" file-name)))
(yes-or-no-p (format "Recover auto save file %s? " file-name)))
(let ((buffer-read-only nil))
(erase-buffer)
(message-forward-make-body-digest-mime forward-buffer)
(message-forward-make-body-digest-plain forward-buffer)))
-(eval-and-compile
- (autoload 'mm-uu-dissect-text-parts "mm-uu")
- (autoload 'mm-uu-dissect "mm-uu"))
+(autoload 'mm-uu-dissect-text-parts "mm-uu")
+(autoload 'mm-uu-dissect "mm-uu")
(defun message-signed-or-encrypted-p (&optional dont-emulate-mime handles)
"Say whether the current buffer contains signed or encrypted message.
projects / gnus / blobdiff