X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmessage.el;h=f3697eb45d134a7f38dc3bf440b1a187af1e9b99;hp=f3ca5265d69f60bc784171f6903c6b479a2a3152;hb=a82fb840dc1a4e4f343f7f3e0faa307e841f3bc2;hpb=543af8701edda4919b14180f17475ae1b1272c14

diff --git a/lisp/message.el b/lisp/message.el
index f3ca5265d..f3697eb45 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,7 +1,7 @@
 ;;; message.el --- composing mail and news messages
 
 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
@@ -34,11 +34,12 @@
 (eval-when-compile
   (require 'cl))
 
-(require 'hashcash)
-(require 'canlock)
 (require 'mailheader)
 (require 'gmm-utils)
-(require 'nnheader)
+(require 'mail-utils)
+;; Only for the trivial macros mail-header-from, mail-header-date
+;; mail-header-references, mail-header-subject, mail-header-id
+(eval-when-compile (require 'nnheader))
 ;; This is apparently necessary even though things are autoloaded.
 ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
 ;; require mailabbrev here.
@@ -48,7 +49,6 @@
 (require 'mail-parse)
 (require 'mml)
 (require 'rfc822)
-(require 'ecomplete)
 
 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
 
@@ -171,6 +171,7 @@ If `angles', they look like:
 
 Otherwise, most addresses look like `angles', but they look like
 `parens' if `angles' would need quoting and `parens' would not."
+  :version "23.2"
   :type '(choice (const :tag "simple" nil)
 		 (const parens)
 		 (const angles)
@@ -246,6 +247,15 @@ included.  Organization and User-Agent are optional."
   :link '(custom-manual "(message)Message Headers")
   :type '(repeat sexp))
 
+(defcustom message-prune-recipient-rules nil
+  "Rules for how to prune the list of recipients when doing wide replies.
+This is a list of regexps and regexp matches."
+  :version "24.1"
+  :group 'message-mail
+  :group 'message-headers
+  :link '(custom-manual "(message)Wide Reply")
+  :type '(repeat regexp))
+
 (defcustom message-deletable-headers '(Message-ID Date Lines)
   "Headers to be deleted if they already exist and were generated by message previously."
   :group 'message-headers
@@ -435,7 +445,8 @@ whitespace)."
 
 (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."
+A value of nil means let mailer mail back a message to report errors."
+  :version "23.2"
   :group 'message-sending
   :group 'message-mail
   :link '(custom-manual "(message)Sending Variables")
@@ -445,11 +456,11 @@ nil means let mailer mail back a message to report errors."
   "When non-nil, ask for confirmation when sending a message."
   :group 'message-sending
   :group 'message-mail
-  :version "22.3" ;; No Gnus
+  :version "23.1" ;; No Gnus
   :link '(custom-manual "(message)Sending Variables")
   :type 'boolean)
 
-(defcustom message-generate-new-buffers 'unique
+(defcustom message-generate-new-buffers 'unsent
   "*Say whether to create a new message buffer to compose a message.
 Valid values include:
 
@@ -472,6 +483,7 @@ function
   If this is a function, call that function with three parameters:
   The type, the To address and the group name (any of these may be nil).
   The function should return the new buffer name."
+  :version "24.1"
   :group 'message-buffers
   :link '(custom-manual "(message)Message Buffers")
   :type '(choice (const nil)
@@ -626,7 +638,7 @@ Done before generating the new subject of a forward."
 		non-word-constituents
 		"]\\)+>+\\|[ \t]*[]>|}]\\)+"))))
   "*Regexp matching the longest possible citation prefix on a line."
-  :version "22.1"
+  :version "23.2"
   :group 'message-insertion
   :link '(custom-manual "(message)Insertion Variables")
   :type 'regexp
@@ -643,8 +655,6 @@ 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)
@@ -653,17 +663,21 @@ Done before generating the new subject of a forward."
 	      (executable-find sendmail-program))
 	 'message-send-mail-with-sendmail)
 	((and (locate-library "smtpmail")
-	      (require 'smtpmail)
+	      (boundp 'smtpmail-default-smtp-server)
 	      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'")))))
+	 (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 (message-send-mail-function)
+(defcustom message-send-mail-function
+  (cond ((eq send-mail-function 'smtpmail-send-it) 'message-smtpmail-send-it)
+	((eq send-mail-function 'feedmail-send-it) 'feedmail-send-it)
+	((eq send-mail-function 'mailclient-send-it)
+	 'message-send-mail-with-mailclient)
+	(t (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'.
@@ -686,7 +700,7 @@ See also `send-mail-function'."
 			       :tag "Use Mailclient package")
  		(function :tag "Other"))
   :group 'message-sending
-  :version "23.1" ;; No Gnus
+  :version "23.2"
   :initialize 'custom-initialize-default
   :link '(custom-manual "(message)Mail Variables")
   :group 'message-mail)
@@ -819,7 +833,7 @@ Doing so would be even more evil than leaving it out."
   "*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"
+  :version "23.2"
   :type '(choice (string :tag "From name")
 		 (const :tag "Use From: header from message" header)
 		 (const :tag "Use `user-mail-address'" nil))
@@ -843,8 +857,8 @@ If this is nil, use `user-mail-address'.  If it is the symbol
 
 (defcustom message-qmail-inject-args nil
   "Arguments passed to qmail-inject programs.
-This should be a list of strings, one string for each argument.  It
-may also be a function.
+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
@@ -996,6 +1010,7 @@ Please also read the note in the documentation of
   "*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' and `message-yank-empty-prefix'."
+  :version "23.2"
   :type 'string
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
@@ -1020,6 +1035,7 @@ See also `message-yank-prefix' and `message-yank-cited-prefix'."
 (defcustom message-indentation-spaces 3
   "*Number of spaces to insert at the beginning of each cited line.
 Used by `message-yank-original' via `message-yank-cite'."
+  :version "23.2"
   :group 'message-insertion
   :link '(custom-manual "(message)Insertion Variables")
   :type 'integer)
@@ -1051,6 +1067,7 @@ point and mark around the citation text as modified."
 If t, the `message-signature-file' file will be inserted instead.
 If a function, the result from the function will be used instead.
 If a form, the result from the form will be used instead."
+  :version "23.2"
   :type 'sexp
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
@@ -1061,6 +1078,7 @@ Ignored if the named file doesn't exist.
 If nil, don't insert a signature.
 If a path is specified, the value of `message-signature-directory' is ignored,
 even if set."
+  :version "23.2"
   :type '(choice file (const :tags "None" nil))
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
@@ -1106,6 +1124,8 @@ If stringp, use this; if non-nil, use no host name (user name only)."
 		 (string :tag "name")
 		 (sexp :tag "none" :format "%t" t)))
 
+;; This can be the name of a buffer, or a cons cell (FUNCTION . ARGS)
+;; for yanking the original buffer.
 (defvar message-reply-buffer nil)
 (defvar message-reply-headers nil
   "The headers of the current replied article.
@@ -1134,12 +1154,29 @@ It is a vector of the following headers:
   "*A string containing header lines to be inserted in outgoing messages.
 It is inserted before you edit the message, so you can edit or delete
 these lines."
+  :version "23.2"
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
   :type 'message-header-lines)
 
-(defcustom message-default-mail-headers ""
+(defcustom message-default-mail-headers
+  ;; Ease the transition from mail-mode to message-mode.  See bugs#4431, 5555.
+  (concat (if (and (boundp 'mail-default-reply-to)
+		   (stringp mail-default-reply-to))
+	      (format "Reply-to: %s\n" mail-default-reply-to))
+	  (if (and (boundp 'mail-self-blind)
+		   mail-self-blind)
+	      (format "BCC: %s\n" user-mail-address))
+	  (if (and (boundp 'mail-archive-file-name)
+		   (stringp mail-archive-file-name))
+	      (format "FCC: %s\n" mail-archive-file-name))
+	  ;; Use the value of `mail-default-headers' if available.
+	  ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is
+	  ;; unavailable unless sendmail.el is loaded.
+	  (if (boundp 'mail-default-headers)
+	      mail-default-headers))
   "*A string of header lines to be inserted in outgoing mails."
+  :version "23.2"
   :group 'message-headers
   :group 'message-mail
   :link '(custom-manual "(message)Mail Headers")
@@ -1223,7 +1260,7 @@ text and it replaces `self-insert-command' with the other command, e.g.
   :type '(repeat function))
 
 (defcustom message-auto-save-directory
-  (file-name-as-directory (nnheader-concat message-directory "drafts"))
+  (file-name-as-directory (expand-file-name "drafts" message-directory))
   "*Directory where Message auto-saves buffers if Gnus isn't running.
 If nil, Message won't auto-save."
   :group 'message-buffers
@@ -1317,6 +1354,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-header-to-face 'face-alias 'message-header-to)
+(put 'message-header-to-face 'obsolete-face "22.1")
 
 (defface message-header-cc
   '((((class color)
@@ -1331,6 +1369,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-header-cc-face 'face-alias 'message-header-cc)
+(put 'message-header-cc-face 'obsolete-face "22.1")
 
 (defface message-header-subject
   '((((class color)
@@ -1345,6 +1384,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-header-subject-face 'face-alias 'message-header-subject)
+(put 'message-header-subject-face 'obsolete-face "22.1")
 
 (defface message-header-newsgroups
   '((((class color)
@@ -1359,6 +1399,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
+(put 'message-header-newsgroups-face 'obsolete-face "22.1")
 
 (defface message-header-other
   '((((class color)
@@ -1373,6 +1414,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-header-other-face 'face-alias 'message-header-other)
+(put 'message-header-other-face 'obsolete-face "22.1")
 
 (defface message-header-name
   '((((class color)
@@ -1387,6 +1429,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-header-name-face 'face-alias 'message-header-name)
+(put 'message-header-name-face 'obsolete-face "22.1")
 
 (defface message-header-xheader
   '((((class color)
@@ -1401,6 +1444,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-header-xheader-face 'face-alias 'message-header-xheader)
+(put 'message-header-xheader-face 'obsolete-face "22.1")
 
 (defface message-separator
   '((((class color)
@@ -1415,6 +1459,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-separator-face 'face-alias 'message-separator)
+(put 'message-separator-face 'obsolete-face "22.1")
 
 (defface message-cited-text
   '((((class color)
@@ -1429,6 +1474,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-cited-text-face 'face-alias 'message-cited-text)
+(put 'message-cited-text-face 'obsolete-face "22.1")
 
 (defface message-mml
   '((((class color)
@@ -1443,6 +1489,7 @@ starting with `not' and followed by regexps."
   :group 'message-faces)
 ;; backward-compatibility alias
 (put 'message-mml-face 'face-alias 'message-mml)
+(put 'message-mml-face 'obsolete-face "22.1")
 
 (defun message-font-lock-make-header-matcher (regexp)
   (let ((form
@@ -1556,11 +1603,11 @@ 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
+(defcustom message-send-mail-partially-limit nil
   "The limitation of messages sent as message/partial.
 The lower bound of message size in characters, beyond which the message
 should be sent in several parts.  If it is nil, the size is unlimited."
-  :version "21.1"
+  :version "24.1"
   :group 'message-buffers
   :link '(custom-manual "(message)Mail Variables")
   :type '(choice (const :tag "unlimited" nil)
@@ -1652,13 +1699,14 @@ functionality to work."
 		 (const :tag "Never" nil)
 		 (const :tag "Always" t)))
 
-(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
+(defcustom message-generate-hashcash (if (executable-find "hashcash") 'opportunistic)
   "*Whether to generate X-Hashcash: headers.
 If t, always generate hashcash headers.  If `opportunistic',
 only generate hashcash headers if it can be done without the user
 waiting (i.e., only asynchronously).
 
 You must have the \"hashcash\" binary installed, see `hashcash-path'."
+  :version "24.1"
   :group 'message-headers
   :link '(custom-manual "(message)Mail Headers")
   :type '(choice (const :tag "Always" t)
@@ -1675,6 +1723,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (defvar message-mime-part nil)
 (defvar message-posting-charset nil)
 (defvar message-inserted-headers nil)
+(defvar message-inhibit-ecomplete nil)
 
 ;; Byte-compiler warning
 (defvar gnus-active-hashtb)
@@ -1824,7 +1873,6 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 (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")
 
 
@@ -1890,6 +1938,8 @@ is used by default."
 		 (setq paren nil))))
 	(nreverse elems)))))
 
+(autoload 'nnheader-insert-file-contents "nnheader")
+
 (defun message-mail-file-mbox-p (file)
   "Say whether FILE looks like a Unix mbox file."
   (when (and (file-exists-p file)
@@ -1950,7 +2000,7 @@ see `message-narrow-to-headers-or-head'."
 
 (defmacro message-with-reply-buffer (&rest forms)
   "Evaluate FORMS in the reply buffer, if it exists."
-  `(when (and message-reply-buffer
+  `(when (and (bufferp message-reply-buffer)
 	      (buffer-name message-reply-buffer))
      (with-current-buffer message-reply-buffer
        ,@forms)))
@@ -2395,6 +2445,8 @@ Return the number of headers removed."
      (point-max)))
   (goto-char (point-min)))
 
+;; FIXME: clarify diffference: message-narrow-to-head,
+;; message-narrow-to-headers-or-head, message-narrow-to-headers
 (defun message-narrow-to-head ()
   "Narrow the buffer to the head of the message.
 Point is left at the beginning of the narrowed-to region."
@@ -2503,7 +2555,8 @@ 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")
-  ;; Why not `info', which is in loaddefs.el?
+  ;; Don't use `info' because support for `(filename)nodename' is not
+  ;; available in XEmacs < 21.5.12.
   (Info-goto-node (format "(%s)Top"
 			  (cond ((eq arg 16)
 				 (require 'mml2015)
@@ -2716,7 +2769,7 @@ PGG manual, depending on the value of `mml2015-use'."
 ;;; Forbidden properties
 ;;
 ;; We use `after-change-functions' to keep special text properties
-;; that interfer with the normal function of message mode out of the
+;; that interfere with the normal function of message mode out of the
 ;; buffer.
 
 (defcustom message-strip-special-text-properties t
@@ -2780,6 +2833,8 @@ See also `message-forbidden-properties'."
 	  (inhibit-read-only t))
       (remove-text-properties begin end message-forbidden-properties))))
 
+(autoload 'ecomplete-setup "ecomplete") ;; for Emacs <23.
+
 ;;;###autoload
 (define-derived-mode message-mode text-mode "Message"
   "Major mode for editing mail and news to be sent.
@@ -3129,7 +3184,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
   "Widen the reply to include maximum recipients."
   (interactive)
   (let ((follow-to
-	 (and message-reply-buffer
+	 (and (bufferp message-reply-buffer)
 	      (buffer-name message-reply-buffer)
 	      (with-current-buffer message-reply-buffer
 		(message-get-reply-headers t)))))
@@ -3182,7 +3237,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
 
 (defun message-kill-to-signature (&optional arg)
   "Kill all text up to the signature.
-If a numberic argument or prefix arg is given, leave that number
+If a numeric argument or prefix arg is given, leave that number
 of lines before the signature intact."
   (interactive "P")
   (save-excursion
@@ -3339,8 +3394,8 @@ Message buffers and is not meant to be called directly."
 				;; if message-signature-file contains a path.
 				(not (file-name-directory
 				      message-signature-file)))
-			   (nnheader-concat message-signature-directory
-					    message-signature-file)
+			   (expand-file-name message-signature-file
+					     message-signature-directory)
 			 message-signature-file))
 		 (file-exists-p signature-file))))
     (when signature
@@ -3624,9 +3679,16 @@ Really top post? ")))
 				      (point-max)))
 	      (delete-region (message-goto-body) (point-max)))
 	  (set (make-local-variable 'message-cite-reply-above) nil)))
-      (delete-windows-on message-reply-buffer t)
+      (if (bufferp message-reply-buffer)
+	  (delete-windows-on message-reply-buffer t))
       (push-mark (save-excursion
-		   (insert-buffer-substring message-reply-buffer)
+		   (cond
+		    ((bufferp message-reply-buffer)
+		     (insert-buffer-substring message-reply-buffer))
+		    ((and (consp message-reply-buffer)
+			  (functionp (car message-reply-buffer)))
+		     (apply (car message-reply-buffer)
+			    (cdr message-reply-buffer))))
 		   (unless (bolp)
 		     (insert ?\n))
 		   (point)))
@@ -3811,9 +3873,8 @@ See `message-citation-line-format'."
 			       (>= i ?a)))
 		  (push i lst)
 		  (push (condition-case nil
-			    (progn (format-time-string (format "%%%c" i)
-						       replydate))
-			  (format ">%c<" i))
+			    (format-time-string (format "%%%c" i) replydate)
+			  (error (format ">%c<" i)))
 			lst))
 		(setq i (1+ i)))
 	      (reverse lst)))
@@ -4015,7 +4076,8 @@ It should typically alter the sending method in some way or other."
 	(run-hooks 'message-sent-hook))
       (message "Sending...done")
       ;; Do ecomplete address snarfing.
-      (when (message-mail-alias-type-p 'ecomplete)
+      (when (and (message-mail-alias-type-p 'ecomplete)
+		 (not message-inhibit-ecomplete))
 	(message-put-addresses-in-ecomplete))
       ;; Mark the buffer as unmodified and delete auto-save.
       (set-buffer-modified-p nil)
@@ -4140,6 +4202,8 @@ conformance."
 		  (and (mm-multibyte-p)
 		       (memq (char-charset char)
 			     '(eight-bit-control eight-bit-graphic
+						 ;; Emacs 23, Bug#1770:
+						 eight-bit
 						 control-1))
 		       (not (get-text-property
 			     (point) 'untranslated-utf-8))))
@@ -4166,10 +4230,13 @@ conformance."
 		  (or (< (mm-char-int char) 128)
 		      (and (mm-multibyte-p)
 			   ;; FIXME: Wrong for Emacs 23 (unicode) and for
-			   ;; things like undecable utf-8.  Should at least
-			   ;; use find-coding-systems-region.
+			   ;; things like undecodable utf-8 (in Emacs 21?).
+			   ;; Should at least use find-coding-systems-region.
+			   ;; -- fx
 			   (memq (char-charset char)
 				 '(eight-bit-control eight-bit-graphic
+						     ;; Emacs 23, Bug#1770:
+						     eight-bit
 						     control-1))
 			   (not (get-text-property
 				 (point) 'untranslated-utf-8)))))
@@ -4232,7 +4299,7 @@ This function could be useful in `message-setup-hook'."
 		 (not (y-or-n-p
 		       (format
 			"Address `%s' might be bogus.  Continue? " bog)))
-		 (error "Bogus address."))))))))
+		 (error "Bogus address"))))))))
 
 (custom-add-option 'message-setup-hook 'message-check-recipients)
 
@@ -4325,14 +4392,15 @@ This function could be useful in `message-setup-hook'."
 	      (end-of-line)
 	      (insert (format " (%d/%d)" n total))
 	      (widen)
-	      (mm-with-unibyte-current-buffer
-		(funcall (or message-send-mail-real-function
-			     message-send-mail-function))))
+              (funcall (or message-send-mail-real-function
+                           message-send-mail-function)))
 	    (setq n (+ n 1))
 	    (setq p (pop plist))
 	    (erase-buffer)))
       (kill-buffer tembuf))))
 
+(declare-function hashcash-wait-async "hashcash" (&optional buffer))
+
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
   (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
@@ -4340,14 +4408,26 @@ This function could be useful in `message-setup-hook'."
 	 (news (message-news-p))
 	 (mailbuf (current-buffer))
 	 (message-this-is-mail t)
+	 ;; gnus-setup-posting-charset is autoloaded in mml.el (FIXME
+	 ;; maybe it should not be), which this file requires.  Hence
+	 ;; the fboundp test is always true.  Loading it from gnus-msg
+	 ;; loads many Gnus files (Bug#5642).  If
+	 ;; gnus-group-posting-charset-alist hasn't been customized,
+	 ;; this is just going to return nil anyway.  FIXME it would
+	 ;; be good to improve this further, because even if g-g-p-c-a
+	 ;; has been customized, that is likely to just be for news.
+	 ;; Eg either move the definition from gnus-msg, or separate out
+	 ;; the mail and news parts.
 	 (message-posting-charset
-	  (if (fboundp 'gnus-setup-posting-charset)
+	  (if (and (fboundp 'gnus-setup-posting-charset)
+		   (boundp 'gnus-group-posting-charset-alist))
 	      (gnus-setup-posting-charset nil)
 	    message-posting-charset))
 	 (headers message-required-mail-headers))
     (when (and message-generate-hashcash
 	       (not (eq message-generate-hashcash 'opportunistic)))
       (message "Generating hashcash...")
+      (require 'hashcash)
       ;; Wait for calculations already started to finish...
       (hashcash-wait-async)
       ;; ...and do calculations not already done.  mail-add-payment
@@ -4429,6 +4509,11 @@ This function could be useful in `message-setup-hook'."
 				  (message-fetch-field
 				   "content-transfer-encoding")))))))
 	    (message-insert-courtesy-copy))
+          ;; Let's make sure we encoded all the body.
+          (assert (save-excursion
+                    (goto-char (point-min))
+                    (not (re-search-forward "[^\000-\377]" nil t))))
+          (mm-disable-multibyte)
 	  (if (or (not message-send-mail-partially-limit)
 		  (< (buffer-size) message-send-mail-partially-limit)
 		  (not (message-y-or-n-p
@@ -4453,7 +4538,7 @@ The size limit is controlled by `message-send-mail-partially-limit'.
 If you always want Gnus to send messages in one piece, set
 `message-send-mail-partially-limit' to nil.
 ")))
-	      (mm-with-unibyte-current-buffer
+	      (progn
 		(message "Sending via mail...")
 		(funcall (or message-send-mail-real-function
 			     message-send-mail-function)))
@@ -4464,6 +4549,7 @@ If you always want Gnus to send messages in one piece, set
 
 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
+  (require 'sendmail)
   (let ((errbuf (if message-interactive
 		    (message-generate-new-buffer-clone-locals
 		     " sendmail errors")
@@ -4512,8 +4598,8 @@ If you always want Gnus to send messages in one piece, set
 			;; since some systems have broken sendmails.
 			;; But some systems are more broken with -f, so
 			;; we'll let users override this.
-			(if (null message-sendmail-f-is-evil)
-			    (list "-f" (message-sendmail-envelope-from)))
+			(and (null message-sendmail-f-is-evil)
+			     (list "-f" (message-sendmail-envelope-from)))
 			;; These mean "report errors by mail"
 			;; and "deliver in background".
 			(if (null message-interactive) '("-oem" "-odb"))
@@ -4603,17 +4689,17 @@ to find out how to use this."
 
 (defun message-smtpmail-send-it ()
   "Send the prepared message buffer with `smtpmail-send-it'.
-This only differs from `smtpmail-send-it' that this command evaluates
-`message-send-mail-hook' just before sending a message.  It is useful
-if your ISP requires the POP-before-SMTP authentication.  See the Gnus
-manual for details."
+The only difference from `smtpmail-send-it' is that this command
+evaluates `message-send-mail-hook' just before sending a message.
+It is useful if your ISP requires the POP-before-SMTP
+authentication.  See the Gnus manual for details."
   (run-hooks 'message-send-mail-hook)
   (smtpmail-send-it))
 
 (defun message-send-mail-with-mailclient ()
   "Send the prepared message buffer with `mailclient-send-it'.
-This only differs from `smtpmail-send-it' that this command evaluates
-`message-send-mail-hook' just before sending a message."
+The only difference from `mailclient-send-it' is that this
+command evaluates `message-send-mail-hook' just before sending a message."
   (run-hooks 'message-send-mail-hook)
   (mailclient-send-it))
 
@@ -4627,10 +4713,14 @@ Do not use this for anything important, it is cryptographically weak."
 		  (prin1-to-string (recent-keys))
 		  (prin1-to-string (garbage-collect))))))
 
+(defvar canlock-password)
+(defvar canlock-password-for-verify)
+
 (defun message-canlock-password ()
   "The password used by message for cancel locks.
 This is the value of `canlock-password', if that option is non-nil.
 Otherwise, generate and save a value for `canlock-password' first."
+  (require 'canlock)
   (unless canlock-password
     (customize-save-variable 'canlock-password (message-canlock-generate))
     (setq canlock-password-for-verify canlock-password))
@@ -4641,7 +4731,12 @@ Otherwise, generate and save a value for `canlock-password' first."
     (message-canlock-password)
     (canlock-insert-header)))
 
+(autoload 'nnheader-get-report "nnheader")
+
+(declare-function gnus-setup-posting-charset "gnus-msg" (group))
+
 (defun message-send-news (&optional arg)
+  (require 'gnus-msg)
   (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
 	 (case-fold-search nil)
 	 (method (if (functionp message-post-method)
@@ -5019,7 +5114,8 @@ Otherwise, generate and save a value for `canlock-password' first."
 	  "Denied posting -- the From looks strange: \"%s\"." from)
 	 nil)
 	((let ((addresses (rfc822-addresses from)))
-	   (while (and addresses
+	   ;; `rfc822-addresses' returns a string if parsing fails.
+	   (while (and (consp addresses)
 		       (not (eq (string-to-char (car addresses)) ?\()))
 	     (setq addresses (cdr addresses)))
 	   addresses)
@@ -5115,17 +5211,24 @@ Otherwise, generate and save a value for `canlock-password' first."
 	nil)))
    ;; Check the length of the signature.
    (message-check 'signature
-     (goto-char (point-max))
-     (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)))
+     (let (sig-start sig-end)
+       (goto-char (point-max))
+       (if (not (re-search-backward message-signature-separator nil t))
+	   t
+	 (setq sig-start (1+ (point-at-eol)))
+	 (setq sig-end
+	       (if (re-search-forward
+		    "<#/?\\(multipart\\|part\\|external\\|mml\\)" nil t)
+		   (- (point-at-bol) 1)
+		 (point-max)))
+	 (if (>= (count-lines sig-start sig-end) 5)
+	     (if (message-gnksa-enable-p 'signature)
+		 (y-or-n-p
+		  (format "Signature is excessively long (%d lines).  Really post? "
+			  (count-lines sig-start sig-end)))
+	       (message "Denied posting -- Excessive signature.")
+	       nil)
+	   t))))
    ;; Ensure that text follows last quoted portion.
    (message-check 'quoting-style
      (goto-char (point-max))
@@ -5204,6 +5307,13 @@ Otherwise, generate and save a value for `canlock-password' first."
 	    (if (and message-fcc-handler-function
 		     (not (eq message-fcc-handler-function 'rmail-output)))
 		(funcall message-fcc-handler-function file)
+	      ;; FIXME this option, rmail-output (also used if
+	      ;; message-fcc-handler-function is nil) is not
+	      ;; documented anywhere AFAICS.  It should work in Emacs
+	      ;; 23; I suspect it does not work in Emacs 22.
+	      ;; FIXME I don't see the need for the two different cases here.
+	      ;; mail-use-rfc822 makes no difference (in Emacs 23),and
+	      ;; the third argument just controls \"Wrote file\" message.
 	      (if (and (file-readable-p file) (mail-file-babyl-p file))
 		  (rmail-output file 1 nil t)
 		(let ((mail-use-rfc822 t))
@@ -5307,7 +5417,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
 	   (* 25 25)))
   (let ((tm (current-time)))
     (concat
-     (if (or (memq system-type '(ms-dos emx))
+     (if (or (eq system-type 'ms-dos)
 	     ;; message-number-base36 doesn't handle bigints.
 	     (floatp (user-uid)))
 	 (let ((user (downcase (user-login-name))))
@@ -5365,7 +5475,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
 (defun message-make-references ()
   "Return the References header for this message."
   (when message-reply-headers
-    (let ((message-id (mail-header-message-id message-reply-headers))
+    (let ((message-id (mail-header-id message-reply-headers))
 	  (references (mail-header-references message-reply-headers)))
       (if (or references message-id)
 	  (concat (or references "") (and references " ")
@@ -5377,7 +5487,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
   (when message-reply-headers
     (let ((from (mail-header-from message-reply-headers))
 	  (date (mail-header-date message-reply-headers))
-	  (msg-id (mail-header-message-id message-reply-headers)))
+	  (msg-id (mail-header-id message-reply-headers)))
       (when from
 	(let ((name (mail-extract-address-components from)))
 	  (concat
@@ -5635,7 +5745,9 @@ subscribed address (and not the additional To and Cc header contents)."
 				(mapcar
 				 'cadr
 				 (mail-extract-address-components field t))))))
-	(setq ace (if (string-match "\\`[[:ascii:]]+\\'" rhs)
+	;; Note that `rhs' will be "" if the address does not have
+	;; the domain part, i.e., if it is a local user's address.
+	(setq ace (if (string-match "\\`[[:ascii:]]*\\'" rhs)
 		      rhs
 		    (downcase (idna-to-ascii rhs))))
 	(when (and (not (equal rhs ace))
@@ -5657,7 +5769,13 @@ See `message-idna-encode'."
   (when message-use-idna
     (save-excursion
       (save-restriction
-	(message-narrow-to-head)
+	;; `message-narrow-to-head' that recognizes only the first empty
+	;; line as the message header separator used to be used here.
+	;; However, since there is the "--text follows this line--" line
+	;; normally, it failed in narrowing to the headers and potentially
+	;; caused the IDNA encoding on lines that look like headers in
+	;; the message body.
+	(message-narrow-to-headers-or-head)
 	(message-idna-to-ascii-rhs-1 "From")
 	(message-idna-to-ascii-rhs-1 "To")
 	(message-idna-to-ascii-rhs-1 "Reply-To")
@@ -5773,6 +5891,7 @@ Headers already prepared in the buffer are not modified."
 		      (if formatter
 			  (funcall formatter header value)
 			(insert header-string ": " value))
+		      (push header-string message-inserted-headers)
 		      (goto-char (message-fill-field))
 		      ;; We check whether the value was ended by a
 		      ;; newline.  If not, we insert one.
@@ -6170,14 +6289,14 @@ between beginning of field and beginning of line."
 	nil
       mua)))
 
-(defun message-setup (headers &optional replybuffer actions
+;; YANK-ACTION, if non-nil, can be a buffer or a yank action of the
+;; form (FUNCTION . ARGS).
+(defun message-setup (headers &optional yank-action actions
 			      continue switch-function)
   (let ((mua (message-mail-user-agent))
-	subject to field yank-action)
+	subject to field)
     (if (not (and message-this-is-mail mua))
-	(message-setup-1 headers replybuffer actions)
-      (if replybuffer
-	  (setq yank-action (list 'insert-buffer replybuffer)))
+	(message-setup-1 headers yank-action actions)
       (setq headers (copy-sequence headers))
       (setq field (assq 'Subject headers))
       (when field
@@ -6194,7 +6313,11 @@ between beginning of field and beginning of line."
 				 (format "%s" (car item))
 				 (cdr item)))
 			      headers)
-		      continue switch-function yank-action actions)))))
+		      continue switch-function
+		      (if (bufferp yank-action)
+			  (list 'insert-buffer yank-action)
+			yank-action)
+		      actions)))))
 
 (defun message-headers-to-generate (headers included-headers excluded-headers)
   "Return a list that includes all headers from HEADERS.
@@ -6221,12 +6344,16 @@ are not included."
 	(push header result)))
     (nreverse result)))
 
-(defun message-setup-1 (headers &optional replybuffer actions)
+(defun message-setup-1 (headers &optional yank-action actions)
   (dolist (action actions)
     (condition-case nil
 	(add-to-list 'message-send-actions
 		     `(apply ',(car action) ',(cdr action)))))
-  (setq message-reply-buffer replybuffer)
+  (setq message-reply-buffer
+	(if (and (consp yank-action)
+		 (eq (car yank-action) 'insert-buffer))
+	    (nth 1 yank-action)
+	  yank-action))
   (goto-char (point-min))
   ;; Insert all the headers.
   (mail-header-format
@@ -6308,9 +6435,7 @@ are not included."
       (setq buffer-file-name (expand-file-name
 			      (concat
 			      (if (memq system-type
-					'(ms-dos ms-windows windows-nt
-						 cygwin cygwin32 win32 w32
-						 mswindows))
+					'(ms-dos windows-nt cygwin))
 				  "message"
 				"*message*")
 			       (format-time-string "-%Y%m%d-%H%M%S"))
@@ -6357,7 +6482,7 @@ OTHER-HEADERS is an alist of header/value pairs.  CONTINUE says whether
 to continue editing a message already being composed.  SWITCH-FUNCTION
 is a function used to switch to and display the mail buffer."
   (interactive)
-  (let ((message-this-is-mail t) replybuffer)
+  (let ((message-this-is-mail t))
     (unless (message-mail-user-agent)
       (message-pop-to-buffer
        ;; Search for the existing message buffer if `continue' is non-nil.
@@ -6368,15 +6493,11 @@ is a function used to switch to and display the mail buffer."
 		message-generate-new-buffers)))
 	 (message-buffer-name "mail" to))
        switch-function))
-    ;; FIXME: message-mail should do something if YANK-ACTION is not
-    ;; insert-buffer.
-    (and (consp yank-action) (eq (car yank-action) 'insert-buffer)
-	 (setq replybuffer (nth 1 yank-action)))
     (message-setup
      (nconc
       `((To . ,(or to "")) (Subject . ,(or subject "")))
       (when other-headers other-headers))
-     replybuffer send-actions continue switch-function)
+     yank-action send-actions continue switch-function)
     ;; FIXME: Should return nil if failure.
     t))
 
@@ -6414,7 +6535,7 @@ The function is called with one parameter, a cons cell ..."
 
 (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.
+    ;; Find all relevant headers we need.
     (save-restriction
       (message-narrow-to-headers-or-head)
       ;; Gmane renames "To".  Look at "Original-To", too, if it is present in
@@ -6540,6 +6661,8 @@ want to get rid of this query permanently.")))
 		(if recip
 		    (setq recipients (delq recip recipients))))))))
 
+      (setq recipients (message-prune-recipients recipients))
+
       ;; Build the header alist.  Allow the user to be asked whether
       ;; or not to reply to all recipients in a wide reply.
       (setq follow-to (list (cons 'To (cdr (pop recipients)))))
@@ -6553,6 +6676,22 @@ want to get rid of this query permanently.")))
 	(push (cons 'Cc recipients) follow-to)))
     follow-to))
 
+(defun message-prune-recipients (recipients)
+  (dolist (rule message-prune-recipient-rules)
+    (let ((match (car rule))
+	  dup-match
+	  address)
+      (dolist (recipient recipients)
+	(setq address (car recipient))
+	(when (string-match match address)
+	  (setq dup-match (replace-match (cadr rule) nil nil address))
+	  (dolist (recipient recipients)
+	    ;; Don't delete the address that triggered this.
+	    (when (and (not (eq address (car recipient)))
+		       (string-match dup-match (car recipient)))
+	      (setq recipients (delq recipient recipients))))))))
+  recipients)
+
 (defcustom message-simplify-subject-functions
   '(message-strip-list-identifiers
     message-strip-subject-re
@@ -7024,22 +7163,28 @@ Optional DIGEST will use digest to forward."
 (defun message-forward-make-body-plain (forward-buffer)
   (insert
    "\n-------------------- Start of forwarded message --------------------\n")
-  (let ((b (point)) e)
-    (insert
-     (with-temp-buffer
-       (mm-disable-multibyte)
-       (insert
-	(with-current-buffer forward-buffer
-	  (mm-with-unibyte-current-buffer (buffer-string))))
-       (mm-enable-multibyte)
-       (mime-to-mml)
-       (goto-char (point-min))
-       (when (looking-at "From ")
-	 (replace-match "X-From-Line: "))
-       (buffer-string)))
+  (let ((b (point))
+	(contents (with-current-buffer forward-buffer (buffer-string)))
+	e)
+    (unless (featurep 'xemacs)
+      (unless (mm-multibyte-string-p contents)
+	(error "Attempt to insert unibyte string from the buffer \"%s\"\
+ to the multibyte buffer \"%s\""
+	       (if (bufferp forward-buffer)
+		   (buffer-name forward-buffer)
+		 forward-buffer)
+	       (buffer-name))))
+    (insert (mm-with-multibyte-buffer
+	      (insert contents)
+	      (mime-to-mml)
+	      (goto-char (point-min))
+	      (when (looking-at "From ")
+		(replace-match "X-From-Line: "))
+	      (buffer-string)))
+    (unless (bolp) (insert "\n"))
     (setq e (point))
     (insert
-     "\n-------------------- End of forwarded message --------------------\n")
+     "-------------------- End of forwarded message --------------------\n")
     (message-remove-ignored-headers b e)))
 
 (defun message-remove-ignored-headers (b e)
@@ -7075,18 +7220,22 @@ Optional DIGEST will use digest to forward."
   (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
   (let ((b (point)) e)
     (if (not message-forward-decoded-p)
-	(insert
-	 (with-temp-buffer
-	   (mm-disable-multibyte)
-	   (insert
-	    (with-current-buffer forward-buffer
-	      (mm-with-unibyte-current-buffer (buffer-string))))
-	   (mm-enable-multibyte)
-	   (mime-to-mml)
-	   (goto-char (point-min))
-	   (when (looking-at "From ")
-	     (replace-match "X-From-Line: "))
-	   (buffer-string)))
+	(let ((contents (with-current-buffer forward-buffer (buffer-string))))
+	  (unless (featurep 'xemacs)
+	    (unless (mm-multibyte-string-p contents)
+	      (error "Attempt to insert unibyte string from the buffer \"%s\"\
+ to the multibyte buffer \"%s\""
+		     (if (bufferp forward-buffer)
+			 (buffer-name forward-buffer)
+		       forward-buffer)
+		     (buffer-name))))
+	  (insert (mm-with-multibyte-buffer
+		    (insert contents)
+		    (mime-to-mml)
+		    (goto-char (point-min))
+		    (when (looking-at "From ")
+		      (replace-match "X-From-Line: "))
+		    (buffer-string))))
       (save-restriction
 	(narrow-to-region (point) (point))
 	(mml-insert-buffer forward-buffer)
@@ -7206,12 +7355,16 @@ is for the internal use."
       (message-forward-make-body-plain forward-buffer)))
   (message-position-point))
 
+(declare-function rmail-toggle-header "rmail" (&optional arg))
+
 ;;;###autoload
 (defun message-forward-rmail-make-body (forward-buffer)
   (save-window-excursion
     (set-buffer forward-buffer)
     (if (rmail-msg-is-pruned)
-	(rmail-msg-restore-non-pruned-header)))
+	(if (fboundp 'rmail-msg-restore-non-pruned-header)
+	    (rmail-msg-restore-non-pruned-header) ; Emacs 22
+	  (rmail-toggle-header 0))))		  ; Emacs 23
   (message-forward-make-body forward-buffer))
 
 ;; Fixme: Should have defcustom.
@@ -7274,6 +7427,7 @@ is for the internal use."
 	(replace-match "X-From-Line: "))
       ;; Send it.
       (let ((message-inhibit-body-encoding t)
+	    (message-inhibit-ecomplete t)
 	    message-required-mail-headers
 	    message-generate-hashcash
 	    rfc2047-encode-encoded-words)
@@ -7421,10 +7575,8 @@ which specify the range to operate on."
 
 (defun message-exchange-point-and-mark ()
   "Exchange point and mark, but don't activate region if it was inactive."
-  (unless (prog1
-	      (message-mark-active-p)
-	    (exchange-point-and-mark))
-    (setq mark-active nil)))
+  (goto-char (prog1 (mark t)
+	       (set-marker (mark-marker) (point)))))
 
 (defalias 'message-make-overlay 'make-overlay)
 (defalias 'message-delete-overlay 'delete-overlay)
@@ -7629,37 +7781,44 @@ those headers."
 		 (point))
 		(skip-chars-backward "^, \t\n") (point))))
 	 (completion-ignore-case t)
-	 (string (buffer-substring b (progn (skip-chars-forward "^,\t\n ")
-					    (point))))
-	 (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
-	 (completions (all-completions string hashtb))
-	 comp)
-    (delete-region b (point))
-    (cond
-     ((= (length completions) 1)
-      (if (string= (car completions) string)
-	  (progn
-	    (insert string)
-	    (message "Only matching group"))
-	(insert (car completions))))
-     ((and (setq comp (try-completion string hashtb))
-	   (not (string= comp string)))
-      (insert comp))
-     (t
-      (insert string)
-      (if (not comp)
-	  (message "No matching groups")
-	(save-selected-window
-	  (pop-to-buffer "*Completions*")
-	  (buffer-disable-undo)
-	  (let ((buffer-read-only nil))
-	    (erase-buffer)
-	    (let ((standard-output (current-buffer)))
-	      (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))))))))))
+         (e (progn (skip-chars-forward "^,\t\n ") (point)))
+	 (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)))
+    (message-completion-in-region e b hashtb)))
+
+(defalias 'message-completion-in-region
+  (if (fboundp 'completion-in-region)
+      'completion-in-region
+    (lambda (e b hashtb)
+      (let* ((string (buffer-substring b e))
+             (completions (all-completions string hashtb))
+             comp)
+        (delete-region b (point))
+        (cond
+         ((= (length completions) 1)
+          (if (string= (car completions) string)
+              (progn
+                (insert string)
+                (message "Only matching group"))
+            (insert (car completions))))
+         ((and (setq comp (try-completion string hashtb))
+               (not (string= comp string)))
+          (insert comp))
+         (t
+          (insert string)
+          (if (not comp)
+              (message "No matching groups")
+            (save-selected-window
+              (pop-to-buffer "*Completions*")
+              (buffer-disable-undo)
+              (let ((buffer-read-only nil))
+                (erase-buffer)
+                (let ((standard-output (current-buffer)))
+                  (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))))))))))))
 
 (defun message-expand-name ()
   (cond ((and (memq 'eudc message-expand-name-databases)
@@ -7881,7 +8040,11 @@ From headers in the original article."
 	(not result)
       result)))
 
+(declare-function ecomplete-add-item "ecomplete" (type key text))
+(declare-function ecomplete-save "ecomplete" ())
+
 (defun message-put-addresses-in-ecomplete ()
+  (require 'ecomplete)
   (dolist (header '("to" "cc" "from" "reply-to"))
     (let ((value (message-field-value header)))
       (dolist (string (mail-header-parse-addresses value 'raw))
@@ -7892,6 +8055,8 @@ From headers in the original article."
 			    string))))
   (ecomplete-save))
 
+(autoload 'ecomplete-display-matches "ecomplete")
+
 (defun message-display-abbrev (&optional choose)
   "Display the next possible abbrev for the text before point."
   (interactive (list t))
@@ -8068,5 +8233,4 @@ Used in `message-simplify-recipients'."
 ;; coding: iso-8859-1
 ;; End:
 
-;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
 ;;; message.el ends here