Applied a bunch of patches:

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 7b4525c..a17617d 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -232,7 +232,7 @@ any confusion."
   :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)


@@ -295,6 +295,11 @@ The provided functions are:
  :type '(radio (function-item message-forward-subject-author-subject)
               (function-item message-forward-subject-fwd)))
 
  :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-wash-forwarded-subjects nil
   "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
   :group 'message-forwarding
 (defcustom message-wash-forwarded-subjects nil
   "*If non-nil, try to remove as much old cruft as possible from the subject of messages before generating the new subject of a forward."
   :group 'message-forwarding


@@ -305,6 +310,12 @@ The provided functions are:
   :group 'message-interface
   :type 'regexp)
 
   :group 'message-interface
   :type 'regexp)
 

+(defcustom message-forward-ignored-headers nil
+  "*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
 (defcustom message-ignored-cited-headers "."
   "*Delete these headers from the messages you yank."
   :group 'message-insertion


@@ -373,10 +384,9 @@ always query the user whether to use the value.  If it is the symbol
                 (const use)
                 (const ask)))
 
                 (const use)
                 (const 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)
 


@@ -396,6 +406,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


@@ -649,6 +664,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.
 


@@ -939,6 +961,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.")
 


@@ -1030,7 +1053,7 @@ The cdr of ech entry is a function for applying the face to a region.")
             (file-readable-p file)
             (file-regular-p file))
     (with-temp-buffer
             (file-readable-p file)
             (file-regular-p file))
     (with-temp-buffer

-      (mm-insert-file-contents file)
+      (nnheader-insert-file-contents file)

       (goto-char (point-min))
       (looking-at message-unix-mail-delimiter))))
 
       (goto-char (point-min))
       (looking-at message-unix-mail-delimiter))))
 


@@ -1041,7 +1064,7 @@ 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.delete-region
+      ;; We remove all text props.

       (format "%s" value))))
 
 (defun message-narrow-to-field ()
       (format "%s" value))))
 
 (defun message-narrow-to-field ()


@@ -1071,6 +1094,7 @@ The cdr of ech entry is a function for applying the face to a region.")
        (insert (car headers) ?\n))))
     (setq headers (cdr headers))))
 
        (insert (car headers) ?\n))))
     (setq headers (cdr headers))))
 

+

 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (when (and message-reply-buffer
 (defun message-fetch-reply-field (header)
   "Fetch FIELD from the message we're replying to."
   (when (and message-reply-buffer


@@ -1280,6 +1304,7 @@ Point is left at the beginning of the narrowed-to region."
   (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-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)


@@ -1367,7 +1392,8 @@ 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-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-a  mml-attach-file (attach a file as MIME)."
+C-c C-a  mml-attach-file (attach a file as MIME).
+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)


@@ -1432,12 +1458,12 @@ C-c C-a  mml-attach-file (attach a file as MIME)."
         '(message-font-lock-keywords t)))
   (make-local-variable 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
         '(message-font-lock-keywords t)))
   (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))
   (mm-enable-multibyte)
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.
                adaptive-fill-first-line-regexp))
   (mm-enable-multibyte)
   (make-local-variable 'indent-tabs-mode) ;Turn off tabs for indentation.


@@ -1520,7 +1546,7 @@ C-c C-a  mml-attach-file (attach a file as MIME)."
   "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.


@@ -1598,17 +1624,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."


@@ -1649,13 +1682,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)
 


@@ -1724,7 +1755,7 @@ Mail and USENET news headers are not rotated."
         (unless (equal 0 (call-process-region
                            (point-min) (point-max) program t t))
             (insert body)
         (unless (equal 0 (call-process-region
                            (point-min) (point-max) program t t))
             (insert body)

-            (message "%s failed." program))))))
+            (message "%s failed" program))))))

 
 (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\".


@@ -1829,6 +1860,24 @@ prefix, and don't delete any headers."
       (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))


@@ -2001,21 +2050,19 @@ the user from the mailer."
        elem sent)
     (while (and success
                (setq elem (pop alist)))
        elem sent)
     (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 sent
+    (unless (or sent (not success))

       (error "No methods specified to send by"))
     (when (and success sent)
       (message-do-fcc)
       (error "No methods specified to send by"))
     (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")


@@ -2130,7 +2177,7 @@ the user from the mailer."
 (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))


@@ -2167,7 +2214,7 @@ the user from the mailer."
                     ;; 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"))


@@ -2701,7 +2748,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-message-id ()
   "Make a unique Message-ID."
 
 (defun message-make-message-id ()
   "Make a unique Message-ID."


@@ -3132,7 +3179,7 @@ Headers already prepared in the buffer are not modified."
 
 (defun message-fill-header (header value)
   (let ((begin (point))
 
 (defun message-fill-header (header value)
   (let ((begin (point))

-       (fill-column 990)
+       (fill-column 78)

        (fill-prefix "\t"))
     (insert (capitalize (symbol-name header))
            ": "
        (fill-prefix "\t"))
     (insert (capitalize (symbol-name header))
            ": "


@@ -3151,23 +3198,60 @@ 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.
+    (when 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 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."


@@ -3455,8 +3539,9 @@ OTHER-HEADERS is an alist of header/value pairs."
              (while (re-search-forward "[ \t]+" nil t)
                (replace-match " " t t))
              ;; Remove addresses that match `rmail-dont-reply-to-names'.
              (while (re-search-forward "[ \t]+" nil t)
                (replace-match " " t t))
              ;; Remove addresses that match `rmail-dont-reply-to-names'.

-             (insert (prog1 (rmail-dont-reply-to (buffer-string))
-                       (erase-buffer)))
+             (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)
              (goto-char (point-min))
              ;; Perhaps Mail-Copies-To: never removed the only address?
              (when (eobp)


@@ -3801,15 +3886,29 @@ Optional NEWS will use news to forward instead of mail."
     ;; Put point where we want it before inserting the forwarded
     ;; message.
     (message-goto-body)
     ;; Put point where we want it before inserting the forwarded
     ;; message.
     (message-goto-body)

-    (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
-    (mml-insert-buffer cur)
-    (insert "<#/part>\n")
+    (if message-forward-as-mime
+        (insert "\n\n<#part type=message/rfc822 disposition=inline>\n")
+      (insert "\n\n"))
+    (let ((b (point))
+         e)
+      (mml-insert-buffer cur)
+      (setq e (point))
+      (and message-forward-as-mime
+          (insert "<#/part>\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))))

     (message-position-point)))
 
 ;;;###autoload
 (defun message-resend (address)
   "Resend the current article to ADDRESS."
     (message-position-point)))
 
 ;;;###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))


@@ -3861,33 +3960,27 @@ This only makes sense if the current message is a bounce message than
 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)

-  (let ((cur (current-buffer))
+  (let ((handles (mm-dissect-buffer t))

        boundary)
     (message-pop-to-buffer (message-buffer-name "bounce"))
        boundary)
     (message-pop-to-buffer (message-buffer-name "bounce"))

-    (insert-buffer-substring cur)
-    (undo-boundary)
-    (message-narrow-to-head)
-    (if (and (message-fetch-field "Mime-Version")
-            (setq boundary (message-fetch-field "Content-Type")))
-       (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
-           (setq boundary (concat (match-string 1 boundary) " *\n"
-                                  "Content-Type: message/rfc822"))
-         (setq boundary nil)))
-    (widen)
-    (goto-char (point-min))
-    (search-forward "\n\n" nil t)
-    (or (and boundary
-            (re-search-forward boundary nil t)
-            (forward-line 2))
-       (and (re-search-forward message-unsent-separator nil t)
-            (forward-line 1))
-       (re-search-forward "^Return-Path:.*\n" nil t))
-    ;; We remove everything before the bounced mail.
-    (delete-region
-     (point-min)
-     (if (re-search-forward "^[^ \n\t]+:" nil t)
-        (match-beginning 0)
-       (point)))
+    (if (stringp (car handles))
+       ;; This is a MIME bounce.
+       (mm-insert-part (car (last handles)))
+      ;; This is a non-MIME bounce, so we try to remove things
+      ;; manually.
+      (mm-insert-part handles)
+      (undo-boundary)
+      (goto-char (point-min))
+      (search-forward "\n\n" nil t)
+      (or (and (re-search-forward message-unsent-separator nil t)
+              (forward-line 1))
+         (re-search-forward "^Return-Path:.*\n" nil t))
+      ;; We remove everything before the bounced mail.
+      (delete-region
+       (point-min)
+       (if (re-search-forward "^[^ \n\t]+:" nil t)
+          (match-beginning 0)
+        (point))))

     (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)


@@ -4086,20 +4179,22 @@ 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)
                  (buffer-local-variables)))
   "Clone the local variables from BUFFER to the current buffer."
   (let ((locals (save-excursion
                  (set-buffer buffer)
                  (buffer-local-variables)))

-       (regexp "^gnus\\|^nn\\|^message"))
+       (regexp "^gnus\\|^nn\\|^message\\|^user-mail-address"))

     (mapcar
      (lambda (local)
        (when (and (consp local)
                  (car local)
     (mapcar
      (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)))))


@@ -4145,7 +4240,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")


@@ -4170,6 +4265,15 @@ 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)))
+

 (provide 'message)
 
 (run-hooks 'message-load-hook)
 (provide 'message)
 
 (run-hooks 'message-load-hook)