Merge remote-tracking branch 'origin/no-gnus'

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index f514fd7..96027a1 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,7 +1,6 @@
 ;;; message.el --- composing mail and news messages
 
 ;;; message.el --- composing mail and news messages
 

-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: mail, news


@@ -50,6 +49,7 @@
 (require 'mail-parse)
 (require 'mml)
 (require 'rfc822)
 (require 'mail-parse)
 (require 'mml)
 (require 'rfc822)

+(require 'format-spec)

 
 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
 
 
 (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/
 


@@ -443,7 +443,10 @@ whitespace)."
   :group 'message-various)
 
 (defcustom message-elide-ellipsis "\n[...]\n\n"
   :group 'message-various)
 
 (defcustom message-elide-ellipsis "\n[...]\n\n"

-  "*The string which is inserted for elided text."
+  "*The string which is inserted for elided text.
+This is a format-spec string, and you can use %l to say how many
+lines were removed, and %c to say how many characters were
+removed."

   :type 'string
   :link '(custom-manual "(message)Various Commands")
   :group 'message-various)
   :type 'string
   :link '(custom-manual "(message)Various Commands")
   :group 'message-various)


@@ -683,6 +686,7 @@ Done before generating the new subject of a forward."
 (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)
 (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 'sendmail-query-once) 'sendmail-query-once)

        ((eq send-mail-function 'mailclient-send-it)
         'message-send-mail-with-mailclient)
        (t (message-send-mail-function)))
        ((eq send-mail-function 'mailclient-send-it)
         'message-send-mail-with-mailclient)
        (t (message-send-mail-function)))


@@ -898,11 +902,7 @@ variable isn't used."
   ;; create a dependence to `gnus.el'.
   :type 'sexp)
 
   ;; create a dependence to `gnus.el'.
   :type 'sexp)
 

-;; FIXME: This should be a temporary workaround until someone implements a
-;; proper solution.  If a crash happens while replying, the auto-save file
-;; will *not* have a `References:' header if `message-generate-headers-first'
-;; is nil.  See: http://article.gmane.org/gmane.emacs.gnus.general/51138
-(defcustom message-generate-headers-first '(references)
+(defcustom message-generate-headers-first nil

   "Which headers should be generated before starting to compose a message.
 If t, generate all required headers.  This can also be a list of headers to
 generate.  The variables `message-required-news-headers' and
   "Which headers should be generated before starting to compose a message.
 If t, generate all required headers.  This can also be a list of headers to
 generate.  The variables `message-required-news-headers' and


@@ -914,7 +914,6 @@ will not have a visible effect for those headers."
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
   :type '(choice (const :tag "None" nil)
   :group 'message-headers
   :link '(custom-manual "(message)Message Headers")
   :type '(choice (const :tag "None" nil)

-                (const :tag "References" '(references))

                 (const :tag "All" t)
                 (repeat (sexp :tag "Header"))))
 
                 (const :tag "All" t)
                 (repeat (sexp :tag "Header"))))
 


@@ -935,7 +934,7 @@ The function `message-setup' runs this hook."
   :type 'hook)
 
 (defcustom message-cancel-hook nil
   :type 'hook)
 
 (defcustom message-cancel-hook nil

-  "Hook run when cancelling articles."
+  "Hook run when canceling articles."

   :group 'message-various
   :link '(custom-manual "(message)Various Message Variables")
   :type 'hook)
   :group 'message-various
   :link '(custom-manual "(message)Various Message Variables")
   :type 'hook)


@@ -1127,6 +1126,71 @@ needed."
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
 
   :link '(custom-manual "(message)Insertion Variables")
   :group 'message-insertion)
 

+(defcustom message-cite-reply-position 'traditional
+  "*Where the reply should be positioned.
+If `traditional', reply inline.
+If `above', reply above quoted text.
+If `below', reply below quoted text.
+
+Note: Many newsgroups frown upon nontraditional reply styles. You
+probably want to set this variable only for specific groups,
+e.g. using `gnus-posting-styles':
+
+  (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
+  :type '(choice (const :tag "Reply inline" 'traditional)
+                (const :tag "Reply above" 'above)
+                (const :tag "Reply below" 'below))
+  :group 'message-insertion)
+
+(defcustom message-cite-style nil
+  "*The overall style to be used when yanking cited text.
+Value is either `nil' (no variable overrides) or a let-style list
+of pairs (VARIABLE VALUE) that will be bound in
+`message-yank-original' to do the quoting.
+
+Presets to impersonate popular mail agents are found in the
+message-cite-style-* variables.  This variable is intended for
+use in `gnus-posting-styles', such as:
+
+  ((posting-from-work-p) (eval (set (make-local-variable 'message-cite-style) message-cite-style-outlook)))"
+  :version "24.1"
+  :group 'message-insertion
+  :type '(choice (const :tag "Do not override variables" :value nil)
+                (const :tag "MS Outlook" :value message-cite-style-outlook)
+                (const :tag "Mozilla Thunderbird" :value message-cite-style-thunderbird)
+                (const :tag "Gmail" :value message-cite-style-gmail)
+                (variable :tag "User-specified")))
+
+(defconst message-cite-style-outlook
+  '((message-cite-function  'message-cite-original)
+    (message-citation-line-function  'message-insert-formatted-citation-line)
+    (message-cite-reply-position 'above)
+    (message-yank-prefix  "")
+    (message-yank-cited-prefix  "")
+    (message-yank-empty-prefix  "")
+    (message-citation-line-format  "\n\n-----------------------\nOn %a, %b %d %Y, %N wrote:\n"))
+  "Message citation style used by MS Outlook. Use with message-cite-style.")
+
+(defconst message-cite-style-thunderbird
+  '((message-cite-function  'message-cite-original)
+    (message-citation-line-function  'message-insert-formatted-citation-line)
+    (message-cite-reply-position 'above)
+    (message-yank-prefix  "> ")
+    (message-yank-cited-prefix  ">")
+    (message-yank-empty-prefix  ">")
+    (message-citation-line-format "On %D %R %p, %N wrote:"))
+  "Message citation style used by Mozilla Thunderbird. Use with message-cite-style.")
+
+(defconst message-cite-style-gmail
+  '((message-cite-function  'message-cite-original)
+    (message-citation-line-function  'message-insert-formatted-citation-line)
+    (message-cite-reply-position 'above)
+    (message-yank-prefix  "    ")
+    (message-yank-cited-prefix  "    ")
+    (message-yank-empty-prefix  "    ")
+    (message-citation-line-format "On %e %B %Y %R, %f wrote:\n"))
+  "Message citation style used by Gmail. Use with message-cite-style.")
+

 (defcustom message-distribution-function nil
   "*Function called to return a Distribution header."
   :group 'message-news
 (defcustom message-distribution-function nil
   "*Function called to return a Distribution header."
   :group 'message-news


@@ -1165,7 +1229,7 @@ It is a vector of the following headers:
 (defvar message-send-actions nil
   "A list of actions to be performed upon successful sending of a message.")
 (defvar message-return-action nil
 (defvar message-send-actions nil
   "A list of actions to be performed upon successful sending of a message.")
 (defvar message-return-action nil

-  "Action to return to the caller after sending or postphoning a message.")
+  "Action to return to the caller after sending or postponing a message.")

 (defvar message-exit-actions nil
   "A list of actions to be performed upon exiting after sending a message.")
 (defvar message-kill-actions nil
 (defvar message-exit-actions nil
   "A list of actions to be performed upon exiting after sending a message.")
 (defvar message-kill-actions nil


@@ -1228,14 +1292,11 @@ called and its result is inserted."
   (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
                         system-configuration)
           (file-readable-p "/etc/sendmail.cf")
   (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
                         system-configuration)
           (file-readable-p "/etc/sendmail.cf")

-          (let ((buffer (get-buffer-create " *temp*")))
-            (unwind-protect
-                (with-current-buffer buffer
-                  (insert-file-contents "/etc/sendmail.cf")
-                  (goto-char (point-min))
-                  (let ((case-fold-search nil))
-                    (re-search-forward "^OR\\>" nil t)))
-              (kill-buffer buffer))))
+          (with-temp-buffer
+             (insert-file-contents "/etc/sendmail.cf")
+             (goto-char (point-min))
+             (let ((case-fold-search nil))
+               (re-search-forward "^OR\\>" nil t))))

       ;; According to RFC822, "The field-name must be composed of printable
       ;; ASCII characters (i. e., characters that have decimal values between
       ;; 33 and 126, except colon)", i. e., any chars except ctl chars,
       ;; According to RFC822, "The field-name must be composed of printable
       ;; ASCII characters (i. e., characters that have decimal values between
       ;; 33 and 126, except colon)", i. e., any chars except ctl chars,


@@ -1293,7 +1354,9 @@ text and it replaces `self-insert-command' with the other command, e.g.
   :type '(repeat function))
 
 (defcustom message-auto-save-directory
   :type '(repeat function))
 
 (defcustom message-auto-save-directory

-  (file-name-as-directory (expand-file-name "drafts" message-directory))
+  (if (file-writable-p message-directory)
+      (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
   "*Directory where Message auto-saves buffers if Gnus isn't running.
 If nil, Message won't auto-save."
   :group 'message-buffers


@@ -1334,7 +1397,8 @@ candidates:
 `quoted-text-only'  Allow you to post quoted text only;
 `multiple-copies'   Allow you to post multiple copies;
 `cancel-messages'   Allow you to cancel or supersede messages from
 `quoted-text-only'  Allow you to post quoted text only;
 `multiple-copies'   Allow you to post multiple copies;
 `cancel-messages'   Allow you to cancel or supersede messages from

-                   your other email addresses.")
+                   your other email addresses;
+`canlock-verify'    Allow you to cancel messages without verifying canlock.")

 
 (defsubst message-gnksa-enable-p (feature)
   (or (not (listp message-shoot-gnksa-feet))
 
 (defsubst message-gnksa-enable-p (feature)
   (or (not (listp message-shoot-gnksa-feet))


@@ -1856,25 +1920,31 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
 
 (defvar        message-options nil
   "Some saved answers when sending message.")
 
 (defvar        message-options nil
   "Some saved answers when sending message.")

+;; FIXME: On XEmacs this causes problems since let-binding like:
+;; (let ((message-options message-options)) ...)
+;; as in `message-send' and `mml-preview' loses to buffer-local
+;; variable initialization.
+(unless (featurep 'xemacs)
+  (make-variable-buffer-local 'message-options))

 
 (defvar message-send-mail-real-function nil
   "Internal send mail function.")
 
 
 (defvar message-send-mail-real-function nil
   "Internal send mail function.")
 

-(defvar message-bogus-system-names "^localhost\\.\\|\\.local$"
+(defvar message-bogus-system-names "\\`localhost\\.\\|\\.local\\'"

   "The regexp of bogus system names.")
 
 (defcustom message-valid-fqdn-regexp
   (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
          ;; valid TLDs:
          "\\([a-z][a-z]\\|" ;; two letter country TDLs
   "The regexp of bogus system names.")
 
 (defcustom message-valid-fqdn-regexp
   (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
          ;; valid TLDs:
          "\\([a-z][a-z]\\|" ;; two letter country TDLs

-         "aero\\|arpa\\|bitnet\\|biz\\|bofh\\|"
+         "aero\\|arpa\\|asia\\|bitnet\\|biz\\|bofh\\|"

          "cat\\|com\\|coop\\|edu\\|gov\\|"
          "info\\|int\\|jobs\\|"
          "mil\\|mobi\\|museum\\|name\\|net\\|"
          "cat\\|com\\|coop\\|edu\\|gov\\|"
          "info\\|int\\|jobs\\|"
          "mil\\|mobi\\|museum\\|name\\|net\\|"

-         "org\\|pro\\|travel\\|uucp\\)")
+         "org\\|pro\\|tel\\|travel\\|uucp\\)")

   ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
   ;; http://en.wikipedia.org/wiki/GTLD
   ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
   ;; http://en.wikipedia.org/wiki/GTLD

-  ;; `in the process of being approved': .asia .post .tel .sex
+  ;; `approved, but not yet in operation': .xxx

   ;; "dead" nato bitnet uucp
   "Regular expression that matches a valid FQDN."
   ;; see also: gnus-button-valid-fqdn-regexp
   ;; "dead" nato bitnet uucp
   "Regular expression that matches a valid FQDN."
   ;; see also: gnus-button-valid-fqdn-regexp


@@ -2477,7 +2547,7 @@ Return the number of headers removed."
      (point-max)))
   (goto-char (point-min)))
 
      (point-max)))
   (goto-char (point-min)))
 

-;; FIXME: clarify diffference: message-narrow-to-head,
+;; FIXME: clarify difference: 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.
 ;; message-narrow-to-headers-or-head, message-narrow-to-headers
 (defun message-narrow-to-head ()
   "Narrow the buffer to the head of the message.


@@ -2817,7 +2887,7 @@ message composition doesn't break too bad."
   :link '(custom-manual "(message)Various Message Variables")
   :type 'boolean)
 
   :link '(custom-manual "(message)Various Message Variables")
   :type 'boolean)
 

-(defconst message-forbidden-properties
+(defvar message-forbidden-properties

   ;; No reason this should be clutter up customize.  We make it a
   ;; property list (rather than a list of property symbols), to be
   ;; directly useful for `remove-text-properties'.
   ;; No reason this should be clutter up customize.  We make it a
   ;; property list (rather than a list of property symbols), to be
   ;; directly useful for `remove-text-properties'.


@@ -3028,66 +3098,79 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
 (defun message-goto-to ()
   "Move point to the To header."
   (interactive)
 (defun message-goto-to ()
   "Move point to the To header."
   (interactive)

+  (push-mark)

   (message-position-on-field "To"))
 
 (defun message-goto-from ()
   "Move point to the From header."
   (interactive)
   (message-position-on-field "To"))
 
 (defun message-goto-from ()
   "Move point to the From header."
   (interactive)

+  (push-mark)

   (message-position-on-field "From"))
 
 (defun message-goto-subject ()
   "Move point to the Subject header."
   (interactive)
   (message-position-on-field "From"))
 
 (defun message-goto-subject ()
   "Move point to the Subject header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Subject"))
 
 (defun message-goto-cc ()
   "Move point to the Cc header."
   (interactive)
   (message-position-on-field "Subject"))
 
 (defun message-goto-cc ()
   "Move point to the Cc header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Cc" "To"))
 
 (defun message-goto-bcc ()
   "Move point to the Bcc  header."
   (interactive)
   (message-position-on-field "Cc" "To"))
 
 (defun message-goto-bcc ()
   "Move point to the Bcc  header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Bcc" "Cc" "To"))
 
 (defun message-goto-fcc ()
   "Move point to the Fcc header."
   (interactive)
   (message-position-on-field "Bcc" "Cc" "To"))
 
 (defun message-goto-fcc ()
   "Move point to the Fcc header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Fcc" "To" "Newsgroups"))
 
 (defun message-goto-reply-to ()
   "Move point to the Reply-To header."
   (interactive)
   (message-position-on-field "Fcc" "To" "Newsgroups"))
 
 (defun message-goto-reply-to ()
   "Move point to the Reply-To header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Reply-To" "Subject"))
 
 (defun message-goto-newsgroups ()
   "Move point to the Newsgroups header."
   (interactive)
   (message-position-on-field "Reply-To" "Subject"))
 
 (defun message-goto-newsgroups ()
   "Move point to the Newsgroups header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Newsgroups"))
 
 (defun message-goto-distribution ()
   "Move point to the Distribution header."
   (interactive)
   (message-position-on-field "Newsgroups"))
 
 (defun message-goto-distribution ()
   "Move point to the Distribution header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Distribution"))
 
 (defun message-goto-followup-to ()
   "Move point to the Followup-To header."
   (interactive)
   (message-position-on-field "Distribution"))
 
 (defun message-goto-followup-to ()
   "Move point to the Followup-To header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Followup-To" "Newsgroups"))
 
 (defun message-goto-mail-followup-to ()
   "Move point to the Mail-Followup-To header."
   (interactive)
   (message-position-on-field "Followup-To" "Newsgroups"))
 
 (defun message-goto-mail-followup-to ()
   "Move point to the Mail-Followup-To header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Mail-Followup-To" "To"))
 
 (defun message-goto-keywords ()
   "Move point to the Keywords header."
   (interactive)
   (message-position-on-field "Mail-Followup-To" "To"))
 
 (defun message-goto-keywords ()
   "Move point to the Keywords header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Keywords" "Subject"))
 
 (defun message-goto-summary ()
   "Move point to the Summary header."
   (interactive)
   (message-position-on-field "Keywords" "Subject"))
 
 (defun message-goto-summary ()
   "Move point to the Summary header."
   (interactive)

+  (push-mark)

   (message-position-on-field "Summary" "Subject"))
 
 (eval-when-compile
   (message-position-on-field "Summary" "Subject"))
 
 (eval-when-compile


@@ -3108,6 +3191,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (when (and (message-called-interactively-p 'any)
             (looking-at "[ \t]*\n"))
     (expand-abbrev))
   (when (and (message-called-interactively-p 'any)
             (looking-at "[ \t]*\n"))
     (expand-abbrev))

+  (push-mark)

   (goto-char (point-min))
   (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
       (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
   (goto-char (point-min))
   (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
       (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))


@@ -3128,6 +3212,7 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
 If there is no signature in the article, go to the end and
 return nil."
   (interactive)
 If there is no signature in the article, go to the end and
 return nil."
   (interactive)

+  (push-mark)

   (goto-char (point-min))
   (if (re-search-forward message-signature-separator nil t)
       (forward-line 1)
   (goto-char (point-min))
   (if (re-search-forward message-signature-separator nil t)
       (forward-line 1)


@@ -3402,8 +3487,12 @@ Message buffers and is not meant to be called directly."
 (defun message-point-in-header-p ()
   "Return t if point is in the header."
   (save-excursion
 (defun message-point-in-header-p ()
   "Return t if point is in the header."
   (save-excursion

-    (not (re-search-backward
-         (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))
+    (and
+     (not
+      (re-search-backward
+       (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
+     (re-search-forward
+      (concat "^" (regexp-quote mail-header-separator) "\n") nil t))))

 
 (defun message-do-auto-fill ()
   "Like `do-auto-fill', but don't fill in message header."
 
 (defun message-do-auto-fill ()
   "Like `do-auto-fill', but don't fill in message header."


@@ -3517,8 +3606,12 @@ Note that this should not be used in newsgroups."
 An ellipsis (from `message-elide-ellipsis') will be inserted where the
 text was killed."
   (interactive "r")
 An ellipsis (from `message-elide-ellipsis') will be inserted where the
 text was killed."
   (interactive "r")

-  (kill-region b e)
-  (insert message-elide-ellipsis))
+  (let ((lines (count-lines b e))
+        (chars (- e b)))
+    (kill-region b e)
+    (insert (format-spec message-elide-ellipsis
+                         `((?l . ,lines)
+                           (?c . ,chars))))))

 
 (defvar message-caesar-translation-table nil)
 
 
 (defvar message-caesar-translation-table nil)
 


@@ -3645,7 +3738,7 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
       (message-delete-line))
     ;; Delete blank lines at the end of the buffer.
     (goto-char (point-max))
       (message-delete-line))
     ;; Delete blank lines at the end of the buffer.
     (goto-char (point-max))

-    (unless (eolp)
+    (unless (eq (preceding-char) ?\n)

       (insert "\n"))
     (while (and (zerop (forward-line -1))
                (looking-at "$"))
       (insert "\n"))
     (while (and (zerop (forward-line -1))
                (looking-at "$"))


@@ -3686,16 +3779,49 @@ To use this automatically, you may add this function to
       (while (re-search-forward citexp nil t)
        (replace-match (if remove "" "\n"))))))
 
       (while (re-search-forward citexp nil t)
        (replace-match (if remove "" "\n"))))))
 

-(defvar message-cite-reply-above nil
-  "If non-nil, start own text above the quote.
-
-Note: Top posting is bad netiquette.  Don't use it unless you
-really must.  You probably want to set variable only for specific
-groups, e.g. using `gnus-posting-styles':
-
-  (eval (set (make-local-variable 'message-cite-reply-above) t))
-
-This variable has no effect in news postings.")
+(defun message--yank-original-internal (arg)
+  (let ((modified (buffer-modified-p))
+       body-text)
+       (when (and message-reply-buffer
+                  message-cite-function)
+         (when (equal message-cite-reply-position 'above)
+           (save-excursion
+             (setq body-text
+                   (buffer-substring (message-goto-body)
+                                     (point-max)))
+             (delete-region (message-goto-body) (point-max))))
+         (if (bufferp message-reply-buffer)
+             (delete-windows-on message-reply-buffer t))
+         (push-mark (save-excursion
+                      (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)))
+         (unless arg
+           (funcall message-cite-function)
+           (unless (eq (char-before (mark t)) ?\n)
+             (let ((pt (point)))
+               (goto-char (mark t))
+               (insert-before-markers ?\n)
+               (goto-char pt))))
+         (case message-cite-reply-position
+           (above
+            (message-goto-body)
+            (insert body-text)
+            (insert (if (bolp) "\n" "\n\n"))
+            (message-goto-body))
+           (below
+            (message-goto-signature)))
+         ;; Add a `message-setup-very-last-hook' here?
+         ;; Add `gnus-article-highlight-citation' here?
+         (unless modified
+        (setq message-checksum (message-checksum))))))

 
 (defun message-yank-original (&optional arg)
   "Insert the message being replied to, if any.
 
 (defun message-yank-original (&optional arg)
   "Insert the message being replied to, if any.


@@ -3708,51 +3834,10 @@ This function uses `message-cite-function' to do the actual citing.
 Just \\[universal-argument] as argument means don't indent, insert no
 prefix, and don't delete any headers."
   (interactive "P")
 Just \\[universal-argument] as argument means don't indent, insert no
 prefix, and don't delete any headers."
   (interactive "P")

-  (let ((modified (buffer-modified-p))
-       body-text)
-    (when (and message-reply-buffer
-              message-cite-function)
-      (when message-cite-reply-above
-       (if (and (not (message-news-p))
-                (or (eq message-cite-reply-above 'is-evil)
-                    (y-or-n-p "\
-Top posting is bad netiquette.  Please don't top post unless you really must.
-Really top post? ")))
-           (save-excursion
-             (setq body-text
-                   (buffer-substring (message-goto-body)
-                                     (point-max)))
-             (delete-region (message-goto-body) (point-max)))
-         (set (make-local-variable 'message-cite-reply-above) nil)))
-      (if (bufferp message-reply-buffer)
-         (delete-windows-on message-reply-buffer t))
-      (push-mark (save-excursion
-                  (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)))
-      (unless arg
-       (funcall message-cite-function)
-       (unless (eq (char-before (mark t)) ?\n)
-         (let ((pt (point)))
-           (goto-char (mark t))
-           (insert-before-markers ?\n)
-           (goto-char pt))))
-      (when message-cite-reply-above
-       (message-goto-body)
-       (insert body-text)
-       (insert (if (bolp) "\n" "\n\n"))
-       (message-goto-body))
-      ;; Add a `message-setup-very-last-hook' here?
-      ;; Add `gnus-article-highlight-citation' here?
-      (unless modified
-       (setq message-checksum (message-checksum))))))
+  ;; eval the let forms contained in message-cite-style
+  (eval
+   `(let ,message-cite-style
+      (message--yank-original-internal ',arg))))

 
 (defun message-yank-buffer (buffer)
   "Insert BUFFER into the current buffer and quote it."
 
 (defun message-yank-buffer (buffer)
   "Insert BUFFER into the current buffer and quote it."


@@ -3996,7 +4081,9 @@ The text will also be indented the normal way."
 ;;;
 
 (defun message-send-and-exit (&optional arg)
 ;;;
 
 (defun message-send-and-exit (&optional arg)

-  "Send message like `message-send', then, if no errors, exit from mail buffer."
+  "Send message like `message-send', then, if no errors, exit from mail buffer.
+The usage of ARG is defined by the instance that called Message.
+It should typically alter the sending method in some way or other."

   (interactive "P")
   (let ((buf (current-buffer))
        (actions message-exit-actions))
   (interactive "P")
   (let ((buf (current-buffer))
        (actions message-exit-actions))


@@ -4052,11 +4139,11 @@ Instead, just auto-save the buffer and then bury it."
 
 (defun message-bury (buffer)
   "Bury this mail BUFFER."
 
 (defun message-bury (buffer)
   "Bury this mail BUFFER."

-  (let ((newbuf (other-buffer buffer)))
-    (bury-buffer buffer)
-    (if message-return-action
-       (apply (car message-return-action) (cdr message-return-action))
-      (switch-to-buffer newbuf))))
+  (if message-return-action
+      (progn
+        (bury-buffer buffer)
+        (apply (car message-return-action) (cdr message-return-action)))
+    (with-current-buffer buffer (bury-buffer))))

 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.


@@ -4175,7 +4262,6 @@ not have PROP."
     (nreverse regions)))
 
 (defcustom message-bogus-addresses
     (nreverse regions)))
 
 (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.
   '("noreply" "nospam" "invalid" "@@" "[^[:ascii:]].*@" "[ \t]")
   "List of regexps of potentially bogus mail addresses.
 See `message-check-recipients' how to setup checking.


@@ -4229,8 +4315,10 @@ conformance."
                 "Invisible text found and made visible; continue sending? ")
          (error "Invisible text found and made visible")))))
   (message-check 'illegible-text
                 "Invisible text found and made visible; continue sending? ")
          (error "Invisible text found and made visible")))))
   (message-check 'illegible-text

-    (let (char found choice)
+    (let (char found choice nul-chars)

       (message-goto-body)
       (message-goto-body)

+      (setq nul-chars (save-excursion
+                       (search-forward "\000" nil t)))

       (while (progn
               (skip-chars-forward mm-7bit-chars)
               (when (get-text-property (point) 'no-illegible-text)
       (while (progn
               (skip-chars-forward mm-7bit-chars)
               (when (get-text-property (point) 'no-illegible-text)


@@ -4256,7 +4344,9 @@ conformance."
       (when found
        (setq choice
              (gnus-multiple-choice
       (when found
        (setq choice
              (gnus-multiple-choice

-              "Non-printable characters found.  Continue sending?"
+              (if nul-chars
+                  "NUL characters found, which may cause problems.  Continue sending?"
+                "Non-printable characters found.  Continue sending?")

               `((?d "Remove non-printable characters and send")
                 (?r ,(format
                       "Replace non-printable characters with \"%s\" and send"
               `((?d "Remove non-printable characters and send")
                 (?r ,(format
                       "Replace non-printable characters with \"%s\" and send"


@@ -4341,7 +4431,17 @@ This function could be useful in `message-setup-hook'."
            (and bog
                 (not (y-or-n-p
                       (format
            (and bog
                 (not (y-or-n-p
                       (format

-                       "Address `%s' might be bogus.  Continue? " bog)))
+                       "Address `%s'%s might be bogus.  Continue? "
+                       bog
+                       ;; If the encoded version of the email address
+                       ;; is different from the unencoded version,
+                       ;; then we likely have invisible characters or
+                       ;; the like.  Display the encoded version,
+                       ;; too.
+                       (let ((encoded (rfc2047-encode-string bog)))
+                         (if (string= encoded bog)
+                             ""
+                           (format " (%s)" encoded))))))

                 (error "Bogus address"))))))))
 
 (custom-add-option 'message-setup-hook 'message-check-recipients)
                 (error "Bogus address"))))))))
 
 (custom-add-option 'message-setup-hook 'message-check-recipients)


@@ -4368,7 +4468,7 @@ This function could be useful in `message-setup-hook'."
        ;; A simple function.
        ((functionp action)
        (funcall action))
        ;; A simple function.
        ((functionp action)
        (funcall action))

-       ;; Something to be evaled.
+       ;; Something to be evalled.

        (t
        (eval action))))))
 
        (t
        (eval action))))))
 


@@ -4384,7 +4484,7 @@ This function could be useful in `message-setup-hook'."
        (tembuf (message-generate-new-buffer-clone-locals " message temp"))
        (curbuf (current-buffer))
        (id (message-make-message-id)) (n 1)
        (tembuf (message-generate-new-buffer-clone-locals " message temp"))
        (curbuf (current-buffer))
        (id (message-make-message-id)) (n 1)

-       plist total  header required-mail-headers)
+        plist total header)

     (while (not (eobp))
       (if (< (point-max) (+ p message-send-mail-partially-limit))
          (goto-char (point-max))
     (while (not (eobp))
       (if (< (point-max) (+ p message-send-mail-partially-limit))
          (goto-char (point-max))


@@ -4435,8 +4535,9 @@ This function could be useful in `message-setup-hook'."
              (end-of-line)
              (insert (format " (%d/%d)" n total))
              (widen)
              (end-of-line)
              (insert (format " (%d/%d)" n total))
              (widen)

-              (funcall (or message-send-mail-real-function
-                           message-send-mail-function)))
+             (if message-send-mail-real-function
+                 (funcall message-send-mail-real-function)
+               (message-multi-smtp-send-mail)))

            (setq n (+ n 1))
            (setq p (pop plist))
            (erase-buffer)))
            (setq n (+ n 1))
            (setq p (pop plist))
            (erase-buffer)))


@@ -4466,7 +4567,8 @@ This function could be useful in `message-setup-hook'."
                   (boundp 'gnus-group-posting-charset-alist))
              (gnus-setup-posting-charset nil)
            message-posting-charset))
                   (boundp 'gnus-group-posting-charset-alist))
              (gnus-setup-posting-charset nil)
            message-posting-charset))

-        (headers message-required-mail-headers))
+        (headers message-required-mail-headers)
+        options)

     (when (and message-generate-hashcash
               (not (eq message-generate-hashcash 'opportunistic)))
       (message "Generating hashcash...")
     (when (and message-generate-hashcash
               (not (eq message-generate-hashcash 'opportunistic)))
       (message "Generating hashcash...")


@@ -4505,9 +4607,11 @@ This function could be useful in `message-setup-hook'."
              (error "Failed to send the message")))))
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
              (error "Failed to send the message")))))
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))

+    (setq options message-options)

     (unwind-protect
        (with-current-buffer tembuf
          (erase-buffer)
     (unwind-protect
        (with-current-buffer tembuf
          (erase-buffer)

+         (setq message-options options)

          ;; Avoid copying text props (except hard newlines).
          (insert (with-current-buffer mailbuf
                    (mml-buffer-substring-no-properties-except-hard-newlines
          ;; Avoid copying text props (except hard newlines).
          (insert (with-current-buffer mailbuf
                    (mml-buffer-substring-no-properties-except-hard-newlines


@@ -4587,13 +4691,40 @@ If you always want Gnus to send messages in one piece, set
 ")))
              (progn
                (message "Sending via mail...")
 ")))
              (progn
                (message "Sending via mail...")

-               (funcall (or message-send-mail-real-function
-                            message-send-mail-function)))
-           (message-send-mail-partially)))
+               (if message-send-mail-real-function
+                   (funcall message-send-mail-real-function)
+                 (message-multi-smtp-send-mail)))
+           (message-send-mail-partially))
+         (setq options message-options))

       (kill-buffer tembuf))
     (set-buffer mailbuf)
       (kill-buffer tembuf))
     (set-buffer mailbuf)

+    (setq message-options options)

     (push 'mail message-sent-message-via)))
 
     (push 'mail message-sent-message-via)))
 

+(defvar sendmail-program)
+(defvar smtpmail-smtp-user)
+
+(defun message-multi-smtp-send-mail ()
+  "Send the current buffer to `message-send-mail-function'.
+Or, if there's a header that specifies a different method, use
+that instead."
+  (let ((method (message-field-value "X-Message-SMTP-Method")))
+    (if (not method)
+       (funcall message-send-mail-function)
+      (message-remove-header "X-Message-SMTP-Method")
+      (setq method (split-string method))
+      (cond
+       ((equal (car method) "sendmail")
+       (message-send-mail-with-sendmail))
+       ((equal (car method) "smtp")
+       (require 'smtpmail)
+       (let ((smtpmail-smtp-server (nth 1 method))
+             (smtpmail-smtp-service (nth 2 method))
+             (smtpmail-smtp-user (or (nth 3 method) smtpmail-smtp-user)))
+         (message-smtpmail-send-it)))
+       (t
+       (error "Unknown method %s" method))))))
+

 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
   (require 'sendmail)
 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
   (require 'sendmail)


@@ -4629,16 +4760,7 @@ If you always want Gnus to send messages in one piece, set
                 (cpr (apply
                       'call-process-region
                       (append
                 (cpr (apply
                       'call-process-region
                       (append

-                       (list (point-min) (point-max)
-                             (cond ((boundp 'sendmail-program)
-                                    sendmail-program)
-                                   ((file-exists-p "/usr/sbin/sendmail")
-                                    "/usr/sbin/sendmail")
-                                   ((file-exists-p "/usr/lib/sendmail")
-                                    "/usr/lib/sendmail")
-                                   ((file-exists-p "/usr/ucblib/sendmail")
-                                    "/usr/ucblib/sendmail")
-                                   (t "fakemail"))
+                       (list (point-min) (point-max) sendmail-program

                              nil errbuf nil "-oi")
                        message-sendmail-extra-arguments
                        ;; Always specify who from,
                              nil errbuf nil "-oi")
                        message-sendmail-extra-arguments
                        ;; Always specify who from,


@@ -4716,6 +4838,8 @@ to find out how to use this."
     ;; should never happen
     (t   (error "qmail-inject reported unknown failure"))))
 
     ;; should never happen
     (t   (error "qmail-inject reported unknown failure"))))
 

+(defvar mh-previous-window-config)
+

 (defun message-send-mail-with-mh ()
   "Send the prepared message buffer with mh."
   (let ((mh-previous-window-config nil)
 (defun message-send-mail-with-mh ()
   "Send the prepared message buffer with mh."
   (let ((mh-previous-window-config nil)


@@ -4756,7 +4880,9 @@ Do not use this for anything important, it is cryptographically weak."
   (require 'sha1)
   (let (sha1-maximum-internal-length)
     (sha1 (concat (message-unique-id)
   (require 'sha1)
   (let (sha1-maximum-internal-length)
     (sha1 (concat (message-unique-id)

-                 (format "%x%x%x" (random) (random t) (random))
+                 (format "%x%x%x" (random)
+                         (progn (random t) (random))
+                         (random))

                  (prin1-to-string (recent-keys))
                  (prin1-to-string (garbage-collect))))))
 
                  (prin1-to-string (recent-keys))
                  (prin1-to-string (garbage-collect))))))
 


@@ -4797,7 +4923,7 @@ Otherwise, generate and save a value for `canlock-password' first."
                           (message-fetch-field "Followup-To")))
         ;; BUG: We really need to get the charset for each name in the
         ;; Newsgroups and Followup-To lines to allow crossposting
                           (message-fetch-field "Followup-To")))
         ;; BUG: We really need to get the charset for each name in the
         ;; Newsgroups and Followup-To lines to allow crossposting

-        ;; between group namess with incompatible character sets.
+        ;; between group names with incompatible character sets.

         ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
         (group-field-charset
          (gnus-group-name-charset method newsgroups-field))
         ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
         (group-field-charset
          (gnus-group-name-charset method newsgroups-field))


@@ -4936,8 +5062,7 @@ Otherwise, generate and save a value for `canlock-password' first."
        t))
    ;; Check long header lines.
    (message-check 'long-header-lines
        t))
    ;; Check long header lines.
    (message-check 'long-header-lines

-     (let ((start (point))
-          (header nil)
+     (let ((header nil)

           (length 0)
           found)
        (while (and (not found)
           (length 0)
           found)
        (while (and (not found)


@@ -4946,7 +5071,6 @@ Otherwise, generate and save a value for `canlock-password' first."
             (setq found t
                   length (- (point) (match-beginning 0)))
           (setq header (match-string-no-properties 1)))
             (setq found t
                   length (- (point) (match-beginning 0)))
           (setq header (match-string-no-properties 1)))

-        (setq start (match-beginning 0))

         (forward-line 1))
        (if found
           (y-or-n-p (format "Your %s header is too long (%d).  Really post? "
         (forward-line 1))
        (if found
           (y-or-n-p (format "Your %s header is too long (%d).  Really post? "


@@ -5461,10 +5585,12 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
 ;; You might for example insert a "." somewhere (not next to another dot
 ;; or string boundary), or modify the "fsf" string.
 (defun message-unique-id ()
 ;; You might for example insert a "." somewhere (not next to another dot
 ;; or string boundary), or modify the "fsf" string.
 (defun message-unique-id ()

+  (random t)

   ;; Don't use microseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq message-unique-id-char
   ;; Don't use microseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq message-unique-id-char

-       (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))
+       (% (1+ (or message-unique-id-char
+                  (logand (random most-positive-fixnum) (1- (lsh 1 20)))))

           ;; (current-time) returns 16-bit ints,
           ;; and 2^16*25 just fits into 4 digits i base 36.
           (* 25 25)))
           ;; (current-time) returns 16-bit ints,
           ;; and 2^16*25 just fits into 4 digits i base 36.
           (* 25 25)))


@@ -5789,7 +5915,7 @@ subscribed address (and not the additional To and Cc header contents)."
 (defun message-idna-to-ascii-rhs-1 (header)
   "Interactively potentially IDNA encode domain names in HEADER."
   (let ((field (message-fetch-field header))
 (defun message-idna-to-ascii-rhs-1 (header)
   "Interactively potentially IDNA encode domain names in HEADER."
   (let ((field (message-fetch-field header))

-       rhs ace  address)
+        ace)

     (when field
       (dolist (rhs
               (mm-delete-duplicates
     (when field
       (dolist (rhs
               (mm-delete-duplicates


@@ -5838,6 +5964,21 @@ See `message-idna-encode'."
        (message-idna-to-ascii-rhs-1 "Mail-Followup-To")
        (message-idna-to-ascii-rhs-1 "Cc")))))
 
        (message-idna-to-ascii-rhs-1 "Mail-Followup-To")
        (message-idna-to-ascii-rhs-1 "Cc")))))
 

+(defvar Date)
+(defvar Message-ID)
+(defvar Organization)
+(defvar From)
+(defvar Path)
+(defvar Subject)
+(defvar Newsgroups)
+(defvar In-Reply-To)
+(defvar References)
+(defvar To)
+(defvar Distribution)
+(defvar Lines)
+(defvar User-Agent)
+(defvar Expires)
+

 (defun message-generate-headers (headers)
   "Prepare article HEADERS.
 Headers already prepared in the buffer are not modified."
 (defun message-generate-headers (headers)
   "Prepare article HEADERS.
 Headers already prepared in the buffer are not modified."


@@ -6111,7 +6252,7 @@ If the current line has `message-yank-prefix', insert it on the new line."
 When sending via news, also check that the REFERENCES are less
 than 988 characters long, and if they are not, trim them until
 they are."
 When sending via news, also check that the REFERENCES are less
 than 988 characters long, and if they are not, trim them until
 they are."

-  ;; 21 is the number suggested by USEAGE.
+  ;; 21 is the number suggested by USAGE.

   (let ((maxcount 21)
        (count 0)
        (cut 2)
   (let ((maxcount 21)
        (count 0)
        (cut 2)


@@ -6278,7 +6419,7 @@ between beginning of field and beginning of line."
              (progn
                (gnus-select-frame-set-input-focus (window-frame window))
                (select-window window))
              (progn
                (gnus-select-frame-set-input-focus (window-frame window))
                (select-window window))

-           (funcall (or switch-function 'pop-to-buffer) buffer)
+           (funcall (or switch-function #'pop-to-buffer) buffer)

            (set-buffer buffer))
          (when (and (buffer-modified-p)
                     (not (prog1
            (set-buffer buffer))
          (when (and (buffer-modified-p)
                     (not (prog1


@@ -6286,7 +6427,11 @@ between beginning of field and beginning of line."
                               "Message already being composed; erase? ")
                            (message nil))))
            (error "Message being composed")))
                               "Message already being composed; erase? ")
                            (message nil))))
            (error "Message being composed")))

-      (funcall (or switch-function 'pop-to-buffer) name)
+      (funcall (or switch-function
+                  (if (fboundp #'pop-to-buffer-same-window)
+                      #'pop-to-buffer-same-window
+                    #'pop-to-buffer))
+              name)

       (set-buffer name))
     (erase-buffer)
     (message-mode)))
       (set-buffer name))
     (erase-buffer)
     (message-mode)))


@@ -6307,35 +6452,38 @@ between beginning of field and beginning of line."
   ;; Rename the buffer.
   (if message-send-rename-function
       (funcall message-send-rename-function)
   ;; Rename the buffer.
   (if message-send-rename-function
       (funcall message-send-rename-function)

-    ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
-    (when (string-match
-          "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
-          (buffer-name))
-      (let ((name (match-string 2 (buffer-name)))
-           to group)
-       (if (not (or (null name)
-                    (string-equal name "mail")
-                    (string-equal name "posting")))
-           (setq name (concat "*sent " name "*"))
-         (message-narrow-to-headers)
-         (setq to (message-fetch-field "to"))
-         (setq group (message-fetch-field "newsgroups"))
-         (widen)
-         (setq name
-               (cond
-                (to (concat "*sent mail to "
-                            (or (car (mail-extract-address-components to))
-                                to) "*"))
-                ((and group (not (string= group "")))
-                 (concat "*sent posting on " group "*"))
-                (t "*sent mail*"))))
-       (unless (string-equal name (buffer-name))
-         (rename-buffer name t)))))
+    (message-default-send-rename-function))

   ;; Push the current buffer onto the list.
   (when message-max-buffers
     (setq message-buffer-list
          (nconc message-buffer-list (list (current-buffer))))))
 
   ;; Push the current buffer onto the list.
   (when message-max-buffers
     (setq message-buffer-list
          (nconc message-buffer-list (list (current-buffer))))))
 

+(defun message-default-send-rename-function ()
+  ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
+  (when (string-match
+        "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
+        (buffer-name))
+    (let ((name (match-string 2 (buffer-name)))
+         to group)
+      (if (not (or (null name)
+                  (string-equal name "mail")
+                  (string-equal name "posting")))
+         (setq name (concat "*sent " name "*"))
+       (message-narrow-to-headers)
+       (setq to (message-fetch-field "to"))
+       (setq group (message-fetch-field "newsgroups"))
+       (widen)
+       (setq name
+             (cond
+              (to (concat "*sent mail to "
+                          (or (car (mail-extract-address-components to))
+                              to) "*"))
+              ((and group (not (string= group "")))
+               (concat "*sent posting on " group "*"))
+              (t "*sent mail*"))))
+      (unless (string-equal name (buffer-name))
+       (rename-buffer name t)))))
+

 (defun message-mail-user-agent ()
   (let ((mua (cond
              ((not message-mail-user-agent) nil)
 (defun message-mail-user-agent ()
   (let ((mua (cond
              ((not message-mail-user-agent) nil)


@@ -6429,30 +6577,35 @@ are not included."
          (funcall message-default-headers)
        message-default-headers))
     (or (bolp) (insert ?\n)))
          (funcall message-default-headers)
        message-default-headers))
     (or (bolp) (insert ?\n)))

-  (insert mail-header-separator "\n")
+  (insert (concat mail-header-separator "\n"))

   (forward-line -1)
   (forward-line -1)

-  (when (message-news-p)
-    (when message-default-news-headers
-      (insert message-default-news-headers)
-      (or (bolp) (insert ?\n)))
-    (when message-generate-headers-first
+  ;; If a crash happens while replying, the auto-save file would *not* have a
+  ;; `References:' header if `message-generate-headers-first' was nil.
+  ;; Therefore, always generate it first.
+  (let ((message-generate-headers-first
+         (if (eq message-generate-headers-first t)
+             t
+           (append message-generate-headers-first '(References)))))
+    (when (message-news-p)
+      (when message-default-news-headers
+        (insert message-default-news-headers)
+        (or (bolp) (insert ?\n)))

       (message-generate-headers
        (message-headers-to-generate
       (message-generate-headers
        (message-headers-to-generate

-       (append message-required-news-headers
-               message-required-headers)
-       message-generate-headers-first
-       '(Lines Subject)))))
-  (when (message-mail-p)
-    (when message-default-mail-headers
-      (insert message-default-mail-headers)
-      (or (bolp) (insert ?\n)))
-    (when message-generate-headers-first
+        (append message-required-news-headers
+                message-required-headers)
+        message-generate-headers-first
+        '(Lines Subject))))
+    (when (message-mail-p)
+      (when message-default-mail-headers
+        (insert message-default-mail-headers)
+        (or (bolp) (insert ?\n)))

       (message-generate-headers
        (message-headers-to-generate
       (message-generate-headers
        (message-headers-to-generate

-       (append message-required-mail-headers
-               message-required-headers)
-       message-generate-headers-first
-       '(Lines Subject)))))
+        (append message-required-mail-headers
+                message-required-headers)
+        message-generate-headers-first
+        '(Lines Subject)))))

   (run-hooks 'message-signature-setup-hook)
   (message-insert-signature)
   (save-restriction
   (run-hooks 'message-signature-setup-hook)
   (message-insert-signature)
   (save-restriction


@@ -6474,7 +6627,9 @@ are not included."
   (message-position-point)
   ;; Allow correct handling of `message-checksum' in `message-yank-original':
   (set-buffer-modified-p nil)
   (message-position-point)
   ;; Allow correct handling of `message-checksum' in `message-yank-original':
   (set-buffer-modified-p nil)

-  (undo-boundary))
+  (undo-boundary)
+  ;; rmail-start-mail expects message-mail to return t (Bug#9392)
+  t)

 
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."
 
 (defun message-set-auto-save-file-name ()
   "Associate the message buffer with a file in the drafts directory."


@@ -6564,9 +6719,7 @@ is a function used to switch to and display the mail buffer."
       (dolist (h other-headers other-headers)
        (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
      yank-action send-actions continue switch-function
       (dolist (h other-headers other-headers)
        (if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
      yank-action send-actions continue switch-function

-     return-action)
-    ;; FIXME: Should return nil if failure.
-    t))
+     return-action)))

 
 ;;;###autoload
 (defun message-news (&optional newsgroups subject)
 
 ;;;###autoload
 (defun message-news (&optional newsgroups subject)


@@ -6706,10 +6859,13 @@ want to get rid of this query permanently.")))
                                  addr))
                 (cons (downcase (mail-strip-quoted-names addr)) addr)))
             (message-tokenize-header recipients)))
                                  addr))
                 (cons (downcase (mail-strip-quoted-names addr)) addr)))
             (message-tokenize-header recipients)))

-      ;; Remove first duplicates.  (Why not all duplicates?  Is this a bug?)
+      ;; Remove all duplicates.

       (let ((s recipients))
        (while s
       (let ((s recipients))
        (while s

-         (setq recipients (delq (assoc (car (pop s)) s) recipients))))
+         (let ((address (car (pop s))))
+           (while (assoc address s)
+             (setq recipients (delq (assoc address s) recipients)
+                   s (delq (assoc address s) s))))))

 
       ;; Remove hierarchical lists that are contained within each other,
       ;; if message-hierarchical-addresses is defined.
 
       ;; Remove hierarchical lists that are contained within each other,
       ;; if message-hierarchical-addresses is defined.


@@ -6793,12 +6949,12 @@ Useful functions to put in this list include:
   subject)
 
 ;;;###autoload
   subject)
 
 ;;;###autoload

-(defun message-reply (&optional to-address wide)
+(defun message-reply (&optional to-address wide switch-function)

   "Start editing a reply to the article in the current buffer."
   (interactive)
   (require 'gnus-sum)                  ; for gnus-list-identifiers
   (let ((cur (current-buffer))
   "Start editing a reply to the article in the current buffer."
   (interactive)
   (require 'gnus-sum)                  ; for gnus-list-identifiers
   (let ((cur (current-buffer))

-       from subject date reply-to to cc
+       from subject date

        references message-id follow-to
        (inhibit-point-motion-hooks t)
        (message-this-is-mail t)
        references message-id follow-to
        (inhibit-point-motion-hooks t)
        (message-this-is-mail t)


@@ -6832,19 +6988,19 @@ Useful functions to put in this list include:
       (unless follow-to
        (setq follow-to (message-get-reply-headers wide to-address))))
 
       (unless follow-to
        (setq follow-to (message-get-reply-headers wide to-address))))
 

-    (unless (message-mail-user-agent)
-      (message-pop-to-buffer
-       (message-buffer-name
-       (if wide "wide reply" "reply") from
-       (if wide to-address nil))))
-
-    (setq message-reply-headers
-         (vector 0 subject from date message-id references 0 0 ""))
-
-    (message-setup
-     `((Subject . ,subject)
-       ,@follow-to)
-     cur)))
+    (let ((headers
+          `((Subject . ,subject)
+            ,@follow-to)))
+      (unless (message-mail-user-agent)
+       (message-pop-to-buffer
+        (message-buffer-name
+         (if wide "wide reply" "reply") from
+         (if wide to-address nil))
+        switch-function))
+      (setq message-reply-headers
+           (vector 0 (cdr (assq 'Subject headers))
+                   from date message-id references 0 0 ""))
+      (message-setup headers cur))))

 
 ;;;###autoload
 (defun message-wide-reply (&optional to-address)
 
 ;;;###autoload
 (defun message-wide-reply (&optional to-address)


@@ -6985,7 +7141,8 @@ regexp to match all of yours addresses."
   (save-excursion
     (save-restriction
       (message-narrow-to-head-1)
   (save-excursion
     (save-restriction
       (message-narrow-to-head-1)

-      (if (message-fetch-field "Cancel-Lock")
+      (if (and (message-fetch-field "Cancel-Lock")
+              (message-gnksa-enable-p 'canlock-verify))

          (if (null (canlock-verify))
              t
            (error "Failed to verify Cancel-lock: This article is not yours"))
          (if (null (canlock-verify))
              t
            (error "Failed to verify Cancel-lock: This article is not yours"))


@@ -7102,7 +7259,7 @@ header line with the old Message-ID."
 
 (defun message-wash-subject (subject)
   "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT.
 
 (defun message-wash-subject (subject)
   "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT.

-Previous forwarders, replyers, etc. may add it."
+Previous forwarders, repliers, etc. may add it."

   (with-temp-buffer
     (insert subject)
     (goto-char (point-min))
   (with-temp-buffer
     (insert subject)
     (goto-char (point-min))


@@ -7319,11 +7476,9 @@ Optional DIGEST will use digest to forward."
 (defun message-forward-make-body-digest-plain (forward-buffer)
   (insert
    "\n-------------------- Start of forwarded message --------------------\n")
 (defun message-forward-make-body-digest-plain (forward-buffer)
   (insert
    "\n-------------------- Start of forwarded message --------------------\n")

-  (let ((b (point)) e)
-    (mml-insert-buffer forward-buffer)
-    (setq e (point))
-    (insert
-     "\n-------------------- End of forwarded message --------------------\n")))
+  (mml-insert-buffer forward-buffer)
+  (insert
+   "\n-------------------- End of forwarded message --------------------\n"))

 
 (defun message-forward-make-body-digest-mime (forward-buffer)
   (insert "\n<#multipart type=digest>\n")
 
 (defun message-forward-make-body-digest-mime (forward-buffer)
   (insert "\n<#multipart type=digest>\n")


@@ -7368,14 +7523,16 @@ is for the internal use."
       (with-temp-buffer
        (insert-buffer-substring cur)
        (when (setq handles (mm-dissect-buffer t t))
       (with-temp-buffer
        (insert-buffer-substring cur)
        (when (setq handles (mm-dissect-buffer t t))

-         (if (and (prog1
-                      (bufferp (car handles))
-                    (mm-destroy-parts handles))
+         (if (and (bufferp (car handles))

                   (equal (mm-handle-media-type handles) "text/plain"))
              (progn
                   (equal (mm-handle-media-type handles) "text/plain"))
              (progn

+               (erase-buffer)
+               (insert-buffer-substring (car handles))

                (mm-decode-content-transfer-encoding
                 (mm-handle-encoding handles))
                (mm-decode-content-transfer-encoding
                 (mm-handle-encoding handles))

+               (mm-destroy-parts handles)

                (setq handles (mm-uu-dissect)))
                (setq handles (mm-uu-dissect)))

+           (mm-destroy-parts handles)

            (setq handles nil))))))
   (when handles
     (prog1
            (setq handles nil))))))
   (when handles
     (prog1


@@ -7443,6 +7600,8 @@ is for the internal use."
   (setq rmail-insert-mime-forwarded-message-function
        'message-forward-rmail-make-body))
 
   (setq rmail-insert-mime-forwarded-message-function
        'message-forward-rmail-make-body))
 

+(defvar message-inhibit-body-encoding nil)
+

 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."
 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."


@@ -7451,11 +7610,12 @@ is for the internal use."
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))

-         beg)
+         gcc beg)

       ;; We first set up a normal mail buffer.
       (unless (message-mail-user-agent)
        (set-buffer (get-buffer-create " *message resend*"))
       ;; We first set up a normal mail buffer.
       (unless (message-mail-user-agent)
        (set-buffer (get-buffer-create " *message resend*"))

-       (erase-buffer))
+       (let ((inhibit-read-only t))
+         (erase-buffer)))

       (let ((message-this-is-mail t)
            message-generate-hashcash
            message-setup-hook)
       (let ((message-this-is-mail t)
            message-generate-hashcash
            message-setup-hook)


@@ -7463,6 +7623,8 @@ is for the internal use."
       ;; Insert our usual headers.
       (message-generate-headers '(From Date To Message-ID))
       (message-narrow-to-headers)
       ;; Insert our usual headers.
       (message-generate-headers '(From Date To Message-ID))
       (message-narrow-to-headers)

+      (when (setq gcc (mail-fetch-field "gcc" nil t))
+       (message-remove-header "gcc"))

       ;; Remove X-Draft-From header etc.
       (message-remove-header message-ignored-mail-headers t)
       ;; Rename them all to "Resent-*".
       ;; Remove X-Draft-From header etc.
       (message-remove-header message-ignored-mail-headers t)
       ;; Rename them all to "Resent-*".


@@ -7472,7 +7634,8 @@ is for the internal use."
        (insert "Resent-"))
       (widen)
       (forward-line)
        (insert "Resent-"))
       (widen)
       (forward-line)

-      (delete-region (point) (point-max))
+      (let ((inhibit-read-only t))
+       (delete-region (point) (point-max)))

       (setq beg (point))
       ;; Insert the message to be resent.
       (insert-buffer-substring cur)
       (setq beg (point))
       ;; Insert the message to be resent.
       (insert-buffer-substring cur)


@@ -7503,6 +7666,10 @@ is for the internal use."
            message-generate-hashcash
            rfc2047-encode-encoded-words)
        (message-send-mail))
            message-generate-hashcash
            rfc2047-encode-encoded-words)
        (message-send-mail))

+      (when gcc
+       (message-goto-eoh)
+       (insert "Gcc: " gcc "\n"))
+      (run-hooks 'message-sent-hook)

       (kill-buffer (current-buffer)))
     (message "Resending message to %s...done" address)))
 
       (kill-buffer (current-buffer)))
     (message "Resending message to %s...done" address)))
 


@@ -7557,12 +7724,8 @@ you."
   "Like `message-mail' command, but display mail buffer in another window."
   (interactive)
   (unless (message-mail-user-agent)
   "Like `message-mail' command, but display mail buffer in another window."
   (interactive)
   (unless (message-mail-user-agent)

-    (let ((pop-up-windows t)
-         (special-display-buffer-names nil)
-         (special-display-regexps nil)
-         (same-window-buffer-names nil)
-         (same-window-regexps nil))
-      (message-pop-to-buffer (message-buffer-name "mail" to))))
+    (message-pop-to-buffer (message-buffer-name "mail" to)
+                          'switch-to-buffer-other-window))

   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
                   nil nil nil 'switch-to-buffer-other-window)))
   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
                   nil nil nil 'switch-to-buffer-other-window)))


@@ -7572,12 +7735,8 @@ you."
   "Like `message-mail' command, but display mail buffer in another frame."
   (interactive)
   (unless (message-mail-user-agent)
   "Like `message-mail' command, but display mail buffer in another frame."
   (interactive)
   (unless (message-mail-user-agent)

-    (let ((pop-up-frames t)
-         (special-display-buffer-names nil)
-         (special-display-regexps nil)
-         (same-window-buffer-names nil)
-         (same-window-regexps nil))
-      (message-pop-to-buffer (message-buffer-name "mail" to))))
+    (message-pop-to-buffer (message-buffer-name "mail" to)
+                          'switch-to-buffer-other-frame))

   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
                   nil nil nil 'switch-to-buffer-other-frame)))
   (let ((message-this-is-mail t))
     (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
                   nil nil nil 'switch-to-buffer-other-frame)))


@@ -7586,12 +7745,8 @@ you."
 (defun message-news-other-window (&optional newsgroups subject)
   "Start editing a news article to be sent."
   (interactive)
 (defun message-news-other-window (&optional newsgroups subject)
   "Start editing a news article to be sent."
   (interactive)

-  (let ((pop-up-windows t)
-       (special-display-buffer-names nil)
-       (special-display-regexps nil)
-       (same-window-buffer-names nil)
-       (same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
+  (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)
+                        'switch-to-buffer-other-window)

   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))
   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))


@@ -7600,12 +7755,8 @@ you."
 (defun message-news-other-frame (&optional newsgroups subject)
   "Start editing a news article to be sent."
   (interactive)
 (defun message-news-other-frame (&optional newsgroups subject)
   "Start editing a news article to be sent."
   (interactive)

-  (let ((pop-up-frames t)
-       (special-display-buffer-names nil)
-       (special-display-regexps nil)
-       (same-window-buffer-names nil)
-       (same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
+  (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)
+                        'switch-to-buffer-other-frame)

   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))
   (let ((message-this-is-news t))
     (message-setup `((Newsgroups . ,(or newsgroups ""))
                     (Subject . ,(or subject ""))))))


@@ -7676,7 +7827,7 @@ Setter function for custom variables."
                              'message-tool-bar-retro)
   "Specifies the message mode tool bar.
 
                              'message-tool-bar-retro)
   "Specifies the message mode tool bar.
 

-It can be either a list or a symbol refering to a list.  See
+It can be either a list or a symbol referring to a list.  See

 `gmm-tool-bar-from-list' for the format of the list.  The
 default key map is `message-mode-map'.
 
 `gmm-tool-bar-from-list' for the format of the list.  The
 default key map is `message-mode-map'.
 


@@ -7829,13 +7980,19 @@ those headers."
                    (lookup-key global-map "\t")
                    'indent-relative)))))
 
                    (lookup-key global-map "\t")
                    'indent-relative)))))
 

+(defvar mail-abbrev-mode-regexp)
+

 (defun message-completion-function ()
   (let ((alist message-completion-alist))
     (while (and alist
                (let ((mail-abbrev-mode-regexp (caar alist)))
                  (not (mail-abbrev-in-expansion-header-p))))
       (setq alist (cdr alist)))
 (defun message-completion-function ()
   (let ((alist message-completion-alist))
     (while (and alist
                (let ((mail-abbrev-mode-regexp (caar alist)))
                  (not (mail-abbrev-in-expansion-header-p))))
       (setq alist (cdr alist)))

-    (cdar alist)))
+    (when (cdar alist)
+      (lexical-let ((fun (cdar alist)))
+        ;; Even if completion fails, return a non-nil value, so as to avoid
+        ;; falling back to message-tab-body-function.
+        (lambda () (funcall fun) 'completion-attempted)))))

 
 (eval-and-compile
   (condition-case nil
 
 (eval-and-compile
   (condition-case nil


@@ -7906,7 +8063,12 @@ those headers."
         (eudc-expand-inline))
        ((and (memq 'bbdb message-expand-name-databases)
              (fboundp 'bbdb-complete-name))
         (eudc-expand-inline))
        ((and (memq 'bbdb message-expand-name-databases)
              (fboundp 'bbdb-complete-name))

-        (bbdb-complete-name))
+         (let ((starttick (buffer-modified-tick)))
+           (or (bbdb-complete-name)
+               ;; Apparently, bbdb-complete-name can return nil even when
+               ;; completion took place.  So let's double check the buffer was
+               ;; not modified.
+               (/= starttick (buffer-modified-tick)))))

        (t
         (expand-abbrev))))
 
        (t
         (expand-abbrev))))
 


@@ -7967,8 +8129,6 @@ regexp VARSTR."
 ;;; MIME functions
 ;;;
 
 ;;; MIME functions
 ;;;
 

-(defvar message-inhibit-body-encoding nil)
-

 (defun message-encode-message-body ()
   (unless message-inhibit-body-encoding
     (let ((mail-parse-charset (or mail-parse-charset
 (defun message-encode-message-body ()
   (unless message-inhibit-body-encoding
     (let ((mail-parse-charset (or mail-parse-charset


@@ -8017,10 +8177,10 @@ regexp VARSTR."
 (defun message-read-from-minibuffer (prompt &optional initial-contents)
   "Read from the minibuffer while providing abbrev expansion."
   (if (fboundp 'mail-abbrevs-setup)
 (defun message-read-from-minibuffer (prompt &optional initial-contents)
   "Read from the minibuffer while providing abbrev expansion."
   (if (fboundp 'mail-abbrevs-setup)

-      (let ((mail-abbrev-mode-regexp "")
-           (minibuffer-setup-hook 'mail-abbrevs-setup)
+      (let ((minibuffer-setup-hook 'mail-abbrevs-setup)

            (minibuffer-local-map message-minibuffer-local-map))
            (minibuffer-local-map message-minibuffer-local-map))

-       (read-from-minibuffer prompt initial-contents))
+       (flet ((mail-abbrev-in-expansion-header-p nil t))
+         (read-from-minibuffer prompt initial-contents)))

     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
          (minibuffer-local-map message-minibuffer-local-map))
       (read-string prompt initial-contents))))
     (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
          (minibuffer-local-map message-minibuffer-local-map))
       (read-string prompt initial-contents))))