Merge from emacs--devo--0
[gnus] / lisp / message.el
index ffcd10b..403cc54 100644 (file)
@@ -1,27 +1,25 @@
 ;;; message.el --- composing mail and news messages
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
 
 ;; 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 2, 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:
 
 
 ;;; Code:
 
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 (eval-when-compile
-  (require 'cl)
-  (defvar gnus-message-group-art)
-  (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
+  (require 'cl))
+
 (require 'hashcash)
 (require 'canlock)
 (require 'mailheader)
 (require 'rfc822)
 (require 'ecomplete)
 
+(autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
+
+(defvar gnus-message-group-art)
+(defvar gnus-list-identifiers) ; gnus-sum is required where necessary
+(defvar rmail-enable-mime-composing)
 
 (defgroup message '((user-mail-address custom-variable)
                    (user-full-name custom-variable))
@@ -188,8 +192,8 @@ To disable checking of long signatures, for instance, add
 
 Don't touch this variable unless you really know what you're doing.
 
-Checks include `approved', `continuation-headers', `control-chars',
-`empty', `existing-newsgroups', `from', `illegible-text',
+Checks include `approved', `bogus-recipient', `continuation-headers',
+`control-chars', `empty', `existing-newsgroups', `from', `illegible-text',
 `invisible-text', `long-header-lines', `long-lines', `message-id',
 `multiple-headers', `new-text', `newsgroups', `quoting-style',
 `repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
@@ -269,7 +273,7 @@ included.  Organization and User-Agent are optional."
   :link '(custom-manual "(message)Mail Headers")
   :type 'regexp)
 
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:\\|^Approved:"
   "*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."
@@ -409,9 +413,17 @@ for `message-cross-post-insert-note'."
 
 ;;; 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)
 
@@ -429,6 +441,14 @@ nil means let mailer mail back a message to report errors."
   :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:
@@ -470,12 +490,11 @@ function
 (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)
 
-(eval-when-compile
-  (defvar gnus-local-organization))
+(defvar gnus-local-organization)
 (defcustom message-user-organization
   (or (and (boundp 'gnus-local-organization)
           (stringp gnus-local-organization)
@@ -556,7 +575,13 @@ Done before generating the new subject of a forward."
   :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")
@@ -585,21 +610,21 @@ Done before generating the new subject of a forward."
   :type 'regexp)
 
 (defcustom message-cite-prefix-regexp
-  (if (string-match "[[:digit:]]" "1") ;; support POSIX?
-      "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
+  (if (string-match "[[:digit:]]" "1")
+      ;; Support POSIX?  XEmacs 21.5.27 doesn't.
+      "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+"
     ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
     (let (non-word-constituents)
       (with-syntax-table text-mode-syntax-table
        (setq non-word-constituents
              (concat
-              (if (string-match "\\w" "-")  "" "-")
               (if (string-match "\\w" "_")  "" "_")
               (if (string-match "\\w" ".")  "" "."))))
       (if (equal non-word-constituents "")
-         "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
+         "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+"
        (concat "\\([ \t]*\\(\\w\\|["
                non-word-constituents
-               "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
+               "]\\)+>+\\|[ \t]*[]>|}]\\)+"))))
   "*Regexp matching the longest possible citation prefix on a line."
   :version "22.1"
   :group 'message-insertion
@@ -618,28 +643,37 @@ Done before generating the new subject of a forward."
   :link '(custom-manual "(message)Canceling News")
   :type 'string)
 
+(defvar smtpmail-default-smtp-server)
+
+(defun message-send-mail-function ()
+  "Return suitable value for the variable `message-send-mail-function'."
+  (cond ((and (require 'sendmail)
+             (boundp 'sendmail-program)
+             sendmail-program
+             (executable-find sendmail-program))
+        'message-send-mail-with-sendmail)
+       ((and (locate-library "smtpmail")
+             (require 'smtpmail)
+             smtpmail-default-smtp-server)
+        'message-smtpmail-send-it)
+       ((locate-library "mailclient")
+        'message-send-mail-with-mailclient)
+       (t
+        (lambda ()
+          (error "Don't know how to send mail.  Please customize `message-send-mail-function'")))))
+
 ;; Useful to set in site-init.el
-(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)))
+(defcustom message-send-mail-function (message-send-mail-function)
   "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'.
 
-Valid values include `message-send-mail-with-sendmail' (the default),
+Valid values include `message-send-mail-with-sendmail'
 `message-send-mail-with-mh', `message-send-mail-with-qmail',
-`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
+`message-smtpmail-send-it', `smtpmail-send-it',
+`feedmail-send-it' and `message-send-mail-with-mailclient'.  The
+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)
@@ -648,8 +682,12 @@ See also `send-mail-function'."
                (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.1" ;; No Gnus
+  :initialize 'custom-initialize-default
   :link '(custom-manual "(message)Mail Variables")
   :group 'message-mail)
 
@@ -791,7 +829,7 @@ If this is nil, use `user-mail-address'.  If it is the symbol
 (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)
@@ -816,9 +854,8 @@ might set this variable to '(\"-f\" \"you@some.where\")."
   :type '(choice (function)
                 (repeat string)))
 
-(eval-when-compile
-  (defvar gnus-post-method)
-  (defvar gnus-select-method))
+(defvar gnus-post-method)
+(defvar gnus-select-method)
 (defcustom message-post-method
   (cond ((and (boundp 'gnus-post-method)
              (listp gnus-post-method)
@@ -914,7 +951,7 @@ the signature is inserted."
   "*Function called to insert the \"Whomever writes:\" line.
 
 Predefined functions include `message-insert-citation-line' and
-`message-insert-formated-citation-line' (see the variable
+`message-insert-formatted-citation-line' (see the variable
 `message-citation-line-format').
 
 Note that Gnus provides a feature where the reader can click on
@@ -923,7 +960,7 @@ people who read your message will have to change their Gnus
 configuration.  See the variable `gnus-cite-attribution-suffix'."
   :type '(choice
          (function-item :tag "plain" message-insert-citation-line)
-         (function-item :tag "formatted" message-insert-formated-citation-line)
+         (function-item :tag "formatted" message-insert-formatted-citation-line)
          (function :tag "Other"))
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
@@ -952,7 +989,7 @@ Please also read the note in the documentation of
                 (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 "> "
@@ -987,7 +1024,7 @@ Used by `message-yank-original' via `message-yank-cite'."
   :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'.
@@ -997,6 +1034,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil."
                (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
@@ -1122,8 +1160,7 @@ these lines."
           (file-readable-p "/etc/sendmail.cf")
           (let ((buffer (get-buffer-create " *temp*")))
             (unwind-protect
-                (save-excursion
-                  (set-buffer buffer)
+                (with-current-buffer buffer
                   (insert-file-contents "/etc/sendmail.cf")
                   (goto-char (point-min))
                   (let ((case-fold-search nil))
@@ -1205,7 +1242,7 @@ If nil, you might be asked to input the charset."
 (defcustom message-dont-reply-to-names
   (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
   "*Addresses to prune when doing wide replies.
-This can be a regexp or a list of regexps. Also, a value of nil means
+This can be a regexp or a list of regexps.  Also, a value of nil means
 exclude your own user name only."
   :version "21.1"
   :group 'message
@@ -1270,7 +1307,7 @@ starting with `not' and followed by regexps."
 (defface message-header-to
   '((((class color)
       (background dark))
-     (:foreground "green2" :bold t))
+     (:foreground "DarkOliveGreen1" :bold t))
     (((class color)
       (background light))
      (:foreground "MidnightBlue" :bold t))
@@ -1284,7 +1321,7 @@ starting with `not' and followed by regexps."
 (defface message-header-cc
   '((((class color)
       (background dark))
-     (:foreground "green4" :bold t))
+     (:foreground "chartreuse1" :bold t))
     (((class color)
       (background light))
      (:foreground "MidnightBlue"))
@@ -1298,7 +1335,7 @@ starting with `not' and followed by regexps."
 (defface message-header-subject
   '((((class color)
       (background dark))
-     (:foreground "green3"))
+     (:foreground "OliveDrab1"))
     (((class color)
       (background light))
      (:foreground "navy blue" :bold t))
@@ -1326,7 +1363,7 @@ starting with `not' and followed by regexps."
 (defface message-header-other
   '((((class color)
       (background dark))
-     (:foreground "#b00000"))
+     (:foreground "VioletRed1"))
     (((class color)
       (background light))
      (:foreground "steel blue"))
@@ -1340,7 +1377,7 @@ starting with `not' and followed by regexps."
 (defface message-header-name
   '((((class color)
       (background dark))
-     (:foreground "DarkGreen"))
+     (:foreground "green"))
     (((class color)
       (background light))
      (:foreground "cornflower blue"))
@@ -1354,7 +1391,7 @@ starting with `not' and followed by regexps."
 (defface message-header-xheader
   '((((class color)
       (background dark))
-     (:foreground "blue"))
+     (:foreground "DeepSkyBlue1"))
     (((class color)
       (background light))
      (:foreground "blue"))
@@ -1368,7 +1405,7 @@ starting with `not' and followed by regexps."
 (defface message-separator
   '((((class color)
       (background dark))
-     (:foreground "blue3"))
+     (:foreground "LightSkyBlue1"))
     (((class color)
       (background light))
      (:foreground "brown"))
@@ -1382,7 +1419,7 @@ sta