2000-10-10 00:00:28 ShengHuo ZHU <zsh@cs.rochester.edu>

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index c8fda3d..38073b4 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -1,5 +1,6 @@
 ;;; message.el --- composing mail and news messages
 ;;; message.el --- composing mail and news messages

-;; Copyright (C) 1996-2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.

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


@@ -29,16 +30,15 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (defvar gnus-list-identifiers))      ; gnus-sum is required where necessary

 (require 'mailheader)
 (require 'nnheader)
 (require 'mailheader)
 (require 'nnheader)

-(require 'easymenu)
-(if (string-match "XEmacs\\|Lucid" emacs-version)
-    (require 'mail-abbrevs)
-  (require 'mailabbrev))
+;; This is apparently necessary even though things are autoloaded:
+(if (featurep 'xemacs)
+    (require 'mail-abbrevs))

 (require 'mail-parse)
 (require 'mail-parse)

-(require 'mm-bodies)
-(require 'mm-encode)

 (require 'mml)
 
 (defgroup message '((user-mail-address custom-variable)
 (require 'mml)
 
 (defgroup message '((user-mail-address custom-variable)


@@ -165,11 +165,12 @@ To disable checking of long signatures, for instance, add
 Don't touch this variable unless you really know what you're doing.
 
 Checks include subject-cmsg multiple-headers sendsys message-id from
 Don't touch this variable unless you really know what you're doing.
 
 Checks include subject-cmsg multiple-headers sendsys message-id from

-long-lines control-chars size new-text redirected-followup signature
-approved sender empty empty-headers message-id from subject
-shorten-followup-to existing-newsgroups buffer-file-name unchanged
-newsgroups."
-  :group 'message-news)
+long-lines control-chars size new-text quoting-style
+redirected-followup signature approved sender empty empty-headers
+message-id from subject shorten-followup-to existing-newsgroups
+buffer-file-name unchanged newsgroups."
+  :group 'message-news
+  :type '(repeat sexp))

 
 (defcustom message-required-news-headers
   '(From Newsgroups Subject Date Message-ID
 
 (defcustom message-required-news-headers
   '(From Newsgroups Subject Date Message-ID


@@ -298,6 +299,11 @@ The provided functions are:
   :group 'message-forwarding
   :type 'boolean)
 
   :group 'message-forwarding
   :type 'boolean)
 

+(defcustom message-forward-show-mml t
+  "*If non-nil, forward messages are shown as mml.  Otherwise, forward messages are unchanged."
+  :group 'message-forwarding
+  :type 'boolean)
+

 (defcustom message-forward-before-signature t
   "*If non-nil, put forwarded message before signature, else after."
   :group 'message-forwarding
 (defcustom message-forward-before-signature t
   "*If non-nil, put forwarded message before signature, else after."
   :group 'message-forwarding


@@ -313,7 +319,7 @@ The provided functions are:
   :group 'message-interface
   :type 'regexp)
 
   :group 'message-interface
   :type 'regexp)
 

-(defcustom message-forward-ignored-headers "Content-Transfer-Encoding"
+(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"

   "*All headers that match this regexp will be deleted when forwarding a message."
   :group 'message-forwarding
   :type '(choice (const :tag "None" nil)
   "*All headers that match this regexp will be deleted when forwarding a message."
   :group 'message-forwarding
   :type '(choice (const :tag "None" nil)


@@ -617,13 +623,10 @@ actually occur."
   :group 'message-sending
   :type 'sexp)
 
   :group 'message-sending
   :type 'sexp)
 

-;; Ignore errors in case this is used in Emacs 19.
-;; Don't use ignore-errors because this is copied into loaddefs.el.

 ;;;###autoload
 ;;;###autoload

-(ignore-errors
-  (define-mail-user-agent 'message-user-agent
-    'message-mail 'message-send-and-exit
-    'message-kill-buffer 'message-send-hook))
+(define-mail-user-agent 'message-user-agent
+  'message-mail 'message-send-and-exit
+  'message-kill-buffer 'message-send-hook)

 
 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
   "If non-nil, delete the deletable headers before feeding to mh.")
 
 (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
   "If non-nil, delete the deletable headers before feeding to mh.")


@@ -661,12 +664,15 @@ Valid valued are `unique' and `unsent'."
   :type '(choice (const :tag "unique" unique)
                 (const :tag "unsent" unsent)))
 
   :type '(choice (const :tag "unique" unique)
                 (const :tag "unsent" unsent)))
 

-(defcustom message-default-charset nil
-  "Default charset used in non-MULE XEmacsen."
+(defcustom message-default-charset 
+  (and (not (mm-multibyte-p)) 'iso-8859-1)
+  "Default charset used in non-MULE Emacsen.
+If nil, you might be asked to input the charset."

   :group 'message
   :type 'symbol)
 
   :group 'message
   :type 'symbol)
 

-(defcustom message-dont-reply-to-names rmail-dont-reply-to-names
+(defcustom message-dont-reply-to-names 
+  (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)

   "*A regexp specifying names to prune when doing wide replies.
 A value of nil means exclude your own name only."
   :group 'message
   "*A regexp specifying names to prune when doing wide replies.
 A value of nil means exclude your own name only."
   :group 'message


@@ -843,7 +849,7 @@ Defaults to `text-mode-abbrev-table'.")
                "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
                "[:>|}].*")
        (0 'message-cited-text-face))
                "\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
                "[:>|}].*")
        (0 'message-cited-text-face))

-      ("<#/?\\(multipart\\|part\\|external\\).*>"
+      ("<#/?\\(multipart\\|part\\|external\\|mml\\).*>"

        (0 'message-mml-face))))
   "Additional expressions to highlight in Message mode.")
 
        (0 'message-mml-face))))
   "Additional expressions to highlight in Message mode.")
 


@@ -888,8 +894,24 @@ The cdr of ech entry is a function for applying the face to a region.")
   mm-auto-save-coding-system
   "Coding system to compose mail.")
 
   mm-auto-save-coding-system
   "Coding system to compose mail.")
 

+(defcustom message-send-mail-partially-limit 1000000
+  "The limitation of messages sent as message/partial.
+The lower bound of message size in characters, beyond which the message 
+should be sent in several parts. If it is nil, the size is unlimited."
+  :group 'message-buffers
+  :type '(choice (const :tag "unlimited" nil)
+                (integer 1000000)))
+
+(defcustom message-alternative-emails nil
+  "A regexp to match the alternative email addresses.
+The first matched address (not primary one) is used in the From field."
+  :group 'message-headers
+  :type '(choice (const :tag "Always use primary" nil)
+                regexp))
+

 ;;; Internal variables.
 
 ;;; Internal variables.
 

+(defvar message-sending-message "Sending...")

 (defvar message-buffer-list nil)
 (defvar message-this-is-news nil)
 (defvar message-this-is-mail nil)
 (defvar message-buffer-list nil)
 (defvar message-this-is-news nil)
 (defvar message-this-is-mail nil)


@@ -991,6 +1013,7 @@ The cdr of ech entry is a function for applying the face to a region.")
   (autoload 'mh-send-letter "mh-comp")
   (autoload 'gnus-point-at-eol "gnus-util")
   (autoload 'gnus-point-at-bol "gnus-util")
   (autoload 'mh-send-letter "mh-comp")
   (autoload 'gnus-point-at-eol "gnus-util")
   (autoload 'gnus-point-at-bol "gnus-util")

+  (autoload 'gnus-output-to-rmail "gnus-util")

   (autoload 'gnus-output-to-mail "gnus-util")
   (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
   (autoload 'nndraft-request-associate-buffer "nndraft")
   (autoload 'gnus-output-to-mail "gnus-util")
   (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")
   (autoload 'nndraft-request-associate-buffer "nndraft")


@@ -998,6 +1021,7 @@ The cdr of ech entry is a function for applying the face to a region.")
   (autoload 'gnus-open-server "gnus-int")
   (autoload 'gnus-request-post "gnus-int")
   (autoload 'gnus-alive-p "gnus-util")
   (autoload 'gnus-open-server "gnus-int")
   (autoload 'gnus-request-post "gnus-int")
   (autoload 'gnus-alive-p "gnus-util")

+  (autoload 'gnus-group-name-charset "gnus-group")

   (autoload 'rmail-output "rmail"))
 
 \f
   (autoload 'rmail-output "rmail"))
 
 \f


@@ -1015,9 +1039,19 @@ The cdr of ech entry is a function for applying the face to a region.")
   `(delete-region (progn (beginning-of-line) (point))
                  (progn (forward-line ,(or n 1)) (point))))
 
   `(delete-region (progn (beginning-of-line) (point))
                  (progn (forward-line ,(or n 1)) (point))))
 

+(defun message-unquote-tokens (elems)
+  "Remove double quotes (\") from strings in list."
+  (mapcar (lambda (item)
+            (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
+              (setq item (concat (match-string 1 item) 
+                                 (match-string 2 item))))
+            item)
+          elems))
+

 (defun message-tokenize-header (header &optional separator)
   "Split HEADER into a list of header elements.
 (defun message-tokenize-header (header &optional separator)
   "Split HEADER into a list of header elements.

-\",\" is used as the separator."
+SEPARATOR is a string of characters to be used as separators.  \",\"
+is used by default."

   (if (not header)
       nil
     (let ((regexp (format "[%s]+" (or separator ",")))
   (if (not header)
       nil
     (let ((regexp (format "[%s]+" (or separator ",")))


@@ -1047,7 +1081,7 @@ The cdr of ech entry is a function for applying the face to a region.")
                ((and (eq (char-after) ?\))
                      (not quoted))
                 (setq paren nil))))
                ((and (eq (char-after) ?\))
                      (not quoted))
                 (setq paren nil))))

-       (nreverse elems)))))
+        (nreverse elems)))))

 
 (defun message-mail-file-mbox-p (file)
   "Say whether FILE looks like a Unix mbox file."
 
 (defun message-mail-file-mbox-p (file)
   "Say whether FILE looks like a Unix mbox file."


@@ -1067,8 +1101,8 @@ The cdr of ech entry is a function for applying the face to a region.")
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))

-      ;; We remove all text props.
-      (format "%s" value))))
+      (set-text-properties 0 (length value) nil value)
+      value)))

 
 (defun message-narrow-to-field ()
   "Narrow the buffer to the header on the current line."
 
 (defun message-narrow-to-field ()
   "Narrow the buffer to the header on the current line."


@@ -1121,6 +1155,21 @@ The cdr of ech entry is a function for applying the face to a region.")
       (and (listp form) (eq (car form) 'lambda))
       (byte-code-function-p form)))
 
       (and (listp form) (eq (car form) 'lambda))
       (byte-code-function-p form)))
 

+(defun message-strip-list-identifiers (subject)
+  "Remove list identifiers in `gnus-list-identifiers'."
+  (require 'gnus-sum)                  ; for gnus-list-identifiers
+  (let ((regexp (if (stringp gnus-list-identifiers)
+                   gnus-list-identifiers
+                 (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+    (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp 
+                               " *\\)\\)+\\(Re: +\\)?\\)") subject)
+       (concat (substring subject 0 (match-beginning 1))
+               (or (match-string 3 subject)
+                   (match-string 5 subject))
+               (substring subject
+                          (match-end 1)))
+      subject)))
+

 (defun message-strip-subject-re (subject)
   "Remove \"Re:\" from subject lines."
   (if (string-match message-subject-re-regexp subject)
 (defun message-strip-subject-re (subject)
   "Remove \"Re:\" from subject lines."
   (if (string-match message-subject-re-regexp subject)


@@ -1398,6 +1447,8 @@ C-c C-r  message-caesar-buffer-body (rot13 the message body).
 C-c C-a  mml-attach-file (attach a file as MIME).
 M-RET    message-newline-and-reformat (break the line and reformat)."
   (interactive)
 C-c C-a  mml-attach-file (attach a file as MIME).
 M-RET    message-newline-and-reformat (break the line and reformat)."
   (interactive)

+  (if (local-variable-p 'mml-buffer-list (current-buffer))
+      (mml-destroy-buffers))

   (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
   (make-local-variable 'message-send-actions)
   (kill-all-local-variables)
   (set (make-local-variable 'message-reply-buffer) nil)
   (make-local-variable 'message-send-actions)


@@ -1422,20 +1473,6 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
              (error "Face %s not configured for %s mode" face mode-name)))
          "")
        facemenu-remove-face-function t)
              (error "Face %s not configured for %s mode" face mode-name)))
          "")
        facemenu-remove-face-function t)

-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  ;; `-- ' precedes the signature.  `-----' appears at the start of the
-  ;; lines that delimit forwarded messages.
-  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
-  ;; are also sometimes used and should be separators.
-  (setq paragraph-start
-       (concat (regexp-quote mail-header-separator)
-               "$\\|[ \t]*[a-z0-9A-Z]*>+[ \t]*$\\|[ \t]*$\\|"
-               "-- $\\|---+$\\|"
-               page-delimiter
-               ;;!!! Uhm... shurely this can't be right?
-               "[> " (regexp-quote message-yank-prefix) "]+$"))
-  (setq paragraph-separate paragraph-start)

   (make-local-variable 'message-reply-headers)
   (setq message-reply-headers nil)
   (make-local-variable 'message-newsreader)
   (make-local-variable 'message-reply-headers)
   (setq message-reply-headers nil)
   (make-local-variable 'message-newsreader)


@@ -1444,10 +1481,13 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
   (set (make-local-variable 'message-sent-message-via) nil)
   (set (make-local-variable 'message-checksum) nil)
   (set (make-local-variable 'message-mime-part) 0)
   (set (make-local-variable 'message-sent-message-via) nil)
   (set (make-local-variable 'message-checksum) nil)
   (set (make-local-variable 'message-mime-part) 0)

+  (message-setup-fill-variables)

   ;;(when (fboundp 'mail-hist-define-keys)
   ;;  (mail-hist-define-keys))
   ;;(when (fboundp 'mail-hist-define-keys)
   ;;  (mail-hist-define-keys))

-  (when (string-match "XEmacs\\|Lucid" emacs-version)
-    (message-setup-toolbar))
+  (if (featurep 'xemacs)
+      (message-setup-toolbar)
+    (set (make-local-variable 'font-lock-defaults)
+        '(message-font-lock-keywords t)))

   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   ;; Allow mail alias things.
   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   ;; Allow mail alias things.


@@ -1456,26 +1496,45 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
        (mail-abbrevs-setup)
       (mail-aliases-setup)))
   (message-set-auto-save-file-name)
        (mail-abbrevs-setup)
       (mail-aliases-setup)))
   (message-set-auto-save-file-name)

-  (unless (string-match "XEmacs" emacs-version)
-    (set (make-local-variable 'font-lock-defaults)
-        '(message-font-lock-keywords t)))
-  (make-local-variable 'adaptive-fill-regexp)
-  (setq adaptive-fill-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp))
-  (unless (boundp 'adaptive-fill-first-line-regexp)
-    (setq adaptive-fill-first-line-regexp nil))
-  (make-local-variable 'adaptive-fill-first-line-regexp)
-  (setq adaptive-fill-first-line-regexp
-       (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|"
-               adaptive-fill-first-line-regexp))
-  (make-local-variable 'auto-fill-inhibit-regexp)
-  (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")

   (mm-enable-multibyte)
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
   (setq indent-tabs-mode nil)
   (mml-mode)
   (run-hooks 'text-mode-hook 'message-mode-hook))
 
   (mm-enable-multibyte)
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
   (setq indent-tabs-mode nil)
   (mml-mode)
   (run-hooks 'text-mode-hook 'message-mode-hook))
 

+(defun message-setup-fill-variables ()
+  "Setup message fill variables."
+  (make-local-variable 'paragraph-separate)
+  (make-local-variable 'paragraph-start)
+  (make-local-variable 'adaptive-fill-regexp)
+  (unless (boundp 'adaptive-fill-first-line-regexp)
+    (setq adaptive-fill-first-line-regexp nil))
+  (make-local-variable 'adaptive-fill-first-line-regexp)
+  (make-local-variable 'auto-fill-inhibit-regexp)
+  (let ((quote-prefix-regexp
+         (concat
+          "[ \t]*"                      ; possible initial space
+          "\\(\\(" (regexp-quote message-yank-prefix) "\\|" ; user's prefix
+          "\\w+>\\|"                    ; supercite-style prefix
+          "[|:>]"                       ; standard prefix
+          "\\)[ \t]*\\)+")))            ; possible space after each prefix
+    (setq paragraph-start
+          (concat
+           (regexp-quote mail-header-separator) "$\\|"
+           "[ \t]*$\\|"                 ; blank lines
+           "-- $\\|"                    ; signature delimiter
+           "---+$\\|"                   ; delimiters for forwarded messages
+           page-delimiter "$\\|"        ; spoiler warnings
+           ".*wrote:$\\|"               ; attribution lines
+           quote-prefix-regexp "$"))    ; empty lines in quoted text
+    (setq paragraph-separate paragraph-start)
+    (setq adaptive-fill-regexp
+          (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
+    (setq adaptive-fill-first-line-regexp
+          (concat quote-prefix-regexp "\\|"
+                  adaptive-fill-first-line-regexp))
+    (setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")))
+

 \f
 
 ;;;
 \f
 
 ;;;


@@ -1585,6 +1644,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)


@@ -1712,14 +1789,7 @@ text was killed."
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
       (setq message-caesar-translation-table
            (message-make-caesar-translation-table n)))
              (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
       (setq message-caesar-translation-table
            (message-make-caesar-translation-table n)))

-    ;; Then we translate the region.  Do it this way to retain
-    ;; text properties.
-    (while (< b e)
-      (when (< (char-after b) 255)
-       (subst-char-in-region
-        b (1+ b) (char-after b)
-        (aref message-caesar-translation-table (char-after b))))
-      (incf b))))
+    (translate-region b e message-caesar-translation-table)))

 
 (defun message-make-caesar-translation-table (n)
   "Create a rot table with offset N."
 
 (defun message-make-caesar-translation-table (n)
   "Create a rot table with offset N."


@@ -2050,21 +2120,21 @@ It should typically alter the sending method in some way or other."
     (put-text-property (point-min) (point-max) 'read-only nil))
   (message-fix-before-sending)
   (run-hooks 'message-send-hook)
     (put-text-property (point-min) (point-max) 'read-only nil))
   (message-fix-before-sending)
   (run-hooks 'message-send-hook)

-  (message "Sending...")
+  (message message-sending-message)

   (let ((alist message-send-method-alist)
        (success t)
        elem sent)
     (while (and success
                (setq elem (pop alist)))
   (let ((alist message-send-method-alist)
        (success t)
        elem sent)
     (while (and success
                (setq elem (pop alist)))

-      (when (or (not (funcall (cadr elem)))
-               (and (or (not (memq (car elem)
-                                   message-sent-message-via))
-                        (y-or-n-p
-                         (format
-                          "Already sent message via %s; resend? "
-                          (car elem))))
-                    (setq success (funcall (caddr elem) arg))))
-       (setq sent t)))
+      (when (funcall (cadr elem))
+       (when (and (or (not (memq (car elem)
+                                 message-sent-message-via))
+                      (y-or-n-p
+                       (format
+                        "Already sent message via %s; resend? "
+                        (car elem))))
+                  (setq success (funcall (caddr elem) arg)))
+         (setq sent t))))

     (unless (or sent (not success))
       (error "No methods specified to send by"))
     (when (and success sent)
     (unless (or sent (not success))
       (error "No methods specified to send by"))
     (when (and success sent)


@@ -2134,6 +2204,72 @@ It should typically alter the sending method in some way or other."
        (eval (car actions)))))
     (pop actions)))
 
        (eval (car actions)))))
     (pop actions)))
 

+(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)
+             (mm-with-unibyte-current-buffer
+               (funcall message-send-mail-function)))
+           (setq n (+ n 1))
+           (setq p (pop plist))
+           (erase-buffer)))
+      (kill-buffer tembuf))))
+

 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
   (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
   (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))


@@ -2171,16 +2307,29 @@ It should typically alter the sending method in some way or other."
              (message-generate-headers '(Lines)))
            ;; Remove some headers.
            (message-remove-header message-ignored-mail-headers t)
              (message-generate-headers '(Lines)))
            ;; Remove some headers.
            (message-remove-header message-ignored-mail-headers t)

-           (mail-encode-encoded-word-buffer))
+           (let ((mail-parse-charset message-default-charset))
+             (mail-encode-encoded-word-buffer)))

          (goto-char (point-max))
          ;; require one newline at the end.
          (or (= (preceding-char) ?\n)
              (insert ?\n))
          (goto-char (point-max))
          ;; require one newline at the end.
          (or (= (preceding-char) ?\n)
              (insert ?\n))

-         (when (and news
+         (when 
+             (save-restriction
+               (message-narrow-to-headers)
+               (and news

                     (or (message-fetch-field "cc")
                     (or (message-fetch-field "cc")

-                        (message-fetch-field "to")))
+                        (message-fetch-field "to"))
+                    (string= "text/plain"
+                             (car
+                              (mail-header-parse-content-type
+                               (message-fetch-field "content-type"))))))

            (message-insert-courtesy-copy))
            (message-insert-courtesy-copy))

-         (funcall message-send-mail-function))
+         (if (or (not message-send-mail-partially-limit)
+                 (< (point-max) message-send-mail-partially-limit)
+                 (not (y-or-n-p "The message size is too large, should it be sent partially?")))
+             (mm-with-unibyte-current-buffer
+               (funcall message-send-mail-function))
+           (message-send-mail-partially)))

       (kill-buffer tembuf))
     (set-buffer mailbuf)
     (push 'mail message-sent-message-via)))
       (kill-buffer tembuf))
     (set-buffer mailbuf)
     (push 'mail message-sent-message-via)))


@@ -2316,6 +2465,12 @@ to find out how to use this."
         (method (if (message-functionp message-post-method)
                     (funcall message-post-method arg)
                   message-post-method))
         (method (if (message-functionp message-post-method)
                     (funcall message-post-method arg)
                   message-post-method))

+        (group-name-charset (gnus-group-name-charset method ""))
+        (rfc2047-header-encoding-alist
+         (if group-name-charset
+             (cons (cons "Newsgroups" group-name-charset)
+                   rfc2047-header-encoding-alist)
+           rfc2047-header-encoding-alist))

         (messbuf (current-buffer))
         (message-syntax-checks
          (if arg
         (messbuf (current-buffer))
         (message-syntax-checks
          (if arg


@@ -2324,7 +2479,9 @@ to find out how to use this."
            message-syntax-checks))
         (message-this-is-news t)
         (message-posting-charset (gnus-setup-posting-charset 
            message-syntax-checks))
         (message-this-is-news t)
         (message-posting-charset (gnus-setup-posting-charset 

-                                  (message-fetch-field "Newsgroups")))
+                                  (save-restriction
+                                    (message-narrow-to-headers-or-head)
+                                    (message-fetch-field "Newsgroups"))))

         result)
     (if (not (message-check-news-body-syntax))
        nil
         result)
     (if (not (message-check-news-body-syntax))
        nil


@@ -2334,6 +2491,10 @@ to find out how to use this."
        (message-generate-headers message-required-news-headers)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))
        (message-generate-headers message-required-news-headers)
        ;; Let the user do all of the above.
        (run-hooks 'message-header-hook))

+      (if group-name-charset
+         (setq message-syntax-checks
+             (cons '(valid-newsgroups . disabled)
+                   message-syntax-checks)))

       (message-cleanup-headers)
       (if (not (message-check-news-syntax))
          nil
       (message-cleanup-headers)
       (if (not (message-check-news-syntax))
          nil


@@ -2356,7 +2517,7 @@ to find out how to use this."
                  (message-generate-headers '(Lines)))
                ;; Remove some headers.
                (message-remove-header message-ignored-news-headers t)
                  (message-generate-headers '(Lines)))
                ;; Remove some headers.
                (message-remove-header message-ignored-news-headers t)

-               (let ((mail-parse-charset (car message-posting-charset)))
+               (let ((mail-parse-charset message-default-charset))

                  (mail-encode-encoded-word-buffer)))
              (goto-char (point-max))
              ;; require one newline at the end.
                  (mail-encode-encoded-word-buffer)))
              (goto-char (point-max))
              ;; require one newline at the end.


@@ -2652,7 +2813,20 @@ to find out how to use this."
          (format
           "Your .sig is %d lines; it should be max 4.  Really post? "
           (1- (count-lines (point) (point-max)))))
          (format
           "Your .sig is %d lines; it should be max 4.  Really post? "
           (1- (count-lines (point) (point-max)))))

-       t))))
+       t))
+   ;; Ensure that text follows last quoted portion.
+   (message-check 'quoting-style
+     (goto-char (point-max))
+     (let ((no-problem t))
+       (when (search-backward-regexp "^>[^\n]*\n>" nil t)
+        (setq no-problem nil)
+        (while (not (eobp))
+          (when (and (not (eolp)) (looking-at "[^> \t]"))
+            (setq no-problem t))
+          (forward-line)))
+       (if no-problem
+          t
+        (y-or-n-p "Your text should follow quoted text.  Really post? "))))))

 
 (defun message-checksum ()
   "Return a \"checksum\" for the current buffer."
 
 (defun message-checksum ()
   "Return a \"checksum\" for the current buffer."


@@ -2682,9 +2856,19 @@ to find out how to use this."
        (while (setq file (message-fetch-field "fcc"))
          (push file list)
          (message-remove-header "fcc" nil t)))
        (while (setq file (message-fetch-field "fcc"))
          (push file list)
          (message-remove-header "fcc" nil t)))

+      (message-encode-message-body)
+      (save-restriction
+       (message-narrow-to-headers)
+       (let ((mail-parse-charset message-default-charset)
+             (rfc2047-header-encoding-alist
+              (cons '("Newsgroups" . default)
+                    rfc2047-header-encoding-alist)))
+         (mail-encode-encoded-word-buffer)))

       (goto-char (point-min))
       (goto-char (point-min))

-      (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-      (replace-match "" t t)
+      (when (re-search-forward
+            (concat "^" (regexp-quote mail-header-separator) "$")
+            nil t)
+       (replace-match "" t t ))

       ;; Process FCC operations.
       (while list
        (setq file (pop list))
       ;; Process FCC operations.
       (while list
        (setq file (pop list))


@@ -2704,14 +2888,13 @@ to find out how to use this."
                (rmail-output file 1 nil t)
              (let ((mail-use-rfc822 t))
                (rmail-output file 1 t t))))))
                (rmail-output file 1 nil t)
              (let ((mail-use-rfc822 t))
                (rmail-output file 1 t t))))))

-

       (kill-buffer (current-buffer)))))
 
 (defun message-output (filename)
   "Append this article to Unix/babyl mail file.."
   (if (and (file-readable-p filename)
           (mail-file-babyl-p filename))
       (kill-buffer (current-buffer)))))
 
 (defun message-output (filename)
   "Append this article to Unix/babyl mail file.."
   (if (and (file-readable-p filename)
           (mail-file-babyl-p filename))

-      (rmail-output-to-rmail-file filename t)
+      (gnus-output-to-rmail filename t)

     (gnus-output-to-mail filename t)))
 
 (defun message-cleanup-headers ()
     (gnus-output-to-mail filename t)))
 
 (defun message-cleanup-headers ()


@@ -2861,18 +3044,7 @@ If NOW, use that time instead."
 (defun message-make-in-reply-to ()
   "Return the In-Reply-To header for this message."
   (when message-reply-headers
 (defun message-make-in-reply-to ()
   "Return the In-Reply-To header for this message."
   (when message-reply-headers

-    (let ((from (mail-header-from message-reply-headers))
-         (date (mail-header-date message-reply-headers)))
-      (when from
-       (let ((stop-pos
-              (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
-         (concat (if (and stop-pos
-                          (not (zerop stop-pos)))
-                     (substring from 0 stop-pos) from)
-                 "'s message of \""
-                 (if (or (not date) (string= date ""))
-                     "(unknown date)" date)
-                 "\""))))))
+    (mail-header-message-id message-reply-headers)))

 
 (defun message-make-distribution ()
   "Make a Distribution header."
 
 (defun message-make-distribution ()
   "Make a Distribution header."


@@ -3415,6 +3587,8 @@ than 988 characters long, and if they are not, trim them until they are."
   (message-insert-signature)
   (save-restriction
     (message-narrow-to-headers)
   (message-insert-signature)
   (save-restriction
     (message-narrow-to-headers)

+    (if message-alternative-emails
+       (message-use-alternative-email-as-from))

     (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)
     (run-hooks 'message-header-setup-hook))
   (set-buffer-modified-p nil)
   (setq buffer-undo-list nil)


@@ -3486,16 +3660,79 @@ 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 ""))))))
 

+(defun message-get-reply-headers (wide &optional to-address)
+  (let (follow-to mct never-mct from to cc reply-to ccalist)
+    ;; Find all relevant headers we need.
+    (setq from (message-fetch-field "from")
+         to (message-fetch-field "to")
+         cc (message-fetch-field "cc")
+         mct (message-fetch-field "mail-copies-to")
+         reply-to (message-fetch-field "reply-to"))
+
+    ;; Handle special values of Mail-Copies-To.
+    (when mct
+      (cond ((or (equal (downcase mct) "never")
+                (equal (downcase mct) "nobody"))
+            (setq never-mct t)
+            (setq mct nil))
+           ((or (equal (downcase mct) "always")
+                (equal (downcase mct) "poster"))
+            (setq mct (or reply-to from)))))
+
+    (if (or (not wide)
+           to-address)
+       (progn
+         (setq follow-to (list (cons 'To (or to-address reply-to 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 to (concat (if (bolp) "" ", ") to "") ""))
+         (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
+         (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
+         (goto-char (point-min))
+         (while (re-search-forward "[ \t]+" nil t)
+           (replace-match " " t t))
+         ;; Remove addresses that match `rmail-dont-reply-to-names'.
+         (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
+           (insert (prog1 (rmail-dont-reply-to (buffer-string))
+                     (erase-buffer))))
+         (goto-char (point-min))
+         ;; Perhaps "Mail-Copies-To: never" removed the only address?
+         (when (eobp)
+           (insert (or 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)
 ;;;###autoload
 (defun message-reply (&optional to-address wide)
   "Start editing a reply to the article in the current buffer."
   (interactive)

+  (require 'gnus-sum)                  ; for gnus-list-identifiers

   (let ((cur (current-buffer))
        from subject date reply-to to cc
        references message-id follow-to
        (inhibit-point-motion-hooks t)
        (message-this-is-mail t)
   (let ((cur (current-buffer))
        from subject date reply-to to cc
        references message-id follow-to
        (inhibit-point-motion-hooks t)
        (message-this-is-mail t)

-       mct never-mct gnus-warning)
+       gnus-warning)

     (save-restriction
       (message-narrow-to-head)
       ;; Allow customizations to have their say.
     (save-restriction
       (message-narrow-to-head)
       ;; Allow customizations to have their say.


@@ -3508,82 +3745,26 @@ OTHER-HEADERS is an alist of header/value pairs."
            (save-excursion
              (setq follow-to
                    (funcall 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")
-           subject (or (message-fetch-field "subject") "none")
-           to (message-fetch-field "to")
-           cc (message-fetch-field "cc")
-           mct (message-fetch-field "mail-copies-to")
-           reply-to (message-fetch-field "reply-to")
+      (setq message-id (message-fetch-field "message-id" t)

            references (message-fetch-field "references")
            references (message-fetch-field "references")

-           message-id (message-fetch-field "message-id" t))
-      ;; 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 (concat "Re: " subject))
+           date (message-fetch-field "date")
+           from (message-fetch-field "from")
+           subject (or (message-fetch-field "subject") "none"))
+    (if gnus-list-identifiers
+       (setq subject (message-strip-list-identifiers subject)))
+    (setq subject (concat "Re: " (message-strip-subject-re subject)))

 
 

-      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
-                (string-match "<[^>]+>" gnus-warning))
-       (setq message-id (match-string 0 gnus-warning)))
+    (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
+              (string-match "<[^>]+>" gnus-warning))
+      (setq message-id (match-string 0 gnus-warning)))

 
 

-      ;; Handle special values of Mail-Copies-To.
-      (when mct
-       (cond ((or (equal (downcase mct) "never")
-                  (equal (downcase mct) "nobody"))
-              (setq never-mct t)
-              (setq mct nil))
-             ((or (equal (downcase mct) "always")
-                  (equal (downcase mct) "poster"))
-              (setq mct (or reply-to from)))))
-
-      (unless follow-to
-       (if (or (not wide)
-               to-address)
-           (progn
-             (setq follow-to (list (cons 'To (or to-address reply-to 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 to (concat (if (bolp) "" ", ") to "") ""))
-             (insert (if mct (concat (if (bolp) "" ", ") mct) ""))
-             (insert (if cc (concat (if (bolp) "" ", ") cc) ""))
-             (goto-char (point-min))
-             (while (re-search-forward "[ \t]+" nil t)
-               (replace-match " " t t))
-             ;; Remove addresses that match `rmail-dont-reply-to-names'.
-             (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
-               (insert (prog1 (rmail-dont-reply-to (buffer-string))
-                         (erase-buffer))))
-             (goto-char (point-min))
-             ;; Perhaps Mail-Copies-To: never removed the only address?
-             (when (eobp)
-               (insert (or 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))))))
-      (widen))
+    (unless follow-to
+      (setq follow-to (message-get-reply-headers wide to-address))))

 
 

-    (message-pop-to-buffer (message-buffer-name
-                           (if wide "wide reply" "reply") from
-                           (if wide to-address nil)))
+    (message-pop-to-buffer
+     (message-buffer-name
+      (if wide "wide reply" "reply") from
+      (if wide to-address nil)))

 
     (setq message-reply-headers
          (vector 0 subject from date message-id references 0 0 ""))
 
     (setq message-reply-headers
          (vector 0 subject from date message-id references 0 0 ""))


@@ -3608,6 +3789,7 @@ OTHER-HEADERS is an alist of header/value pairs."
   "Follow up to the message in the current buffer.
 If TO-NEWSGROUPS, use that as the new Newsgroups line."
   (interactive)
   "Follow up to the message in the current buffer.
 If TO-NEWSGROUPS, use that as the new Newsgroups line."
   (interactive)

+  (require 'gnus-sum)                  ; for gnus-list-identifiers

   (let ((cur (current-buffer))
        from subject date reply-to mct
        references message-id follow-to
   (let ((cur (current-buffer))
        from subject date reply-to mct
        references message-id follow-to


@@ -3642,11 +3824,9 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
                 (let ((case-fold-search t))
                   (string-match "world" distribution)))
        (setq distribution nil))
                 (let ((case-fold-search t))
                   (string-match "world" distribution)))
        (setq distribution nil))

-      ;; Remove any (buggy) Re:'s that are present and make a
-      ;; proper one.
-      (when (string-match message-subject-re-regexp subject)
-       (setq subject (substring subject (match-end 0))))
-      (setq subject (concat "Re: " subject))
+      (if gnus-list-identifiers
+         (setq subject (message-strip-list-identifiers subject)))
+      (setq subject (concat "Re: " (message-strip-subject-re subject)))

       (widen))
 
     (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
       (widen))
 
     (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))


@@ -3750,7 +3930,7 @@ If ARG, allow editing of the cancellation message."
          (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
        (erase-buffer)
        (insert "Newsgroups: " newsgroups "\n"
          (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
        (erase-buffer)
        (insert "Newsgroups: " newsgroups "\n"

-               "From: " (message-make-from) "\n"
+               "From: " from "\n"

                "Subject: cmsg cancel " message-id "\n"
                "Control: cancel " message-id "\n"
                (if distribution
                "Subject: cmsg cancel " message-id "\n"
                "Control: cancel " message-id "\n"
                (if distribution


@@ -3789,6 +3969,7 @@ header line with the old Message-ID."
     ;; Get a normal message buffer.
     (message-pop-to-buffer (message-buffer-name "supersede"))
     (insert-buffer-substring cur)
     ;; Get a normal message buffer.
     (message-pop-to-buffer (message-buffer-name "supersede"))
     (insert-buffer-substring cur)

+    (mime-to-mml)

     (message-narrow-to-head)
     ;; Remove unwanted headers.
     (when message-ignored-supersedes-headers
     (message-narrow-to-head)
     ;; Remove unwanted headers.
     (when message-ignored-supersedes-headers


@@ -3897,13 +4078,17 @@ the message."
        subject))))
 
 ;;;###autoload
        subject))))
 
 ;;;###autoload

-(defun message-forward (&optional news)
+(defun message-forward (&optional news digest)

   "Forward the current message via mail.
   "Forward the current message via mail.

-Optional NEWS will use news to forward instead of mail."
+Optional NEWS will use news to forward instead of mail.
+Optional DIGEST will use digest to forward."

   (interactive "P")
   (interactive "P")

-  (let ((cur (current-buffer))
-       (subject (message-make-forward-subject))
-       art-beg)
+  (let* ((cur (current-buffer))
+        (subject (if message-forward-show-mml
+                     (message-make-forward-subject)
+                   (mail-decode-encoded-word-string
+                    (message-make-forward-subject))))
+        art-beg)

     (if news
        (message-news nil subject)
       (message-mail nil subject))
     (if news
        (message-news nil subject)
       (message-mail nil subject))


@@ -3913,22 +4098,43 @@ Optional NEWS will use news to forward instead of mail."
         (message-goto-body)
       (goto-char (point-max)))
     (if message-forward-as-mime
         (message-goto-body)
       (goto-char (point-max)))
     (if message-forward-as-mime

-       (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
+       (if digest
+           (insert "\n<#multipart type=digest>\n")
+         (if message-forward-show-mml
+             (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
+           (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")))

       (insert "\n-------------------- Start of forwarded message --------------------\n"))
       (insert "\n-------------------- Start of forwarded message --------------------\n"))

-    (let ((b (point))
-         e)
-      (mml-insert-buffer cur)
+    (let ((b (point)) e)
+      (if digest
+         (if message-forward-as-mime
+             (insert-buffer-substring cur)
+           (mml-insert-buffer cur))
+       (if message-forward-show-mml
+           (insert-buffer-substring cur)
+         (mml-insert-buffer cur)))

       (setq e (point))
       (if message-forward-as-mime
       (setq e (point))
       (if message-forward-as-mime

-         (insert "<#/part>\n")
+         (if digest
+             (insert "<#/multipart>\n")
+           (if message-forward-show-mml
+               (insert "<#/mml>\n")
+             (insert "<#/part>\n")))

        (insert "\n-------------------- End of forwarded message --------------------\n"))
        (insert "\n-------------------- End of forwarded message --------------------\n"))

-      (when (and (not current-prefix-arg)
-                message-forward-ignored-headers)
-       (save-restriction
-         (narrow-to-region b e)
-         (goto-char b)
-         (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point)))
-         (message-remove-header message-forward-ignored-headers t))))
+      (if (and digest message-forward-as-mime)
+         (save-restriction
+           (narrow-to-region b e)
+           (goto-char b)
+           (narrow-to-region (point) 
+                             (or (search-forward "\n\n" nil t) (point)))
+           (delete-region (point-min) (point-max)))
+       (when (and (not current-prefix-arg)
+                  message-forward-ignored-headers)
+         (save-restriction
+           (narrow-to-region b e)
+           (goto-char b)
+           (narrow-to-region (point) 
+                             (or (search-forward "\n\n" nil t) (point)))
+           (message-remove-header message-forward-ignored-headers t)))))

     (message-position-point)))
 
 ;;;###autoload
     (message-position-point)))
 
 ;;;###autoload


@@ -3983,7 +4189,7 @@ Optional NEWS will use news to forward instead of mail."
 ;;;###autoload
 (defun message-bounce ()
   "Re-mail the current message.
 ;;;###autoload
 (defun message-bounce ()
   "Re-mail the current message.

-This only makes sense if the current message is a bounce message than
+This only makes sense if the current message is a bounce message that

 contains some mail you have written which has been bounced back to
 you."
   (interactive)
 contains some mail you have written which has been bounced back to
 you."
   (interactive)


@@ -4008,6 +4214,8 @@ you."
        (if (re-search-forward "^[^ \n\t]+:" nil t)
           (match-beginning 0)
         (point))))
        (if (re-search-forward "^[^ \n\t]+:" nil t)
           (match-beginning 0)
         (point))))

+    (mm-enable-multibyte)
+    (mime-to-mml)

     (save-restriction
       (message-narrow-to-head)
       (message-remove-header message-ignored-bounced-headers t)
     (save-restriction
       (message-narrow-to-head)
       (message-remove-header message-ignored-bounced-headers t)


@@ -4110,7 +4318,7 @@ which specify the range to operate on."
 (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
 
 ;; Support for toolbar
 (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
 
 ;; Support for toolbar

-(when (string-match "XEmacs\\|Lucid" emacs-version)
+(when (featurep 'xemacs)

   (require 'messagexmas))
 
 ;;; Group name completion.
   (require 'messagexmas))
 
 ;;; Group name completion.


@@ -4231,17 +4439,20 @@ regexp varstr."
 ;;; Miscellaneous functions
 
 ;; stolen (and renamed) from nnheader.el
 ;;; Miscellaneous functions
 
 ;; stolen (and renamed) from nnheader.el

-(defun message-replace-chars-in-string (string from to)
-  "Replace characters in STRING from FROM to TO."
-  (let ((string (substring string 0))  ;Copy string.
-       (len (length string))
-       (idx 0))
-    ;; Replace all occurrences of FROM with TO.
-    (while (< idx len)
-      (when (= (aref string idx) from)
-       (aset string idx to))
-      (setq idx (1+ idx)))
-    string))
+(if (fboundp 'subst-char-in-string)
+    (defsubst message-replace-chars-in-string (string from to)
+      (subst-char-in-string from to string))
+  (defun message-replace-chars-in-string (string from to)
+    "Replace characters in STRING from FROM to TO."
+    (let ((string (substring string 0))        ;Copy string.
+         (len (length string))
+         (idx 0))
+      ;; Replace all occurrences of FROM with TO.
+      (while (< idx len)
+       (when (= (aref string idx) from)
+         (aset string idx to))
+       (setq idx (1+ idx)))
+      string)))

 
 ;;;
 ;;; MIME functions
 
 ;;;
 ;;; MIME functions


@@ -4297,9 +4508,27 @@ regexp varstr."
   (if (fboundp 'mail-abbrevs-setup)
       (let ((mail-abbrev-mode-regexp "")
            (minibuffer-setup-hook 'mail-abbrevs-setup))
   (if (fboundp 'mail-abbrevs-setup)
       (let ((mail-abbrev-mode-regexp "")
            (minibuffer-setup-hook 'mail-abbrevs-setup))

-       (read-from-minibuffer prompt)))
-  (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
-    (read-string prompt)))
+       (read-from-minibuffer prompt))
+    (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook))
+      (read-string prompt))))
+
+(defun message-use-alternative-email-as-from ()
+  (require 'mail-utils)
+  (let* ((fields '("To" "Cc")) 
+        (emails
+         (split-string
+          (mail-strip-quoted-names
+           (mapconcat 'message-fetch-reply-field fields ","))
+          "[ \f\t\n\r\v,]+"))
+        email)
+    (while emails
+      (if (string-match message-alternative-emails (car emails))
+         (setq email (car emails)
+               emails nil))
+      (pop emails))
+    (unless (or (not email) (equal email user-mail-address))
+      (goto-char (point-max))
+      (insert "From: " email "\n"))))

 
 (provide 'message)
 
 
 (provide 'message)