T-gnus 6.14.4 (r01)
[elisp/gnus.git-] / lisp / message.el
index ef9d2e3..bc15862 100644 (file)
@@ -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>
 
 ;;; Code:
 
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl)
-  (require 'smtp)
-  )
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'smtp))
 
 (require 'mailheader)
 (require 'nnheader)
 (require 'easymenu)
 
 (require 'mailheader)
 (require 'nnheader)
 (require 'easymenu)
-(require 'custom)
 (if (string-match "XEmacs\\|Lucid" emacs-version)
     (require 'mail-abbrevs)
   (require 'mailabbrev))
 (require 'mime-edit)
 (if (string-match "XEmacs\\|Lucid" emacs-version)
     (require 'mail-abbrevs)
   (require 'mailabbrev))
 (require 'mime-edit)
+(eval-when-compile (require 'static))
 
 ;; Avoid byte-compile warnings.
 (eval-when-compile
 
 ;; Avoid byte-compile warnings.
 (eval-when-compile
@@ -192,7 +191,7 @@ Otherwise, most addresses look like `angles', but they look like
   :group 'message-headers)
 
 (defcustom message-syntax-checks nil
   :group 'message-headers)
 
 (defcustom message-syntax-checks nil
-  ; Guess this one shouldn't be easy to customize...
+  ;; Guess this one shouldn't be easy to customize...
   "*Controls what syntax checks should not be performed on outgoing posts.
 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
   "*Controls what syntax checks should not be performed on outgoing posts.
 To disable checking of long signatures, for instance, add
  `(signature . disabled)' to this list.
@@ -202,7 +201,8 @@ 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
 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."
+shorten-followup-to existing-newsgroups buffer-file-name unchanged
+newsgroups."
   :group 'message-news)
 
 (defcustom message-required-news-headers
   :group 'message-news)
 
 (defcustom message-required-news-headers
@@ -311,7 +311,7 @@ is the symbol `guess', try to detect \"Re: \" within an encoded-word."
   :type 'regexp
   :group 'message-various)
 
   :type 'regexp
   :group 'message-various)
 
-(defcustom message-elide-elipsis "\n[...]\n\n"
+(defcustom message-elide-ellipsis "\n[...]\n\n"
   "*The string which is inserted for elided text."
   :type 'string
   :group 'message-various)
   "*The string which is inserted for elided text."
   :type 'string
   :group 'message-various)
@@ -379,11 +379,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."
@@ -392,7 +387,7 @@ If t, use `message-user-organization-file'."
 
 (defcustom message-make-forward-subject-function
   'message-forward-subject-author-subject
 
 (defcustom message-make-forward-subject-function
   'message-forward-subject-author-subject
- "*A list of functions that are called to generate a subject header for forwarded messages.
+  "*A list of functions that are called to generate a subject header for forwarded messages.
 The subject generated by the previous function is passed into each
 successive function.
 
 The subject generated by the previous function is passed into each
 successive function.
 
@@ -402,9 +397,24 @@ The provided functions are:
       newsgroup)), in brackets followed by the subject
 * message-forward-subject-fwd (Subject of article with 'Fwd:' prepended
       to it."
       newsgroup)), in brackets followed by the subject
 * message-forward-subject-fwd (Subject of article with 'Fwd:' prepended
       to it."
- :group 'message-forwarding
- :type '(radio (function-item message-forward-subject-author-subject)
-              (function-item message-forward-subject-fwd)))
+  :group 'message-forwarding
+  :type '(radio (function-item message-forward-subject-author-subject)
+               (function-item message-forward-subject-fwd)))
+
+(defcustom message-forward-as-mime t
+  "*If non-nil, forward messages as an inline/rfc822 MIME section.  Otherwise, directly inline the old message in the forwarded message."
+  :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."
 
 (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."
@@ -416,12 +426,18 @@ The provided functions are:
   :group 'message-interface
   :type 'regexp)
 
   :group 'message-interface
   :type 'regexp)
 
+(defcustom message-forward-ignored-headers "Content-Transfer-Encoding"
+  "*All headers that match this regexp will be deleted when forwarding a message."
+  :group 'message-forwarding
+  :type '(choice (const :tag "None" nil)
+                regexp))
+
 (defcustom message-ignored-cited-headers "."
   "*Delete these headers from the messages you yank."
   :group 'message-insertion
   :type 'regexp)
 
 (defcustom message-ignored-cited-headers "."
   "*Delete these headers from the messages you yank."
   :group 'message-insertion
   :type 'regexp)
 
-(defcustom message-cancel-message "I am canceling my own article."
+(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)
@@ -522,10 +538,9 @@ is never used."
                 (const :tag "always" use)
                 (const :tag "ask" ask)))
 
                 (const :tag "always" use)
                 (const :tag "ask" ask)))
 
-;; stuff relating to broken sendmail in MMDF
 (defcustom message-sendmail-f-is-evil nil
 (defcustom message-sendmail-f-is-evil nil
-  "*Non-nil means that \"-f username\" should not be added to the sendmail
-command line, because it is even more evil than leaving it out."
+  "*Non-nil means that \"-f username\" should not be added to the sendmail command line.
+Doing so would be even more evil than leaving it out."
   :group 'message-sending
   :type 'boolean)
 
   :group 'message-sending
   :type 'boolean)
 
@@ -545,6 +560,11 @@ might set this variable to '(\"-f\" \"you@some.where\")."
   :group 'message-sending
   :type '(repeat string))
 
   :group 'message-sending
   :type '(repeat string))
 
+(defvar message-cater-to-broken-inn t
+  "Non-nil means Gnus should not fold the `References' header.
+Folding `References' makes ancient versions of INN create incorrect
+NOV lines.")
+
 (defvar gnus-post-method)
 (defvar gnus-select-method)
 (defcustom message-post-method
 (defvar gnus-post-method)
 (defvar gnus-select-method)
 (defcustom message-post-method
@@ -627,9 +647,21 @@ The function `message-supersede' runs this hook."
   :group 'message-insertion)
 
 (defcustom message-yank-add-new-references t
   :group 'message-insertion)
 
 (defcustom message-yank-add-new-references t
-  "*Non-nil means new IDs will be added to \"References\" field when an
-article is yanked by the command `message-yank-original' interactively."
-  :type 'boolean
+  "Non-nil means new IDs will be added to \"References\" field when an
+article is yanked by the command `message-yank-original' interactively.
+If it is a symbol `message-id-only', only an ID from \"Message-ID\" field
+is used, otherwise IDs extracted from \"References\", \"In-Reply-To\" and
+\"Message-ID\" fields are used."
+  :type '(radio (const :tag "Do not add anything" nil)
+               (const :tag "From Message-Id, References and In-Reply-To fields" t)
+               (const :tag "From only Message-Id field." message-id-only))
+  :group 'message-insertion)
+
+(defcustom message-list-references-add-position nil
+  "Integer value means position for adding to \"References\" field when
+an article is yanked by the command `message-yank-original' interactively."
+  :type '(radio (const :tag "Add to last" nil)
+               (integer :tag "Position from last ID"))
   :group 'message-insertion)
 
 (defcustom message-indentation-spaces 3
   :group 'message-insertion)
 
 (defcustom message-indentation-spaces 3
@@ -646,6 +678,7 @@ Predefined functions include `message-cite-original' and
 Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
 Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
+               (function-item mu-cite-original)
                (function-item sc-cite-original)
                (function :tag "Other"))
   :group 'message-insertion)
                (function-item sc-cite-original)
                (function :tag "Other"))
   :group 'message-insertion)
@@ -735,8 +768,7 @@ these lines."
   :type 'message-header-lines)
 
 (defcustom message-default-news-headers ""
   :type 'message-header-lines)
 
 (defcustom message-default-news-headers ""
-  "*A string of header lines to be inserted in outgoing news
-articles."
+  "*A string of header lines to be inserted in outgoing news articles."
   :group 'message-headers
   :group 'message-news
   :type 'message-header-lines)
   :group 'message-headers
   :group 'message-news
   :type 'message-header-lines)
@@ -821,6 +853,13 @@ Valid valued are `unique' and `unsent'."
   :group 'message
   :type 'symbol)
 
   :group 'message
   :type 'symbol)
 
+(defcustom message-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
+  :type '(choice (const :tag "Yourself" nil)
+                regexp))
+
 ;;; Internal variables.
 ;;; Well, not really internal.
 
 ;;; Internal variables.
 ;;; Well, not really internal.
 
@@ -960,10 +999,152 @@ Defaults to `text-mode-abbrev-table'.")
   "Face used for displaying MML."
   :group 'message-faces)
 
   "Face used for displaying MML."
   :group 'message-faces)
 
-(defvar message-font-lock-keywords
-  (let* ((cite-prefix "A-Za-z")
-        (cite-suffix (concat cite-prefix "0-9_.@-"))
-        (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
+(defvar message-font-lock-fence-open-regexp "[+|]"
+  "*Regexp that matches fence open string.")
+
+(defvar message-font-lock-fence-close-regexp "|"
+  "*Regexp that matches fence close string.")
+
+(defvar message-font-lock-fence-open-position nil
+  "*Cons of SYMBOL of a function or a variable and a number of OFFSET that
+indicate the fence open position.  If it is non-nil,
+`message-font-lock-fence-open-regexp' is not used for searching for the
+fence open position.  If SYMBOL is a function, it is called with one argument
+last cursor position and should return the fence open position as a number
+or a marker.  If SYMBOL is a variable symbol, the value is examined with
+`symbol-value'.  OFFSET is added to the position to compensate the value.
+For example, the following combinations of variable symbol and offset value
+can be used:
+
+Egg v3: '(egg:*region-start* . -1)
+Canna:  '(canna:*region-start* . 0)
+")
+
+(defvar message-font-lock-fence-close-position nil
+  "*Cons of SYMBOL of a function or a variable and a number of OFFSET that
+indicate the fence close position.  If it is non-nil,
+`message-font-lock-fence-close-regexp' is not used for searching for the
+fence close position.  If SYMBOL is a function, it is called with one argument
+last cursor position and should return the fence close position as a number
+or a marker.  If SYMBOL is a variable symbol, the value is examined with
+`symbol-value'.  OFFSET is added to the position to compensate the value.
+For example, the following combinations of variable symbol and offset value
+can be used:
+
+Egg v3: '(egg:*region-end* . 0)
+Canna:  '(canna:*region-end* . 0)
+")
+
+(defvar message-font-lock-cited-text-regexp
+  "^[\t ]*\\([^\000- :>|}\177]*\\)[:>|}].*"
+  "*Regexp that matches cited text.  It should have a grouping for the
+citation prefix which is ended at the beginning of citation mark string.")
+
+(defvar message-font-lock-citation-name-max-column 10
+  "*Maximun number of column for citation name for fontifying.")
+
+(defvar message-font-lock-last-position nil
+  "Internal buffer local variable to save the last cursor position
+before fontifying.")
+
+(eval-after-load "font-lock"
+  '(defadvice font-lock-after-change-function
+     (before message-font-lock-save-last-position activate)
+     "Save last cursor position before fontifying."
+     (if (eq 'message-mode major-mode)
+        (setq message-font-lock-last-position (point)))))
+
+(defun message-font-lock-cited-text-matcher (limit)
+  "Search for a cited text containing `message-font-lock-cited-text-regexp'
+forward.  Argument LIMIT bounds the search.  If a cited text is found, it
+returns t and sets match data 1 and 2, otherwise it returns nil.  Normally,
+match data 2 has zero length, but if the FENCE (for input method) is detected
+in matched text, result is divided into match data 1 and 2 across the FENCE.
+See also the documentations for the following variables:
+ `message-font-lock-fence-open-regexp'
+ `message-font-lock-fence-close-regexp'
+ `message-font-lock-fence-open-position'
+ `message-font-lock-fence-close-position'
+"
+  (prog1
+      (when (re-search-forward message-font-lock-cited-text-regexp limit t)
+       (let* ((start0 (match-beginning 0))
+              (end0 (match-end 0))
+              (cite-mark (match-end 1))
+              (should-fontify
+               (progn
+                 (goto-char cite-mark)
+                 (<= (current-column)
+                     message-font-lock-citation-name-max-column)))
+              end1 start2)
+         (and
+          should-fontify
+          message-font-lock-last-position
+          (>= message-font-lock-last-position start0)
+          (<= message-font-lock-last-position end0)
+          (cond
+           (message-font-lock-fence-open-position
+            (let* ((symbol (car message-font-lock-fence-open-position))
+                   (open
+                    (cond ((functionp symbol)
+                           (funcall symbol message-font-lock-last-position))
+                          ((and (symbolp symbol)
+                                (boundp symbol))
+                           (symbol-value symbol)))))
+              (when (markerp open)
+                (setq open (marker-position open)))
+              (and (numberp open)
+                   (setq open
+                         (+ open
+                            (cdr message-font-lock-fence-open-position)))
+                   (>= message-font-lock-last-position open)
+                   (goto-char open)
+                   (or (not message-font-lock-fence-open-regexp)
+                       (looking-at message-font-lock-fence-open-regexp))
+                   (setq end1 open))))
+           (message-font-lock-fence-open-regexp
+            (goto-char message-font-lock-last-position)
+            (when (re-search-backward
+                   message-font-lock-fence-open-regexp start0 t)
+              (setq end1 (match-beginning 0)))))
+          (setq should-fontify
+                (and message-font-lock-fence-open-position
+                     (not (eq cite-mark end1))))
+          (cond
+           (message-font-lock-fence-close-position
+            (let* ((symbol (car message-font-lock-fence-close-position))
+                   (close
+                    (cond ((functionp symbol)
+                           (funcall symbol message-font-lock-last-position))
+                          ((and (symbolp symbol)
+                                (boundp symbol))
+                           (symbol-value symbol)))))
+              (when (markerp close)
+                (setq close (marker-position close)))
+              (and (numberp close)
+                   (setq close
+                         (+ close
+                            (cdr message-font-lock-fence-close-position)))
+                   (<= message-font-lock-last-position close)
+                   (setq start2 close))))
+           (message-font-lock-fence-close-regexp
+            (goto-char message-font-lock-last-position)
+            (when (looking-at message-font-lock-fence-close-regexp)
+              (setq start2 (match-end 0)))))
+          (setq should-fontify
+                (and (not (and (not message-font-lock-fence-open-position)
+                               (eq cite-mark end1)))
+                     (not (eq cite-mark start2)))))
+         (goto-char end0)
+         (when should-fontify
+           (if start2
+               (store-match-data (list start0 end0 start0 end1 start2 end0))
+             (store-match-data (list start0 end0 start0 end0 end0 end0)))
+           t)))
+    (setq message-font-lock-last-position nil)))
+
+(defvar message-font-lock-keywords-1
+  (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)"))
     `((,(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))
@@ -989,18 +1170,27 @@ Defaults to `text-mode-abbrev-table'.")
                 (not (equal mail-header-separator "")))
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
               1 'message-separator-face))
                 (not (equal mail-header-separator "")))
            `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
               1 'message-separator-face))
-         nil)
-      (,(concat "^[ \t]*"
-               "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-               "[:>|}].*")
-       (0 'message-cited-text-face))
-      ("<#/?\\(multipart\\|part\\|external\\).*>"
-       (0 'message-mml-face))))
+         nil))))
+
+(defvar message-font-lock-keywords-2
+  (append message-font-lock-keywords-1
+         '((message-font-lock-cited-text-matcher
+            (1 'message-cited-text-face)
+            (2 'message-cited-text-face))
+           ("<#/?\\(multipart\\|part\\|external\\).*>"
+            (0 'message-mml-face)))))
+
+(defvar message-font-lock-keywords message-font-lock-keywords-2
   "Additional expressions to highlight in Message mode.")
 
 ;; XEmacs does it like this.  For Emacs, we have to set the
 ;; `font-lock-defaults' buffer-local variable.
   "Additional expressions to highlight in Message mode.")
 
 ;; XEmacs does it like this.  For Emacs, we have to set the
 ;; `font-lock-defaults' buffer-local variable.
-(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
+(put 'message-mode '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)))
 
 (defvar message-face-alist
   '((bold . bold-region)
 
 (defvar message-face-alist
   '((bold . bold-region)
@@ -1046,15 +1236,24 @@ The cdr of ech entry is a function for applying the face to a region.")
 
 (defvar message-draft-coding-system
   (cond
 
 (defvar message-draft-coding-system
   (cond
+   ((boundp 'MULE) '*junet*)
    ((not (fboundp 'find-coding-system)) nil)
    ((find-coding-system 'emacs-mule)
    ((not (fboundp 'find-coding-system)) nil)
    ((find-coding-system 'emacs-mule)
-    (if (string-match "nt" system-configuration)
+    (if (memq system-type '(windows-nt ms-dos ms-windows))
        'emacs-mule-dos 'emacs-mule))
    ((find-coding-system 'escape-quoted) 'escape-quoted)
    ((find-coding-system 'no-conversion) 'no-conversion)
    (t nil))
   "Coding system to compose mail.")
 
        'emacs-mule-dos 'emacs-mule))
    ((find-coding-system 'escape-quoted) 'escape-quoted)
    ((find-coding-system 'no-conversion) 'no-conversion)
    (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)))
+
 ;;; Internal variables.
 
 (defvar message-buffer-list nil)
 ;;; Internal variables.
 
 (defvar message-buffer-list nil)
@@ -1102,10 +1301,10 @@ The cdr of ech entry is a function for applying the face to a region.")
      "\\([^\0-\b\n-\r\^?].*\\)? "
 
      ;; The time the message was sent.
      "\\([^\0-\b\n-\r\^?].*\\)? "
 
      ;; The time the message was sent.
-     "\\([^\0-\r \^?]+\\) +"                           ; day of the week
-     "\\([^\0-\r \^?]+\\) +"                           ; month
-     "\\([0-3]?[0-9]\\) +"                             ; day of month
-     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
+     "\\([^\0-\r \^?]+\\) +"           ; day of the week
+     "\\([^\0-\r \^?]+\\) +"           ; month
+     "\\([0-3]?[0-9]\\) +"             ; day of month
+     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
 
      ;; Perhaps a time zone, specified by an abbreviation, or by a
      ;; numeric offset.
 
      ;; Perhaps a time zone, specified by an abbreviation, or by a
      ;; numeric offset.
@@ -1130,6 +1329,7 @@ The cdr of ech entry is a function for applying the face to a region.")
          "^ *---+ +Original message +---+ *$\\|"
          "^ *--+ +begin message +--+ *$\\|"
          "^ *---+ +Original message follows +---+ *$\\|"
          "^ *---+ +Original message +---+ *$\\|"
          "^ *--+ +begin message +--+ *$\\|"
          "^ *---+ +Original message follows +---+ *$\\|"
+         "^ *---+ +Undelivered message follows +---+ *$\\|"
          "^|? *---+ +Message text follows: +---+ *|?$")
   "A regexp that matches the separator before the text of a failed message.")
 
          "^|? *---+ +Message text follows: +---+ *|?$")
   "A regexp that matches the separator before the text of a failed message.")
 
@@ -1165,7 +1365,8 @@ 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 'rmail-output "rmail"))
+  (autoload 'rmail-output "rmail")
+  (autoload 'mu-cite-original "mu-cite"))
 
 \f
 
 
 \f
 
@@ -1245,11 +1446,12 @@ 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.delete-region
+      ;; We remove all text props.
       (format "%s" value))))
 
 (defun message-narrow-to-field ()
       (format "%s" value))))
 
 (defun message-narrow-to-field ()
@@ -1273,12 +1475,13 @@ The cdr of ech entry is a function for applying the face to a region.")
       (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
        (error "Invalid header `%s'" (car headers)))
       (setq hclean (match-string 1 (car headers)))
       (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
        (error "Invalid header `%s'" (car headers)))
       (setq hclean (match-string 1 (car headers)))
-    (save-restriction
-      (message-narrow-to-headers)
-      (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
-       (insert (car headers) ?\n))))
+      (save-restriction
+       (message-narrow-to-headers)
+       (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
+         (insert (car headers) ?\n))))
     (setq headers (cdr headers))))
 
     (setq headers (cdr headers))))
 
+
 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (let ((buffer (message-eval-parameter message-reply-buffer)))
 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (let ((buffer (message-eval-parameter message-reply-buffer)))
@@ -1485,11 +1688,13 @@ Point is left at the beginning of the narrowed-to region."
   (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
   (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
   (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
   (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
   (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
   (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
+  (define-key message-mode-map "\C-c\C-fc" 'message-goto-mail-copies-to)
 
   (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
 
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
 
   (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
   (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
 
   (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
+  (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
   (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
   (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
   (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
   (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
@@ -1581,7 +1786,8 @@ C-c C-q  message-fill-yanked-message (fill what was yanked).
 C-c C-e  message-elide-region (elide the text between point and mark).
 C-c C-v  message-delete-not-region (remove the text outside the region).
 C-c C-z  message-kill-to-signature (kill the text up to the signature).
 C-c C-e  message-elide-region (elide the text between point and mark).
 C-c C-v  message-delete-not-region (remove the text outside the region).
 C-c C-z  message-kill-to-signature (kill the text up to the signature).
-C-c C-r  message-caesar-buffer-body (rot13 the message body)."
+C-c C-r  message-caesar-buffer-body (rot13 the message body).
+M-RET    message-newline-and-reformat (break the line and reformat)."
   (interactive)
   (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
   (interactive)
   (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
@@ -1644,16 +1850,24 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (message-set-auto-save-file-name)
   (unless (string-match "XEmacs" emacs-version)
     (set (make-local-variable 'font-lock-defaults)
   (message-set-auto-save-file-name)
   (unless (string-match "XEmacs" emacs-version)
     (set (make-local-variable 'font-lock-defaults)
-        '(message-font-lock-keywords t)))
+        '((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 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
   (make-local-variable 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*>+[ \t]*\\|" 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)
   (setq 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]*\\|"
+       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
                adaptive-fill-first-line-regexp))
                adaptive-fill-first-line-regexp))
+  (make-local-variable 'auto-fill-inhibit-regexp)
+  (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")
   (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 'indent-tabs-mode) ;Turn off tabs for indentation.
   (setq indent-tabs-mode nil)
   (run-hooks 'text-mode-hook 'message-mode-hook))
@@ -1702,14 +1916,29 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   (message-position-on-field "Mail-Reply-To" "Subject"))
 
 (defun message-goto-mail-followup-to ()
   (message-position-on-field "Mail-Reply-To" "Subject"))
 
 (defun message-goto-mail-followup-to ()
-  "Move point to the Mail-Followup-To header."
+  "Move point to the Mail-Followup-To header.  If the header is newly created
+and To field contains only one address, the address is inserted in default."
   (interactive)
   (interactive)
-  (message-position-on-field "Mail-Followup-To" "Subject"))
+  (unless (message-position-on-field "Mail-Followup-To" "Subject")
+    (let ((start (point))
+         addresses)
+      (save-restriction
+       (message-narrow-to-headers)
+       (setq addresses (split-string (mail-strip-quoted-names
+                                      (or (std11-fetch-field "to") ""))
+                                     "[ \f\t\n\r\v,]+"))
+       (when (eq 1 (length addresses))
+         (goto-char start)
+         (insert (car addresses))
+         (goto-char start))))))
 
 (defun message-goto-mail-copies-to ()
 
 (defun message-goto-mail-copies-to ()
-  "Move point to the Mail-Copies-To header."
+  "Move point to the Mail-Copies-To header.  If the header is newly created,
+a string \"never\" is inserted in default."
   (interactive)
   (interactive)
-  (message-position-on-field "Mail-Copies-To" "Subject"))
+  (unless (message-position-on-field "Mail-Copies-To" "Subject")
+    (insert "never")
+    (backward-char 5)))
 
 (defun message-goto-newsgroups ()
   "Move point to the Newsgroups header."
 
 (defun message-goto-newsgroups ()
   "Move point to the Newsgroups header."
@@ -1748,7 +1977,7 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body)."
   "Move point to the end of the headers."
   (interactive)
   (message-goto-body)
   "Move point to the end of the headers."
   (interactive)
   (message-goto-body)
-  (forward-line -2))
+  (forward-line -1))
 
 (defun message-goto-signature ()
   "Move point to the beginning of the message signature.
 
 (defun message-goto-signature ()
   "Move point to the beginning of the message signature.
@@ -1782,6 +2011,24 @@ With the prefix argument FORCE, insert the header anyway."
   (insert (or (message-fetch-reply-field "reply-to")
              (message-fetch-reply-field "from") "")))
 
   (insert (or (message-fetch-reply-field "reply-to")
              (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)
@@ -1826,17 +2073,24 @@ 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 ((point (point))
-       quoted)
-    (save-excursion
-      (beginning-of-line)
-      (setq quoted (looking-at (regexp-quote message-yank-prefix))))
-    (insert "\n\n\n\n")
+  (let ((prefix "[]>»|:}+ \t]*")
+       (supercite-thing "[-._a-zA-Z0-9]*[>]+[ \t]*")
+       quoted point)
+    (unless (bolp)
+      (save-excursion
+       (beginning-of-line)
+       (when (looking-at (concat prefix
+                                 supercite-thing))
+         (setq quoted (match-string 0))))
+      (insert "\n"))
+    (setq point (point))
+    (insert "\n\n\n")
+    (delete-region (point) (re-search-forward "[ \t]*"))
     (when quoted
     (when quoted
-      (insert message-yank-prefix))
+      (insert quoted))
     (fill-paragraph nil)
     (goto-char point)
     (fill-paragraph nil)
     (goto-char point)
-    (forward-line 2)))
+    (forward-line 1)))
 
 (defun message-insert-signature (&optional force)
   "Insert a signature.  See documentation for the `message-signature' variable."
 
 (defun message-insert-signature (&optional force)
   "Insert a signature.  See documentation for the `message-signature' variable."
@@ -1877,13 +2131,11 @@ With the prefix argument FORCE, insert the header anyway."
 
 (defun message-elide-region (b e)
   "Elide the text between point and mark.
 
 (defun message-elide-region (b e)
   "Elide the text between point and mark.
-An ellipsis (from `message-elide-elipsis') will be inserted where the
+An ellipsis (from `message-elide-ellipsis') will be inserted where the
 text was killed."
   (interactive "r")
   (kill-region b e)
 text was killed."
   (interactive "r")
   (kill-region b e)
-  (unless (bolp)
-    (insert "\n"))
-  (insert message-elide-elipsis))
+  (insert message-elide-ellipsis))
 
 (defvar message-caesar-translation-table nil)
 
 
 (defvar message-caesar-translation-table nil)
 
@@ -1902,16 +2154,9 @@ text was killed."
     ;; We build the table, if necessary.
     (when (or (not message-caesar-translation-table)
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
     ;; We build the table, if necessary.
     (when (or (not message-caesar-translation-table)
              (/= (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))))
+      (setq message-caesar-translation-table
+           (message-make-caesar-translation-table n)))
+    (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."
@@ -1948,11 +2193,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\".
@@ -1986,7 +2228,7 @@ Numeric argument means justify as well."
     (goto-char (point-min))
     (search-forward (concat "\n" mail-header-separator "\n") nil t)
     (let ((fill-prefix message-yank-prefix))
     (goto-char (point-min))
     (search-forward (concat "\n" mail-header-separator "\n") nil t)
     (let ((fill-prefix message-yank-prefix))
-      (fill-individual-paragraphs (point) (point-max) justifyp t))))
+      (fill-individual-paragraphs (point) (point-max) justifyp))))
 
 (defun message-indent-citation ()
   "Modify text just inserted from a message to be cited.
 
 (defun message-indent-citation ()
   "Modify text just inserted from a message to be cited.
@@ -2037,23 +2279,25 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
 (defun message-list-references (refs-list &rest refs-strs)
   "Add `Message-ID's which appear in REFS-STRS but not in REFS-LIST,
 to REFS-LIST."
 (defun message-list-references (refs-list &rest refs-strs)
   "Add `Message-ID's which appear in REFS-STRS but not in REFS-LIST,
 to REFS-LIST."
-  (let (refs ref id)
+  (let (refs ref id saved-id)
+    (when (and refs-list
+              (integerp message-list-references-add-position))
+      (let ((pos message-list-references-add-position))
+       (while (and refs-list
+                   (> pos 0))
+         (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))))))
                (push id refs-list))))))
+    (while saved-id
+      (push (pop saved-id) refs-list))
     refs-list))
 
 (defvar gnus-article-copy)
     refs-list))
 
 (defvar gnus-article-copy)
@@ -2070,7 +2314,8 @@ prefix, and don't delete any headers.
 
 In addition, if `message-yank-add-new-references' is non-nil and this
 command is called interactively, new IDs from the yanked article will
 
 In addition, if `message-yank-add-new-references' is non-nil and this
 command is called interactively, new IDs from the yanked article will
-be added to \"References\" field."
+be added to \"References\" field.
+\(See also `message-yank-add-new-references'.)"
   (interactive "P")
   (let ((modified (buffer-modified-p))
        (buffer (message-eval-parameter message-reply-buffer))
   (interactive "P")
   (let ((modified (buffer-modified-p))
        (buffer (message-eval-parameter message-reply-buffer))
@@ -2095,8 +2340,10 @@ be added to \"References\" field."
            (std11-narrow-to-header)
            (when (setq refs (message-list-references
                              refs
            (std11-narrow-to-header)
            (when (setq refs (message-list-references
                              refs
-                             (or (message-fetch-field "References")
-                                 (message-fetch-field "In-Reply-To"))
+                             (unless (eq message-yank-add-new-references
+                                         'message-id-only)
+                               (or (message-fetch-field "References")
+                                   (message-fetch-field "In-Reply-To")))
                              (message-fetch-field "Message-ID")))
              (widen)
              (message-narrow-to-headers)
                              (message-fetch-field "Message-ID")))
              (widen)
              (message-narrow-to-headers)
@@ -2119,6 +2366,24 @@ be added to \"References\" field."
       (unless modified
        (setq message-checksum (message-checksum))))))
 
       (unless modified
        (setq message-checksum (message-checksum))))))
 
+(defun message-yank-buffer (buffer)
+  "Insert BUFFER into the current buffer and quote it."
+  (interactive "bYank buffer: ")
+  (let ((message-reply-buffer buffer))
+    (save-window-excursion
+      (message-yank-original))))
+
+(defun message-buffers ()
+  "Return a list of active message buffers."
+  (let (buffers)
+    (save-excursion
+      (dolist (buffer (buffer-list t))
+       (set-buffer buffer)
+       (when (and (eq major-mode 'message-mode)
+                  (null message-sent-message-via))
+         (push (buffer-name buffer) buffers))))
+    (nreverse buffers)))
+
 (defun message-cite-original-without-signature ()
   "Cite function in the standard Message manner."
   (let ((start (point))
 (defun message-cite-original-without-signature ()
   "Cite function in the standard Message manner."
   (let ((start (point))
@@ -2128,6 +2393,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.
@@ -2156,7 +2423,18 @@ be added to \"References\" field."
           (when message-indent-citation-function
             (if (listp message-indent-citation-function)
                 message-indent-citation-function
           (when message-indent-citation-function
             (if (listp message-indent-citation-function)
                 message-indent-citation-function
-              (list message-indent-citation-function)))))
+              (list message-indent-citation-function))))
+         (message-reply-headers (or message-reply-headers
+                                    (make-mail-header))))
+      (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)))
@@ -2292,9 +2570,9 @@ The text will also be indented the normal way."
 
 (defun message-delete-frame (frame org-frame)
   "Delete frame for editing message."
 
 (defun message-delete-frame (frame org-frame)
   "Delete frame for editing message."
-  (when (and (or (and (featurep 'xemacs)
-                     (not (eq 'tty (device-type))))
-                window-system
+  (when (and (or (static-if (featurep 'xemacs)
+                    (device-on-window-system-p)
+                  window-system)
                 (>= emacs-major-version 20))
             (or (and (eq message-delete-frame-on-exit t)
                      (select-frame frame)
                 (>= emacs-major-version 20))
             (or (and (eq message-delete-frame-on-exit t)
                      (select-frame frame)
@@ -2321,10 +2599,12 @@ The text will also be indented the normal way."
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
 
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
-If `message-interactive' is non-nil, wait for success indication
-or error messages, and inform user.
-Otherwise any failure is reported in a message back to
-the user from the mailer."
+If `message-interactive' is non-nil, wait for success indication or
+error messages, and inform user.
+Otherwise any failure is reported in a message back to the user from
+the mailer.
+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")
   ;; Disabled test.
   (when (or (buffer-modified-p)
   (interactive "P")
   ;; Disabled test.
   (when (or (buffer-modified-p)
@@ -2351,20 +2631,20 @@ the user from the mailer."
        (message-fix-before-sending)
        (while (and success
                    (setq elem (pop alist)))
        (message-fix-before-sending)
        (while (and success
                    (setq elem (pop alist)))
-         (when (and (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)))))
+         (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))))
            (setq sent t))))
+      (unless (or sent (not success))
+       (error "No methods specified to send by"))
       (prog1
          (when (and success sent)
            (message-do-fcc)
       (prog1
          (when (and success sent)
            (message-do-fcc)
-           ;;(when (fboundp 'mail-hist-put-headers-into-history)
-           ;; (mail-hist-put-headers-into-history))
            (save-excursion
              (run-hooks 'message-sent-hook))
            (message "Sending...done")
            (save-excursion
              (run-hooks 'message-sent-hook))
            (message "Sending...done")
@@ -2475,12 +2755,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."
+  (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)
+             (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)
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
-  (let ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
-       (case-fold-search nil)
-       (news (message-news-p))
-       failure)
+  (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
+        (case-fold-search nil)
+        (news (message-news-p))
+        (message-this-is-mail t)
+        failure)
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -2527,7 +2873,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
-                   (generate-new-buffer " 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))
@@ -2564,7 +2911,7 @@ This sub function is for exclusive use of `message-send-mail'."
                      ;; But some systems are more broken with -f, so
                      ;; we'll let users override this.
                      (if (null message-sendmail-f-is-evil)
                      ;; But some systems are more broken with -f, so
                      ;; we'll let users override this.
                      (if (null message-sendmail-f-is-evil)
-                         (list "-f" (user-login-name)))
+                         (list "-f" (message-make-address)))
                      ;; These mean "report errors by mail"
                      ;; and "deliver in background".
                      (if (null message-interactive) '("-oem" "-odb"))
                      ;; These mean "report errors by mail"
                      ;; and "deliver in background".
                      (if (null message-interactive) '("-oem" "-odb"))
@@ -2710,17 +3057,18 @@ This sub function is for exclusive use of `message-send-news'."
      (not (funcall message-send-news-function method)))))
 
 (defun message-send-news (&optional arg)
      (not (funcall message-send-news-function method)))))
 
 (defun message-send-news (&optional arg)
-  (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
-       (case-fold-search nil)
-       (method (if (message-functionp message-post-method)
-                   (funcall message-post-method arg)
-                 message-post-method))
-       (message-syntax-checks
-        (if arg
-            (cons '(existing-newsgroups . disabled)
-                  message-syntax-checks)
-          message-syntax-checks))
-       result)
+  (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
+        (case-fold-search nil)
+        (method (if (message-functionp message-post-method)
+                    (funcall message-post-method arg)
+                  message-post-method))
+        (message-syntax-checks
+         (if arg
+             (cons '(existing-newsgroups . disabled)
+                   message-syntax-checks)
+           message-syntax-checks))
+        (message-this-is-news t)
+        result)
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -2803,6 +3151,15 @@ This sub function is for exclusive use of `message-send-news'."
 
 (defun message-check-news-header-syntax ()
   (and
 
 (defun message-check-news-header-syntax ()
   (and
+   ;; Check Newsgroups header.
+   (message-check 'newsgroups
+     (let ((group (message-fetch-field "newsgroups")))
+       (or
+       (and group
+            (not (string-match "\\`[ \t]*\\'" group)))
+       (ignore
+        (message
+         "The newsgroups field is empty or missing.  Posting is denied.")))))
    ;; Check the Subject header.
    (message-check 'subject
      (let* ((case-fold-search t)
    ;; Check the Subject header.
    (message-check 'subject
      (let* ((case-fold-search t)
@@ -2965,12 +3322,15 @@ This sub function is for exclusive use of `message-send-news'."
    (message-check 'from
      (let* ((case-fold-search t)
            (from (message-fetch-field "from"))
    (message-check 'from
      (let* ((case-fold-search t)
            (from (message-fetch-field "from"))
-           (ad (nth 1 (std11-extract-address-components from))))
+           ad)
        (cond
        ((not from)
         (message "There is no From line.  Posting is denied.")
         nil)
        (cond
        ((not from)
         (message "There is no From line.  Posting is denied.")
         nil)
-       ((or (not (string-match "@[^\\.]*\\." ad)) ;larsi@ifi
+       ((or (not (string-match
+                  "@[^\\.]*\\."
+                  (setq ad (nth 1 (mail-extract-address-components
+                                   from))))) ;larsi@ifi
             (string-match "\\.\\." ad) ;larsi@ifi..uio
             (string-match "@\\." ad)   ;larsi@.ifi.uio
             (string-match "\\.$" ad)   ;larsi@ifi.uio.
             (string-match "\\.\\." ad) ;larsi@ifi..uio
             (string-match "@\\." ad)   ;larsi@.ifi.uio
             (string-match "\\.$" ad)   ;larsi@ifi.uio.
@@ -3108,6 +3468,7 @@ This sub function is for exclusive use of `message-send-news'."
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
        (coding-system-for-write 'raw-text)
   "Process Fcc headers in the current buffer."
   (let ((case-fold-search t)
        (coding-system-for-write 'raw-text)
+       (output-coding-system 'raw-text)
        list file)
     (save-excursion
       (set-buffer (get-buffer-create " *message temp*"))
        list file)
     (save-excursion
       (set-buffer (get-buffer-create " *message temp*"))
@@ -3198,7 +3559,7 @@ If NOW, use that time instead."
                                      parse-time-months))))
      (format-time-string "%Y %H:%M:%S " now)
      ;; We do all of this because XEmacs doesn't have the %z spec.
                                      parse-time-months))))
      (format-time-string "%Y %H:%M:%S " now)
      ;; We do all of this because XEmacs doesn't have the %z spec.
-     (format "%s%02d%02d" sign (/ zone 3600) (% zone 3600)))))
+     (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
 
 (defun message-make-followup-subject (subject)
   "Make a followup Subject."
 
 (defun message-make-followup-subject (subject)
   "Make a followup Subject."
@@ -3275,9 +3636,9 @@ If NOW, use that time instead."
   "Make an Organization header."
   (let* ((organization
          (when message-user-organization
   "Make an Organization header."
   (let* ((organization
          (when message-user-organization
-               (if (message-functionp message-user-organization)
-                   (funcall message-user-organization)
-                 message-user-organization))))
+           (if (message-functionp message-user-organization)
+               (funcall message-user-organization)
+             message-user-organization))))
     (save-excursion
       (message-set-work-buffer)
       (cond ((stringp organization)
     (save-excursion
       (message-set-work-buffer)
       (cond ((stringp organization)
@@ -3560,7 +3921,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
@@ -3574,12 +3935,16 @@ Headers already prepared in the buffer are not modified."
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
                    (insert (if (stringp header) header (symbol-name header))
                    ;; This header didn't exist, so we insert it.
                    (goto-char (point-max))
                    (insert (if (stringp header) header (symbol-name header))
-                           ": " value "\n")
+                           ": " value)
+                   (unless (bolp)
+                     (insert "\n"))
                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.
                (delete-region (point) (gnus-point-at-eol))
                    (forward-line -1))
                ;; The value of this header was empty, so we clear
                ;; totally and insert the new value.
                (delete-region (point) (gnus-point-at-eol))
-               (insert value))
+               (insert value)
+               (when (bolp)
+                 (delete-char -1)))
              ;; Add the deletable property to the headers that require it.
              (and (memq header message-deletable-headers)
                   (progn (beginning-of-line) (looking-at "[^:]+: "))
              ;; Add the deletable property to the headers that require it.
              (and (memq header message-deletable-headers)
                   (progn (beginning-of-line) (looking-at "[^:]+: "))
@@ -3690,23 +4055,63 @@ Headers already prepared in the buffer are not modified."
        (replace-match " " t t))
       (goto-char (point-max)))))
 
        (replace-match " " t t))
       (goto-char (point-max)))))
 
+(defun message-shorten-1 (list cut surplus)
+  ;; Cut SURPLUS elements out of LIST, beginning with CUTth one.
+  (setcdr (nthcdr (- cut 2) list)
+         (nthcdr (+ (- cut 2) surplus 1) list)))
+
 (defun message-shorten-references (header references)
 (defun message-shorten-references (header references)
-  "Limit REFERENCES to be shorter than 988 characters."
-  (let ((max 988)
-       (cut 4)
+  "Trim REFERENCES to be less than 31 Message-ID long, and fold them.
+If folding is disallowed, also check that the REFERENCES are less
+than 988 characters long, and if they are not, trim them until they are."
+  (let ((maxcount 31)
+       (count 0)
+       (cut 6)
        refs)
     (with-temp-buffer
       (insert references)
       (goto-char (point-min))
        refs)
     (with-temp-buffer
       (insert references)
       (goto-char (point-min))
+      ;; Cons a list of valid references.
       (while (re-search-forward "<[^>]+>" nil t)
        (push (match-string 0) refs))
       (while (re-search-forward "<[^>]+>" nil t)
        (push (match-string 0) refs))
-      (setq refs (nreverse refs))
-      (while (> (length (mapconcat 'identity refs " ")) max)
-       (when (< (length refs) (1+ cut))
-         (decf cut))
-       (setcdr (nthcdr cut refs) (cddr (nthcdr cut refs)))))
-    (insert (capitalize (symbol-name header)) ": "
-           (mapconcat 'identity refs " ") "\n")))
+      (setq refs (nreverse refs)
+           count (length refs)))
+
+    ;; If the list has more than MAXCOUNT elements, trim it by
+    ;; removing the CUTth element and the required number of
+    ;; elements that follow.
+    (when (> count maxcount)
+      (let ((surplus (- count maxcount)))
+       (message-shorten-1 refs cut surplus)
+       (decf count surplus)))
+
+    ;; If folding is disallowed, make sure the total length (including
+    ;; the spaces between) will be less than MAXSIZE characters.
+    ;;
+    ;; 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)))
+           (surplus 0)
+           (ptr (nthcdr (1- cut) refs)))
+       ;; Decide how many elements to cut off...
+       (while (> totalsize maxsize)
+         (decf totalsize (1+ (length (car ptr))))
+         (incf surplus)
+         (setq ptr (cdr ptr)))
+       ;; ...and do it.
+       (when (> surplus 0)
+         (message-shorten-1 refs cut surplus))))
+
+    ;; Finally, collect the references back into a string and insert
+    ;; it into the buffer.
+    (let ((refstring (mapconcat #'identity refs " ")))
+      (if (and message-this-is-news message-cater-to-broken-inn)
+         (insert (capitalize (symbol-name header)) ": "
+                 refstring "\n")
+       (message-fill-header header refstring)))))
 
 (defun message-position-point ()
   "Move point to where the user probably wants to find it."
 
 (defun message-position-point ()
   "Move point to where the user probably wants to find it."
@@ -3759,40 +4164,36 @@ Headers already prepared in the buffer are not modified."
    (t
     (format "*%s message*" type))))
 
    (t
     (format "*%s message*" type))))
 
+(defmacro message-pop-to-buffer-1 (buffer)
+  `(if pop-up-frames
+       (let (special-display-buffer-names
+            special-display-regexps
+            same-window-buffer-names
+            same-window-regexps)
+        (pop-to-buffer ,buffer))
+     (pop-to-buffer ,buffer)))
+
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
 (defun message-pop-to-buffer (name)
   "Pop to buffer NAME, and warn if it already exists and is modified."
-  (let ((pop-up-frames pop-up-frames)
-       (special-display-buffer-names special-display-buffer-names)
-       (special-display-regexps special-display-regexps)
-       (same-window-buffer-names same-window-buffer-names)
-       (same-window-regexps same-window-regexps)
-       (buffer (get-buffer name))
-       (cur (current-buffer)))
-    (if (or (and (featurep 'xemacs)
-                (not (eq 'tty (device-type))))
-           window-system
-           (>= emacs-major-version 20))
-       (when message-use-multi-frames
-         (setq pop-up-frames t
-               special-display-buffer-names nil
-               special-display-regexps nil
-               same-window-buffer-names nil
-               same-window-regexps nil))
-      (setq pop-up-frames nil))
+  (let ((buffer (get-buffer name))
+       (pop-up-frames (and (or (static-if (featurep 'xemacs)
+                                   (device-on-window-system-p)
+                                 window-system)
+                               (>= emacs-major-version 20))
+                           message-use-multi-frames)))
     (if (and buffer
             (buffer-name buffer))
        (progn
     (if (and buffer
             (buffer-name buffer))
        (progn
-         (set-buffer (pop-to-buffer buffer))
+         (message-pop-to-buffer-1 buffer)
          (when (and (buffer-modified-p)
                     (not (y-or-n-p
                           "Message already being composed; erase? ")))
            (error "Message being composed")))
          (when (and (buffer-modified-p)
                     (not (y-or-n-p
                           "Message already being composed; erase? ")))
            (error "Message being composed")))
-      (set-buffer (pop-to-buffer name)))
+      (message-pop-to-buffer-1 name))
     (erase-buffer)
     (message-mode)
     (when pop-up-frames
     (erase-buffer)
     (message-mode)
     (when pop-up-frames
-      (make-local-variable 'message-original-frame)
-      (setq message-original-frame (selected-frame)))))
+      (set (make-local-variable 'message-original-frame) (selected-frame)))))
 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."
 
 (defun message-do-send-housekeeping ()
   "Kill old message buffers."
@@ -3891,7 +4292,9 @@ Headers already prepared in the buffer are not modified."
                                               message-auto-save-directory))
       (setq buffer-auto-save-file-name (make-auto-save-file-name)))
     (clear-visited-file-modtime)
                                               message-auto-save-directory))
       (setq buffer-auto-save-file-name (make-auto-save-file-name)))
     (clear-visited-file-modtime)
-    (setq buffer-file-coding-system message-draft-coding-system)))
+    (static-if (boundp 'MULE)
+       (set-file-coding-system message-draft-coding-system)
+      (setq buffer-file-coding-system message-draft-coding-system))))
 
 (defun message-disassociate-draft ()
   "Disassociate the message buffer from the drafts directory."
 
 (defun message-disassociate-draft ()
   "Disassociate the message buffer from the drafts directory."
@@ -3945,55 +4348,21 @@ 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)
-       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 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 (when message-use-mail-reply-to
+                    (or (message-fetch-field "mail-reply-to")
+                        (message-fetch-field "reply-to")))
+         mft (when (and (not to-address)
+                        (not 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
@@ -4018,7 +4387,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 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
@@ -4029,18 +4398,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 "'
@@ -4050,50 +4414,105 @@ directs your response to " (if (string-match "," mft)
 
 A typical situation where Mail-Followup-To is used is when the author thinks
 that further discussion should take place only in "
 
 A typical situation where Mail-Followup-To is used is when the author thinks
 that further discussion should take place only in "
-                 (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)
-           (unless never-mct
-             (insert (or mrt from "")))
-           (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'.
+                            (if (string-match "," mft)
+                                "the specified mailing lists"
+                              "that mailing list") ".")))
+      (setq mft nil))
+
+    (if (or (not wide)
+           to-address)
+       (progn
+         (setq follow-to (list (cons 'To (or to-address reply-to mft from))))
+         (when (and wide mct)
+           (push (cons 'Cc mct) follow-to)))
+      (let (ccalist)
+       (save-excursion
+         (message-set-work-buffer)
+         (unless never-mct
+           (insert (or reply-to from "")))
+         (insert (if mft (concat (if (bolp) "" ", ") mft "") ""))
+         (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))
            (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)))
+                     (erase-buffer))))
+         (goto-char (point-min))
+         ;; Perhaps "Mail-Copies-To: never" removed the only address?
+         (when (eobp)
+           (insert (or 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)
+  (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"))
+      ;; Remove any (buggy) Re:'s that are present and make a
+      ;; proper one.
+      (when (string-match message-subject-re-regexp subject)
+       (setq subject (substring subject (match-end 0))))
+      (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
@@ -4104,7 +4523,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
@@ -4277,15 +4697,16 @@ that further discussion should take place only in "
      cur)))
 
 ;;;###autoload
      cur)))
 
 ;;;###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? ")
     (let (from newsgroups message-id distribution buf sender)
       (save-excursion
   (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? ")
     (let (from newsgroups message-id distribution buf sender)
       (save-excursion
-       ;; Get header info. from original article.
+       ;; Get header info from original article.
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")
        (save-restriction
          (message-narrow-to-head)
          (setq from (message-fetch-field "from")
@@ -4305,7 +4726,9 @@ 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"
                "From: " (message-make-from) "\n"
        (erase-buffer)
        (insert "Newsgroups: " newsgroups "\n"
                "From: " (message-make-from) "\n"
@@ -4318,13 +4741,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)
@@ -4377,6 +4801,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
@@ -4478,9 +4904,9 @@ 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.
     (unless (eolp)
       (insert "\n"))
     ;; Make sure we're at the start of the line.
     (unless (eolp)
       (insert "\n"))
@@ -4506,7 +4932,8 @@ Optional NEWS will use news to forward instead of mail."
 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."
 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."
-  (interactive "sResend message to: ")
+  (interactive
+   (list (message-read-from-minibuffer "Resend message to: ")))
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))
   (message "Resending message to %s..." address)
   (save-excursion
     (let ((cur (current-buffer))
@@ -4771,6 +5198,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))
@@ -4794,10 +5222,10 @@ regexp varstr."
   (let ((oldbuf (current-buffer)))
     (save-excursion
       (set-buffer (generate-new-buffer name))
   (let ((oldbuf (current-buffer)))
     (save-excursion
       (set-buffer (generate-new-buffer name))
-      (message-clone-locals oldbuf)
+      (message-clone-locals oldbuf varstr)
       (current-buffer))))
 
       (current-buffer))))
 
-(defun message-clone-locals (buffer)
+(defun message-clone-locals (buffer &optional varstr)
   "Clone the local variables from BUFFER to the current buffer."
   (let ((locals (save-excursion
                  (set-buffer buffer)
   "Clone the local variables from BUFFER to the current buffer."
   (let ((locals (save-excursion
                  (set-buffer buffer)
@@ -4808,7 +5236,9 @@ regexp varstr."
      (lambda (local)
        (when (and (consp local)
                  (car local)
      (lambda (local)
        (when (and (consp local)
                  (car local)
-                 (string-match regexp (symbol-name (car local))))
+                 (string-match regexp (symbol-name (car local)))
+                 (or (null varstr)
+                     (string-match varstr (symbol-name (car local)))))
         (ignore-errors
           (set (make-local-variable (car local))
                (cdr local)))))
         (ignore-errors
           (set (make-local-variable (car local))
                (cdr local)))))
@@ -4881,8 +5311,7 @@ regexp varstr."
 (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
-                                 message-default-charset
-                                 message-posting-charset))
+                                 message-default-charset))
          (case-fold-search t)
          lines content-type-p)
       (message-goto-body)
          (case-fold-search t)
          lines content-type-p)
       (message-goto-body)
@@ -4897,7 +5326,7 @@ regexp varstr."
                (delete-char 1)
              (search-forward "\n\n")
              (setq lines (buffer-substring (point-min) (1- (point))))
                (delete-char 1)
              (search-forward "\n\n")
              (setq lines (buffer-substring (point-min) (1- (point))))
-             (delete-region (point-min)  (point))))))
+             (delete-region (point-min) (point))))))
       (save-restriction
        (message-narrow-to-headers-or-head)
        (message-remove-header "Mime-Version")
       (save-restriction
        (message-narrow-to-headers-or-head)
        (message-remove-header "Mime-Version")
@@ -4922,16 +5351,28 @@ regexp varstr."
        (forward-line 1)
        (insert "Content-Type: text/plain; charset=us-ascii\n")))))
 
        (forward-line 1)
        (insert "Content-Type: text/plain; charset=us-ascii\n")))))
 
+(defun message-read-from-minibuffer (prompt)
+  "Read from the minibuffer while providing abbrev expansion."
+  (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)))
+
 (defvar message-save-buffer " *encoding")
 (defun message-save-drafts ()
   (interactive)
   (if (not (get-buffer message-save-buffer))
       (get-buffer-create message-save-buffer))
   (let ((filename buffer-file-name)
 (defvar message-save-buffer " *encoding")
 (defun message-save-drafts ()
   (interactive)
   (if (not (get-buffer message-save-buffer))
       (get-buffer-create message-save-buffer))
   (let ((filename buffer-file-name)
-       (buffer (current-buffer)))
+       (buffer (current-buffer))
+       (reply-headers message-reply-headers))
     (set-buffer message-save-buffer)
     (erase-buffer)
     (insert-buffer buffer)
     (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)
     (mime-edit-translate-buffer)
     (write-region (point-min) (point-max) filename)
     (set-buffer buffer)
@@ -4941,4 +5382,8 @@ regexp varstr."
 
 (run-hooks 'message-load-hook)
 
 
 (run-hooks 'message-load-hook)
 
+;; Local Variables:
+;; coding: iso-8859-1
+;; End:
+
 ;;; message.el ends here
 ;;; message.el ends here