Synch with Gnus.

[elisp/gnus.git-] / lisp / message.el
diff --git a/lisp/message.el b/lisp/message.el

index ab03b46..124c154 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,5 +1,6 @@
  ;;; message.el --- composing mail and news messages
  ;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
  
  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
  ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
  
  ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
  ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -35,26 +36,23 @@
  
  ;;; Code:
  
  
  ;;; Code:
  
-(eval-when-compile (require 'cl))
-(eval-when-compile (require 'smtp))
+(eval-when-compile
+  (require 'cl)
+  (require 'smtp)
+  (defvar gnus-list-identifiers))      ; gnus-sum is required where necessary
  
  (require 'mailheader)
  (require 'nnheader)
  
  (require 'mailheader)
  (require 'nnheader)
-(require 'easymenu)
-(require 'custom)
-(if (string-match "XEmacs\\|Lucid" emacs-version)
-    (require 'mail-abbrevs)
-  (require 'mailabbrev))
+;; This is apparently necessary even though things are autoloaded:
+(if (featurep 'xemacs)
+    (require 'mail-abbrevs))
  (require 'mime-edit)
  (eval-when-compile (require 'static))
  
  ;; Avoid byte-compile warnings.
  (eval-when-compile
    (require 'mail-parse)
  (require 'mime-edit)
  (eval-when-compile (require 'static))
  
  ;; Avoid byte-compile warnings.
  (eval-when-compile
    (require 'mail-parse)
-  (require 'mm-bodies)
-  (require 'mm-encode)
-  (require 'mml)
-  )
+  (require 'mml))
  
  (defgroup message '((user-mail-address custom-variable)
                     (user-full-name custom-variable))
  
  (defgroup message '((user-mail-address custom-variable)
                     (user-full-name custom-variable))
@@ -199,11 +197,12 @@ To disable checking of long signatures, for instance, add
  Don't touch this variable unless you really know what you're doing.
  
  Checks include subject-cmsg multiple-headers sendsys message-id from
  Don't touch this variable unless you really know what you're doing.
  
  Checks include subject-cmsg multiple-headers sendsys message-id from
-long-lines control-chars size new-text redirected-followup signature
-approved sender empty empty-headers message-id from subject
-shorten-followup-to existing-newsgroups buffer-file-name unchanged
-newsgroups."
-  :group 'message-news)
+long-lines control-chars size new-text quoting-style
+redirected-followup signature approved sender empty empty-headers
+message-id from subject shorten-followup-to existing-newsgroups
+buffer-file-name unchanged newsgroups."
+  :group 'message-news
+  :type '(repeat sexp))
  
  (defcustom message-required-news-headers
    '(From Newsgroups Subject Date Message-ID
  
  (defcustom message-required-news-headers
    '(From Newsgroups Subject Date Message-ID
@@ -246,7 +245,7 @@ included.  Organization, Lines and User-Agent are optional."
    :group 'message-headers
    :type 'regexp)
  
    :group 'message-headers
    :type 'regexp)
  
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:"
+(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:"
    "*Header lines matching this regexp will be deleted before posting.
  It's best to delete old Path and Date headers before posting to avoid
  any confusion."
    "*Header lines matching this regexp will be deleted before posting.
  It's best to delete old Path and Date headers before posting to avoid
  any confusion."
@@ -379,11 +378,6 @@ If t, use `message-user-organization-file'."
    :group 'message-forwarding
    :type 'string)
  
    :group 'message-forwarding
    :type 'string)
  
-(defcustom message-signature-before-forwarded-message t
-  "*If non-nil, put the signature before any included forwarded message."
-  :group 'message-forwarding
-  :type 'boolean)
-
  (defcustom message-included-forward-headers
    "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:"
    "*Regexp matching headers to be included in forwarded messages."
  (defcustom message-included-forward-headers
    "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^\\(Mail-\\)?Followup-To:\\|^\\(Mail-\\)?Reply-To:\\|^Mail-Copies-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:"
    "*Regexp matching headers to be included in forwarded messages."
@@ -411,6 +405,16 @@ The provided functions are:
    :group 'message-forwarding
    :type 'boolean)
  
    :group 'message-forwarding
    :type 'boolean)
  
+(defcustom message-forward-show-mml t
+  "*If non-nil, forward messages are shown as mml.  Otherwise, forward messages are unchanged."
+  :group 'message-forwarding
+  :type 'boolean)
+
+(defcustom message-forward-before-signature t
+  "*If non-nil, put forwarded message before signature, else after."
+  :group 'message-forwarding
+  :type 'boolean)
+
  (defcustom message-wash-forwarded-subjects nil
    "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
    :group 'message-forwarding
  (defcustom message-wash-forwarded-subjects nil
    "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
    :group 'message-forwarding
@@ -421,7 +425,7 @@ The provided functions are:
    :group 'message-interface
    :type 'regexp)
  
    :group 'message-interface
    :type 'regexp)
  
-(defcustom message-forward-ignored-headers nil
+(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
    "*All headers that match this regexp will be deleted when forwarding a message."
    :group 'message-forwarding
    :type '(choice (const :tag "None" nil)
    "*All headers that match this regexp will be deleted when forwarding a message."
    :group 'message-forwarding
    :type '(choice (const :tag "None" nil)
@@ -432,7 +436,14 @@ The provided functions are:
    :group 'message-insertion
    :type 'regexp)
  
    :group 'message-insertion
    :type 'regexp)
  
-(defcustom message-cancel-message "I am canceling my own article."
+(defcustom message-cite-prefix-regexp
+  ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
+  "[ \t]*\\(\\(\\w\\|[-_.]\\)+>+[ \t]*\\|[]>»|:}+][ \t]*\\)+"
+  "*Regexp matching the longest possible citation prefix on a line."
+  :group 'message-insertion
+  :type 'regexp)
+
+(defcustom message-cancel-message "I am canceling my own article.\n"
    "Message to be inserted in the cancel message."
    :group 'message-interface
    :type 'string)
    "Message to be inserted in the cancel message."
    :group 'message-interface
    :type 'string)
@@ -799,13 +810,13 @@ actually occur."
  (defvar message-user-agent nil
    "String of the form of PRODUCT/VERSION.  Used for User-Agent header field.")
  
  (defvar message-user-agent nil
    "String of the form of PRODUCT/VERSION.  Used for User-Agent header field.")
  
-;; Ignore errors in case this is used in Emacs 19.
-;; Don't use ignore-errors because this is copied into loaddefs.el.
+(static-when (boundp 'MULE)
+  (require 'reporter));; `define-mail-user-agent' is here.
+
  ;;;###autoload
  ;;;###autoload
-(ignore-errors
-  (define-mail-user-agent 'message-user-agent
-    'message-mail 'message-send-and-exit
-    'message-kill-buffer 'message-send-hook))
+(define-mail-user-agent 'message-user-agent
+  'message-mail 'message-send-and-exit
+  'message-kill-buffer 'message-send-hook)
  
  (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
    "If non-nil, delete the deletable headers before feeding to mh.")
  
  (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
    "If non-nil, delete the deletable headers before feeding to mh.")
@@ -843,12 +854,14 @@ Valid valued are `unique' and `unsent'."
    :type '(choice (const :tag "unique" unique)
                  (const :tag "unsent" unsent)))
  
    :type '(choice (const :tag "unique" unique)
                  (const :tag "unsent" unsent)))
  
-(defcustom message-default-charset nil
+(defcustom message-default-charset
+  (and (featurep 'xemacs) (not (featurep 'mule)) 'iso-8859-1)
    "Default charset used in non-MULE XEmacsen."
    :group 'message
    :type 'symbol)
  
    "Default charset used in non-MULE XEmacsen."
    :group 'message
    :type 'symbol)
  
-(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+(defcustom message-dont-reply-to-names
+  (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
    "*A regexp specifying names to prune when doing wide replies.
  A value of nil means exclude your own name only."
    :group 'message
    "*A regexp specifying names to prune when doing wide replies.
  A value of nil means exclude your own name only."
    :group 'message
@@ -1139,7 +1152,7 @@ See also the documentations for the following variables:
      (setq message-font-lock-last-position nil)))
  
  (defvar message-font-lock-keywords-1
      (setq message-font-lock-last-position nil)))
  
  (defvar message-font-lock-keywords-1
-  (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
+  (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
      `((,(concat "^\\([Tt]o:\\)" content)
         (1 'message-header-name-face)
         (2 'message-header-to-face nil t))
      `((,(concat "^\\([Tt]o:\\)" content)
         (1 'message-header-name-face)
         (2 'message-header-to-face nil t))
@@ -1169,10 +1182,12 @@ See also the documentations for the following variables:
  
  (defvar message-font-lock-keywords-2
    (append message-font-lock-keywords-1
  
  (defvar message-font-lock-keywords-2
    (append message-font-lock-keywords-1
-         '((message-font-lock-cited-text-matcher
+         `((message-font-lock-cited-text-matcher
              (1 'message-cited-text-face)
              (2 'message-cited-text-face))
              (1 'message-cited-text-face)
              (2 'message-cited-text-face))
-           ("<#/?\\(multipart\\|part\\|external\\).*>"
+           (,(concat "^\\(" message-cite-prefix-regexp "\\).*")
+            (0 'message-cited-text-face))
+           ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"
              (0 'message-mml-face)))))
  
  (defvar message-font-lock-keywords message-font-lock-keywords-2
              (0 'message-mml-face)))))
  
  (defvar message-font-lock-keywords message-font-lock-keywords-2
@@ -1241,8 +1256,24 @@ The cdr of ech entry is a function for applying the face to a region.")
     (t nil))
    "Coding system to compose mail.")
  
     (t nil))
    "Coding system to compose mail.")
  
+(defcustom message-send-mail-partially-limit 1000000
+  "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."
+  :group 'message-buffers
+  :type '(choice (const :tag "unlimited" nil)
+                (integer 1000000)))
+
+(defcustom message-alternative-emails nil
+  "A regexp to match the alternative email addresses.
+The first matched address (not primary one) is used in the From field."
+  :group 'message-headers
+  :type '(choice (const :tag "Always use primary" nil)
+                regexp))
+
  ;;; Internal variables.
  
  ;;; Internal variables.
  
+(defvar message-sending-message "Sending...")
  (defvar message-buffer-list nil)
  (defvar message-this-is-news nil)
  (defvar message-this-is-mail nil)
  (defvar message-buffer-list nil)
  (defvar message-this-is-news nil)
  (defvar message-this-is-mail nil)
@@ -1338,12 +1369,16 @@ The cdr of ech entry is a function for applying the face to a region.")
      (User-Agent))
    "Alist used for formatting headers.")
  
      (User-Agent))
    "Alist used for formatting headers.")
  
+(defvar        message-options nil
+  "Some saved answers when sending message.")
+
  (eval-and-compile
    (autoload 'message-setup-toolbar "messagexmas")
    (autoload 'mh-new-draft-name "mh-comp")
    (autoload 'mh-send-letter "mh-comp")
    (autoload 'gnus-point-at-eol "gnus-util")
    (autoload 'gnus-point-at-bol "gnus-util")
  (eval-and-compile
    (autoload 'message-setup-toolbar "messagexmas")
    (autoload 'mh-new-draft-name "mh-comp")
    (autoload 'mh-send-letter "mh-comp")
    (autoload 'gnus-point-at-eol "gnus-util")
    (autoload 'gnus-point-at-bol "gnus-util")
+  (autoload 'gnus-output-to-rmail "gnus-util")
    (autoload 'gnus-output-to-mail "gnus-util")
    (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
    (autoload 'nndraft-request-associate-buffer "nndraft")
    (autoload 'gnus-output-to-mail "gnus-util")
    (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
    (autoload 'nndraft-request-associate-buffer "nndraft")
@@ -1352,6 +1387,7 @@ The cdr of ech entry is a function for applying the face to a region.")
    (autoload 'gnus-request-post "gnus-int")
    (autoload 'gnus-copy-article-buffer "gnus-msg")
    (autoload 'gnus-alive-p "gnus-util")
    (autoload 'gnus-request-post "gnus-int")
    (autoload 'gnus-copy-article-buffer "gnus-msg")
    (autoload 'gnus-alive-p "gnus-util")
+  (autoload 'gnus-group-name-charset "gnus-group")
    (autoload 'rmail-output "rmail")
    (autoload 'mu-cite-original "mu-cite"))
  
    (autoload 'rmail-output "rmail")
    (autoload 'mu-cite-original "mu-cite"))
  
@@ -1386,9 +1422,19 @@ The cdr of ech entry is a function for applying the face to a region.")
    `(delete-region (progn (beginning-of-line) (point))
                   (progn (forward-line ,(or n 1)) (point))))
  
    `(delete-region (progn (beginning-of-line) (point))
                   (progn (forward-line ,(or n 1)) (point))))
  
+(defun message-unquote-tokens (elems)
+  "Remove double quotes (\") from strings in list."
+  (mapcar (lambda (item)
+            (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
+              (setq item (concat (match-string 1 item)
+                                 (match-string 2 item))))
+            item)
+          elems))
+
  (defun message-tokenize-header (header &optional separator)
    "Split HEADER into a list of header elements.
  (defun message-tokenize-header (header &optional separator)
    "Split HEADER into a list of header elements.
-\",\" is used as the separator."
+SEPARATOR is a string of characters to be used as separators.  \",\"
+is used by default."
    (if (not header)
        nil
      (let ((regexp (format "[%s]+" (or separator ",")))
    (if (not header)
        nil
      (let ((regexp (format "[%s]+" (or separator ",")))
@@ -1418,7 +1464,7 @@ The cdr of ech entry is a function for applying the face to a region.")
                 ((and (eq (char-after) ?\))
                       (not quoted))
                  (setq paren nil))))
                 ((and (eq (char-after) ?\))
                       (not quoted))
                  (setq paren nil))))
-       (nreverse elems)))))
+        (nreverse elems)))))
  
  (defun message-mail-file-mbox-p (file)
    "Say whether FILE looks like a Unix mbox file."
  
  (defun message-mail-file-mbox-p (file)
    "Say whether FILE looks like a Unix mbox file."
@@ -1433,12 +1479,13 @@ The cdr of ech entry is a function for applying the face to a region.")
  (defun message-fetch-field (header &optional not-all)
    "The same as `mail-fetch-field', only remove all newlines."
    (let* ((inhibit-point-motion-hooks t)
  (defun message-fetch-field (header &optional not-all)
    "The same as `mail-fetch-field', only remove all newlines."
    (let* ((inhibit-point-motion-hooks t)
+        (case-fold-search t)
          (value (mail-fetch-field header nil (not not-all))))
      (when value
        (while (string-match "\n[\t ]+" value)
         (setq value (replace-match " " t t value)))
          (value (mail-fetch-field header nil (not not-all))))
      (when value
        (while (string-match "\n[\t ]+" value)
         (setq value (replace-match " " t t value)))
-      ;; We remove all text props.
-      (format "%s" value))))
+      (set-text-properties 0 (length value) nil value)
+      value)))
  
  (defun message-narrow-to-field ()
    "Narrow the buffer to the header on the current line."
  
  (defun message-narrow-to-field ()
    "Narrow the buffer to the header on the current line."
@@ -1491,6 +1538,21 @@ The cdr of ech entry is a function for applying the face to a region.")
        (and (listp form) (eq (car form) 'lambda))
        (byte-code-function-p form)))
  
        (and (listp form) (eq (car form) 'lambda))
        (byte-code-function-p form)))
  
+(defun message-strip-list-identifiers (subject)
+  "Remove list identifiers in `gnus-list-identifiers'."
+  (require 'gnus-sum)                  ; for gnus-list-identifiers
+  (let ((regexp (if (stringp gnus-list-identifiers)
+                   gnus-list-identifiers
+                 (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+    (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+                               " *\\)\\)+\\(Re: +\\)?\\)") subject)
+       (concat (substring subject 0 (match-beginning 1))
+               (or (match-string 3 subject)
+                   (match-string 5 subject))
+               (substring subject
+                          (match-end 1)))
+      subject)))
+
  (defun message-strip-subject-re (subject)
    "Remove \"Re:\" from subject lines."
    (if (string-match message-subject-re-regexp subject)
  (defun message-strip-subject-re (subject)
    "Remove \"Re:\" from subject lines."
    (if (string-match message-subject-re-regexp subject)
@@ -1799,20 +1861,6 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
               (error "Face %s not configured for %s mode" face mode-name)))
           "")
         facemenu-remove-face-function t)
               (error "Face %s not configured for %s mode" face mode-name)))
           "")
         facemenu-remove-face-function t)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  ;; `-- ' precedes the signature.  `-----' appears at the start of the
-  ;; lines that delimit forwarded messages.
-  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
-  ;; are also sometimes used and should be separators.
-  (setq paragraph-start
-       (concat (regexp-quote mail-header-separator)
-               "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
-               "-- $\\|---+$\\|"
-               page-delimiter
-               ;;!!! Uhm... shurely this can't be right?
-               "[> " (regexp-quote message-yank-prefix) "]+$"))
-  (setq paragraph-separate paragraph-start)
    (make-local-variable 'message-reply-headers)
    (setq message-reply-headers nil)
    (make-local-variable 'message-user-agent)
    (make-local-variable 'message-reply-headers)
    (setq message-reply-headers nil)
    (make-local-variable 'message-user-agent)
@@ -1822,10 +1870,18 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
    (make-local-variable 'message-parameter-alist)
    (setq message-parameter-alist
         (copy-sequence message-startup-parameter-alist))
    (make-local-variable 'message-parameter-alist)
    (setq message-parameter-alist
         (copy-sequence message-startup-parameter-alist))
+  (message-setup-fill-variables)
    ;;(when (fboundp 'mail-hist-define-keys)
    ;;  (mail-hist-define-keys))
    ;;(when (fboundp 'mail-hist-define-keys)
    ;;  (mail-hist-define-keys))
-  (when (string-match "XEmacs\\|Lucid" emacs-version)
-    (message-setup-toolbar))
+  (if (featurep 'xemacs)
+      (message-setup-toolbar)
+    (set (make-local-variable 'font-lock-defaults)
+        '((message-font-lock-keywords
+           message-font-lock-keywords-1
+           message-font-lock-keywords-2)
+          nil nil nil nil
+          (font-lock-mark-block-function . mark-paragraph))))
+  (set (make-local-variable 'message-font-lock-last-position) nil)
    (easy-menu-add message-mode-menu message-mode-map)
    (easy-menu-add message-mode-field-menu message-mode-map)
    ;; Allow mail alias things.
    (easy-menu-add message-mode-menu message-mode-map)
    (easy-menu-add message-mode-field-menu message-mode-map)
    ;; Allow mail alias things.
@@ -1834,27 +1890,42 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
         (mail-abbrevs-setup)
        (mail-aliases-setup)))
    (message-set-auto-save-file-name)
         (mail-abbrevs-setup)
        (mail-aliases-setup)))
    (message-set-auto-save-file-name)
-  (unless (string-match "XEmacs" emacs-version)
-    (set (make-local-variable 'font-lock-defaults)
-        '((message-font-lock-keywords
-           message-font-lock-keywords-1
-           message-font-lock-keywords-2)
-          nil nil nil nil
-          (font-lock-mark-block-function . mark-paragraph))))
-  (set (make-local-variable 'message-font-lock-last-position) nil)
+  (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
+  (setq indent-tabs-mode nil)
+  (run-hooks 'text-mode-hook 'message-mode-hook))
+
+(defun message-setup-fill-variables ()
+  "Setup message fill variables."
+  (make-local-variable 'paragraph-separate)
+  (make-local-variable 'paragraph-start)
    (make-local-variable 'adaptive-fill-regexp)
    (make-local-variable 'adaptive-fill-regexp)
-  (setq adaptive-fill-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
-               adaptive-fill-regexp))
    (unless (boundp 'adaptive-fill-first-line-regexp)
      (setq adaptive-fill-first-line-regexp nil))
    (make-local-variable 'adaptive-fill-first-line-regexp)
    (unless (boundp 'adaptive-fill-first-line-regexp)
      (setq adaptive-fill-first-line-regexp nil))
    (make-local-variable 'adaptive-fill-first-line-regexp)
-  (setq adaptive-fill-first-line-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
-               adaptive-fill-first-line-regexp))
-  (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
-  (setq indent-tabs-mode nil)
-  (run-hooks 'text-mode-hook 'message-mode-hook))
+  (make-local-variable 'auto-fill-inhibit-regexp)
+  (let ((quote-prefix-regexp
+        (concat
+         "[ \t]*"                      ; possible initial space
+         "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix
+         "\\(\\w\\|[-_.]\\)+>\\|"      ; supercite-style prefix
+         "[|:>]"                       ; standard prefix
+         "\\)[ \t]*\\)+")))            ; possible space after each prefix
+    (setq paragraph-start
+         (concat
+          (regexp-quote mail-header-separator) "$\\|"
+          "[ \t]*$\\|"                 ; blank lines
+          "-- $\\|"                    ; signature delimiter
+          "---+$\\|"                   ; delimiters for forwarded messages
+          page-delimiter "$\\|"        ; spoiler warnings
+          ".*wrote:$\\|"               ; attribution lines
+          quote-prefix-regexp "$"))    ; empty lines in quoted text
+    (setq paragraph-separate paragraph-start)
+    (setq adaptive-fill-regexp
+         (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+    (setq adaptive-fill-first-line-regexp
+         (concat quote-prefix-regexp "\\|"
+                 adaptive-fill-first-line-regexp))
+    (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")))
  
  \f
  
  
  \f
  
@@ -1992,9 +2063,28 @@ With the prefix argument FORCE, insert the header anyway."
              (mail-fetch-field "to")
              (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
      (insert ", "))
              (mail-fetch-field "to")
              (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
      (insert ", "))
-  (insert (or (message-fetch-reply-field "reply-to")
+  (insert (or (message-fetch-reply-field "mail-reply-to")
+             (message-fetch-reply-field "reply-to")
               (message-fetch-reply-field "from") "")))
  
               (message-fetch-reply-field "from") "")))
  
+(defun message-widen-reply ()
+  "Widen the reply to include maximum recipients."
+  (interactive)
+  (let ((follow-to
+        (and message-reply-buffer
+             (buffer-name message-reply-buffer)
+             (save-excursion
+               (set-buffer message-reply-buffer)
+               (message-get-reply-headers t)))))
+    (save-excursion
+      (save-restriction
+       (message-narrow-to-headers)
+       (dolist (elem follow-to)
+         (message-remove-header (symbol-name (car elem)))
+         (goto-char (point-min))
+         (insert (symbol-name (car elem)) ": "
+                 (cdr elem) "\n"))))))
+
  (defun message-insert-newsgroups ()
    "Insert the Newsgroups header from the article being replied to."
    (interactive)
  (defun message-insert-newsgroups ()
    "Insert the Newsgroups header from the article being replied to."
    (interactive)
@@ -2039,14 +2129,11 @@ With the prefix argument FORCE, insert the header anyway."
  (defun message-newline-and-reformat ()
    "Insert four newlines, and then reformat if inside quoted text."
    (interactive)
  (defun message-newline-and-reformat ()
    "Insert four newlines, and then reformat if inside quoted text."
    (interactive)
-  (let ((prefix "[]>»|:}+ \t]*")
-       (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
-       quoted point)
+  (let (quoted point)
      (unless (bolp)
        (save-excursion
         (beginning-of-line)
      (unless (bolp)
        (save-excursion
         (beginning-of-line)
-       (when (looking-at (concat prefix
-                                 supercite-thing))
+       (when (looking-at message-cite-prefix-regexp)
           (setq quoted (match-string 0))))
        (insert "\n"))
      (setq point (point))
           (setq quoted (match-string 0))))
        (insert "\n"))
      (setq point (point))
@@ -2122,14 +2209,7 @@ text was killed."
               (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
        (setq message-caesar-translation-table
             (message-make-caesar-translation-table n)))
               (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
        (setq message-caesar-translation-table
             (message-make-caesar-translation-table n)))
-    ;; Then we translate the region.  Do it this way to retain
-    ;; text properties.
-    (while (< b e)
-      (when (< (char-after b) 255)
-       (subst-char-in-region
-        b (1+ b) (char-after b)
-        (aref message-caesar-translation-table (char-after b))))
-      (incf b))))
+    (translate-region b e message-caesar-translation-table)))
  
  (defun message-make-caesar-translation-table (n)
    "Create a rot table with offset N."
  
  (defun message-make-caesar-translation-table (n)
    "Create a rot table with offset N."
@@ -2166,11 +2246,8 @@ Mail and USENET news headers are not rotated."
      (save-restriction
        (when (message-goto-body)
          (narrow-to-region (point) (point-max)))
      (save-restriction
        (when (message-goto-body)
          (narrow-to-region (point) (point-max)))
-      (let ((body (buffer-substring (point-min) (point-max))))
-        (unless (equal 0 (call-process-region
-                         (point-min) (point-max) program t t))
-         (insert body)
-         (message "%s failed" program))))))
+      (shell-command-on-region
+       (point-min) (point-max) program nil t))))
  
  (defun message-rename-buffer (&optional enter-string)
    "Rename the *message* buffer to \"*message* RECIPIENT\".
  
  (defun message-rename-buffer (&optional enter-string)
    "Rename the *message* buffer to \"*message* RECIPIENT\".
@@ -2237,7 +2314,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 (bolp)
        (insert "\n"))
      (while (and (zerop (forward-line -1))
                 (looking-at "$"))
        (insert "\n"))
      (while (and (zerop (forward-line -1))
                 (looking-at "$"))
@@ -2261,28 +2338,19 @@ to REFS-LIST."
        (let ((pos message-list-references-add-position))
         (while (and refs-list
                     (> pos 0))
        (let ((pos message-list-references-add-position))
         (while (and refs-list
                     (> pos 0))
-         (setq saved-id (cons (car refs-list) saved-id)
-               refs-list (cdr refs-list)
-               pos (1- pos)))))
+         (push (pop refs-list) saved-id)
+         (setq pos (1- pos)))))
      (while refs-strs
      (while refs-strs
-      (setq refs (car refs-strs)
-           refs-strs (cdr refs-strs))
-      (when refs
+      (when (setq refs (pop refs-strs))
         (setq refs (std11-parse-msg-ids (std11-lexical-analyze refs)))
         (while refs
         (setq refs (std11-parse-msg-ids (std11-lexical-analyze refs)))
         (while refs
-         (setq ref (car refs)
-               refs (cdr refs))
-         (when (eq (car ref) 'msg-id)
-           (setq id (concat "<"
-                            (mapconcat
-                             (function (lambda (p) (cdr p)))
-                             (cdr ref) "")
-                            ">"))
+         (when (eq (car (setq ref (pop refs))) 'msg-id)
+           (setq id (concat "<" (mapconcat 'cdr (cdr ref) "") ">"))
             (or (member id refs-list)
             (or (member id refs-list)
+               (member id saved-id)
                 (push id refs-list))))))
      (while saved-id
                 (push id refs-list))))))
      (while saved-id
-      (setq refs-list (cons (car saved-id) refs-list)
-           saved-id (cdr saved-id)))
+      (push (pop saved-id) refs-list))
      refs-list))
  
  (defvar gnus-article-copy)
      refs-list))
  
  (defvar gnus-article-copy)
@@ -2378,6 +2446,8 @@ be added to \"References\" field.
            (if (listp message-indent-citation-function)
                message-indent-citation-function
              (list message-indent-citation-function)))))
            (if (listp message-indent-citation-function)
                message-indent-citation-function
              (list message-indent-citation-function)))))
+    ;; Allow undoing.
+    (undo-boundary)
      (goto-char end)
      (when (re-search-backward message-signature-separator start t)
        ;; Also peel off any blank lines before the signature.
      (goto-char end)
      (when (re-search-backward message-signature-separator start t)
        ;; Also peel off any blank lines before the signature.
@@ -2407,15 +2477,17 @@ be added to \"References\" field.
              (if (listp message-indent-citation-function)
                  message-indent-citation-function
                (list message-indent-citation-function))))
              (if (listp message-indent-citation-function)
                  message-indent-citation-function
                (list message-indent-citation-function))))
-         (from (save-restriction
-                 (narrow-to-region (point)
-                                   (if (search-forward "\n\n" nil t)
-                                       (1- (point))
-                                     (point-max)))
-                 (message-fetch-field "from")))
           (message-reply-headers (or message-reply-headers
                                      (make-mail-header))))
           (message-reply-headers (or message-reply-headers
                                      (make-mail-header))))
-      (mail-header-set-from message-reply-headers from)
+      (mail-header-set-from message-reply-headers
+                           (save-restriction
+                             (narrow-to-region
+                              (point)
+                              (if (search-forward "\n\n" nil t)
+                                  (1- (point))
+                                (point-max)))
+                             (or (message-fetch-field "from")
+                                 "unknown sender")))
        (goto-char start)
        (while functions
         (funcall (pop functions)))
        (goto-char start)
        (while functions
         (funcall (pop functions)))
@@ -2596,31 +2668,33 @@ It should typically alter the sending method in some way or other."
      (let ((inhibit-read-only t))
        (put-text-property (point-min) (point-max) 'read-only nil))
      (run-hooks 'message-send-hook)
      (let ((inhibit-read-only t))
        (put-text-property (point-min) (point-max) 'read-only nil))
      (run-hooks 'message-send-hook)
-    (message "Sending...")
+    (message-fix-before-sending)
+    (message message-sending-message)
      (let ((message-encoding-buffer
            (message-generate-new-buffer-clone-locals " message encoding"))
           (message-edit-buffer (current-buffer))
           (message-mime-mode mime-edit-mode-flag)
           (alist message-send-method-alist)
           (success t)
      (let ((message-encoding-buffer
            (message-generate-new-buffer-clone-locals " message encoding"))
           (message-edit-buffer (current-buffer))
           (message-mime-mode mime-edit-mode-flag)
           (alist message-send-method-alist)
           (success t)
-         elem sent)
+         elem sent
+         (message-options message-options))
+      (message-options-set-recipient)
        (save-excursion
         (set-buffer message-encoding-buffer)
         (erase-buffer)
         (insert-buffer message-edit-buffer)
         (funcall message-encode-function)
        (save-excursion
         (set-buffer message-encoding-buffer)
         (erase-buffer)
         (insert-buffer message-edit-buffer)
         (funcall message-encode-function)
-       (message-fix-before-sending)
         (while (and success
                     (setq elem (pop alist)))
         (while (and success
                     (setq elem (pop alist)))
-         (when (or (not (funcall (cadr elem)))
-                   (and (or (not (memq (car elem)
-                                       message-sent-message-via))
-                            (y-or-n-p
-                             (format
-                              "Already sent message via %s; resend? "
-                              (car elem))))
-                        (setq success (funcall (caddr elem) arg))))
-           (setq sent t))))
+         (when (funcall (cadr elem))
+           (when (and (or (not (memq (car elem)
+                                     message-sent-message-via))
+                          (y-or-n-p
+                           (format
+                            "Already sent message via %s; resend? "
+                            (car elem))))
+                      (setq success (funcall (caddr elem) arg)))
+             (setq sent t)))))
        (unless (or sent (not success))
         (error "No methods specified to send by"))
        (prog1
        (unless (or sent (not success))
         (error "No methods specified to send by"))
        (prog1
@@ -2629,7 +2703,7 @@ It should typically alter the sending method in some way or other."
             (save-excursion
               (run-hooks 'message-sent-hook))
             (message "Sending...done")
             (save-excursion
               (run-hooks 'message-sent-hook))
             (message "Sending...done")
-           ;; Mark the buffer as unmodified and delete autosave.
+           ;; Mark the buffer as unmodified and delete auto-save.
             (set-buffer-modified-p nil)
             (delete-auto-save-file-if-necessary t)
             (message-disassociate-draft)
             (set-buffer-modified-p nil)
             (delete-auto-save-file-if-necessary t)
             (message-disassociate-draft)
@@ -2657,13 +2731,42 @@ It should typically alter the sending method in some way or other."
  (put 'message-check 'lisp-indent-function 1)
  (put 'message-check 'edebug-form-spec '(form body))
  
  (put 'message-check 'lisp-indent-function 1)
  (put 'message-check 'edebug-form-spec '(form body))
  
+;; This function will be used by MIME-Edit when inserting invisible parts.
+(defun message-invisible-region (start end)
+  (if (featurep 'xemacs)
+      (if (save-excursion
+           (goto-char start)
+           (eq (following-char) ?\n))
+         (setq start (1+ start)))
+    (if (save-excursion
+         (goto-char (1- end))
+         (eq (following-char) ?\n))
+       (setq end (1- end))))
+  (put-text-property start end 'invisible t)
+  (if (eq 'message-mode major-mode)
+      (put-text-property start end 'message-invisible t)))
+
+(eval-after-load "invisible"
+  '(defalias 'invisible-region 'message-invisible-region))
+
  (defun message-fix-before-sending ()
    "Do various things to make the message nice before sending it."
    ;; Make sure there's a newline at the end of the message.
  (defun message-fix-before-sending ()
    "Do various things to make the message nice before sending it."
    ;; Make sure there's a newline at the end of the message.
+  (widen)
    (goto-char (point-max))
    (unless (bolp)
      (insert "\n"))
    (goto-char (point-max))
    (unless (bolp)
      (insert "\n"))
-  ;; Delete all invisible text.
+  ;; Expose all invisible text with the property `message-invisible'.
+  ;; We should believe that the things might be created by MIME-Edit.
+  (let (start)
+    (while (setq start (text-property-any (point-min) (point-max)
+                                         'message-invisible t))
+      (remove-text-properties start
+                             (or (text-property-not-all start (point-max)
+                                                        'message-invisible t)
+                                 (point-max))
+                             '(invisible nil message-invisible nil))))
+  ;; Expose all invisible text.
    (message-check 'invisible-text
      (when (text-property-any (point-min) (point-max) 'invisible t)
        (put-text-property (point-min) (point-max) 'invisible nil)
    (message-check 'invisible-text
      (when (text-property-any (point-min) (point-max) 'invisible t)
        (put-text-property (point-min) (point-max) 'invisible nil)
@@ -2736,6 +2839,78 @@ This sub function is for exclusive use of `message-send-mail'."
           (cadr failure)
         (prin1-to-string failure)))))
  
           (cadr failure)
         (prin1-to-string failure)))))
  
+(defun message-send-mail-partially ()
+  "Sendmail as message/partial."
+  ;; replace the header delimiter with a blank line
+  (goto-char (point-min))
+  (re-search-forward
+   (concat "^" (regexp-quote mail-header-separator) "\n"))
+  (replace-match "\n")
+  (run-hooks 'message-send-mail-hook)
+  (let ((p (goto-char (point-min)))
+       (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)
+    (while (not (eobp))
+      (if (< (point-max) (+ p message-send-mail-partially-limit))
+         (goto-char (point-max))
+       (goto-char (+ p message-send-mail-partially-limit))
+       (beginning-of-line)
+       (if (<= (point) p) (forward-line 1))) ;; In case of bad message.
+      (push p plist)
+      (setq p (point)))
+    (setq total (length plist))
+    (push (point-max) plist)
+    (setq plist (nreverse plist))
+    (unwind-protect
+       (save-excursion
+         (setq p (pop plist))
+         (while plist
+           (set-buffer curbuf)
+           (copy-to-buffer tembuf p (car plist))
+           (set-buffer tembuf)
+           (goto-char (point-min))
+           (if header
+               (progn
+                 (goto-char (point-min))
+                 (narrow-to-region (point) (point))
+                 (insert header))
+             (message-goto-eoh)
+             (setq header (buffer-substring (point-min) (point)))
+             (goto-char (point-min))
+             (narrow-to-region (point) (point))
+             (insert header)
+             (message-remove-header "Mime-Version")
+             (message-remove-header "Content-Type")
+             (message-remove-header "Content-Transfer-Encoding")
+             (message-remove-header "Message-ID")
+             (message-remove-header "Lines")
+             (goto-char (point-max))
+             (insert "Mime-Version: 1.0\n")
+             (setq header (buffer-substring (point-min) (point-max))))
+           (goto-char (point-max))
+           (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n"
+                           id n total))
+           (let ((mail-header-separator ""))
+             (when (memq 'Message-ID message-required-mail-headers)
+               (insert "Message-ID: " (message-make-message-id) "\n"))
+             (when (memq 'Lines message-required-mail-headers)
+               (let ((mail-header-separator ""))
+                 (insert "Lines: " (message-make-lines) "\n")))
+             (message-goto-subject)
+             (end-of-line)
+             (insert (format " (%d/%d)" n total))
+             (goto-char (point-max))
+             (insert "\n")
+             (widen)
+             (mm-with-unibyte-current-buffer
+               (funcall message-send-mail-function)))
+           (setq n (+ n 1))
+           (setq p (pop plist))
+           (erase-buffer)))
+      (kill-buffer tembuf))))
+
  (defun message-send-mail (&optional arg)
    (require 'mail-utils)
    (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
  (defun message-send-mail (&optional arg)
    (require 'mail-utils)
    (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
@@ -2773,9 +2948,15 @@ This sub function is for exclusive use of `message-send-mail'."
             ;; require one newline at the end.
             (or (= (preceding-char) ?\n)
                 (insert ?\n))
             ;; require one newline at the end.
             (or (= (preceding-char) ?\n)
                 (insert ?\n))
-           (when (and news
+           (when
+               (save-restriction
+                 (message-narrow-to-headers)
+                 (and news
                        (or (message-fetch-field "cc")
                        (or (message-fetch-field "cc")
-                          (message-fetch-field "to")))
+                          (message-fetch-field "to"))
+                      (let ((ct (mime-read-Content-Type)))
+                        (and (eq 'text (cdr (assq 'type ct)))
+                             (eq 'plain (cdr (assq 'subtype ct)))))))
               (message-insert-courtesy-copy))
             (setq failure (message-maybe-split-and-send-mail)))
         (kill-buffer tembuf))
               (message-insert-courtesy-copy))
             (setq failure (message-maybe-split-and-send-mail)))
         (kill-buffer tembuf))
@@ -2789,7 +2970,8 @@ This sub function is for exclusive use of `message-send-mail'."
  (defun message-send-mail-with-sendmail ()
    "Send off the prepared buffer with sendmail."
    (let ((errbuf (if message-interactive
  (defun message-send-mail-with-sendmail ()
    "Send off the prepared buffer with sendmail."
    (let ((errbuf (if message-interactive
-                   (message-generate-new-buffer-clone-locals " sendmail errors")
+                   (message-generate-new-buffer-clone-locals
+                    " sendmail errors")
                   0))
         resend-to-addresses delimline)
      (let ((case-fold-search t))
                   0))
         resend-to-addresses delimline)
      (let ((case-fold-search t))
@@ -2977,6 +3159,7 @@ This sub function is for exclusive use of `message-send-news'."
          (method (if (message-functionp message-post-method)
                      (funcall message-post-method arg)
                    message-post-method))
          (method (if (message-functionp message-post-method)
                      (funcall message-post-method arg)
                    message-post-method))
+        (group-name-charset (gnus-group-name-charset method ""))
          (message-syntax-checks
           (if arg
               (cons '(existing-newsgroups . disabled)
          (message-syntax-checks
           (if arg
               (cons '(existing-newsgroups . disabled)
@@ -2990,6 +3173,10 @@ This sub function is for exclusive use of `message-send-news'."
        (message-generate-headers message-required-news-headers)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
        (message-generate-headers message-required-news-headers)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
+    (if group-name-charset
+       (setq message-syntax-checks
+             (cons '(valid-newsgroups . disabled)
+                   message-syntax-checks)))
      (message-cleanup-headers)
      (if (not (message-check-news-syntax))
         nil
      (message-cleanup-headers)
      (if (not (message-check-news-syntax))
         nil
@@ -3067,7 +3254,7 @@ This sub function is for exclusive use of `message-send-news'."
  (defun message-check-news-header-syntax ()
    (and
     ;; Check Newsgroups header.
  (defun message-check-news-header-syntax ()
    (and
     ;; Check Newsgroups header.
-   (message-check 'newsgroyps
+   (message-check 'newsgroups
       (let ((group (message-fetch-field "newsgroups")))
         (or
         (and group
       (let ((group (message-fetch-field "newsgroups")))
         (or
         (and group
@@ -3311,11 +3498,24 @@ This sub function is for exclusive use of `message-send-news'."
     (message-check 'signature
       (goto-char (point-max))
       (if (> (count-lines (point) (point-max)) 5)
     (message-check 'signature
       (goto-char (point-max))
       (if (> (count-lines (point) (point-max)) 5)
-        (y-or-n-p
-         (format
-          "Your .sig is %d lines; it should be max 4.  Really post? "
-          (1- (count-lines (point) (point-max)))))
-       t))))
+        (y-or-n-p
+         (format
+          "Your .sig is %d lines; it should be max 4.  Really post? "
+          (1- (count-lines (point) (point-max)))))
+       t))
+   ;; Ensure that text follows last quoted portion.
+   (message-check 'quoting-style
+     (goto-char (point-max))
+     (let ((no-problem t))
+       (when (search-backward-regexp "^>[^\n]*\n>" nil t)
+        (setq no-problem nil)
+        (while (not (eobp))
+          (when (and (not (eolp)) (looking-at "[^> \t]"))
+            (setq no-problem t))
+          (forward-line)))
+       (if no-problem
+          t
+        (y-or-n-p "Your text should follow quoted text.  Really post? "))))))
  
  (defun message-check-mail-syntax ()
    "Check the syntax of the message."
  
  (defun message-check-mail-syntax ()
    "Check the syntax of the message."
@@ -3422,7 +3622,7 @@ This sub function is for exclusive use of `message-send-news'."
    "Append this article to Unix/babyl mail file.."
    (if (and (file-readable-p filename)
            (mail-file-babyl-p filename))
    "Append this article to Unix/babyl mail file.."
    (if (and (file-readable-p filename)
            (mail-file-babyl-p filename))
-      (rmail-output-to-rmail-file filename t)
+      (gnus-output-to-rmail filename t)
      (gnus-output-to-mail filename t)))
  
  (defun message-cleanup-headers ()
      (gnus-output-to-mail filename t)))
  
  (defun message-cleanup-headers ()
@@ -3836,7 +4036,7 @@ Headers already prepared in the buffer are not modified."
                   ;; The element is a symbol.  We insert the value
                   ;; of this symbol, if any.
                   (symbol-value header))
                   ;; The element is a symbol.  We insert the value
                   ;; of this symbol, if any.
                   (symbol-value header))
-                (t
+                ((not (message-check-element header))
                   ;; We couldn't generate a value for this header,
                   ;; so we just ask the user.
                   (read-from-minibuffer
                   ;; We couldn't generate a value for this header,
                   ;; so we just ask the user.
                   (read-from-minibuffer
@@ -4002,7 +4202,10 @@ than 988 characters long, and if they are not, trim them until they are."
  
      ;; If folding is disallowed, make sure the total length (including
      ;; the spaces between) will be less than MAXSIZE characters.
  
      ;; If folding is disallowed, make sure the total length (including
      ;; the spaces between) will be less than MAXSIZE characters.
-    (when message-cater-to-broken-inn
+    ;;
+    ;; Only disallow folding for News messages. At this point the headers
+    ;; have not been generated, thus we use message-this-is-news directly.
+    (when (and message-this-is-news message-cater-to-broken-inn)
        (let ((maxsize 988)
             (totalsize (+ (apply #'+ (mapcar #'length refs))
                           (1- count)))
        (let ((maxsize 988)
             (totalsize (+ (apply #'+ (mapcar #'length refs))
                           (1- count)))
@@ -4020,7 +4223,7 @@ than 988 characters long, and if they are not, trim them until they are."
      ;; Finally, collect the references back into a string and insert
      ;; it into the buffer.
      (let ((refstring (mapconcat #'identity refs " ")))
      ;; Finally, collect the references back into a string and insert
      ;; it into the buffer.
      (let ((refstring (mapconcat #'identity refs " ")))
-      (if message-cater-to-broken-inn
+      (if (and message-this-is-news message-cater-to-broken-inn)
           (insert (capitalize (symbol-name header)) ": "
                   refstring "\n")
         (message-fill-header header refstring)))))
           (insert (capitalize (symbol-name header)) ": "
                   refstring "\n")
         (message-fill-header header refstring)))))
@@ -4187,6 +4390,8 @@ than 988 characters long, and if they are not, trim them until they are."
    (message-insert-signature)
    (save-restriction
      (message-narrow-to-headers)
    (message-insert-signature)
    (save-restriction
      (message-narrow-to-headers)
+    (if message-alternative-emails
+       (message-use-alternative-email-as-from))
      (run-hooks 'message-header-setup-hook))
    (set-buffer-modified-p nil)
    (setq buffer-undo-list nil)
      (run-hooks 'message-header-setup-hook))
    (set-buffer-modified-p nil)
    (setq buffer-undo-list nil)
@@ -4260,56 +4465,20 @@ OTHER-HEADERS is an alist of header/value pairs."
      (message-setup `((Newsgroups . ,(or newsgroups ""))
                      (Subject . ,(or subject ""))))))
  
      (message-setup `((Newsgroups . ,(or newsgroups ""))
                      (Subject . ,(or subject ""))))))
  
-;;;###autoload
-(defun message-reply (&optional to-address wide)
-  "Start editing a reply to the article in the current buffer."
-  (interactive)
-  (let ((cur (current-buffer))
-       from subject date to cc
-       references message-id follow-to
-       (inhibit-point-motion-hooks t)
-       (message-this-is-mail t)
-       mct never-mct mft mrt gnus-warning in-reply-to)
-    (save-restriction
-      (message-narrow-to-head)
-      ;; Allow customizations to have their say.
-      (if (not wide)
-         ;; This is a regular reply.
-         (if (message-functionp message-reply-to-function)
-             (setq follow-to (funcall message-reply-to-function)))
-       ;; This is a followup.
-       (if (message-functionp message-wide-reply-to-function)
-           (save-excursion
-             (setq follow-to
-                   (funcall message-wide-reply-to-function)))))
-      ;; Find all relevant headers we need.
-      (setq from (message-fetch-field "from")
-           date (message-fetch-field "date" t)
-           subject (or (message-fetch-field "subject") "none")
-           references (message-fetch-field "references")
-           message-id (message-fetch-field "message-id" t)
-           to (message-fetch-field "to")
-           cc (message-fetch-field "cc")
-           mct (when (and wide message-use-mail-copies-to)
-                 (message-fetch-field "mail-copies-to"))
-           mft (when (and wide message-use-mail-followup-to)
-                 (message-fetch-field "mail-followup-to"))
-           mrt (when message-use-mail-reply-to
-                 (or (message-fetch-field "mail-reply-to")
-                     (message-fetch-field "reply-to")))
-           gnus-warning (message-fetch-field "gnus-warning"))
-      (when (and gnus-warning (string-match "<[^>]+>" gnus-warning))
-       (setq message-id (match-string 0 gnus-warning)))
-      ;; Get the references from "In-Reply-To" field if there were
-      ;; no references and "In-Reply-To" field looks promising.
-      (unless references
-       (when (and (setq in-reply-to (message-fetch-field "in-reply-to"))
-                  (string-match "<[^>]+>" in-reply-to))
-         (setq references (match-string 0 in-reply-to))))
-      ;; Remove any (buggy) Re:'s that are present and make a
-      ;; proper one.
-      (setq subject (message-make-followup-subject subject))
-      (widen))
+(defun message-get-reply-headers (wide &optional to-address)
+  (let (follow-to mct never-mct from to cc reply-to mrt mft)
+    ;; Find all relevant headers we need.
+    (setq from (message-fetch-field "from")
+         to (message-fetch-field "to")
+         cc (message-fetch-field "cc")
+         mct (when message-use-mail-copies-to
+               (message-fetch-field "mail-copies-to"))
+         reply-to (message-fetch-field "reply-to")
+         mrt (when message-use-mail-reply-to
+               (message-fetch-field "mail-reply-to"))
+         mft (when (and (not (or to-address mrt reply-to))
+                        message-use-mail-followup-to)
+               (message-fetch-field "mail-followup-to")))
  
      ;; Handle special values of Mail-Copies-To.
      (when mct
  
      ;; Handle special values of Mail-Copies-To.
      (when mct
@@ -4334,7 +4503,7 @@ You should normally obey the Mail-Copies-To: header.
  
         `Mail-Copies-To: always'
  sends a copy of your response to the author.")))
  
         `Mail-Copies-To: always'
  sends a copy of your response to the author.")))
-       (setq mct (or mrt from)))
+       (setq mct (or mrt reply-to from)))
         ((and (eq message-use-mail-copies-to 'ask)
              (not
               (message-y-or-n-p
         ((and (eq message-use-mail-copies-to 'ask)
              (not
               (message-y-or-n-p
@@ -4345,18 +4514,13 @@ You should normally obey the Mail-Copies-To: header.
  sends a copy of your response to " (if (string-match "," mct)
                                        "the specified addresses"
                                      "that address") ".")))
  sends a copy of your response to " (if (string-match "," mct)
                                        "the specified addresses"
                                      "that address") ".")))
-       (setq mct nil))
-       ))
+       (setq mct nil))))
  
  
-    (unless follow-to
-      (cond
-       (to-address (setq follow-to (list (cons 'To to-address))))
-       ((not wide) (setq follow-to (list (cons 'To (or mrt from)))))
-       ;; Handle Mail-Followup-To.
-       ((and mft
-            (or (not (eq message-use-mail-followup-to 'ask))
-                (message-y-or-n-p
-                 (concat "Obey Mail-Followup-To: " mft "? ") t "\
+    ;; Handle Mail-Followup-To.
+    (when (and mft
+              (eq message-use-mail-followup-to 'ask)
+              (not (message-y-or-n-p
+                    (concat "Obey Mail-Followup-To: " mft "? ") t "\
  You should normally obey the Mail-Followup-To: header.
  
         `Mail-Followup-To: " mft "'
  You should normally obey the Mail-Followup-To: header.
  
         `Mail-Followup-To: " mft "'
@@ -4369,48 +4533,122 @@ that further discussion should take place only in "
                              (if (string-match "," mft)
                                  "the specified mailing lists"
                                "that mailing list") ".")))
                              (if (string-match "," mft)
                                  "the specified mailing lists"
                                "that mailing list") ".")))
-       (setq follow-to (list (cons 'To mft)))
-       (when mct
-         (push (cons 'Cc mct) follow-to)))
-       (t
-       (let (ccalist)
-         (save-excursion
-           (message-set-work-buffer)
+      (setq mft nil))
+
+    (if (or (not wide)
+           to-address)
+       (progn
+         (setq follow-to (list (cons 'To
+                                     (or to-address mrt reply-to mft from))))
+         (when (and wide mct)
+           (push (cons 'Cc mct) follow-to)))
+      (let (ccalist)
+       (save-excursion
+         (message-set-work-buffer)
+          (if (and mft
+                   message-use-followup-to
+                   (or (not (eq message-use-followup-to 'ask))
+                       (message-y-or-n-p "Obey Mail-Followup-To? " t "\
+You should normally obey the Mail-Followup-To: header.  In this
+article, it has the value of
+
+" mft "
+
+which directs your response to " (if (string-match "," mft)
+                              "the specified addresses"
+                            "that address only") ".
+
+If a message is posted to several mailing lists, Mail-Followup-To is
+often used to direct the following discussion to one list only,
+because discussions that are spread over several lists tend to be
+fragmented and very difficult to follow.
+
+Also, some source/announcement lists are not indented for discussion;
+responses here are directed to other addresses.")))
+             (insert mft)
             (unless never-mct
             (unless never-mct
-             (insert (or mrt from "")))
+             (insert (or mrt reply-to from "")))
             (insert (if to (concat (if (bolp) "" ", ") to "") ""))
             (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
             (insert (if to (concat (if (bolp) "" ", ") to "") ""))
             (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
-           (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
-           (goto-char (point-min))
-           (while (re-search-forward "[ \t]+" nil t)
-             (replace-match " " t t))
-           ;; Remove addresses that match `rmail-dont-reply-to-names'.
-           (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
-             (insert (prog1 (rmail-dont-reply-to (buffer-string))
-                       (erase-buffer))))
-           (goto-char (point-min))
-           ;; Perhaps Mail-Copies-To: never removed the only address?
-           (when (eobp)
-             (insert (or mrt from "")))
-           (setq ccalist
-                 (mapcar
-                  (lambda (addr)
-                    (cons (mail-strip-quoted-names addr) addr))
-                  (message-tokenize-header (buffer-string))))
-           (let ((s ccalist))
-             (while s
-               (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
-         (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
-         (when ccalist
-           (let ((ccs (cons 'Cc (mapconcat
-                                 (lambda (addr) (cdr addr)) ccalist ", "))))
-             (when (string-match "^ +" (cdr ccs))
-               (setcdr ccs (substring (cdr ccs) (match-end 0))))
-             (push ccs follow-to)))))))
-
-    (message-pop-to-buffer (message-buffer-name
-                           (if wide "wide reply" "reply") from
-                           (if wide to-address nil)))
+           (insert (if cc (concat (if (bolp) "" ", ") cc) "")))
+         (goto-char (point-min))
+         (while (re-search-forward "[ \t]+" nil t)
+           (replace-match " " t t))
+         ;; Remove addresses that match `rmail-dont-reply-to-names'.
+         (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+           (insert (prog1 (rmail-dont-reply-to (buffer-string))
+                     (erase-buffer))))
+         (goto-char (point-min))
+         ;; Perhaps "Mail-Copies-To: never" removed the only address?
+         (when (eobp)
+           (insert (or mrt reply-to from "")))
+         (setq ccalist
+               (mapcar
+                (lambda (addr)
+                  (cons (mail-strip-quoted-names addr) addr))
+                (message-tokenize-header (buffer-string))))
+         (let ((s ccalist))
+           (while s
+             (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+       (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
+       (when ccalist
+         (let ((ccs (cons 'Cc (mapconcat
+                               (lambda (addr) (cdr addr)) ccalist ", "))))
+           (when (string-match "^ +" (cdr ccs))
+             (setcdr ccs (substring (cdr ccs) (match-end 0))))
+           (push ccs follow-to)))))
+    follow-to))
+
+;;;###autoload
+(defun message-reply (&optional to-address wide)
+  "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
+       references message-id follow-to
+       (inhibit-point-motion-hooks t)
+       (message-this-is-mail t)
+       gnus-warning in-reply-to)
+    (save-restriction
+      (message-narrow-to-head)
+      ;; Allow customizations to have their say.
+      (if (not wide)
+         ;; This is a regular reply.
+         (if (message-functionp message-reply-to-function)
+             (setq follow-to (funcall message-reply-to-function)))
+       ;; This is a followup.
+       (if (message-functionp message-wide-reply-to-function)
+           (save-excursion
+             (setq follow-to
+                   (funcall message-wide-reply-to-function)))))
+      (setq message-id (message-fetch-field "message-id" t)
+           references (message-fetch-field "references")
+           date (message-fetch-field "date")
+           from (message-fetch-field "from")
+           subject (or (message-fetch-field "subject") "none"))
+      (if gnus-list-identifiers
+         (setq subject (message-strip-list-identifiers subject)))
+      (setq subject (message-make-followup-subject subject))
+
+      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+                (string-match "<[^>]+>" gnus-warning))
+       (setq message-id (match-string 0 gnus-warning)))
+
+      (unless follow-to
+       (setq follow-to (message-get-reply-headers wide to-address)))
+
+      ;; Get the references from "In-Reply-To" field if there were
+      ;; no references and "In-Reply-To" field looks promising.
+      (unless references
+       (when (and (setq in-reply-to (message-fetch-field "in-reply-to"))
+                  (string-match "<[^>]+>" in-reply-to))
+         (setq references (match-string 0 in-reply-to)))))
+
+    (message-pop-to-buffer
+     (message-buffer-name
+      (if wide "wide reply" "reply") from
+      (if wide to-address nil)))
  
      (setq message-reply-headers
           (make-full-mail-header-from-decoded-header
  
      (setq message-reply-headers
           (make-full-mail-header-from-decoded-header
@@ -4421,7 +4659,8 @@ that further discussion should take place only in "
         ,@follow-to
         ,@(if (or references message-id)
              `((References . ,(concat (or references "") (and references " ")
         ,@follow-to
         ,@(if (or references message-id)
              `((References . ,(concat (or references "") (and references " ")
-                                     (or message-id ""))))))
+                                     (or message-id ""))))
+          nil))
       cur)))
  
  ;;;###autoload
       cur)))
  
  ;;;###autoload
@@ -4435,44 +4674,44 @@ that further discussion should take place only in "
    "Follow up to the message in the current buffer.
  If TO-NEWSGROUPS, use that as the new Newsgroups line."
    (interactive)
    "Follow up to the message in the current buffer.
  If TO-NEWSGROUPS, use that as the new Newsgroups line."
    (interactive)
+  (require 'gnus-sum)                  ; for gnus-list-identifiers
    (let ((cur (current-buffer))
    (let ((cur (current-buffer))
-       from subject date mct
+       from subject date reply-to mrt mct mft
         references message-id follow-to
         (inhibit-point-motion-hooks t)
         (message-this-is-news t)
         references message-id follow-to
         (inhibit-point-motion-hooks t)
         (message-this-is-news t)
-       followup-to distribution newsgroups gnus-warning posted-to mft mrt)
+       followup-to distribution newsgroups gnus-warning posted-to)
      (save-restriction
        (message-narrow-to-head)
        (when (message-functionp message-followup-to-function)
         (setq follow-to
               (funcall message-followup-to-function)))
        (setq from (message-fetch-field "from")
      (save-restriction
        (message-narrow-to-head)
        (when (message-functionp message-followup-to-function)
         (setq follow-to
               (funcall message-followup-to-function)))
        (setq from (message-fetch-field "from")
-           date (message-fetch-field "date" t)
+           date (message-fetch-field "date")
             subject (or (message-fetch-field "subject") "none")
             references (message-fetch-field "references")
             message-id (message-fetch-field "message-id" t)
             subject (or (message-fetch-field "subject") "none")
             references (message-fetch-field "references")
             message-id (message-fetch-field "message-id" t)
-           followup-to (when message-use-followup-to
-                         (message-fetch-field "followup-to"))
-           distribution (message-fetch-field "distribution")
+           followup-to (message-fetch-field "followup-to")
             newsgroups (message-fetch-field "newsgroups")
             posted-to (message-fetch-field "posted-to")
             newsgroups (message-fetch-field "newsgroups")
             posted-to (message-fetch-field "posted-to")
+           reply-to (message-fetch-field "reply-to")
+           mrt (when message-use-mail-reply-to
+                 (message-fetch-field "mail-reply-to"))
+           distribution (message-fetch-field "distribution")
             mct (when message-use-mail-copies-to
                   (message-fetch-field "mail-copies-to"))
             mft (when message-use-mail-followup-to
             mct (when message-use-mail-copies-to
                   (message-fetch-field "mail-copies-to"))
             mft (when message-use-mail-followup-to
-                 (message-fetch-field "mail-followup-to"))
-           mrt (when message-use-mail-reply-to
-                 (or (message-fetch-field "mail-reply-to")
-                     (message-fetch-field "reply-to")))
-           gnus-warning (message-fetch-field "gnus-warning"))
-      (when (and gnus-warning (string-match "<[^>]+>" gnus-warning))
+                 (message-fetch-field "mail-followup-to")))
+      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+                (string-match "<[^>]+>" gnus-warning))
         (setq message-id (match-string 0 gnus-warning)))
        ;; Remove bogus distribution.
        (when (and (stringp distribution)
                  (let ((case-fold-search t))
                    (string-match "world" distribution)))
         (setq distribution nil))
         (setq message-id (match-string 0 gnus-warning)))
        ;; Remove bogus distribution.
        (when (and (stringp distribution)
                  (let ((case-fold-search t))
                    (string-match "world" distribution)))
         (setq distribution nil))
-      ;; Remove any (buggy) Re:'s that are present and make a
-      ;; proper one.
+      (if gnus-list-identifiers
+         (setq subject (message-strip-list-identifiers subject)))
        (setq subject (message-make-followup-subject subject))
        (widen))
  
        (setq subject (message-make-followup-subject subject))
        (widen))
  
@@ -4498,7 +4737,7 @@ You should normally obey the Mail-Copies-To: header.
  
         `Mail-Copies-To: always'
  sends a copy of your response to the author.")))
  
         `Mail-Copies-To: always'
  sends a copy of your response to the author.")))
-       (setq mct (or mrt from)))
+       (setq mct (or mrt reply-to from)))
         ((and (eq message-use-mail-copies-to 'ask)
              (not
               (message-y-or-n-p
         ((and (eq message-use-mail-copies-to 'ask)
              (not
               (message-y-or-n-p
@@ -4519,7 +4758,7 @@ sends a copy of your response to " (if (string-match "," mct)
         (followup-to
         (cond
          ((equal (downcase followup-to) "poster")
         (followup-to
         (cond
          ((equal (downcase followup-to) "poster")
-         (if (or (eq message-use-followup-to 'use)
+         (if (or (and followup-to (eq message-use-followup-to 'use))
                   (message-y-or-n-p "Obey Followup-To: poster? " t "\
  You should normally obey the Followup-To: header.
  
                   (message-y-or-n-p "Obey Followup-To: poster? " t "\
  You should normally obey the Followup-To: header.
  
@@ -4530,11 +4769,11 @@ A typical situation where `Followup-To: poster' is used is when the author
  does not read the newsgroup, so he wouldn't see any replies sent to it."))
               (setq message-this-is-news nil
                     distribution nil
  does not read the newsgroup, so he wouldn't see any replies sent to it."))
               (setq message-this-is-news nil
                     distribution nil
-                   follow-to (list (cons 'To (or mrt from ""))))
+                   follow-to (list (cons 'To (or mrt reply-to from ""))))
             (setq follow-to (list (cons 'Newsgroups newsgroups)))))
          (t
           (if (or (equal followup-to newsgroups)
             (setq follow-to (list (cons 'Newsgroups newsgroups)))))
          (t
           (if (or (equal followup-to newsgroups)
-                 (not (eq message-use-followup-to 'ask))
+                 (not (and followup-to (eq message-use-followup-to 'ask)))
                   (message-y-or-n-p
                    (concat "Obey Followup-To: " followup-to "? ") t "\
  You should normally obey the Followup-To: header.
                   (message-y-or-n-p
                    (concat "Obey Followup-To: " followup-to "? ") t "\
  You should normally obey the Followup-To: header.
@@ -4579,10 +4818,6 @@ that further discussion should take place only in "
  
      (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
  
  
      (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
  
-    (setq message-reply-headers
-         (make-full-mail-header-from-decoded-header
-          0 subject from date message-id references 0 0 ""))
-
      (message-setup
       `((Subject . ,subject)
         ,@follow-to
      (message-setup
       `((Subject . ,subject)
         ,@follow-to
@@ -4591,12 +4826,17 @@ that further discussion should take place only in "
         ,@(if (or references message-id)
              `((References . ,(concat (or references "") (and references " ")
                                       (or message-id ""))))))
         ,@(if (or references message-id)
              `((References . ,(concat (or references "") (and references " ")
                                       (or message-id ""))))))
-     cur)))
+     cur)
+
+    (setq message-reply-headers
+         (make-full-mail-header-from-decoded-header
+          0 subject from date message-id references 0 0 ""))))
  
  ;;;###autoload
  
  ;;;###autoload
-(defun message-cancel-news ()
-  "Cancel an article you posted."
-  (interactive)
+(defun message-cancel-news (&optional arg)
+  "Cancel an article you posted.
+If ARG, allow editing of the cancellation message."
+  (interactive "P")
    (unless (message-news-p)
      (error "This is not a news article; canceling is impossible"))
    (when (yes-or-no-p "Do you really want to cancel this article? ")
    (unless (message-news-p)
      (error "This is not a news article; canceling is impossible"))
    (when (yes-or-no-p "Do you really want to cancel this article? ")
@@ -4622,10 +4862,12 @@ that further discussion should take place only in "
                                       (message-make-from))))))
           (error "This article is not yours"))
         ;; Make control message.
                                       (message-make-from))))))
           (error "This article is not yours"))
         ;; Make control message.
-       (setq buf (set-buffer (get-buffer-create " *message cancel*")))
+       (if arg
+           (message-news)
+         (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
         (erase-buffer)
         (insert "Newsgroups: " newsgroups "\n"
         (erase-buffer)
         (insert "Newsgroups: " newsgroups "\n"
-               "From: " (message-make-from) "\n"
+               "From: " from "\n"
                 "Subject: cmsg cancel " message-id "\n"
                 "Control: cancel " message-id "\n"
                 (if distribution
                 "Subject: cmsg cancel " message-id "\n"
                 "Control: cancel " message-id "\n"
                 (if distribution
@@ -4635,13 +4877,14 @@ that further discussion should take place only in "
                 message-cancel-message)
         (run-hooks 'message-cancel-hook)
         (message "Canceling your article...")
                 message-cancel-message)
         (run-hooks 'message-cancel-hook)
         (message "Canceling your article...")
-       (if (let ((message-syntax-checks
-                  'dont-check-for-anything-just-trust-me)
-                 (message-encoding-buffer (current-buffer))
-                 (message-edit-buffer (current-buffer)))
-             (message-send-news))
-           (message "Canceling your article...done"))
-       (kill-buffer buf)))))
+       (unless arg
+         (if (let ((message-syntax-checks
+                    'dont-check-for-anything-just-trust-me)
+                   (message-encoding-buffer (current-buffer))
+                   (message-edit-buffer (current-buffer)))
+               (message-send-news))
+             (message "Canceling your article...done"))
+         (kill-buffer buf))))))
  
  (defun message-supersede-setup-for-mime-edit ()
    (set (make-local-variable 'message-setup-hook) nil)
  
  (defun message-supersede-setup-for-mime-edit ()
    (set (make-local-variable 'message-setup-hook) nil)
@@ -4694,6 +4937,8 @@ header line with the old Message-ID."
      (cond ((save-window-excursion
              (if (not (eq system-type 'vax-vms))
                  (with-output-to-temp-buffer "*Directory*"
      (cond ((save-window-excursion
              (if (not (eq system-type 'vax-vms))
                  (with-output-to-temp-buffer "*Directory*"
+                  (with-current-buffer standard-output
+                    (fundamental-mode)) ; for Emacs 20.4+
                    (buffer-disable-undo standard-output)
                    (let ((default-directory "/"))
                      (call-process
                    (buffer-disable-undo standard-output)
                    (let ((default-directory "/"))
                      (call-process
@@ -4759,7 +5004,6 @@ the message."
    "Return a Subject header suitable for the message in the current buffer."
    (save-excursion
      (save-restriction
    "Return a Subject header suitable for the message in the current buffer."
    (save-excursion
      (save-restriction
-      (current-buffer)
        (message-narrow-to-head)
        (let ((funcs message-make-forward-subject-function)
             (subject (message-fetch-field "Subject")))
        (message-narrow-to-head)
        (let ((funcs message-make-forward-subject-function)
             (subject (message-fetch-field "Subject")))
@@ -4795,11 +5039,11 @@ Optional NEWS will use news to forward instead of mail."
        (message-mail nil subject))
      ;; Put point where we want it before inserting the forwarded
      ;; message.
        (message-mail nil subject))
      ;; Put point where we want it before inserting the forwarded
      ;; message.
-    (if message-signature-before-forwarded-message
-       (goto-char (point-max))
-      (message-goto-body))
+    (if message-forward-before-signature
+       (message-goto-body)
+      (goto-char (point-max)))
      ;; Make sure we're at the start of the line.
      ;; Make sure we're at the start of the line.
-    (unless (eolp)
+    (unless (bolp)
        (insert "\n"))
      ;; Narrow to the area we are to insert.
      (narrow-to-region (point) (point))
        (insert "\n"))
      ;; Narrow to the area we are to insert.
      (narrow-to-region (point) (point))
@@ -4880,7 +5124,7 @@ Optional NEWS will use news to forward instead of mail."
  ;;;###autoload
  (defun message-bounce ()
    "Re-mail the current message.
  ;;;###autoload
  (defun message-bounce ()
    "Re-mail the current message.
-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that
  contains some mail you have written which has been bounced back to
  you."
    (interactive)
  contains some mail you have written which has been bounced back to
  you."
    (interactive)
@@ -5016,7 +5260,7 @@ which specify the range to operate on."
  (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
  
  ;; Support for toolbar
  (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
  
  ;; Support for toolbar
-(when (string-match "XEmacs\\|Lucid" emacs-version)
+(when (featurep 'xemacs)
    (require 'messagexmas))
  
  ;;; Group name completion.
    (require 'messagexmas))
  
  ;;; Group name completion.
@@ -5089,6 +5333,7 @@ The following arguments may contain lists of values."
         (save-excursion
           (with-output-to-temp-buffer " *MESSAGE information message*"
             (set-buffer " *MESSAGE information message*")
         (save-excursion
           (with-output-to-temp-buffer " *MESSAGE information message*"
             (set-buffer " *MESSAGE information message*")
+           (fundamental-mode)          ; for Emacs 20.4+
             (mapcar 'princ text)
             (goto-char (point-min))))
         (funcall ask question))
             (mapcar 'princ text)
             (goto-char (point-min))))
         (funcall ask question))
@@ -5180,17 +5425,20 @@ regexp varstr."
  ;;; Miscellaneous functions
  
  ;; stolen (and renamed) from nnheader.el
  ;;; Miscellaneous functions
  
  ;; stolen (and renamed) from nnheader.el
-(defun message-replace-chars-in-string (string from to)
-  "Replace characters in STRING from FROM to TO."
-  (let ((string (substring string 0))  ;Copy string.
-       (len (length string))
-       (idx 0))
-    ;; Replace all occurrences of FROM with TO.
-    (while (< idx len)
-      (when (= (aref string idx) from)
-       (aset string idx to))
-      (setq idx (1+ idx)))
-    string))
+(static-if (fboundp 'subst-char-in-string)
+    (defsubst message-replace-chars-in-string (string from to)
+      (subst-char-in-string from to string))
+  (defun message-replace-chars-in-string (string from to)
+    "Replace characters in STRING from FROM to TO."
+    (let ((string (substring string 0))        ;Copy string.
+         (len (length string))
+         (idx 0))
+      ;; Replace all occurrences of FROM with TO.
+      (while (< idx len)
+       (when (= (aref string idx) from)
+         (aset string idx to))
+       (setq idx (1+ idx)))
+      string)))
  
  ;;;
  ;;; MIME functions
  
  ;;;
  ;;; MIME functions
@@ -5246,27 +5494,64 @@ regexp varstr."
    (if (fboundp 'mail-abbrevs-setup)
        (let ((mail-abbrev-mode-regexp "")
             (minibuffer-setup-hook 'mail-abbrevs-setup))
    (if (fboundp 'mail-abbrevs-setup)
        (let ((mail-abbrev-mode-regexp "")
             (minibuffer-setup-hook 'mail-abbrevs-setup))
-       (read-from-minibuffer prompt)))
-  (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
-    (read-string prompt)))
+       (read-from-minibuffer prompt))
+    (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+      (read-string prompt))))
+
+(defun message-use-alternative-email-as-from ()
+  (require 'mail-utils)
+  (let* ((fields '("To" "Cc")) 
+        (emails
+         (split-string
+          (mail-strip-quoted-names
+           (mapconcat 'message-fetch-reply-field fields ","))
+          "[ \f\t\n\r\v,]+"))
+        email)
+    (while emails
+      (if (string-match message-alternative-emails (car emails))
+         (setq email (car emails)
+               emails nil))
+      (pop emails))
+    (unless (or (not email) (equal email user-mail-address))
+      (goto-char (point-max))
+      (insert "From: " email "\n"))))
+
+(defun message-options-get (symbol)
+  (cdr (assq symbol message-options)))
+
+(defun message-options-set (symbol value)
+  (let ((the-cons (assq symbol message-options)))
+    (if the-cons
+       (if value 
+           (setcdr the-cons value)
+         (setq message-options (delq the-cons message-options)))
+      (and value
+          (push (cons symbol value) message-options))))
+  value)
+
+(defun message-options-set-recipient ()
+  (save-restriction
+    (message-narrow-to-headers-or-head)
+    (message-options-set 'message-sender
+                        (mail-strip-quoted-names 
+                         (message-fetch-field "from")))
+    (message-options-set 'message-recipients
+                         (mail-strip-quoted-names 
+                          (message-fetch-field "to")))))
  
  
-(defvar message-save-buffer " *encoding")
  (defun message-save-drafts ()
  (defun message-save-drafts ()
+  "Postponing the message."
    (interactive)
    (interactive)
-  (if (not (get-buffer message-save-buffer))
-      (get-buffer-create message-save-buffer))
-  (let ((filename buffer-file-name)
-       (buffer (current-buffer))
-       (reply-headers message-reply-headers))
-    (set-buffer message-save-buffer)
-    (erase-buffer)
-    (insert-buffer buffer)
-    (setq message-reply-headers reply-headers)
-    (message-generate-headers  '((optional . In-Reply-To)))
-    (mime-edit-translate-buffer)
-    (write-region (point-min) (point-max) filename)
-    (set-buffer buffer)
-    (set-buffer-modified-p nil)))
+  (message "Saving %s..." buffer-file-name)
+  (let ((reply-headers message-reply-headers)
+       (msg (buffer-substring-no-properties (point-min) (point-max))))
+    (with-temp-file buffer-file-name
+      (insert msg)
+      (setq message-reply-headers reply-headers)
+      (message-generate-headers '((optional . In-Reply-To)))
+      (mime-edit-translate-buffer))
+    (set-buffer-modified-p nil))
+  (message "Saving %s...done" buffer-file-name))
  
  (provide 'message)
  
  
  (provide 'message)