Commits

Anonymous committed 53d1a3e

Finish update to vm-6.67

  • Participants
  • Parent commits 2b74b5e

Comments (0)

Files changed (17)

 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 1.16
+VERSION = 1.17
 AUTHOR_VERSION = 6.67
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = vm
 		     (format "edit of %s's note re: %s"
 			     (vm-su-full-name (car vm-message-pointer))
 			     (vm-su-subject (car vm-message-pointer)))))
+	      (if vm-fsfemacs-mule-p
+		  (set-buffer-multibyte nil))
 	      (vm-set-edit-buffer-of (car mp) edit-buf)
 	      (copy-to-buffer edit-buf
 			      (vm-headers-of (car mp))

File vm-folder.el

 Returns non-nil if the separator is found, nil otherwise."
   (cond
    ((eq vm-folder-type 'From_)
-    (let ((reg1 "^From .* [1-9][0-9][0-9][0-9]$")
+    (let ((reg1 "^From .*[0-9]$")
 	  (case-fold-search nil))
       (catch 'done
 	(while (re-search-forward reg1 nil 'no-error)
 	    (forward-char 1)))
 	nil )))
    ((eq vm-folder-type 'BellFrom_)
-    (let ((reg1 "^From .* [1-9][0-9][0-9][0-9]$")
+    (let ((reg1 "^From .*[0-9]$")
 	  (case-fold-search nil))
       (if (re-search-forward reg1 nil 'no-error)
 	  (progn
   "Find the next trailing message separator in a folder."
   (cond
    ((eq vm-folder-type 'From_)
-    (if (vm-find-leading-message-separator)
-	(forward-char -1)))
+    (vm-find-leading-message-separator)
+    (forward-char -1))
    ((eq vm-folder-type 'BellFrom_)
     (vm-find-leading-message-separator))
    ((eq vm-folder-type 'From_-with-Content-Length)
 		       oldpoint (buffer-name)))))))
     t ))
 
+(defun vm-gobble-imap-retrieved ()
+  (let ((case-fold-search t)
+	ob lim oldpoint)
+    (save-excursion
+      (vm-save-restriction
+       (widen)
+       (goto-char (point-min))
+       (vm-skip-past-folder-header)
+       (vm-skip-past-leading-message-separator)
+       (search-forward "\n\n" nil t)
+       (setq lim (point))
+       (goto-char (point-min))
+       (vm-skip-past-folder-header)
+       (vm-skip-past-leading-message-separator)
+       (if (re-search-forward vm-imap-retrieved-header-regexp lim t)
+	   (condition-case ()
+	       (progn
+		 (setq oldpoint (point)
+		       ob (read (current-buffer)))
+		 (if (not (listp ob))
+		     (error "Bad imap-retrieved header at %d in buffer %s"
+			    oldpoint (buffer-name)))
+		 (setq vm-imap-retrieved-messages ob))
+	     (error
+	      (message "Bad imap-retrieved header at %d in buffer %s, ignoring"
+		       oldpoint (buffer-name)))))))
+    t ))
+
 (defun vm-gobble-visible-header-variables ()
   (save-excursion
     (vm-save-restriction
 	  (unwind-protect
 	      (let (obj attr-list cache-list location-list label-list
 		    validity-check vis invis folder-type
-		    bookmark summary labels retrieved order
+		    bookmark summary labels pop-retrieved imap-retrieved order
 		    v m (m-list nil) tail)
 		(message "Reading index file...")
 		(setq work-buffer (vm-make-work-buffer))
 			label-list (cdr label-list)))
 
 		;; pop retrieved messages
-		(setq retrieved (read work-buffer))
+		(setq pop-retrieved (read work-buffer))
+
+		;; imap retrieved messages
+		(setq imap-retrieved (read work-buffer))
 
 		(setq vm-message-list m-list
 		      vm-folder-type folder-type
-		      vm-pop-retrieved-messages retrieved)
+		      vm-pop-retrieved-messages pop-retrieved
+		      vm-imap-retrieved-messages imap-retrieved)
 
 		(vm-startup-apply-bookmark bookmark)
 		(and order (vm-startup-apply-message-order order))
 	    (save-excursion
 	      (set-buffer work-buffer)
 	      (condition-case data
-		  (let ((coding-system-for-write 'binary))
+		  (let ((coding-system-for-write 'binary)
+			(selective-display nil))
 		    (write-region (point-min) (point-max) index-file))
 		(error
 		 (message "Write of %s signaled: %s" index-file data)
        (setq got-mail (/= opoint-max (point-max)))
        (if (not got-mail)
 	   nil
-	 (write-region opoint-max (point-max) buffer-file-name t t)
+	 (let ((coding-system-for-write 'binary)
+	       (selective-display nil))
+	   (write-region opoint-max (point-max) buffer-file-name t t))
 	 (vm-increment vm-modification-counter)
 	 (set-buffer-modified-p old-buffer-modified-p))
        (kill-buffer crash-buf)
 (defun vm-display-startup-message ()
   (if (sit-for 5)
       (let ((lines vm-startup-message-lines))
-	(message "VM %s, Copyright (C) 1998 Kyle E. Jones; type ? for help"
+	(message "VM %s, Copyright (C) 1999 Kyle E. Jones; type ? for help"
 		 vm-version)
 	(setq vm-startup-message-displayed t)
 	(while (and (sit-for 4) lines)
    ;; before it was put into vm-mode.
    buffer-offer-save t
    require-final-newline nil
+   ;; don't let CR's in folders be mashed into LF's because of a
+   ;; stupid user setting.
+   selective-display nil
    vm-thread-obarray nil
    vm-thread-subject-obarray nil
    vm-label-obarray (make-vector 29 0)
 
 (if (fboundp 'define-error)
     (progn
-      (define-error 'vm-imap-store-failed "IMAP STORE failed")
-      (define-error 'vm-imap-protocol-error "IMAP protocl error"))
-  (put 'vm-imap-store-failed 'error-conditions '(vm-imap-store-failed error))
-  (put 'vm-imap-store-failed 'error-message "IMAP STORE failed")
+      (define-error 'vm-imap-protocol-error "IMAP protocol error"))
   (put 'vm-imap-protocol-error 'error-conditions
        '(vm-imap-protocol-error error))
   (put 'vm-imap-protocol-error 'error-message "IMAP protocol error"))
 	  (setq process-buffer
 		(generate-new-buffer (format "trace of IMAP session to %s"
 					     host)))
-	  ;; Tell XEmacs/MULE not to mess with the text.
-	  (and vm-xemacs-mule-p
-	       (set-buffer-file-coding-system 'binary t))
-	  ;; clear the trace buffer of old output
 	  (save-excursion
 	    (set-buffer process-buffer)
 	    (buffer-disable-undo process-buffer)
-	    (erase-buffer))
-	  ;; open the connection to the server
-	  (setq process (open-network-stream "IMAP" process-buffer host port))
-	  (and (null process) (throw 'end-of-session nil))
-	  (process-kill-without-query process)
-	  (save-excursion
-	    (set-buffer process-buffer)
+	    ;; clear the trace buffer of old output
+	    (erase-buffer)
+	    ;; Tell MULE not to mess with the text.
+	    (if (or vm-xemacs-mule-p vm-fsfemacs-mule-p)
+		(set-buffer-file-coding-system 'binary t))
+	    (insert "starting IMAP session " (current-time-string) "\n")
+	    (insert (format "connecting to %s:%s\n" host port))
+	    ;; open the connection to the server
+	    (setq process (open-network-stream "IMAP" process-buffer
+					       host port))
+	    (and (null process) (throw 'end-of-session nil))
+	    (insert "connected\n")
+	    (process-kill-without-query process)
 	    (make-local-variable 'vm-imap-read-point)
-	    (setq vm-imap-read-point (point-min))
+	    (setq vm-imap-read-point (point))
 	    (if (null (setq greeting (vm-imap-read-greeting process)))
 		(progn (delete-process process)
 		       (throw 'end-of-session nil)))
     (vm-imap-send-command process "LOGOUT")
     ;; we don't care about the response
     ;;(vm-imap-read-ok-response process)
-    (kill-buffer (process-buffer process))
+    (if (not vm-imap-keep-trace-buffer)
+	(kill-buffer (process-buffer process)))
     (if (fboundp 'add-async-timeout)
 	(add-async-timeout 2 'delete-process process)
       (run-at-time 2 nil 'delete-process process))))
     (vm-convert-folder-type-headers nil vm-folder-type)
     (goto-char end)
     (insert-before-markers (vm-trailing-message-separator))
+    ;; Some IMAP servers don't understand Sun's stupid
+    ;; From_-with-Content-Length style folder and assume the last
+    ;; newline in the message is a separator.  And so the server
+    ;; strips it, leaving us with a message that does not end
+    ;; with a newline.  Add the newline if needed.
+    ;;
+    ;; HP Openmail seems to have this problem.
+    (if (and (not (eq ?\n (char-before (point))))
+	     (memq vm-folder-type '(From_-with-Content-Length BellFrom_)))
+	(insert-before-markers "\n"))
     ;; Set file type to binary for DOS/Windows.  I don't know if
     ;; this is correct to do or not; it depends on whether the
     ;; the CRLF or the LF newline convention is used on the inbox
     ;; associated with this crashbox.  This setting assumes the LF
     ;; newline convention is used.
-    (let ((buffer-file-type t))
+    (let ((buffer-file-type t)
+	  (selective-display nil))
       (write-region start end crash t 0))
     (delete-region start end)
     t ))
       (throw 'end-of-session t)))
 
 (defun vm-imap-protocol-error (&rest args)
+  (set (make-local-variable 'vm-imap-keep-trace-buffer) t)
   (signal 'vm-imap-protocol-error (list (apply 'format args))))
 
 (defun vm-imap-scan-list-for-flag (list flag)
       (setq vm-xemacs-p (string-match "XEmacs" emacs-version)
 	    vm-xemacs-mule-p (and vm-xemacs-p (featurep 'mule)
 				  ;; paranoia
-				  (fboundp 'set-file-coding-system))
+				  (fboundp 'set-buffer-file-coding-system))
 	    vm-fsfemacs-p (not vm-xemacs-p)
 	    vm-fsfemacs-mule-p (and (not vm-xemacs-mule-p) (featurep 'mule)
 				    (fboundp 'set-buffer-file-coding-system)))))
 (defconst vm-menu-label-menu
   '("Label"
     ["Add Label" vm-add-message-labels vm-message-list]
+    ["Add Existing Label" vm-add-existing-message-labels vm-message-list]
     ["Remove Label" vm-delete-message-labels vm-message-list]
     ))
 
     ["By Subject (backward)" (vm-sort-messages "reversed-subject") vm-message-list]
     ["By Author (backward)" (vm-sort-messages "reversed-author") vm-message-list]
     ["By Recipients (backward)" (vm-sort-messages "reversed-recipients") vm-message-list]
-    ["By Lines (backwards)" (vm-sort-messages "reversed-line-count") vm-message-list]
+    ["By Lines (backward)" (vm-sort-messages "reversed-line-count") vm-message-list]
     ["By Bytes (backward)" (vm-sort-messages "reversed-byte-count") vm-message-list]
     "---"
     ["Toggle Threading" vm-toggle-threads-display t]
 
 (provide 'vm-mime)
 
+(defvar enable-multibyte-characters)
+(defvar default-enable-multibyte-characters)
+
 (defun vm-mime-error (&rest args)
   (signal 'vm-mime-error (list (apply 'format args)))
   (error "can't return from vm-mime-error"))
 (defun vm-mm-layout-body-end (e) (aref e 9))
 (defun vm-mm-layout-parts (e) (aref e 10))
 (defun vm-mm-layout-cache (e) (aref e 11))
+(defun vm-mm-layout-message-symbol (e) (aref e 12))
+(defun vm-mm-layout-message (e)
+  (symbol-value (vm-mm-layout-message-symbol e)))
 ;; if display of MIME part fails, error string will be here.
-(defun vm-mm-layout-display-error (e) (aref e 12))
+(defun vm-mm-layout-display-error (e) (aref e 13))
 
 (defun vm-set-mm-layout-type (e type) (aset e 0 type))
 (defun vm-set-mm-layout-qtype (e type) (aset e 1 type))
 (defun vm-set-mm-layout-cache (e c) (aset e 11 c))
-(defun vm-set-mm-layout-display-error (e c) (aset e 12 c))
+(defun vm-set-mm-layout-display-error (e c) (aset e 13 c))
+
+(defun vm-mime-make-message-symbol (m)
+  (let ((s (make-symbol "<<m>>")))
+    (set s m)
+    s ))
 
 (defun vm-mm-layout (m)
   (or (vm-mime-layout-of m)
 	   (vm-mime-uuencode-decode-region start end crlf)))))
 
 (defun vm-mime-base64-decode-region (start end &optional crlf)
-  (message "Decoding base64...")
+  (and (> (- end start) 200)
+       (message "Decoding base64..."))
   (let ((work-buffer nil)
 	(done nil)
 	(counter 0)
 	(non-data-chars (concat "^=" vm-mime-base64-alphabet)))
     (unwind-protect
 	(save-excursion
-	  (setq work-buffer (generate-new-buffer " *vm-work*"))
+	  (let ((default-enable-multibyte-characters nil))
+	    (setq work-buffer (generate-new-buffer " *vm-work*")))
 	  (buffer-disable-undo work-buffer)
 	  (if vm-mime-base64-decoder-program
 	      (let* ((binary-process-output t) ; any text already has CRLFs
+		     ;; use binary coding system in FSF Emacs/MULE
+		     (coding-system-for-read 'binary)
+		     (coding-system-for-write 'binary)
 		     (status (apply 'vm-run-command-on-region
 				   start end work-buffer
 				   vm-mime-base64-decoder-program
 	  (insert-buffer-substring work-buffer)
 	  (delete-region (point) end))
       (and work-buffer (kill-buffer work-buffer))))
-  (message "Decoding base64... done"))
+  (and (> (- end start) 200)
+       (message "Decoding base64... done")))
 
 (defun vm-mime-base64-encode-region (start end &optional crlf B-encoding)
   (and (> (- end start) 200)
 	inputpos)
     (unwind-protect
 	(save-excursion
-	  (setq work-buffer (generate-new-buffer " *vm-work*"))
+	  (let ((default-enable-multibyte-characters nil))
+	    (setq work-buffer (generate-new-buffer " *vm-work*")))
 	  (buffer-disable-undo work-buffer)
 	  (if crlf
 	      (progn
 		(if (not (eq status t))
 		    (vm-mime-error "%s" (cdr status)))
 		(if B-encoding
-		    (progn
+		    (save-excursion
+		      (set-buffer work-buffer)
 		      ;; if we're B encoding, strip out the line breaks
 		      (goto-char (point-min))
 		      (while (search-forward "\n" nil t)
 	(hex-digit-alist '((?0 .  0)  (?1 .  1)  (?2 .  2)  (?3 .  3)
 			   (?4 .  4)  (?5 .  5)  (?6 .  6)  (?7 .  7)
 			   (?8 .  8)  (?9 .  9)  (?A . 10)  (?B . 11)
-			   (?C . 12)  (?D . 13)  (?E . 14)  (?F . 15)))
+			   (?C . 12)  (?D . 13)  (?E . 14)  (?F . 15)
+			   ;; some mailer uses lower-case hex
+			   ;; digits despite this being forbidden
+			   ;; by the MIME spec.
+			   (?a . 10)  (?b . 11)  (?c . 12)  (?d . 13)
+			   (?e . 14)  (?f . 15)))
 	inputpos stop-point copy-point)
     (unwind-protect
 	(save-excursion
-	  (setq work-buffer (generate-new-buffer " *vm-work*"))
+	  (let ((default-enable-multibyte-characters nil))
+	    (setq work-buffer (generate-new-buffer " *vm-work*")))
 	  (buffer-disable-undo work-buffer)
-	  (goto-char start)
-	  (setq inputpos start)
-	  (while (< inputpos end)
-	    (skip-chars-forward "^=\n" end)
-	    (setq stop-point (point))
-	    (cond ((looking-at "\n")
-		   ;; spaces or tabs before a hard line break must be ignored
-		   (skip-chars-backward " \t")
-		   (setq copy-point (point))
-		   (goto-char stop-point))
-		  (t (setq copy-point stop-point)))
-	    (save-excursion
-	      (set-buffer work-buffer)
-	      (insert-buffer-substring buf inputpos copy-point))
-	    (cond ((= (point) end) t)
-		  ((looking-at "\n")
-		   (vm-insert-char ?\n 1 nil work-buffer)
-		   (forward-char))
-		  (t ;; looking at =
-		   (forward-char)
-		   (cond ((looking-at "[0-9A-F][0-9A-F]")
-			  (vm-insert-char (+ (* (cdr (assq (char-after (point))
-							   hex-digit-alist))
-						16)
-					     (cdr (assq (char-after
-							 (1+ (point)))
-							hex-digit-alist)))
-					  1 nil work-buffer)
-			  (forward-char 2))
-			 ((looking-at "\n") ; soft line break
-			  (forward-char))
-			 ((looking-at "\r")
-			  ;; assume the user's goatloving
-			  ;; delivery software didn't convert
-			  ;; from Internet's CRLF newline
-			  ;; convention to the local LF
-			  ;; convention.
-			  (forward-char))
-			 ((looking-at "[ \t]")
-			  ;; garbage added in transit
-			  (skip-chars-forward " \t" end))
-			 (t (vm-mime-error "something other than line break or hex digits after = in quoted-printable encoding")))))
-	    (setq inputpos (point)))
+	  (if vm-mime-qp-decoder-program
+	      (let* ((binary-process-output t) ; any text already has CRLFs
+		     ;; use binary coding system in FSF Emacs/MULE
+		     (coding-system-for-read 'binary)
+		     (coding-system-for-write 'binary)
+		     (status (apply 'vm-run-command-on-region
+				    start end work-buffer
+				    vm-mime-qp-decoder-program
+				    vm-mime-qp-decoder-switches)))
+		(if (not (eq status t))
+		    (vm-mime-error "%s" (cdr status))))
+	    (goto-char start)
+	    (setq inputpos start)
+	    (while (< inputpos end)
+	      (skip-chars-forward "^=\n" end)
+	      (setq stop-point (point))
+	      (cond ((looking-at "\n")
+		     ;; spaces or tabs before a hard line break must be ignored
+		     (skip-chars-backward " \t")
+		     (setq copy-point (point))
+		     (goto-char stop-point))
+		    (t (setq copy-point stop-point)))
+	      (save-excursion
+		(set-buffer work-buffer)
+		(insert-buffer-substring buf inputpos copy-point))
+	      (cond ((= (point) end) t)
+		    ((looking-at "\n")
+		     (vm-insert-char ?\n 1 nil work-buffer)
+		     (forward-char))
+		    (t;; looking at =
+		     (forward-char)
+		     ;; a-f because some mailers use lower case hex
+		     ;; digits despite them being forbidden by the
+		     ;; MIME spec.
+		     (cond ((looking-at "[0-9A-Fa-f][0-9A-Fa-f]")
+			    (vm-insert-char (+ (* (cdr (assq (char-after (point))
+							     hex-digit-alist))
+						  16)
+					       (cdr (assq (char-after
+							   (1+ (point)))
+							  hex-digit-alist)))
+					    1 nil work-buffer)
+			    (forward-char 2))
+			   ((looking-at "\n") ; soft line break
+			    (forward-char))
+			   ((looking-at "\r")
+			    ;; assume the user's goatloving
+			    ;; delivery software didn't convert
+			    ;; from Internet's CRLF newline
+			    ;; convention to the local LF
+			    ;; convention.
+			    (forward-char))
+			   ((looking-at "[ \t]")
+			    ;; garbage added in transit
+			    (skip-chars-forward " \t" end))
+			   (t (vm-mime-error "something other than line break or hex digits after = in quoted-printable encoding")))))
+	      (setq inputpos (point))))
 	  (or (markerp end) (setq end (vm-marker end)))
 	  (goto-char start)
 	  (insert-buffer-substring work-buffer)
 	char inputpos)
     (unwind-protect
 	(save-excursion
-	  (setq work-buffer (generate-new-buffer " *vm-work*"))
+	  (let ((default-enable-multibyte-characters nil))
+	    (setq work-buffer (generate-new-buffer " *vm-work*")))
 	  (buffer-disable-undo work-buffer)
-	  (setq inputpos start)
-	  (while (< inputpos end)
-	    (setq char (char-after inputpos))
-	    (cond ((= char ?\n)
-		   (vm-insert-char char 1 nil work-buffer)
-		   (setq cols 0))
-		  ((and (= char 32)
-			(not (= (1+ inputpos) end))
-			(not (= ?\n (char-after (1+ inputpos)))))
-		   (vm-insert-char char 1 nil work-buffer)
-		   (vm-increment cols))
-		  ((or (< char 33) (> char 126) (= char 61)
-		       (and quote-from (= cols 0) (let ((case-fold-search nil))
-						    (looking-at "From ")))
-		       (and (= cols 0) (= char ?.)
-			    (looking-at "\\.\\(\n\\|\\'\\)")))
-		   (vm-insert-char ?= 1 nil work-buffer)
-		   (vm-insert-char (car (rassq (lsh char -4) hex-digit-alist))
-				   1 nil work-buffer)
-		   (vm-insert-char (car (rassq (logand char 15)
-					       hex-digit-alist))
-				   1 nil work-buffer)
-		   (setq cols (+ cols 3)))
-		  (t (vm-insert-char char 1 nil work-buffer)
-		     (vm-increment cols)))
-	    (cond ((> cols 70)
-		   (setq cols 0)
-		   (if Q-encoding
-		       nil
+	  (if vm-mime-qp-encoder-program
+	      (let* ((binary-process-output t) ; any text already has CRLFs
+		     ;; use binary coding system in FSF Emacs/MULE
+		     (coding-system-for-read 'binary)
+		     (coding-system-for-write 'binary)
+		     (status (apply 'vm-run-command-on-region
+				    start end work-buffer
+				    vm-mime-qp-encoder-program
+				    vm-mime-qp-encoder-switches)))
+		(if (not (eq status t))
+		    (vm-mime-error "%s" (cdr status)))
+		(if quote-from
+		    (save-excursion
+		      (set-buffer work-buffer)
+		      (goto-char (point-min))
+		      (while (re-search-forward "^From " nil t)
+			(replace-match "=46rom " t t))))
+		(if Q-encoding
+		    (save-excursion
+		      (set-buffer work-buffer)
+		      ;; strip out the line breaks
+		      (goto-char (point-min))
+		      (while (search-forward "=\n" nil t)
+			(delete-char -2))
+		      ;; strip out the soft line breaks
+		      (goto-char (point-min))
+		      (while (search-forward "\n" nil t)
+			(delete-char -1)))))
+	    (setq inputpos start)
+	    (while (< inputpos end)
+	      (setq char (char-after inputpos))
+	      (cond ((= char ?\n)
+		     (vm-insert-char char 1 nil work-buffer)
+		     (setq cols 0))
+		    ((and (= char 32)
+			  (not (= (1+ inputpos) end))
+			  (not (= ?\n (char-after (1+ inputpos)))))
+		     (vm-insert-char char 1 nil work-buffer)
+		     (vm-increment cols))
+		    ((or (< char 33) (> char 126) (= char 61)
+			 (and quote-from (= cols 0) (let ((case-fold-search nil))
+						      (looking-at "From ")))
+			 (and (= cols 0) (= char ?.)
+			      (looking-at "\\.\\(\n\\|\\'\\)")))
 		     (vm-insert-char ?= 1 nil work-buffer)
-		     (vm-insert-char ?\n 1 nil work-buffer))))
-	    (vm-increment inputpos))
+		     (vm-insert-char (car (rassq (lsh char -4) hex-digit-alist))
+				     1 nil work-buffer)
+		     (vm-insert-char (car (rassq (logand char 15)
+						 hex-digit-alist))
+				     1 nil work-buffer)
+		     (setq cols (+ cols 3)))
+		    (t (vm-insert-char char 1 nil work-buffer)
+		       (vm-increment cols)))
+	      (cond ((> cols 70)
+		     (setq cols 0)
+		     (if Q-encoding
+			 nil
+		       (vm-insert-char ?= 1 nil work-buffer)
+		       (vm-insert-char ?\n 1 nil work-buffer))))
+	      (vm-increment inputpos)))
 	  (or (markerp end) (setq end (vm-marker end)))
 	  (goto-char start)
 	  (insert-buffer-substring work-buffer)
 	(tempfile (vm-make-tempfile-name)))
     (unwind-protect
 	(save-excursion
-	  (setq work-buffer (generate-new-buffer " *vm-work*"))
+	  (let ((default-enable-multibyte-characters nil))
+	    (setq work-buffer (generate-new-buffer " *vm-work*")))
 	  (set-buffer work-buffer)
 	  (buffer-disable-undo work-buffer)
 	  (insert-buffer-substring region-buffer start end)
 		(insert "\n")))
 	  (if (stringp vm-mime-uuencode-decoder-program)
 	      (let* ((binary-process-output t) ; any text already has CRLFs
+		     ;; use binary coding system in FSF Emacs/MULE
+		     (coding-system-for-read 'binary)
+		     (coding-system-for-write 'binary)
+		     (process-coding-system-alist '(("." . binary)))
 		     (status (apply 'vm-run-command-on-region
 				    (point-min) (point-max) nil
 				    vm-mime-uuencode-decoder-program
 	      (insert "?=")
 	      (setq pos (point))
 	      (goto-char start)
-	      (insert "=?" charset "?" (if q-encoding "Q" "B") "?")))
+	      (insert "=?" charset "?" (if q-encoding "Q" "B") "?")
+	      (setq pos (+ pos (- (point) start)))))
 	(setq start pos)))))
 
 (defun vm-reencode-mime-encoded-words-in-string (string)
 	    (vm-matched-header-contents)
 	  nil )))))
 
-(defun vm-mime-parse-entity (&optional m default-type default-encoding)
+(defun vm-mime-parse-entity (&optional m default-type default-encoding
+				       passing-message-only)
   (let ((case-fold-search t) version type qtype encoding id description
 	disposition qdisposition boundary boundary-regexp start
 	multipart-list c-t c-t-e done p returnval)
     (catch 'return-value
       (save-excursion
-	(if m
+	(if (and m (not passing-message-only))
 	    (progn
 	      (setq m (vm-real-message-of m))
 	      (set-buffer (vm-buffer-of m))))
 	(save-excursion
 	  (save-restriction
-	    (if m
+	    (if (and m (not passing-message-only))
 		(progn
 		  (setq version (vm-get-header-contents m "MIME-Version:")
 			version (car (vm-mime-parse-content-header version))
 				     (vm-mime-parse-content-header
 				      disposition ?\;))))
 	    (cond ((null m) t)
+		  (passing-message-only t)
 		  ((null version)
 		   (throw 'return-value 'none))
 		  ((or vm-mime-ignore-mime-version (string= version "1.0")) t)
 		  (t (vm-mime-error "Unsupported MIME version: %s" version)))
-	    (cond ((and m (null type))
+	    (cond ((and m (not passing-message-only) (null type))
 		   (throw 'return-value
 			  (vector '("text/plain" "charset=us-ascii")
 				  '("text/plain" "charset=us-ascii")
 				  (vm-headers-of m)
 				  (vm-text-of m)
 				  (vm-text-end-of m)
-				  nil nil nil )))
+				  nil nil
+				  (vm-mime-make-message-symbol m)
+				  nil )))
 		  ((null type)
 		   (goto-char (point-min))
 		   (or (re-search-forward "^\n\\|\n\\'" nil t)
 			   (vm-marker (point-min))
 			   (vm-marker (point))
 			   (vm-marker (point-max))
-			   nil nil nil ))
+			   nil nil
+			   (vm-mime-make-message-symbol m)
+			   nil ))
 		  ((null (string-match "[^/ ]+/[^/ ]+" (car type)))
 		   (vm-mime-error "Malformed MIME content type: %s" (car type)))
 		  ((and (string-match "^multipart/\\|^message/" (car type))
 				  (list
 				   (save-restriction
 				     (narrow-to-region (point) (point-max))
-				     (vm-mime-parse-entity-safe nil c-t
-								c-t-e)))
-				  nil nil )))
+				     (vm-mime-parse-entity-safe m c-t
+								c-t-e t)))
+				  nil
+				  (vm-mime-make-message-symbol m)
+				  nil )))
 		  (t
 		   (goto-char (point-min))
 		   (or (re-search-forward "^\n\\|\n\\'" nil t)
 				  (vm-marker (point-min))
 				  (vm-marker (point))
 				  (vm-marker (point-max))
-				  nil nil nil ))))
+				  nil nil
+				  (vm-mime-make-message-symbol m)
+				  nil ))))
 	    (setq p (cdr type)
 		  boundary nil)
 	    (while p
 			 (narrow-to-region start (1- (match-beginning 0)))
 			 (setq start (match-end 0))
 			 (setq multipart-list
-			       (cons (vm-mime-parse-entity-safe nil c-t c-t-e)
+			       (cons (vm-mime-parse-entity-safe m c-t c-t-e
+								t)
 				     multipart-list)))))))
 	    (if (not done)
 		(vm-mime-error "final %s boundary missing" boundary))
 		    (vm-marker (point))
 		    (vm-marker (point-max))
 		    (nreverse multipart-list)
-		    nil nil )))))))
+		    nil
+		    (vm-mime-make-message-symbol m)
+		    nil )))))))
 
-(defun vm-mime-parse-entity-safe (&optional m c-t c-t-e)
+(defun vm-mime-parse-entity-safe (&optional m c-t c-t-e passing-message-only)
   (or c-t (setq c-t '("text/plain" "charset=us-ascii")))
   ;; don't let subpart parse errors make the whole parse fail.  use default
   ;; type if the parse fails.
   (condition-case error-data
-      (vm-mime-parse-entity nil c-t c-t-e)
+      (vm-mime-parse-entity m c-t c-t-e passing-message-only)
     (vm-mime-error
-     (let ((header (if m
+     (let ((header (if (and m (not passing-message-only))
 		       (vm-headers-of m)
 		     (vm-marker (point-min))))
-	   (text (if m
+	   (text (if (and m (not passing-message-only))
 		     (vm-text-of m)
 		   (save-excursion
 		     (re-search-forward "^\n\\|\n\\'"
 					nil 0)
 		     (vm-marker (point)))))
-	   (text-end (if m
+	   (text-end (if (and m (not passing-message-only))
 			 (vm-text-end-of m)
 		       (vm-marker (point-max)))))
      (vector c-t c-t
 	     header
 	     text
 	     text-end
-	     nil nil nil)))))
+	     nil nil
+	     (vm-mime-make-message-symbol m)
+	     nil)))))
 
 (defun vm-mime-get-xxx-parameter (layout name param-list)
   (let ((match-end (1+ (length name)))
 	     (defvar scroll-in-place)
 	     (make-local-variable 'scroll-in-place)
 	     (setq scroll-in-place nil)
-	     (and vm-xemacs-mule-p
-		  (set-buffer-file-coding-system 'binary t))
-	     (cond (vm-fsfemacs-p
+	     (if (or vm-xemacs-mule-p vm-fsfemacs-mule-p)
+		 (set-buffer-file-coding-system 'binary t))
+	     (cond ((and vm-fsfemacs-p (not vm-fsfemacs-mule-p))
 		    ;; need to do this outside the let because
 		    ;; loading disp-table initializes
 		    ;; standard-display-table.
     (setq b vm-presentation-buffer-handle
 	  vm-presentation-buffer vm-presentation-buffer-handle
 	  vm-mime-decoded nil)
+    ;; W3 or some other external mode might set some local colors
+    ;; in this buffer; remove them before displaying a different
+    ;; message here.
+    (if (fboundp 'remove-specifier)
+	(progn
+	  (remove-specifier (face-foreground 'default) b)
+	  (remove-specifier (face-background 'default) b)))
     (save-excursion
       (set-buffer (vm-buffer-of real-m))
       (save-restriction
 	(set-buffer b)
 	(widen)
 	(let ((buffer-read-only nil)
-	      ;; disable read-only text properties
-	      (inhibit-read-only t)
 	      (modified (buffer-modified-p)))
 	  (unwind-protect
 	      (progn
       (narrow-to-region beg end)
       (catch 'done
 	(goto-char (point-min))
-	(if vm-xemacs-mule-p
-	    (let ((charsets (delq 'ascii (charsets-in-region beg end))))
+	(if (or vm-xemacs-mule-p vm-fsfemacs-mule-p)
+	    (let ((charsets (delq 'ascii (vm-charsets-in-region beg end))))
 	      (cond ((null charsets)
 		     "us-ascii")
 		    ((cdr charsets)
 			(nth 1 ooo))
     (save-excursion
       (set-buffer (generate-new-buffer " *mime object*"))
+      ;; call-process-region calls write-region.
+      ;; don't let it do CR -> LF translation.
+      (setq selective-display nil)
       (setq vm-message-garbage-alist
 	    (cons (cons (current-buffer) 'kill-buffer)
 		  vm-message-garbage-alist))
-      (vm-mime-insert-mime-body layout)
-      (vm-mime-transfer-decode-region layout (point-min) (point-max))
+      (vm-with-unibyte-buffer
+       (vm-mime-insert-mime-body layout)
+       (vm-mime-transfer-decode-region layout (point-min) (point-max)))
       (call-process-region (point-min) (point-max) shell-file-name
 			   t t nil shell-command-switch (nth 2 ooo))
       (goto-char (point-min))
       (insert "Content-Transfer-Encoding: binary\n\n")
       (set-buffer-modified-p nil)
       (message "Converting %s to %s... done"
-			(car (vm-mm-layout-type layout))
-			(nth 1 ooo))
+	       (car (vm-mm-layout-type layout))
+	       (nth 1 ooo))
       (vector (list (nth 1 ooo))
 	      (list (nth 1 ooo))
 	      "binary"
 	      (vm-marker (point-max))
 	      nil
 	      nil
+	      (vm-mm-layout-message layout)
 	      nil))))
 
 (defun vm-mime-should-display-button (layout dont-honor-content-disposition)
 		(start (point))
 		end buffer-size)
 	    (message "Inlining text/html, be patient...")
-	    ;; We need to keep track of where the end of the
-	    ;; processed text is.  Best way to do this is to
-	    ;; avoid markers and save-exurcsion, and just use
-	    ;; buffer size changes as an indicator.
-	    (vm-mime-insert-mime-body layout)
-	    (setq end (point))
-	    (setq buffer-size (buffer-size))
-	    (vm-mime-transfer-decode-region layout start end)
-	    (setq end (+ end (- (buffer-size) buffer-size)))
-	    (setq buffer-size (buffer-size))
-	    (w3-region start end)
-	    (setq end (+ end (- (buffer-size) buffer-size)))
+	    (vm-with-unibyte-buffer
+	     ;; We need to keep track of where the end of the
+	     ;; processed text is.  Best way to do this is to
+	     ;; avoid markers and save-excursion, and just use
+	     ;; buffer size changes as an indicator.
+	     (vm-mime-insert-mime-body layout)
+	     (setq end (point))
+	     (setq buffer-size (buffer-size))
+	     (vm-mime-transfer-decode-region layout start end)
+	     (setq end (+ end (- (buffer-size) buffer-size)))
+	     (setq buffer-size (buffer-size))
+	     (w3-region start end)
+	     (setq end (+ end (- (buffer-size) buffer-size))))
+	    ;; remove read-only text properties
+	    (let ((inhibit-read-only t))
+	      (remove-text-properties start end '(read-only nil)))
 	    (goto-char end)
 	    (message "Inlining text/html... done")
 	    t )
 	  (vm-set-mm-layout-display-error
 	   layout (concat "Undisplayable charset: " charset))
 	  nil)
-      (vm-mime-insert-mime-body layout)
-      (setq end (point-marker))
-      (vm-mime-transfer-decode-region layout start end)
-      (setq old-size (buffer-size))
-      (vm-mime-charset-decode-region charset start end)
-      (set-marker end (+ end (- (buffer-size) old-size)))
+      (vm-with-unibyte-buffer
+       (vm-mime-insert-mime-body layout)
+       (setq end (point-marker))
+       (vm-mime-transfer-decode-region layout start end)
+       (setq old-size (buffer-size))
+       (vm-mime-charset-decode-region charset start end)
+       (set-marker end (+ end (- (buffer-size) old-size))))
       (or no-highlighting (vm-energize-urls-in-message-region start end))
       (goto-char end)
       t )))
 	(buffer-read-only nil)
 	(enriched-verbose t))
     (message "Decoding text/enriched, be patient...")
-    (vm-mime-insert-mime-body layout)
-    (setq end (point-marker))
-    (vm-mime-transfer-decode-region layout start end)
+    (vm-with-unibyte-buffer
+     (vm-mime-insert-mime-body layout)
+     (setq end (point-marker))
+     (vm-mime-transfer-decode-region layout start end))
     ;; enriched-decode expects a couple of headers at the top of
     ;; the region and will remove anything that looks like a
     ;; header.  Put a header section here for it to eat so it
 		       (vm-mime-find-external-viewer
 			(car (vm-mm-layout-type layout)))))
 	(buffer-read-only nil)
-	(start (point))
+	start
 	(coding-system-for-read 'binary)
 	(coding-system-for-write 'binary)
 	(append-file t)
     (if (and (processp process) (eq (process-status process) 'run))
 	t
       (cond ((or (null tempfile) (null (file-exists-p tempfile)))
-	     (vm-mime-insert-mime-body layout)
-	     (setq end (point-marker))
-	     (vm-mime-transfer-decode-region layout start end)
-	     (setq suffix (vm-mime-extract-filename-suffix layout))
-	     (setq tempfile (vm-make-tempfile-name suffix))
-	     (let ((buffer-file-type buffer-file-type)
-		   buffer-file-coding-system)
-	       ;; Tell DOS/Windows NT whether the file is binary
-	       (setq buffer-file-type
-		     (not (vm-mime-text-type-layout-p layout)))
-	       ;; Tell XEmacs/MULE not to mess with the bits unless
-	       ;; this is a text type.
-	       (if vm-xemacs-mule-p
-		   (if (vm-mime-text-type-layout-p layout)
-		       (set-buffer-file-coding-system 'no-conversion nil)
-		     (set-buffer-file-coding-system 'binary t)))
-               ;; Write an empty tempfile out to disk and set its
-               ;; permissions to 0600, then write the actual buffer
-               ;; contents to tempfile.
-               (write-region start start tempfile nil 0)
-               (set-file-modes tempfile 384)
-	       (write-region start end tempfile nil 0))
-	     (delete-region start end)
-	     (save-excursion
-	       (vm-select-folder-buffer)
-	       (setq vm-folder-garbage-alist
-		     (cons (cons tempfile 'delete-file)
-			   vm-folder-garbage-alist)))))
+	     (vm-with-unibyte-buffer
+	      (setq start (point))
+	      (vm-mime-insert-mime-body layout)
+	      (setq end (point-marker))
+	      (vm-mime-transfer-decode-region layout start end)
+	      (setq suffix (vm-mime-extract-filename-suffix layout))
+	      (setq tempfile (vm-make-tempfile-name suffix))
+	      (let ((buffer-file-type buffer-file-type)
+		    (selective-display nil)
+		    buffer-file-coding-system)
+		;; Tell DOS/Windows NT whether the file is binary
+		(setq buffer-file-type
+		      (not (vm-mime-text-type-layout-p layout)))
+		;; Tell XEmacs/MULE not to mess with the bits unless
+		;; this is a text type.
+		(if (or vm-xemacs-mule-p vm-fsfemacs-mule-p)
+		    (if (vm-mime-text-type-layout-p layout)
+			(set-buffer-file-coding-system 'no-conversion nil)
+		      (set-buffer-file-coding-system 'binary t)))
+		;; Write an empty tempfile out to disk and set its
+		;; permissions to 0600, then write the actual buffer
+		;; contents to tempfile.
+		(write-region start start tempfile nil 0)
+		(set-file-modes tempfile 384)
+		(write-region start end tempfile nil 0))
+	      (delete-region start end)
+	      (save-excursion
+		(vm-select-folder-buffer)
+		(setq vm-folder-garbage-alist
+		      (cons (cons tempfile 'delete-file)
+			    vm-folder-garbage-alist))))))
 
       ;; expand % specs
       (let ((p program-list)
 					     (vm-number-of
 					      (car vm-message-pointer)))))
     (setq vm-folder-type vm-default-folder-type)
-    (vm-mime-burst-layout layout nil)
+    (let ((ident-header nil))
+      (if vm-digest-identifier-header-format
+	  (setq ident-header (vm-summary-sprintf
+			      vm-digest-identifier-header-format
+			      (vm-mm-layout-message layout))))
+      (vm-mime-burst-layout layout ident-header))
     (vm-save-buffer-excursion
      (vm-goto-new-folder-frame-maybe 'folder)
      (vm-mode)
   (if (vectorp layout)
       (let ((start (point))
 	    (buffer-read-only nil))
-	(vm-mime-insert-mime-headers (car (vm-mm-layout-parts layout)))
-	(insert ?\n)
+	(vm-with-unibyte-buffer
+	 (vm-mime-insert-mime-headers (car (vm-mm-layout-parts layout)))
+	 (insert ?\n))
 	(save-excursion
 	  (goto-char start)
 	  (vm-reorder-message-headers nil vm-visible-headers
 			 (buffer-name vm-mail-buffer)
 			 (vm-number-of
 			  (car vm-message-pointer)))))
+    (if vm-fsfemacs-mule-p
+	(set-buffer-multibyte nil))
     (setq vm-folder-type vm-default-folder-type)
     (vm-mime-burst-layout layout nil)
     (set-buffer-modified-p nil)
 (fset 'vm-mime-display-internal-message/news
       'vm-mime-display-internal-message/rfc822)
 
+(defun vm-mime-display-internal-message/delivery-status (layout)
+  (vm-mime-display-internal-text/plain layout t))
+
 (defun vm-mime-display-internal-message/partial (layout)
   (if (vectorp layout)
       (let ((buffer-read-only nil))
 			     (concat " and " (car missing))
 			   "")))
       (set-buffer (generate-new-buffer "assembled message"))
+      (if vm-fsfemacs-mule-p
+	  (set-buffer-multibyte nil))
       (setq vm-folder-type vm-default-folder-type)
       (vm-mime-insert-mime-headers (car (cdr (car parts))))
       (goto-char (point-min))
 (defun vm-mime-display-internal-image-xxxx (layout feature name)
   (if (and (vm-images-possible-here-p)
 	   (featurep feature))
-      (let ((start (point)) end tempfile g e
+      (let ((start (point-marker)) end tempfile g e
+	    (selective-display nil)
 	    (buffer-read-only nil))
 	(if (setq g (cdr (assq 'vm-mime-display-internal-image-xxxx
 			       (vm-mm-layout-cache layout))))
 	    nil
-	  (vm-mime-insert-mime-body layout)
-	  (setq end (point-marker))
-	  (vm-mime-transfer-decode-region layout start end)
-	  (setq tempfile (vm-make-tempfile-name))
-	  ;; Write an empty tempfile out to disk and set its
-	  ;; permissions to 0600, then write the actual buffer
-	  ;; contents to tempfile.
-	  (write-region start start tempfile nil 0)
-	  (set-file-modes tempfile 384)
-	  ;; coding system for presentation buffer is binary so
-	  ;; we don't need to set it here.
-	  (write-region start end tempfile nil 0)
-	  (message "Creating %s glyph..." name)
-	  (setq g (make-glyph
-		   (list
-		    (cons (list 'win)
-			  (vector feature ':file tempfile))
-		    (cons (list 'win)
-			  (vector 'string
-				  ':data
-				  (format "[Unknown/Bad %s image encoding]"
-					  name)))
-		    (cons nil
-			  (vector 'string
-				  ':data
-				  (format "[%s image]\n" name))))))
-	  (message "")
-	  (vm-set-mm-layout-cache
-	   layout
-	   (nconc (vm-mm-layout-cache layout)
-		  (list (cons 'vm-mime-display-internal-image-xxxx g))))
-	  (save-excursion
-	    (vm-select-folder-buffer)
-	    (setq vm-folder-garbage-alist
-		  (cons (cons tempfile 'delete-file)
-			vm-folder-garbage-alist)))
-	  (delete-region start end))
+	  (vm-with-unibyte-buffer
+	   (vm-mime-insert-mime-body layout)
+	   (setq end (point-marker))
+	   (vm-mime-transfer-decode-region layout start end)
+	   (setq tempfile (vm-make-tempfile-name))
+	   ;; Write an empty tempfile out to disk and set its
+	   ;; permissions to 0600, then write the actual buffer
+	   ;; contents to tempfile.
+	   (write-region start start tempfile nil 0)
+	   (set-file-modes tempfile 384)
+	   ;; coding system for presentation buffer is binary so
+	   ;; we don't need to set it here.
+	   (write-region start end tempfile nil 0)
+	   (message "Creating %s glyph..." name)
+	   (setq g (make-glyph
+		    (list
+		     (cons (list 'win)
+			   (vector feature ':file tempfile))
+		     (cons (list 'win)
+			   (vector 'string
+				   ':data
+				   (format "[Unknown/Bad %s image encoding]"
+					   name)))
+		     (cons nil
+			   (vector 'string
+				   ':data
+				   (format "[%s image]\n" name))))))
+	   (message "")
+	   (vm-set-mm-layout-cache
+	    layout
+	    (nconc (vm-mm-layout-cache layout)
+		   (list (cons 'vm-mime-display-internal-image-xxxx g))))
+	   (save-excursion
+	     (vm-select-folder-buffer)
+	     (setq vm-folder-garbage-alist
+		   (cons (cons tempfile 'delete-file)
+			 vm-folder-garbage-alist)))
+	   (delete-region start end)))
 	(if (not (bolp))
 	    (insert-char ?\n 2)
 	  (insert-char ?\n 1))
 	       (and (featurep 'native-sound)
 		    (not native-sound-only-on-console)
 		    (eq (device-type) 'x))))
-      (let ((start (point)) end tempfile
+      (let ((start (point-marker)) end tempfile
+	    (selective-display nil)
 	    (buffer-read-only nil))
 	(if (setq tempfile (cdr (assq 'vm-mime-display-internal-audio/basic
 				      (vm-mm-layout-cache layout))))
 	    nil
-	  (vm-mime-insert-mime-body layout)
-	  (setq end (point-marker))
-	  (vm-mime-transfer-decode-region layout start end)
-	  (setq tempfile (vm-make-tempfile-name))
-	  ;; Write an empty tempfile out to disk and set its
-	  ;; permissions to 0600, then write the actual buffer
-	  ;; contents to tempfile.
-	  (write-region start start tempfile nil 0)
-	  (set-file-modes tempfile 384)
-	  ;; coding system for presentation buffer is binary, so
-	  ;; we don't need to set it here.
-	  (write-region start end tempfile nil 0)
-	  (vm-set-mm-layout-cache
-	   layout
-	   (nconc (vm-mm-layout-cache layout)
-		  (list (cons 'vm-mime-display-internal-audio/basic
-			      tempfile))))
-	  (save-excursion
-	    (vm-select-folder-buffer)
-	    (setq vm-folder-garbage-alist
-		  (cons (cons tempfile 'delete-file)
-			vm-folder-garbage-alist)))
-	  (delete-region start end))
+	  (vm-with-unibyte-buffer
+	   (vm-mime-insert-mime-body layout)
+	   (setq end (point-marker))
+	   (vm-mime-transfer-decode-region layout start end)
+	   (setq tempfile (vm-make-tempfile-name))
+	   ;; Write an empty tempfile out to disk and set its
+	   ;; permissions to 0600, then write the actual buffer
+	   ;; contents to tempfile.
+	   (write-region start start tempfile nil 0)
+	   (set-file-modes tempfile 384)
+	   ;; coding system for presentation buffer is binary, so
+	   ;; we don't need to set it here.
+	   (write-region start end tempfile nil 0)
+	   (vm-set-mm-layout-cache
+	    layout
+	    (nconc (vm-mm-layout-cache layout)
+		   (list (cons 'vm-mime-display-internal-audio/basic
+			       tempfile))))
+	   (save-excursion
+	     (vm-select-folder-buffer)
+	     (setq vm-folder-garbage-alist
+		   (cons (cons tempfile 'delete-file)
+			 vm-folder-garbage-alist)))
+	   (delete-region start end)))
 	(start-itimer "audioplayer"
 		      (list 'lambda nil (list 'play-sound-file tempfile))
 		      1)
       (unwind-protect
 	  (let ((coding-system-for-read 'binary)
 		(coding-system-for-write 'binary))
-	    (setq work-buffer (generate-new-buffer " *vm-work*"))
+	    (let ((default-enable-multibyte-characters nil))
+	      (setq work-buffer (generate-new-buffer " *vm-work*")))
 	    (buffer-disable-undo work-buffer)
 	    (set-buffer work-buffer)
+	    (setq selective-display nil)
 	    ;; Tell DOS/Windows NT whether the file is binary
 	    (setq buffer-file-type (not (vm-mime-text-type-layout-p layout)))
 	    ;; Tell XEmacs/MULE not to mess with the bits unless
 	    ;; this is a text type.
-	    (if vm-xemacs-mule-p
+	    (if (or vm-xemacs-mule-p vm-fsfemacs-mule-p)
 		(if (vm-mime-text-type-layout-p layout)
 		    (set-buffer-file-coding-system 'no-conversion nil)
 		  (set-buffer-file-coding-system 'binary t)))
-	    (vm-mime-insert-mime-body layout)
-	    (vm-mime-transfer-decode-region layout (point-min) (point-max))
+	    (vm-with-unibyte-buffer
+	     (vm-mime-insert-mime-body layout)
+	     (vm-mime-transfer-decode-region layout (point-min) (point-max)))
 	    (or (not (file-exists-p file))
 		(y-or-n-p "File exists, overwrite? ")
 		(error "Aborted"))
 	    (erase-buffer)))
       (unwind-protect
 	  (progn
-	    (setq work-buffer (generate-new-buffer " *vm-work*"))
+	    (let ((default-enable-multibyte-characters nil))
+	      (setq work-buffer (generate-new-buffer " *vm-work*")))
+	    ;; call-process-region calls write-region.
+	    ;; don't let it do CR -> LF translation.
+	    (setq selective-display nil)
 	    (buffer-disable-undo work-buffer)
 	    (set-buffer work-buffer)
+	    (if vm-fsfemacs-mule-p
+		(set-buffer-multibyte nil))
 	    (vm-mime-insert-mime-body layout)
 	    (vm-mime-transfer-decode-region layout (point-min) (point-max))
 	    (let ((pop-up-windows (and pop-up-windows
 				       (eq vm-mutable-windows t)))
+		  (process-coding-system-alist
+		   (if (vm-mime-text-type-layout-p layout)
+		       nil
+		     '(("." . binary))))
 		  ;; Tell DOS/Windows NT whether the input is binary
 		  (binary-process-input
-		   (not (vm-mime-text-type-layout-p layout))))
+		   (not
+		    (vm-mime-text-type-layout-p layout))))
 	      (call-process-region (point-min) (point-max)
 				   (or shell-file-name "sh")
 				   nil output-buffer nil
 (defun vm-mime-charset-internally-displayable-p (name)
   (cond ((and vm-xemacs-mule-p (memq (device-type) '(x mswindows)))
 	 (vm-string-assoc name vm-mime-mule-charset-to-coding-alist))
-	((and vm-fsfemacs-mule-p (eq window-system 'x))
+	((and vm-fsfemacs-mule-p (memq window-system '(x win32)))
 	 (vm-string-assoc name vm-mime-mule-charset-to-coding-alist))
 	((vm-multiple-fonts-possible-p)
 	 (or (vm-string-member name vm-mime-default-face-charsets)
 (defun vm-mime-attach-file (file type &optional charset description)
   "Attach a file to a VM composition buffer to be sent along with the message.
 The file is not inserted into the buffer and MIME encoded until
-you execute vm-mail-send or vm-mail-send-and-exit.  A visible tag
+you execute `vm-mail-send' or `vm-mail-send-and-exit'.  A visible tag
 indicating the existence of the attachment is placed in the
 composition buffer.  You can move the attachment around or remove
 it entirely with normal text editing commands.  If you remove the
 third argument CHARSET is the character set of the attached
 document.  This argument is only used for text types, and it is
 ignored for other types.  Optional fourth argument DESCRIPTION
-should be a one line description of the file.
+should be a one line description of the file.  Nil means include
+no description.
 
 When called interactively all arguments are read from the
 minibuffer.
 
 This command is for attaching files that have a MIME
 header section at the top.  For files without MIME headers, you
-should use vm-mime-attach-file to attach such a file."
+should use vm-mime-attach-file to attach the file."
   (interactive
    ;; protect value of last-command and this-command
    (let ((last-command last-command)
       (error "You don't have permission to read %s" file))
   (vm-mime-attach-object file type nil nil t))
 
+(defun vm-mime-attach-buffer (buffer type &optional charset description)
+  "Attach a buffer to a VM composition buffer to be sent along with
+the message.
+
+The buffer contents are not inserted into the composition
+buffer and MIME encoded until you execute `vm-mail-send' or
+`vm-mail-send-and-exit'.  A visible tag indicating the existence
+of the attachment is placed in the composition buffer.  You
+can move the attachment around or remove it entirely with
+normal text editing commands.  If you remove the attachment
+tag, the attachment will not be sent.
+
+First argument, BUFFER, is the buffer or name of the buffer to
+attach.  Second argument, TYPE, is the MIME Content-Type of the
+file.  Optional third argument CHARSET is the character set of
+the attached document.  This argument is only used for text
+types, and it is ignored for other types.  Optional fourth
+argument DESCRIPTION should be a one line description of the
+file.  Nil means include no description.
+
+When called interactively all arguments are read from the
+minibuffer.
+
+This command is for attaching files that do not have a MIME
+header section at the top.  For files with MIME headers, you
+should use vm-mime-attach-mime-file to attach such a file.  VM
+will extract the content type information from the headers in
+this case and not prompt you for it in the minibuffer."
+  (interactive
+   ;; protect value of last-command and this-command
+   (let ((last-command last-command)
+	 (this-command this-command)
+	 (charset nil)
+	 description file default-type type buffer buffer-name)
+     (if (null vm-send-using-mime)
+	 (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable."))
+     (setq buffer-name (read-buffer "Attach buffer: " nil t)
+	   default-type (or (vm-mime-default-type-from-filename buffer-name)
+			    "application/octet-stream")
+	   type (completing-read
+		 (format "Content type (default %s): "
+			 default-type)
+		 vm-mime-type-completion-alist)
+	   type (if (> (length type) 0) type default-type))
+     (if (vm-mime-types-match "text" type)
+	 (setq charset (completing-read "Character set (default US-ASCII): "
+					vm-mime-charset-completion-alist)
+	       charset (if (> (length charset) 0) charset)))
+     (setq description (read-string "One line description: "))
+     (if (string-match "^[ \t]*$" description)
+	 (setq description nil))
+     (list buffer-name type charset description)))
+  (if (null (setq buffer (get-buffer buffer)))
+      (error "Buffer %s does not exist." buffer))
+  (if (null vm-send-using-mime)
+      (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable."))
+  (and charset (setq charset (list (concat "charset=" charset))))
+  (and description (setq description (vm-mime-scrub-description description)))
+  (vm-mime-attach-object buffer type charset description nil))
+
+(defun vm-mime-attach-message (message &optional description)
+  "Attach a message from a folder to a VM composition buffer
+to be sent along with the message.
+
+The message is not inserted into the buffer and MIME encoded until
+you execute `vm-mail-send' or `vm-mail-send-and-exit'.  A visible tag
+indicating the existence of the attachment is placed in the
+composition buffer.  You can move the attachment around or remove
+it entirely with normal text editing commands.  If you remove the
+attachment tag, the attachment will not be sent.
+
+First argument, MESSAGE, is a VM message struct.  When called
+interactively a message number read.  The message will come from
+the parent folder of this composition.  If the composition has no
+parent, the name of a folder will be read from the minibuffer
+before the message number is read.
+
+If this command is invoked with a prefix argument, the name of a
+folder is read and that folder is used instead of the parent
+folder of the composition.
+
+Optional second argument DESCRIPTION is a one-line description of
+the message being attached.  This is also read from the
+minibuffer if the command is run interactively."
+  (interactive
+   ;; protect value of last-command and this-command
+   (let ((last-command last-command)
+	 (this-command this-command)
+	 (result 0)
+	 mp default prompt description folder)
+     (if (null vm-send-using-mime)
+	 (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable."))
+     (cond ((or current-prefix-arg (null vm-mail-buffer)
+		(not (buffer-live-p vm-mail-buffer)))
+	    (let ((dir (if vm-folder-directory
+			   (expand-file-name vm-folder-directory)
+			 default-directory))
+		  file
+		  (last-command last-command)
+		  (this-command this-command))
+	      (setq file (read-file-name "Yank from folder: " dir nil t))
+	      (save-excursion
+		(set-buffer
+		 (let ((coding-system-for-read 'binary))
+		   (find-file-noselect file)))
+		(setq folder (current-buffer))
+		(vm-mode))))
+	   (t
+	    (setq folder vm-mail-buffer)))
+     (save-excursion
+       (set-buffer folder)
+       (setq default (and vm-message-pointer
+			  (vm-number-of (car vm-message-pointer)))
+	     prompt (if default
+			(format "Yank message number: (default %s) "
+				default)
+		      "Yank message number: "))
+       (while (zerop result)
+	 (setq result (read-string prompt))
+	 (and (string= result "") default (setq result default))
+	 (setq result (string-to-int result)))
+       (if (null (setq mp (nthcdr (1- result) vm-message-list)))
+	   (error "No such message.")))
+     (setq description (read-string "Description: "))
+     (if (string-match "^[ \t]*$" description)
+	 (setq description nil))
+     (list (car mp) description)))
+  (if (null vm-send-using-mime)
+      (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable."))
+  (let* ((buf (generate-new-buffer "*attached message*"))
+	 (m (vm-real-message-of message))
+	 (folder (vm-buffer-of m)))
+    (save-excursion
+      (set-buffer buf)
+      (if vm-fsfemacs-mule-p
+	  (set-buffer-multibyte nil))
+      (vm-insert-region-from-buffer folder (vm-headers-of m)
+				    (vm-text-end-of m))
+      (goto-char (point-min))
+      (vm-reorder-message-headers nil nil "\\(X-VM-\\|Status:\\)"))
+    (and description (setq description
+			   (vm-mime-scrub-description description)))
+    (vm-mime-attach-object buf "message/rfc822" nil description nil)
+    (add-hook 'kill-buffer-hook
+	      (list 'lambda ()
+		    (list 'if (list 'eq (current-buffer) '(current-buffer))
+			  (list 'kill-buffer buf))))))
+
 (defun vm-mime-attach-object (object type params description mimed)
   (if (not (eq major-mode 'mail-mode))
       (error "Command must be used in a VM Mail mode buffer."))
+  (if (vm-mail-mode-get-header-contents "MIME-Version")
+      (error "Can't attach MIME object to already encoded MIME buffer."))
   (let (start end e tag-string disposition)
     (if (< (point) (save-excursion (mail-text) (point)))
 	(mail-text))
 	   (put-text-property start end 'vm-mime-parameters params)
 	   (put-text-property start end 'vm-mime-description description)
 	   (put-text-property start end 'vm-mime-disposition disposition)
-	   (put-text-property start end 'vm-mime-encoded mimed)
-	   (put-text-property start end 'vm-mime-object object))
+	   (put-text-property start end 'vm-mime-encoded mimed))
 	  (vm-xemacs-p
 	   (setq e (make-extent start end))
 	   (vm-mime-set-extent-glyph-for-type e (or type "text/plain"))
 Attachment tags added to the buffer with vm-mime-attach-file are expanded
 and the approriate content-type and boundary markup information is added."
   (interactive)
-  (cond (vm-xemacs-mule-p
-	 (vm-mime-xemacs-encode-composition))
-	(vm-xemacs-p
+  (cond (vm-xemacs-p
 	 (vm-mime-xemacs-encode-composition))
 	(vm-fsfemacs-p
 	 (vm-mime-fsfemacs-encode-composition))
 		((vm-mime-composite-type-p type)
 		 (setq opoint-min (point-min))
 		 (if (not already-mimed)
-		     (setq layout (vm-mime-parse-entity
-				   nil (list "text/plain" "charset=us-ascii")
-				   "7bit")))
+		     (progn
+		       (goto-char (point-min))
+		       (insert "Content-Type: " type "\n")
+		       ;; vm-mime-trasnfer-encode-layout will replace
+		       ;; this if the transfer encoding changes.
+		       (insert "Content-Transfer-Encoding: 7bit\n\n")
+		       (setq already-mimed t)))
+		 (setq layout (vm-mime-parse-entity
+			       nil (list "text/plain" "charset=us-ascii")
+			       "7bit"))
 		 (setq encoding (vm-mime-transfer-encode-layout layout))
 		 (setq 8bit (or 8bit (equal encoding "8bit")))
 		 (goto-char (point-max))
 		      (insert "; " (mapconcat 'identity (cdr disposition) "; ")
 			      "\n")
 		    (insert ";\n\t" (mapconcat 'identity (cdr disposition)
-					       ";\n\t")))
+					       ";\n\t") "\n"))
 		(insert "\n"))))
 	(if just-one
 	    (insert "Content-Transfer-Encoding: " encoding "\n")
 	(error "Command must be used in a VM Mail mode buffer."))
     (or (null (vm-mail-mode-get-header-contents "MIME-Version:"))
 	(error "Message is already MIME encoded."))
-    (let ((8bit nil)
-	  (just-one nil)
-	  (boundary-positions nil)
-	  (enriched (and (boundp 'enriched-mode) enriched-mode))
-	  already-mimed layout o o-list boundary
-	  type encoding charset params description disposition object
-	  opoint-min)
-      (mail-text)
-      (setq o-list (vm-mime-fake-attachment-overlays (point) (point-max))
-	    o-list (vm-delete (function
-			       (lambda (o)
-				 (overlay-get o 'vm-mime-object)))
-			      o-list t)
-	    o-list (sort o-list (function
-				 (lambda (e1 e2)
-				   (< (overlay-end e1)
-				      (overlay-end e2))))))
-      ;; If there's just one attachment and no other readable
-      ;; text in the buffer then make the message type just be
-      ;; the attachment type rather than sending a multipart
-      ;; message with one attachment
-      (setq just-one (and (= (length o-list) 1)
-			  (looking-at "[ \t\n]*")
-			  (= (match-end 0)
-			     (overlay-start (car o-list)))
-			  (save-excursion
-			    (goto-char (overlay-end (car o-list)))
-			    (looking-at "[ \t\n]*\\'"))))
-      (if (null o-list)
-	  (progn
-	    (narrow-to-region (point) (point-max))
-	    ;; support enriched-mode for text/enriched composition
-	    (if enriched
-		(let ((enriched-initial-annotation ""))
-		  (enriched-encode (point-min) (point-max))))
-	    (setq charset (vm-determine-proper-charset (point-min)
-						       (point-max)))
-	    (if vm-fsfemacs-mule-p
-		(encode-coding-region (point-min) (point-max)
-				      buffer-file-coding-system))
-	    (setq encoding (vm-determine-proper-content-transfer-encoding
-			    (point-min)
-			    (point-max))
-		  encoding (vm-mime-transfer-encode-region encoding
-							   (point-min)
-							   (point-max)
-							   t))
-	    (widen)
-	    (vm-remove-mail-mode-header-separator)
-	    (goto-char (point-min))
-	    (vm-reorder-message-headers
-	     nil nil "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)")
-	    (insert "MIME-Version: 1.0\n")
-	    (if enriched
-		(insert "Content-Type: text/enriched; charset=" charset "\n")
-	      (insert "Content-Type: text/plain; charset=" charset "\n"))
-	    (insert "Content-Transfer-Encoding: " encoding "\n")
-	    (vm-add-mail-mode-header-separator))
-	(while o-list
-	  (setq o (car o-list))
-	  (if (or just-one
-		  (save-excursion
-		    (eq (overlay-start o)
-			(re-search-forward "[ \t\n]*" (overlay-start o) t))))
-	      (delete-region (point) (overlay-start o))
-	    (narrow-to-region (point) (overlay-start o))
-	    ;; support enriched-mode for text/enriched composition
-	    (if enriched
-		(let ((enriched-initial-annotation ""))
-		  (save-excursion
-		    ;; insert/delete trick needed to avoid
-		    ;; enriched-mode tags from seeping into the
-		    ;; attachment overlays.  I really wish
-		    ;; front-advance / rear-advance overlay
-		    ;; endpoint properties actually worked.
-		    (goto-char (point-max))
-		    (insert-before-markers "\n")
-		    (enriched-encode (point-min) (1- (point)))
-		    (goto-char (point-max))
-		    (delete-char -1))))
-	    (setq charset (vm-determine-proper-charset (point-min)
-						       (point-max)))
-	    (if vm-fsfemacs-mule-p
-		(encode-coding-region (point-min) (point-max)
-				      buffer-file-coding-system))
-	    (setq encoding (vm-determine-proper-content-transfer-encoding
-			    (point-min)
-			    (point-max))
-		  encoding (vm-mime-transfer-encode-region encoding
-							   (point-min)
-							   (point-max)
-							   t)
-		  description (vm-mime-text-description (point-min)
+    (vm-with-unibyte-buffer
+     (let ((8bit nil)
+	   (just-one nil)
+	   (boundary-positions nil)
+	   (enriched (and (boundp 'enriched-mode) enriched-mode))
+	   already-mimed layout o o-list boundary
+	   type encoding charset params description disposition object
+	   opoint-min)
+       (mail-text)
+       (setq o-list (vm-mime-fake-attachment-overlays (point) (point-max))
+	     o-list (vm-delete (function
+				(lambda (o)
+				  (overlay-get o 'vm-mime-object)))
+			       o-list t)
+	     o-list (sort o-list (function
+				  (lambda (e1 e2)
+				    (< (overlay-end e1)
+				       (overlay-end e2))))))
+       ;; If there's just one attachment and no other readable
+       ;; text in the buffer then make the message type just be
+       ;; the attachment type rather than sending a multipart
+       ;; message with one attachment
+       (setq just-one (and (= (length o-list) 1)
+			   (looking-at "[ \t\n]*")
+			   (= (match-end 0)
+			      (overlay-start (car o-list)))
+			   (save-excursion
+			     (goto-char (overlay-end (car o-list)))
+			     (looking-at "[ \t\n]*\\'"))))
+       (if (null o-list)
+	   (progn
+	     (narrow-to-region (point) (point-max))
+	     ;; support enriched-mode for text/enriched composition
+	     (if enriched
+		 (let ((enriched-initial-annotation ""))
+		   (enriched-encode (point-min) (point-max))))
+	     (setq charset (vm-determine-proper-charset (point-min)
 							(point-max)))
-	    (setq boundary-positions (cons (point-marker) boundary-positions))
-	    (if enriched
-		(insert "Content-Type: text/enriched; charset=" charset "\n")
-	      (insert "Content-Type: text/plain; charset=" charset "\n"))
-	    (if description
-		(insert "Content-Description: " description "\n"))
-	    (insert "Content-Transfer-Encoding: " encoding "\n\n")
-	    (widen))
-	  (goto-char (overlay-start o))
-	  (narrow-to-region (point) (point))
-	  (setq object (overlay-get o 'vm-mime-object))
-	  ;; insert the object
-	  (cond ((bufferp object)
-		 ;; as of FSF Emacs 19.34, even with the hooks
-		 ;; we've attached to the attachment overlays,
-		 ;; text STILL can be inserted into them when
-		 ;; font-lock is enabled.  Explaining why is
-		 ;; beyond the scope of this comment and I
-		 ;; don't know the answer anyway.  This works
-		 ;; to prevent it.
-		 (insert-before-markers " ")
-		 (forward-char -1)
-		 (insert-buffer-substring object)
-		 (delete-char 1))
-		((stringp object)
-		 (insert-before-markers " ")
-		 (forward-char -1)
-		 (let ((coding-system-for-read
-			(if (vm-mime-text-type-p
-			     (overlay-get o 'vm-mime-type))
-			    'no-conversion
-			  'binary))
-		       ;; don't let buffer-file-coding-system be
-		       ;; changed by insert-file-contents.  The
-		       ;; value we bind to it to here isn't
-		       ;; important.
-		       (buffer-file-coding-system 'binary))
-		   (insert-file-contents object))
-		 (goto-char (point-max))
-		 (delete-char -1)))
-	  ;; gather information about the object from the extent.
-	  (if (setq already-mimed (overlay-get o 'vm-mime-encoded))
-	      (setq layout (vm-mime-parse-entity
-			    nil (list "text/plain" "charset=us-ascii")
-			    "7bit")
-		    type (or (overlay-get o 'vm-mime-type)
-			     (car (vm-mm-layout-type layout)))
-		    params (or (overlay-get o 'vm-mime-parameters)
-			       (cdr (vm-mm-layout-qtype layout)))
-		    description (overlay-get o 'vm-mime-description)
-		    disposition
-		      (if (not
-			   (equal
-			    (car (overlay-get o 'vm-mime-disposition))
-			    "unspecified"))
-			  (overlay-get o 'vm-mime-disposition)
-			(vm-mm-layout-qdisposition layout)))
-	    (setq type (overlay-get o 'vm-mime-type)
-		  params (overlay-get o 'vm-mime-parameters)
-		  description (overlay-get o 'vm-mime-description)
-		  disposition
-		    (if (not (equal
-			      (car (overlay-get o 'vm-mime-disposition))
-			      "unspecified"))
-			(overlay-get o 'vm-mime-disposition)
-		      nil)))
-	  (cond ((vm-mime-types-match "text" type)
-		 (setq encoding
-		       (vm-determine-proper-content-transfer-encoding
-			(if already-mimed
-			    (vm-mm-layout-body-start layout)
-			  (point-min))
-			(point-max))
-		       encoding (vm-mime-transfer-encode-region
-				 encoding
-				 (if already-mimed
-				     (vm-mm-layout-body-start layout)
-				   (point-min))
-				 (point-max)
-				 t))
-		 (setq 8bit (or 8bit (equal encoding "8bit"))))
-		((vm-mime-composite-type-p type)
-		 (setq opoint-min (point-min))
-		 (if (not already-mimed)
-		     (setq layout (vm-mime-parse-entity
-				   nil (list "text/plain" "charset=us-ascii")
-				   "7bit")))
-		 (setq encoding (vm-mime-transfer-encode-layout layout))
-		 (setq 8bit (or 8bit (equal encoding "8bit")))
-		 (goto-char (point-max))
-		 (widen)
-		 (narrow-to-region opoint-min (point)))
-		(t
-		 (vm-mime-base64-encode-region
-		  (if already-mimed
-		      (vm-mm-layout-body-start layout)
-		    (point-min))
-		  (point-max))
-		 (setq encoding "base64")))
-	  (if just-one
-	      nil
-	    (goto-char (point-min))
-	    (setq boundary-positions (cons (point-marker) boundary-positions))
-	    (if (not already-mimed)
-		nil
-	      ;; trim headers
-	      (vm-reorder-message-headers nil '("Content-ID:") nil)
-	      ;; remove header/text separator
-	      (goto-char (1- (vm-mm-layout-body-start layout)))
-	      (if (looking-at "\n")
-		  (delete-char 1)))
-	    (insert "Content-Type: " type)
-	    (if params
-		(if vm-mime-avoid-folding-content-type
-		    (insert "; " (mapconcat 'identity params "; ") "\n")
-		  (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n"))
-	      (insert "\n"))
-	    (and description
+	     (if vm-fsfemacs-mule-p
+		 (let ((coding-system
+			(car (cdr (vm-string-assoc
+				   charset
+				   vm-mime-mule-charset-to-coding-alist)))))
+		   (if (null coding-system)
+		       (error "Can't find a coding system for charset %s"
+			      charset)
+		     (encode-coding-region (point-min) (point-max)
+					   coding-system))))
+	     (setq encoding (vm-determine-proper-content-transfer-encoding
+			     (point-min)
+			     (point-max))
+		   encoding (vm-mime-transfer-encode-region encoding
+							    (point-min)
+							    (point-max)
+							    t))
+	     (widen)
+	     (vm-remove-mail-mode-header-separator)
+	     (goto-char (point-min))
+	     (vm-reorder-message-headers
+	      nil nil "\\(Content-Type:\\|Content-Transfer-Encoding\\|MIME-Version:\\)")
+	     (insert "MIME-Version: 1.0\n")
+	     (if enriched
+		 (insert "Content-Type: text/enriched; charset=" charset "\n")
+	       (insert "Content-Type: text/plain; charset=" charset "\n"))
+	     (insert "Content-Transfer-Encoding: " encoding "\n")
+	     (vm-add-mail-mode-header-separator))
+	 (while o-list
+	   (setq o (car o-list))
+	   (if (or just-one
+		   (save-excursion
+		     (eq (overlay-start o)
+			 (re-search-forward "[ \t\n]*" (overlay-start o) t))))
+	       (delete-region (point) (overlay-start o))
+	     (narrow-to-region (point) (overlay-start o))
+	     ;; support enriched-mode for text/enriched composition
+	     (if enriched
+		 (let ((enriched-initial-annotation ""))
+		   (save-excursion
+		     ;; insert/delete trick needed to avoid
+		     ;; enriched-mode tags from seeping into the
+		     ;; attachment overlays.  I really wish
+		     ;; front-advance / rear-advance overlay
+		     ;; endpoint properties actually worked.
+		     (goto-char (point-max))
+		     (insert-before-markers "\n")
+		     (enriched-encode (point-min) (1- (point)))
+		     (goto-char (point-max))
+		     (delete-char -1))))
+	     (setq charset (vm-determine-proper-charset (point-min)
+							(point-max)))
+	     (if vm-fsfemacs-mule-p
+		 (let ((coding-system
+			(car (cdr (vm-string-assoc
+				   charset
+				   vm-mime-mule-charset-to-coding-alist)))))
+		   (if (null coding-system)
+		       (error "Can't find a coding system for charset %s"
+			      charset)
+		     (encode-coding-region (point-min) (point-max)
+					   coding-system))))
+	     (setq encoding (vm-determine-proper-content-transfer-encoding
+			     (point-min)
+			     (point-max))
+		   encoding (vm-mime-transfer-encode-region encoding
+							    (point-min)
+							    (point-max)
+							    t)
+		   description (vm-mime-text-description (point-min)
+							 (point-max)))
+	     (setq boundary-positions (cons (point-marker) boundary-positions))
+	     (if enriched
+		 (insert "Content-Type: text/enriched; charset=" charset "\n")
+	       (insert "Content-Type: text/plain; charset=" charset "\n"))
+	     (if description
 		 (insert "Content-Description: " description "\n"))
-	    (if disposition
-		(progn
-		  (insert "Content-Disposition: " (car disposition))
-		  (if (cdr disposition)
-		      (insert ";\n\t" (mapconcat 'identity
-						 (cdr disposition)
-						 ";\n\t")))
-		  (insert "\n")))
-	    (insert "Content-Transfer-Encoding: " encoding "\n\n"))
-	  (goto-char (point-max))
-	  (widen)
-	  (save-excursion
-	    (goto-char (overlay-start o))
-	    (vm-assert (looking-at "\\[ATTACHMENT")))
-	  (delete-region (overlay-start o)
-			 (overlay-end o))
-	  (delete-overlay o)
-	  (if (looking-at "\n")
-	      (delete-char 1))
-	  (setq o-list (cdr o-list)))
-	;; handle the remaining chunk of text after the last
-	;; extent, if any.
-	(if (or just-one (looking-at "[ \t\n]*\\'"))
-	    (delete-region (point) (point-max))
-	  ;; support enriched-mode for text/enriched composition
-	  (if enriched
-	      (let ((enriched-initial-annotation ""))
-		(enriched-encode (point) (point-max))))
-	  (setq charset (vm-determine-proper-charset (point)
-						     (point-max)))
-	  (if vm-fsfemacs-mule-p
-	      (encode-coding-region (point) (point-max)
-				    buffer-file-coding-system))
-	  (setq encoding (vm-determine-proper-content-transfer-encoding
-			  (point)
-			  (point-max))
-		encoding (vm-mime-transfer-encode-region encoding
-							 (point)
-							 (point-max)
-							 t)
-		description (vm-mime-text-description (point) (point-max)))
-	  (setq 8bit (or 8bit (equal encoding "8bit")))
-	  (setq boundary-positions (cons (point-marker) boundary-positions))
-	  (if enriched
-	      (insert "Content-Type: text/enriched; charset=" charset "\n")
-	    (insert "Content-Type: text/plain; charset=" charset "\n"))
-	  (if description
-	      (insert "Content-Description: " description "\n"))
-	  (insert "Content-Transfer-Encoding: " encoding "\n\n")
-	  (goto-char (point-max)))
-	(setq boundary (vm-mime-make-multipart-boundary))
-	(mail-text)
-	(while (re-search-forward (concat "^--"
-					  (regexp-quote boundary)
-					  "\\(--\\)?$")
-				  nil t)
-	  (setq boundary (vm-mime-make-multipart-boundary))
-	  (mail-text))
-	(goto-char (point-max))
-	(or just-one (insert "\n--" boundary "--\n"))
-	(while boundary-positions
-	  (goto-char (car boundary-positions))
-	  (insert "\n--" boundary "\n")
-	  (setq boundary-positions (cdr boundary-positions)))
-	(if (and just-one already-mimed)
-	    (progn
-	      (goto-char (vm-mm-layout-header-start layout))
-	      ;; trim headers
-	      (vm-reorder-message-headers nil '("Content-ID:") nil)
-	      ;; remove header/text separator
-	      (goto-char (1- (vm-mm-layout-body-start layout)))
-	      (if (looking-at "\n")
+	     (insert "Content-Transfer-Encoding: " encoding "\n\n")
+	     (widen))
+	   (goto-char (overlay-start o))
+	   (narrow-to-region (point) (point))
+	   (setq object (overlay-get o 'vm-mime-object))
+	   ;; insert the object
+	   (cond ((bufferp object)
+		  ;; as of FSF Emacs 19.34, even with the hooks
+		  ;; we've attached to the attachment overlays,
+		  ;; text STILL can be inserted into them when
+		  ;; font-lock is enabled.  Explaining why is
+		  ;; beyond the scope of this comment and I
+		  ;; don't know the answer anyway.  This works
+		  ;; to prevent it.
+		  (insert-before-markers " ")
+		  (forward-char -1)
+		  (insert-buffer-substring object)
 		  (delete-char 1))
-	      ;; copy remainder to enclosing entity's header section
-	      (goto-char (point-max))
-	      (insert-buffer-substring (current-buffer)
-				       (vm-mm-layout-header-start layout)
-				       (vm-mm-layout-body-start layout))
-	      (delete-region (vm-mm-layout-header-start layout)
-			     (vm-mm-layout-body-start layout))))
-	(goto-char (point-min))
-	(vm-remove-mail-mode-header-separator)
-	(vm-reorder-message-headers
-	 nil nil "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)")
-	(vm-add-mail-mode-header-separator)
-	(insert "MIME-Version: 1.0\n")
-	(if (not just-one)
-	    (insert (if vm-mime-avoid-folding-content-type
-			"Content-Type: multipart/mixed; boundary=\""
-		      "Content-Type: multipart/mixed;\n\tboundary=\"")
-		    boundary "\"\n")
-	  (insert "Content-Type: " type)
-	  (if params
-	      (if vm-mime-avoid-folding-content-type
-		  (insert "; " (mapconcat 'identity params "; ") "\n")
-		(insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n"))
-	    (insert "\n")))
-	(if (and just-one description)
-	    (insert "Content-Description: " description "\n"))
-	(if (and just-one disposition)
-	    (progn
-	      (insert "Content-Disposition: " (car disposition))
-	      (if (cdr disposition)
-		  (if vm-mime-avoid-folding-content-type
-		      (insert "; " (mapconcat 'identity (cdr disposition) "; ")
-			      "\n")
-		    (insert ";\n\t" (mapconcat 'identity (cdr disposition)
-					       ";\n\t")))
-		(insert "\n"))))
-	(if just-one
-	    (insert "Content-Transfer-Encoding: " encoding "\n")
-	  (if 8bit
-	      (insert "Content-Transfer-Encoding: 8bit\n")
-	    (insert "Content-Transfer-Encoding: 7bit\n")))))))
+		 ((stringp object)
+		  (insert-before-markers " ")
+		  (forward-char -1)
+		  (let ((coding-system-for-read
+			 (if (vm-mime-text-type-p
+			      (overlay-get o 'vm-mime-type))
+			     'no-conversion
+			   'binary))
+			;; don't let buffer-file-coding-system be
+			;; changed by insert-file-contents.  The
+			;; value we bind to it to here isn't
+			;; important.
+			(buffer-file-coding-system 'binary)
+			;; For NTEmacs 19: need to do this to make
+			;; sure CRs aren't eaten.
+			(file-name-buffer-file-type-alist '(("." . t))))
+		    (insert-file-contents object))
+		  (goto-char (point-max))
+		  (delete-char -1)))
+	   ;; gather information about the object from the extent.
+	   (if (setq already-mimed (overlay-get o 'vm-mime-encoded))
+	       (setq layout (vm-mime-parse-entity
+			     nil (list "text/plain" "charset=us-ascii")
+			     "7bit")
+		     type (or (overlay-get o 'vm-mime-type)
+			      (car (vm-mm-layout-type layout)))
+		     params (or (overlay-get o 'vm-mime-parameters)
+				(cdr (vm-mm-layout-qtype layout)))
+		     description (overlay-get o 'vm-mime-description)
+		     disposition
+		     (if (not
+			  (equal
+			   (car (overlay-get o 'vm-mime-disposition))
+			   "unspecified"))
+			 (overlay-get o 'vm-mime-disposition)
+		       (vm-mm-layout-qdisposition layout)))
+	     (setq type (overlay-get o 'vm-mime-type)
+		   params (overlay-get o 'vm-mime-parameters)
+		   description (overlay-get o 'vm-mime-description)
+		   disposition
+		   (if (not (equal
+			     (car (overlay-get o 'vm-mime-disposition))
+			     "unspecified"))
+		       (overlay-get o 'vm-mime-disposition)
+		     nil)))
+	   (cond ((vm-mime-types-match "text" type)
+		  (setq encoding
+			(vm-determine-proper-content-transfer-encoding
+			 (if already-mimed
+			     (vm-mm-layout-body-start layout)
+			   (point-min))
+			 (point-max))
+			encoding (vm-mime-transfer-encode-region
+				  encoding
+				  (if already-mimed
+				      (vm-mm-layout-body-start layout)
+				    (point-min))
+				  (point-max)
+				  t))
+		  (setq 8bit (or 8bit (equal encoding "8bit"))))
+		 ((vm-mime-composite-type-p type)
+		  (setq opoint-min (point-min))
+		  (if (not already-mimed)
+		      (progn
+			(goto-char (point-min))
+			(insert "Content-Type: " type "\n")
+			;; vm-mime-trasnfer-encode-layout will replace
+			;; this if the transfer encoding changes.
+			(insert "Content-Transfer-Encoding: 7bit\n\n")
+			(setq already-mimed t)))
+		  (setq layout (vm-mime-parse-entity
+				nil (list "text/plain" "charset=us-ascii")
+				"7bit"))
+		  (setq encoding (vm-mime-transfer-encode-layout layout))
+		  (setq 8bit (or 8bit (equal encoding "8bit")))
+		  (goto-char (point-max))
+		  (widen)
+		  (narrow-to-region opoint-min (point)))
+		 (t
+		  (vm-mime-base64-encode-region
+		   (if already-mimed
+		       (vm-mm-layout-body-start layout)
+		     (point-min))
+		   (point-max))
+		  (setq encoding "base64")))
+	   (if just-one
+	       nil
+	     (goto-char (point-min))
+	     (setq boundary-positions (cons (point-marker) boundary-positions))
+	     (if (not already-mimed)
+		 nil
+	       ;; trim headers
+	       (vm-reorder-message-headers nil '("Content-ID:") nil)
+	       ;; remove header/text separator
+	       (goto-char (1- (vm-mm-layout-body-start layout)))
+	       (if (looking-at "\n")
+		   (delete-char 1)))
+	     (insert "Content-Type: " type)
+	     (if params
+		 (if vm-mime-avoid-folding-content-type
+		     (insert "; " (mapconcat 'identity params "; ") "\n")
+		   (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n"))
+	       (insert "\n"))
+	     (and description
+		  (insert "Content-Description: " description "\n"))
+	     (if disposition
+		 (progn
+		   (insert "Content-Disposition: " (car disposition))
+		   (if (cdr disposition)
+		       (insert ";\n\t" (mapconcat 'identity
+						  (cdr disposition)
+						  ";\n\t")))
+		   (insert "\n")))
+	     (insert "Content-Transfer-Encoding: " encoding "\n\n"))
+	   (goto-char (point-max))
+	   (widen)
+	   (save-excursion
+	     (goto-char (overlay-start o))
+	     (vm-assert (looking-at "\\[ATTACHMENT")))
+	   (delete-region (overlay-start o)
+			  (overlay-end o))
+	   (delete-overlay o)
+	   (if (looking-at "\n")
+	       (delete-char 1))
+	   (setq o-list (cdr o-list)))
+	 ;; handle the remaining chunk of text after the last
+	 ;; extent, if any.
+	 (if (or just-one (looking-at "[ \t\n]*\\'"))
+	     (delete-region (point) (point-max))
+	   ;; support enriched-mode for text/enriched composition
+	   (if enriched
+	       (let ((enriched-initial-annotation ""))
+		 (enriched-encode (point) (point-max))))
+	   (setq charset (vm-determine-proper-charset (point)
+						      (point-max)))
+	   (if vm-fsfemacs-mule-p
+	       (let ((coding-system
+		      (car (cdr (vm-string-assoc
+				 charset
+				 vm-mime-mule-charset-to-coding-alist)))))
+		 (if (null coding-system)
+		     (error "Can't find a coding system for charset %s"
+			    charset)
+		   (encode-coding-region (point) (point-max)
+					 coding-system))))
+	   (setq encoding (vm-determine-proper-content-transfer-encoding
+			   (point)
+			   (point-max))
+		 encoding (vm-mime-transfer-encode-region encoding
+							  (point)
+							  (point-max)
+							  t)
+		 description (vm-mime-text-description (point) (point-max)))
+	   (setq 8bit (or 8bit (equal encoding "8bit")))
+	   (setq boundary-positions (cons (point-marker) boundary-positions))
+	   (if enriched
+	       (insert "Content-Type: text/enriched; charset=" charset "\n")
+	     (insert "Content-Type: text/plain; charset=" charset "\n"))
+	   (if description
+	       (insert "Content-Description: " description "\n"))
+	   (insert "Content-Transfer-Encoding: " encoding "\n\n")
+	   (goto-char (point-max)))
+	 (setq boundary (vm-mime-make-multipart-boundary))
+	 (mail-text)
+	 (while (re-search-forward (concat "^--"
+					   (regexp-quote boundary)
+					   "\\(--\\)?$")
+				   nil t)
+	   (setq boundary (vm-mime-make-multipart-boundary))
+	   (mail-text))
+	 (goto-char (point-max))
+	 (or just-one (insert "\n--" boundary "--\n"))
+	 (while boundary-positions
+	   (goto-char (car boundary-positions))
+	   (insert "\n--" boundary "\n")
+	   (setq boundary-positions (cdr boundary-positions)))
+	 (if (and just-one already-mimed)
+	     (progn
+	       (goto-char (vm-mm-layout-header-start layout))
+	       ;; trim headers
+	       (vm-reorder-message-headers nil '("Content-ID:") nil)
+	       ;; remove header/text separator
+	       (goto-char (1- (vm-mm-layout-body-start layout)))
+	       (if (looking-at "\n")
+		   (delete-char 1))
+	       ;; copy remainder to enclosing entity's header section
+	       (goto-char (point-max))
+	       (insert-buffer-substring (current-buffer)
+					(vm-mm-layout-header-start layout)
+					(vm-mm-layout-body-start layout))
+	       (delete-region (vm-mm-layout-header-start layout)
+			      (vm-mm-layout-body-start layout))))
+	 (goto-char (point-min))
+	 (vm-remove-mail-mode-header-separator)
+	 (vm-reorder-message-headers
+	  nil nil "\\(Content-Type:\\|MIME-Version:\\|Content-Transfer-Encoding\\)")
+	 (vm-add-mail-mode-header-separator)
+	 (insert "MIME-Version: 1.0\n")
+	 (if (not just-one)
+	     (insert (if vm-mime-avoid-folding-content-type
+			 "Content-Type: multipart/mixed; boundary=\""
+		       "Content-Type: multipart/mixed;\n\tboundary=\"")
+		     boundary "\"\n")
+	   (insert "Content-Type: " type)
+	   (if params
+	       (if vm-mime-avoid-folding-content-type
+		   (insert "; " (mapconcat 'identity params "; ") "\n")
+		 (insert ";\n\t" (mapconcat 'identity params ";\n\t") "\n"))
+	     (insert "\n")))
+	 (if (and just-one description)
+	     (insert "Content-Description: " description "\n"))
+	 (if (and just-one disposition)
+	     (progn
+	       (insert "Content-Disposition: " (car disposition))
+	       (if (cdr disposition)
+		   (if vm-mime-avoid-folding-content-type
+		       (insert "; " (mapconcat 'identity (cdr disposition) "; ")
+			       "\n")
+		     (insert ";\n\t" (mapconcat 'identity (cdr disposition)
+						";\n\t") "\n"))
+		 (insert "\n"))))
+	 (if just-one
+	     (insert "Content-Transfer-Encoding: " encoding "\n")
+	   (if 8bit
+	       (insert "Content-Transfer-Encoding: 8bit\n")
+	     (insert "Content-Transfer-Encoding: 7bit\n"))))))))
 
 (defun vm-mime-fragment-composition (size)
   (save-restriction
 (fset 'vm-mime-preview-composition 'vm-preview-composition)
 
 (defun vm-mime-composite-type-p (type)
-  (or (and (vm-mime-types-match "message" type)
-	   (not (vm-mime-types-match "message/partial" type))
-	   (not (vm-mime-types-match "message/external-body" type)))
+  (or (vm-mime-types-match "message/rfc822" type)
+      (vm-mime-types-match "message/news" type)
       (vm-mime-types-match "multipart" type)))
 
 ;; Unused currrently.