Commits

Anonymous committed 4e2f001

Sync with VM-6.85

Comments (0)

Files changed (14)

+2000-11-26  Steve Youngs  <youngs@xemacs.org>
+
+	* Sync with VM-6.85
+
 2000-11-16  Steve Youngs  <youngs@xemacs.org>
 
 	* Makefile (ELCS): Updated to accommodate VM-6.84.
 
 	* Sync with VM-6.84.
 
-2000-11-14  Martin Buchholz  <martin@xemacs.org>
-
-	* vm-user.el: Doc fix.
-	
 2000-10-05  Martin Buchholz  <martin@xemacs.org>
 
 	* *: Mega typo fix.
 # Boston, MA 02111-1307, USA.
 
 VERSION = 1.25
-AUTHOR_VERSION = 6.84
+AUTHOR_VERSION = 6.85
 MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
 PACKAGE = vm
 PKG_TYPE = regular
 # vm-image-directory must point to the same place.
 PIXMAPDIR = /usr/local/lib/emacs/etc/vm
 
+# where the binaries should be go.
+# only used if you 'make install-utils'
+BINDIR = /usr/local/bin
+
 ############## no user servicable parts beyond this point ###################
 
 # no csh please
     vm-toolbar.el vm-undo.el \
     vm-user.el vm-vars.el vm-virtual.el vm-window.el
 
+UTILS = qp-decode qp-encode base64-decode base64-encode
+
 vm:	vm.elc
 
 vm.elc:	autoload
 
 autoload:	vm-autoload.elc $(OBJECTS) tapestry.elc
 	@echo "building vm.elc (with all modules set to autoload)..."
-	@echo "(require 'vm-version)" > vm.elc
-	@echo "(require 'vm-startup)" >> vm.elc
-	@echo "(require 'vm-vars)" >> vm.elc
-	@echo "(require 'vm-autoload)" >> vm.elc
+	@echo "(defun vm-its-such-a-cruel-world ()" > vm.el
+	@echo "   (require 'vm-version)" >> vm.el
+	@echo "   (require 'vm-startup)" >> vm.el
+	@echo "   (require 'vm-vars)" >> vm.el
+	@echo "   (require 'vm-autoload))" >> vm.el
+	@echo "(vm-its-such-a-cruel-world)" >> vm.el
+	@$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm.el
 
-all:	vm.info vm
+all:	vm.info vm utils
 
 debug:	$(SOURCES) tapestry.el
 	@echo "building vm.elc (uncompiled, no autoloads)..."
 	@cat $(SOURCES) tapestry.el > vm.elc
 
+utils: $(UTILS)
+
+qp-decode: qp-decode.c
+	$(CC) $(CFLAGS) -o qp-decode qp-decode.c
+
+qp-encode: qp-encode.c
+	$(CC) $(CFLAGS) -o qp-encode qp-encode.c
+
+base64-decode: base64-decode.c
+	$(CC) $(CFLAGS) -o base64-decode base64-decode.c
+
+base64-encode: base64-encode.c
+	$(CC) $(CFLAGS) -o base64-encode base64-encode.c
+
 install:	all
 	cp vm.info vm.info-* $(INFODIR)
 	cp *.elc $(LISPDIR)
 	cp pixmaps/*.xpm $(PIXMAPDIR)
+	cp $(UTILS) $(BINDIR)
 
 clean:
-	rm -f vm-autoload.el vm-autoload.elc $(OBJECTS) tapestry.elc
+	rm -f $(UTILS) vm-autoload.el vm-autoload.elc $(OBJECTS) tapestry.elc
 
 vm.info:	vm.texinfo
 	@echo "making vm.info..."
 How to setup VM:
 
-0) Look at the Makefile and change the values of EMACS, INFODIR,
+0) Look at the Makefile and review the values of EMACS, INFODIR,
    LISPDIR, and PIXMAPDIR.  If they are not right for your system,
    change them.
 
-1) Do one of these:
-     `make'.
+1) Your build options:
+     `make' to build a usable VM.
      `make vm.info' to build the Info online help document.
+     'make utils' to compile the external Quoted-Printable and
+         BASE64 encoders and decoders.
      `make all' to make everything.
-   Ignore the byte compiler warnings.
+   If there are byte compiler warnings, ignore them.  They
+   probably can't be avoided with code that is run on multipe
+   Emacs versions.
 
-2) Put all the .elc files into a Lisp directory that Emacs knows
-   about.  (see load-path).
+2) Put all the .elc files into a Lisp directory that is in your
+   Emacs load-path.  If you've already set LISPDIR to this
+   directory, just `make install'.
 
-3) If you're using XEmacs 19.14 and you want toolbar support,
-   make a directory called `vm' in the XEmacs `etc' directory.
-   Copy the files in pixmaps directory into the directory you
-   just created.  VM will look for the pixmaps there by default.
+3) If you're using XEmacs and you want toolbar support, make a
+   directory called `vm' in the XEmacs `etc' directory.  Copy
+   the files in pixmaps directory into the directory you just
+   created.  VM will look for the pixmaps there by default.
 
    Alternately you can put the pixmap files in any directory you
    want or just leave them where they are.  Be sure to point the
    variable vm-toolbar-pixmap-directory at the direrctory where
-   you put the files.
+   you put the files.  That is
+
+      (setq vm-toolbar-pixmap-directory "/path/to/pixmaps")
+
+   in your .emacs or .vm file.
 
 4) If you built the Info document, copy the file vm.info* files
    into the Emacs' info.  You may need to edit the "dir" file in
 will be sent to bug-vm@uunet.uu.net and be gatewayed from there to
 gnu.emacs.vm.bug.
 
-VM's home page on the World Wide Web is at http://www.wonderworks.com/vm/ .
+VM's home page on the World Wide Web is at http://www.wonderworks.com/vm .
 You can get the latest version of VM from there.
 	  ;; changes it needs to make.
 	  (vm-update-summary-and-mode-line)
 	  (vm-sort-messages "thread")))
-    (if (and vm-arrived-message-hook
+    (if (and (or vm-arrived-message-hook vm-arrived-messages-hook)
 	     new-messages
 	     ;; tail-cons == nil means vm-message-list was empty.
 	     ;; Thus new-messages == vm-message-list.  In this
 	  ;; slate as we can provide, given we're currently deep
 	  ;; in the guts of VM.
 	  (vm-update-summary-and-mode-line)
-	  (while new-messages
-	    (vm-run-message-hook (car new-messages) 'vm-arrived-message-hook)
-	    (setq new-messages (cdr new-messages)))))
-    (vm-update-summary-and-mode-line)
-    (run-hooks 'vm-arrived-messages-hook)
+	  (if vm-arrived-message-hook
+	      (while new-messages
+		(vm-run-message-hook (car new-messages)
+				     'vm-arrived-message-hook)
+		(setq new-messages (cdr new-messages))))
+	  (run-hooks 'vm-arrived-messages-hook)))
     (if (and new-messages vm-virtual-buffers)
 	(save-excursion
 	  (setq b-list vm-virtual-buffers)
 (defun vm-mime-can-display-internal (layout &optional deep)
   (let ((type (car (vm-mm-layout-type layout))))
     (cond ((vm-mime-types-match "image/jpeg" type)
-	   (and (featurep 'jpeg) (vm-images-possible-here-p)))
+	   (and (vm-image-type-available-p 'jpeg) (vm-images-possible-here-p)))
 	  ((vm-mime-types-match "image/gif" type)
-	   (and (featurep 'gif) (vm-images-possible-here-p)))
+	   (and (vm-image-type-available-p 'gif) (vm-images-possible-here-p)))
 	  ((vm-mime-types-match "image/png" type)
-	   (and (featurep 'png) (vm-images-possible-here-p)))
+	   (and (vm-image-type-available-p 'png) (vm-images-possible-here-p)))
 	  ((vm-mime-types-match "image/tiff" type)
-	   (and (featurep 'tiff) (vm-images-possible-here-p)))
+	   (and (vm-image-type-available-p 'tiff) (vm-images-possible-here-p)))
 	  ((vm-mime-types-match "audio/basic" type)
 	   (and vm-xemacs-p
 		(or (featurep 'native-sound)
     (if (and (processp process) (eq (process-status process) 'run))
 	t
       (cond ((or (null tempfile) (null (file-exists-p tempfile)))
-	     (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 (fboundp 'set-buffer-file-coding-system)
-		    (if (vm-mime-text-type-layout-p layout)
-			(set-buffer-file-coding-system
-			 (vm-line-ending-coding-system) nil)
-		      (set-buffer-file-coding-system
-		       (vm-binary-coding-system) 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-message-garbage-alist
-		      (cons (cons tempfile 'delete-file)
-			    vm-message-garbage-alist))))))
+	     (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 (fboundp 'set-buffer-file-coding-system)
+		   (if (vm-mime-text-type-layout-p layout)
+		       (set-buffer-file-coding-system
+			(vm-line-ending-coding-system) nil)
+		     (set-buffer-file-coding-system
+		      (vm-binary-coding-system) 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-message-garbage-alist
+		       (cons (cons tempfile 'delete-file)
+			     vm-message-garbage-alist))))))
 
       ;; expand % specs
       (let ((p program-list)
   (if (vectorp layout)
       (let ((start (point))
 	    (buffer-read-only nil))
-	(vm-with-unibyte-buffer
-	 (vm-mime-insert-mime-headers (car (vm-mm-layout-parts layout)))
-	 (insert ?\n))
+	(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
 	  (condition-case data
 	      (save-excursion
 		(setq work-buffer
-		      (vm-make-work-buffer
+		      (vm-make-multibyte-work-buffer
 		       (format "*%s mime object*"
 			       (car (vm-mm-layout-type child-layout)))))
 		(set-buffer work-buffer)
+		(if (fboundp 'set-buffer-file-coding-system)
+		    (set-buffer-file-coding-system
+		     (vm-binary-coding-system) t))
 		(cond
 		 ((string= access-method "local-file")
 		  (let ((name (vm-mime-get-parameter layout "name")))
 (fset 'vm-mime-display-button-message/partial
       'vm-mime-display-internal-message/partial)
 
-(defun vm-mime-display-internal-image-xxxx (layout feature name)
+(defun vm-mime-display-internal-image-xxxx (layout image-type name)
+  (cond
+   (vm-xemacs-p
+    (vm-mime-display-internal-image-xemacs-xxxx layout image-type name))
+   (vm-fsfemacs-p
+    (vm-mime-display-internal-image-fsfemacs-xxxx layout image-type name))))
+
+(defun vm-mime-display-internal-image-xemacs-xxxx (layout image-type name)
   (if (and (vm-images-possible-here-p)
-	   (featurep feature))
+	   (vm-image-type-available-p image-type))
       (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-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 "")
-	   ;; XEmacs 21.2 can pixel scroll images if the entire
-	   ;; image is above the baseline.
-	   (set-glyph-baseline g 100)
-	   (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-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 image-type ':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 "")
+	  ;; XEmacs 21.2 can pixel scroll images if the entire
+	  ;; image is above the baseline.
+	  (set-glyph-baseline g 100)
+	  (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))
 	(vm-set-extent-property e 'begin-glyph g)
 	t )))
 
+(defun vm-mime-display-internal-image-fsfemacs-xxxx (layout image-type name)
+  (if (and (vm-images-possible-here-p)
+	   (image-type-available-p image-type))
+      (let ((start (point-marker)) end tempfile
+	    (selective-display nil)
+	    (buffer-read-only 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)
+	;; keep one char so we can attach the image to it.
+	(delete-region start (1- end))
+	(put-text-property (1- end) end 'display
+			   (list 'image
+				 ':type image-type
+				 ':file tempfile))
+	(save-excursion
+	  (vm-select-folder-buffer)
+	  (setq vm-folder-garbage-alist
+		(cons (cons tempfile 'delete-file)
+		      vm-folder-garbage-alist)))
+	(if (not (save-excursion (goto-char start) (bolp)))
+	    (insert-char ?\n 2)
+	  (insert-char ?\n 1))
+	t )
+    nil ))
+
 (defun vm-mime-display-internal-image/gif (layout)
   (vm-mime-display-internal-image-xxxx layout 'gif "GIF"))
 
 	(if (setq tempfile (cdr (assq 'vm-mime-display-internal-audio/basic
 				      (vm-mm-layout-cache layout))))
 	    nil
-	  (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)))
+	  (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)
 ;; for the karking compiler
 (defvar vm-menu-mime-dispose-menu)
 
-(defun vm-mime-set-extent-glyph-for-type (e type)
+(defun vm-mime-set-image-stamp-for-type (e type)
+  (cond
+   (vm-xemacs-p
+    (vm-mime-xemacs-set-image-stamp-for-type e type))
+   (vm-fsfemacs-p
+    (vm-mime-fsfemacs-set-image-stamp-for-type e type))))
+
+(defun vm-mime-xemacs-set-image-stamp-for-type (e type)
   (if (and (vm-images-possible-here-p)
-	   (featurep 'xpm)
+	   (vm-image-type-available-p 'xpm)
 	   (> (device-bitplanes) 7))
       (let ((dir vm-image-directory)
 	    (colorful (> (device-bitplanes) 15))
 	(and sym (not (boundp sym)) (set sym glyph))
 	(and glyph (set-extent-begin-glyph e glyph)))))
 
+(defun vm-mime-fsfemacs-set-image-stamp-for-type (e type)
+  (if (and (vm-images-possible-here-p)
+	   (vm-image-type-available-p 'xpm))
+      (let ((dir vm-image-directory)
+	    ;; no device-bitplanes under FSF Emacs, so assume we
+	    ;; have a >=16-bit display
+	    (colorful t)
+	    (tuples
+	     '(("text" "document-simple.xpm" "document-colorful.xpm")
+	       ("image" "mona_stamp-simple.xpm" "mona_stamp-colorful.xpm")
+	       ("audio" "audio_stamp-simple.xpm" "audio_stamp-colorful.xpm")
+	       ("video" "film-simple.xpm" "film-colorful.xpm")
+	       ("message" "message-simple.xpm" "message-colorful.xpm")
+	       ("application" "gear-simple.xpm" "gear-colorful.xpm")
+	       ("multipart" "stuffed_box-simple.xpm"
+		"stuffed_box-colorful.xpm")))
+	    file)
+	(setq file (catch 'done
+		     (while tuples
+		       (if (vm-mime-types-match (car (car tuples)) type)
+			   (throw 'done (car tuples))
+			 (setq tuples (cdr tuples))))
+		     nil)
+	      file (and file (if colorful (nth 2 file) (nth 1 file)))
+	      file (and file (expand-file-name file dir)))
+	(if file
+	    (save-excursion
+	      (let ((buffer-read-only nil))
+		(set-buffer (overlay-buffer e))
+		(goto-char (overlay-start e))
+		(insert "x")
+		(move-overlay e (1- (point)) (overlay-end e))
+		(put-text-property (1- (point)) (point) 'display
+				   (list 'image
+					 ':ascent 80
+					 ':color-symbols
+					   (list
+					    (cons "background"
+						  (cdr (assq
+							'background-color
+							(frame-parameters)))))
+					 ':type 'xpm
+					 ':file file))))))))
+
 (defun vm-mime-insert-button (caption action layout disposable)
   (let ((start (point))	e
 	(keymap vm-mime-reader-map)
       (setq e (make-extent start (point)))
       (set-extent-property e 'start-open t)
       (set-extent-property e 'end-open t))
-    (vm-mime-set-extent-glyph-for-type e (car (vm-mm-layout-type layout)))
+    (vm-mime-set-image-stamp-for-type e (car (vm-mm-layout-type layout)))
     ;; for emacs
     (vm-set-extent-property e 'mouse-face 'highlight)
     (vm-set-extent-property e 'local-map keymap)
     (vm-set-extent-endpoints button start (vm-extent-end-position button))
     (delete-region (point) (vm-extent-end-position button))))
 
-(defun vm-mime-send-body-to-file (layout &optional default-filename)
+(defun vm-mime-send-body-to-file (layout &optional default-filename file)
   (if (not (vectorp layout))
       (setq layout (vm-extent-property layout 'vm-mime-layout)))
   (or default-filename
 	(dir vm-mime-attachment-save-directory)
 	(done nil)
 	file)
-    (while (not done)
-      (setq file
-	    (read-file-name
-	     (if default-filename
-		 (format "Write MIME body to file (default %s): "
-			 default-filename)
-	       "Write MIME body to file: ")
-	     dir default-filename)
-	  file (expand-file-name file dir))
-      (if (not (file-directory-p file))
-	  (setq done t)
-	(if (null default-filename)
-	    (error "%s is a directory" file))
-	(setq file (expand-file-name default-filename file)
-	      done t)))
+    (if file
+	nil
+      (while (not done)
+	(setq file
+	      (read-file-name
+	       (if default-filename
+		   (format "Write MIME body to file (default %s): "
+			   default-filename)
+		 "Write MIME body to file: ")
+	       dir default-filename)
+	      file (expand-file-name file dir))
+	(if (not (file-directory-p file))
+	    (setq done t)
+	  (if (null default-filename)
+	      (error "%s is a directory" file))
+	  (setq file (expand-file-name default-filename file)
+		done t))))
     (save-excursion
       (unwind-protect
 	  (let ((coding-system-for-read (vm-binary-coding-system))
 		    (set-buffer-file-coding-system
 		     (vm-line-ending-coding-system) nil)
 		  (set-buffer-file-coding-system (vm-binary-coding-system) t)))
-	    (vm-with-unibyte-buffer
-	     (vm-mime-insert-mime-body layout)
-	     (vm-mime-transfer-decode-region layout (point-min) (point-max)))
+	    (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"))
 	(setq suffix (substring filename (match-beginning 0) (match-end 0))))
     suffix ))
 
-(defun vm-mime-attach-file (file type &optional charset description)
+(defun vm-mime-attach-file (file type &optional charset description
+			    no-suggested-filename)
   "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
 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.
+no description.  Optional fifth argument NO-SUGGESTED-FILENAME non-nil
+means that VM should not add a filename to the Content-Disposition
+header created for the object.
 
 When called interactively all arguments are read from the
 minibuffer.
      (setq description (read-string "One line description: "))
      (if (string-match "^[ \t]*$" description)
 	 (setq description nil))
-     (list file type charset description)))
+     (list file type charset description nil)))
   (if (null vm-send-using-mime)
       (error "MIME attachments disabled, set vm-send-using-mime non-nil to enable."))
   (if (file-directory-p file)
 		    (list 'if (list 'eq (current-buffer) '(current-buffer))
 			  (list 'kill-buffer buf))))))
 
-(defun vm-mime-attach-object (object type params description mimed)
+(defun vm-mime-attach-object (object type params description mimed
+			      &optional no-suggested-filename)
   (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")
 		  (vm-mime-types-match "model" type))
 	      (setq disposition (list "attachment"))
 	    (setq disposition (list "inline")))
-	  (setq disposition (nconc disposition
-				   (list
-				    (concat "filename=\""
-					    (file-name-nondirectory object)
-					    "\"")))))
+	  (if (not no-suggested-filename)
+	      (setq disposition (nconc disposition
+				       (list
+					(concat "filename=\""
+						(file-name-nondirectory object)
+						"\""))))))
       (setq disposition (list "unspecified")))
     (cond (vm-fsfemacs-p
 	   (put-text-property start end 'front-sticky nil)
 	   (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"))
+	   (vm-mime-set-image-stamp-for-type e (or type "text/plain"))
 	   (set-extent-property e 'start-open t)
 	   (set-extent-property e 'face vm-mime-button-face)
 	   (set-extent-property e 'duplicable t)
 	(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."))
-    (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)
+    (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
+		(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)))
-	     (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
+	    (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))
+			    (vm-line-ending-coding-system)
+			  (vm-binary-coding-system)))
+		       ;; no transformations!
+		       (format-alist nil)
+		       ;; no decompression!
+		       (jka-compr-compression-info-list nil)
+		       ;; 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 (vm-binary-coding-system))
+		       ;; 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"))
-	     (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)
+	    (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 (vm-mm-layout-header-end layout))
+	      (if (looking-at "\n")
 		  (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))
-			     (vm-line-ending-coding-system)
-			   (vm-binary-coding-system)))
-			;; no transformations!
-			(format-alist nil)
-			;; no decompression!
-			(jka-compr-compression-info-list nil)
-			;; 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 (vm-binary-coding-system))
-			;; 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 (vm-mm-layout-header-end 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"))))))))
+	   ;; 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
 (defun vm-minibuffer-complete-word (&optional exiting)
   (interactive)
   (let ((opoint (point))
+	;; In Emacs 21, during a minibuffer read the minibuffer
+	;; contains propt as buffer text and that text is read
+	;; only.  So we can no longer assume that (point-min) is
+	;; where the user-entered text starts and we must avoid
+	;; modifying that prompt text.  Calling
+	;; previous-property-change is a kludge but it does the
+	;; job.
+	(point-min (previous-property-change (point) nil (point-min)))
 	trimmed-c-list c-list beg end diff word word-prefix-regexp completion)
     ;; find the beginning and end of the word we're trying to complete
     (if (or (eobp) (memq (following-char) '(?\t ?\n ?\ )))
     ;; if there can't be multiple words in the input the beginning
     ;; of the word must be at point-min.
     (if (not vm-completion-auto-space)
-	(setq beg (point-min))
+	(setq beg point-min)
       (skip-chars-backward "^ \t\n")
       (setq beg (point)))
     (goto-char opoint)
    (if (and vm-display-using-mime
 	    vm-auto-decode-mime-messages
 	    vm-mime-decode-for-preview
+	    vm-preview-lines
 	    (not (equal vm-preview-lines 0))
 	    (if vm-mail-buffer
 		(not (vm-buffer-variable-value vm-mail-buffer
        ;; decode-for-preview is meant to allow a numeric
        ;; vm-preview-lines to be useful in the face of multipart
        ;; messages.
-       (let ((vm-auto-displayed-mime-content-types
-	      '("text" "multipart" "message"))
-	     (vm-auto-displayed-mime-content-type-exceptions
-	      '("message/external-body"))
+       (let ((vm-auto-displayed-mime-content-type-exceptions
+	      (cons "message/external-body" vm-auto-displayed-mime-content-type-exceptions))
 	     (vm-mime-external-content-types-alist nil))
 	 (condition-case data
 	     (progn
   (push-mark)
   (vm-display (current-buffer) t '(vm-beginning-of-message)
 	      '(vm-beginning-of-message reading-message))
-  (let ((osw (selected-window)))
-    (unwind-protect
-	(progn
-	  (select-window (vm-get-visible-buffer-window (current-buffer)))
-	  (goto-char (point-min)))
-      (if (not (eq osw (selected-window)))
-	  (select-window osw))))
+  (vm-save-buffer-excursion
+    (let ((osw (selected-window)))
+      (unwind-protect
+	  (progn
+	    (select-window (vm-get-visible-buffer-window (current-buffer)))
+	    (goto-char (point-min)))
+	(if (not (eq osw (selected-window)))
+	    (select-window osw)))))
   (if vm-honor-page-delimiters
       (vm-narrow-to-page)))
 
   (push-mark)
   (vm-display (current-buffer) t '(vm-end-of-message)
 	      '(vm-end-of-message reading-message))
-  (let ((osw (selected-window)))
-    (unwind-protect
-	(progn
-	  (select-window (vm-get-visible-buffer-window (current-buffer)))
-	  (goto-char (point-max)))
-      (if (not (eq osw (selected-window)))
-	  (select-window osw))))
+  (vm-save-buffer-excursion
+    (let ((osw (selected-window)))
+      (unwind-protect
+	  (progn
+	    (select-window (vm-get-visible-buffer-window (current-buffer)))
+	    (goto-char (point-max)))
+	(if (not (eq osw (selected-window)))
+	    (select-window osw)))))
   (if vm-honor-page-delimiters
       (vm-narrow-to-page)))
+
+(defun vm-move-to-next-button (count)
+  "Moves to the next button in the current message.
+Prefix argument N means move to the Nth next button.
+Negavite N means move to the Nth previous button.
+If there is no next button, an error is signaled and point is not moved.
+
+A button is a highlighted region of text where pressing RETURN
+will produce an action.  If the message is being previewed, it is
+exposed and marked as read."
+  (interactive "p")
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-check-for-killed-presentation)
+  (vm-error-if-folder-empty)
+  (and vm-presentation-buffer
+       (set-buffer vm-presentation-buffer))
+  (if (eq vm-system-state 'previewing)
+      (vm-show-current-message))
+  (setq vm-system-state 'reading)
+  (vm-widen-page)
+  (vm-display (current-buffer) t '(vm-move-to-next-button)
+	      '(vm-move-to-next-button reading-message))
+  (select-window (vm-get-visible-buffer-window (current-buffer)))
+  (unwind-protect
+      (vm-move-to-xxxx-button (vm-abs count) (>= count 0))
+    (if vm-honor-page-delimiters
+	(vm-narrow-to-page))))
+
+(defun vm-move-to-previous-button (count)
+  "Moves to the previous button in the current message.
+Prefix argument N means move to the Nth previous button.
+Negavite N means move to the Nth next button.
+If there is no previous button, an error is signaled and point is not moved.
+
+A button is a highlighted region of text where pressing RETURN
+will produce an action.  If the message is being previewed, it is
+exposed and marked as read."
+  (interactive "p")
+  (vm-follow-summary-cursor)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-check-for-killed-presentation)
+  (vm-error-if-folder-empty)
+  (and vm-presentation-buffer
+       (set-buffer vm-presentation-buffer))
+  (if (eq vm-system-state 'previewing)
+      (vm-show-current-message))
+  (setq vm-system-state 'reading)
+  (vm-widen-page)
+  (vm-display (current-buffer) t '(vm-move-to-previous-button)
+	      '(vm-move-to-previous-button reading-message))
+  (select-window (vm-get-visible-buffer-window (current-buffer)))
+  (unwind-protect
+      (vm-move-to-xxxx-button (vm-abs count) (< count 0))
+    (if vm-honor-page-delimiters
+	(vm-narrow-to-page))))
+
+(defun vm-move-to-xxxx-button (count next)
+  (let ((old-point (point))
+	(endp (if next 'eobp 'bobp))
+	(extent-end-position (if vm-xemacs-p
+				 (if next
+				     'extent-end-position
+				   'extent-start-position)
+			       (if next
+				   'overlay-end
+				 'overlay-start)))
+	(next-extent-change (if vm-xemacs-p
+				(if next
+				    'next-etent-change
+				  'previous-extent-change)
+			      (if next
+				  'next-overlay-change
+				'previous-overlay-change)))
+	e)
+    (setq e (or (vm-extent-at (point) nil 'keymap)
+		(vm-extent-at (point) nil 'local-map)))
+    (and e (goto-char (funcall extent-end-position e)))
+    (while (and (> count 0) (not (funcall endp)))
+      (goto-char (funcall next-extent-change (+ (point) (if next 0 -1))))
+      (setq e (vm-extent-at (point)))
+      (if e
+	  (if (or (vm-extent-property e 'keymap)
+		  (vm-extent-property e 'local-map))
+	      (vm-decrement count)
+	    (goto-char (funcall extent-end-position e)))
+	(goto-char old-point)
+	(error "No more buttons")))
+    (and e (goto-char (vm-extent-start-position e)))))
   (save-excursion
     (set-buffer (process-buffer process))
     (vm-pop-send-command process "QUIT")
-    ;; we don't care about the response
-    ;;(vm-pop-read-response process)
+    ;; Previously we did not read the QUIT response because of
+    ;; TCP shutdown problems (under Windows?) that made it better
+    ;; if we just closed the connection.  Microsoft Exchange
+    ;; apparently fails to expunge messages if we shut down the
+    ;; connection without reading the QUIT response.
+    (vm-pop-read-response process)
     (if (not keep-buffer)
 	(kill-buffer (process-buffer process))
       (save-excursion
 
 (defun vm-save-message-sans-headers (file &optional count)
   "Save the current message to a file, without its header section.
-If the file already exists, the message will be appended to it.
-Prefix arg COUNT means save the next COUNT messages.  A negative COUNT means
-save the previous COUNT.
+If the file already exists, the message body will be appended to it.
+Prefix arg COUNT means save the next COUNT message bodiess.  A
+negative COUNT means save the previous COUNT bodies.
 
 When invoked on marked messages (via vm-next-command-uses-marks),
-all marked messages in the current folder are saved; other messages are
-ignored.
+only the next COUNT marked messages are saved; other intervening
+messages are ignored.
 
 The saved messages are flagged as `written'.
 
 				 (find-file-noselect file))))
 	  ((and mlist vm-visit-when-saving)
 	   (setq file-buffer (vm-get-file-buffer file))))
-    (if (and (not (eq (vm-get-folder-type file) 'unknown))
+    (if (and (not (memq (vm-get-folder-type file) '(nil unknown)))
 	     (not (y-or-n-p "This file looks like a mail folder, append to it anyway? ")))
 	(error "Aborted"))
     (save-excursion
 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 6.84.
+This is VM 6.85.
 
 Commands:
    h - summarize folder contents
    b - scroll backward a page
    < - go to beginning of current message
    > - go to end of current message
+   [ - go to previous button
+   ] - go to next button
 
    d - delete message, prefix arg deletes messages forward
  C-d - delete message, prefix arg deletes messages backward
    u - undelete
-   k - flag for deletion all messages with same subject as the current message
+   k - delete all messages with same subject as the current message
 
    r - reply (only to the sender of the message)
    R - reply with included text from the current message
 (or (fboundp 'vm-toolbar-decode-mime-command)
     (fset 'vm-toolbar-decode-mime-command 'vm-decode-mime-message))
 
-(defvar vm-toolbar-delete-icon nil)
-
+;; The values of these two are used by the FSF Emacs toolbar
+;; code.  The values don't matter as long as they are different
+;; (as compared with eq).  Under XEmacs these values are ignored
+;; and overwritten.
+(defvar vm-toolbar-delete-icon t)
 (defvar vm-toolbar-undelete-icon nil)
 
 (defvar vm-toolbar-delete/undelete-button
 						   vm-toolbar)))))
 
 (defun vm-toolbar-install-toolbar ()
-  (if (not (and (stringp vm-toolbar-pixmap-directory)
-		(file-directory-p vm-toolbar-pixmap-directory)))
-      (progn
-	(message "Bad toolbar pixmap directory, can't setup toolbar.")
-	(sit-for 2))
-    (vm-toolbar-initialize)
-    (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon))))
-	  (width (+ 4 (glyph-width (car vm-toolbar-help-icon))))
-	  (frame (selected-frame))
-	  (buffer (current-buffer))
-	  (tag-set '(win))
-	  (myframe (vm-created-this-frame-p))
-	  toolbar )
-      ;; glyph-width and glyph-height return 0 at startup sometimes
-      ;; use reasonable values if they fail.
-      (if (= width 4)
-	  (setq width 68))
-      (if (= height 4)
-	  (setq height 46))
-      ;; honor user setting of vm-toolbar if they are daring enough
-      ;; to set it.
-      (if vm-toolbar
-	  (setq toolbar vm-toolbar)
-	(setq toolbar (vm-toolbar-make-toolbar-spec)
-	      vm-toolbar toolbar))
-      (cond ((eq vm-toolbar-orientation 'right)
-	     (setq vm-toolbar-specifier right-toolbar)
-	     (if myframe
-		 (set-specifier right-toolbar toolbar frame tag-set))
-	     (set-specifier right-toolbar toolbar buffer)
-	     (set-specifier right-toolbar-width width frame tag-set))
-	    ((eq vm-toolbar-orientation 'left)
-	     (setq vm-toolbar-specifier left-toolbar)
-	     (if myframe
-		 (set-specifier left-toolbar toolbar frame tag-set))
-	     (set-specifier left-toolbar toolbar buffer)
-	     (set-specifier left-toolbar-width width frame tag-set))
-	    ((eq vm-toolbar-orientation 'bottom)
-	     (setq vm-toolbar-specifier bottom-toolbar)
-	     (if myframe
-		 (set-specifier bottom-toolbar toolbar frame tag-set))
-	     (set-specifier bottom-toolbar toolbar buffer)
-	     (set-specifier bottom-toolbar-height height frame tag-set))
-	    (t
-	     (setq vm-toolbar-specifier top-toolbar)
-	     (if myframe
-		 (set-specifier top-toolbar toolbar frame tag-set))
-	     (set-specifier top-toolbar toolbar buffer)
-	     (set-specifier top-toolbar-height height frame tag-set))))))
+  (if vm-fsfemacs-p
+      (vm-toolbar-fsfemacs-install-toolbar)
+    (if (not (and (stringp vm-toolbar-pixmap-directory)
+		  (file-directory-p vm-toolbar-pixmap-directory)))
+	(progn
+	  (message "Bad toolbar pixmap directory, can't setup toolbar.")
+	  (sit-for 2))
+      (vm-toolbar-initialize)
+      (let ((height (+ 4 (glyph-height (car vm-toolbar-help-icon))))
+	    (width (+ 4 (glyph-width (car vm-toolbar-help-icon))))
+	    (frame (selected-frame))
+	    (buffer (current-buffer))
+	    (tag-set '(win))
+	    (myframe (vm-created-this-frame-p))
+	    toolbar )
+	;; glyph-width and glyph-height return 0 at startup sometimes
+	;; use reasonable values if they fail.
+	(if (= width 4)
+	    (setq width 68))
+	(if (= height 4)
+	    (setq height 46))
+	;; honor user setting of vm-toolbar if they are daring enough
+	;; to set it.
+	(if vm-toolbar
+	    (setq toolbar vm-toolbar)
+	  (setq toolbar (vm-toolbar-make-toolbar-spec)
+		vm-toolbar toolbar))
+	(cond ((eq vm-toolbar-orientation 'right)
+	       (setq vm-toolbar-specifier right-toolbar)
+	       (if myframe
+		   (set-specifier right-toolbar toolbar frame tag-set))
+	       (set-specifier right-toolbar toolbar buffer)
+	       (set-specifier right-toolbar-width width frame tag-set))
+	      ((eq vm-toolbar-orientation 'left)
+	       (setq vm-toolbar-specifier left-toolbar)
+	       (if myframe
+		   (set-specifier left-toolbar toolbar frame tag-set))
+	       (set-specifier left-toolbar toolbar buffer)
+	       (set-specifier left-toolbar-width width frame tag-set))
+	      ((eq vm-toolbar-orientation 'bottom)
+	       (setq vm-toolbar-specifier bottom-toolbar)
+	       (if myframe
+		   (set-specifier bottom-toolbar toolbar frame tag-set))
+	       (set-specifier bottom-toolbar toolbar buffer)
+	       (set-specifier bottom-toolbar-height height frame tag-set))
+	      (t
+	       (setq vm-toolbar-specifier top-toolbar)
+	       (if myframe
+		   (set-specifier top-toolbar toolbar frame tag-set))
+	       (set-specifier top-toolbar toolbar buffer)
+	       (set-specifier top-toolbar-height height frame tag-set)))))))
 
 (defun vm-toolbar-make-toolbar-spec ()
   (let ((button-alist '(
   (require 'vm-save)
   (require 'vm-summary)
   (cond
+   (vm-fsfemacs-p nil)
    ((null vm-toolbar-help-icon)
     (let ((tuples
 	   (if (featurep 'xpm)
   (setq vm-toolbar-helper-command 'vm-help)
   (setq vm-toolbar-helper-icon vm-toolbar-help-icon)
   (setq-default vm-toolbar-helper-icon vm-toolbar-help-icon))
+
+(defun vm-toolbar-fsfemacs-install-toolbar ()
+  (let ((button-list (reverse vm-use-toolbar))
+	(dir vm-toolbar-pixmap-directory)
+	(extension (if (image-type-available-p 'xpm) "xpm" "xbm"))
+	item t-spec sym name images)
+    (defvar tool-bar-map)
+    ;; hide the toolbar entries that are in the global keymap so
+    ;; VM has full control of the toolbar in its buffers.
+    (if (and (boundp 'tool-bar-map)
+	     (consp tool-bar-map))
+	(let ((map (cdr tool-bar-map))
+	      (v [tool-bar x]))
+	  (while map
+	    (aset v 1 (car (car map)))
+	    (define-key vm-mode-map v 'undefined)
+	    (setq map (cdr map)))))
+    (while button-list
+      (setq sym (car button-list))
+      (cond ((null sym)
+	     ;; can't do flushright in FSF Emacs
+	     t)
+	    ((integerp sym)
+	     ;; can't do separators in FSF Emacs
+	     t)
+	    ((memq sym '(autofile compose file getmail
+			 mime next previous print quit reply visit))
+	     (setq t-spec (symbol-value
+			   (intern (format "vm-toolbar-%s-button" sym))))
+	     (if (eq sym 'mime)
+		 (setq name "mime-colorful")
+	       (setq name (symbol-name sym)))
+	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
+			   name extension dir))
+	     (setq item
+		   (list 'menu-item
+			 (aref t-spec 3)
+			 (aref t-spec 1)
+			 ':enable (aref t-spec 2)
+			 ':button '(:toggle nil)
+			 ':image images))
+	     (define-key vm-mode-map (vector 'tool-bar sym) item))
+	    ((eq sym 'delete/undelete)
+	     (setq t-spec vm-toolbar-delete/undelete-button)
+	     (setq name "delete")
+	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
+			   name extension dir))
+	     (setq item
+		   (list 'menu-item
+			 (aref t-spec 3)
+			 (aref t-spec 1)
+			 ':visible '(eq vm-toolbar-delete/undelete-icon
+					vm-toolbar-delete-icon)
+			 ':enable (aref t-spec 2)
+			 ':button '(:toggle nil)
+			 ':image images))
+	     (define-key vm-mode-map (vector 'tool-bar 'delete) item)
+	     (setq name "undelete")
+	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
+			   name extension dir))
+	     (setq item
+		   (list 'menu-item
+			 (aref t-spec 3)
+			 (aref t-spec 1)
+			 ':visible '(eq vm-toolbar-delete/undelete-icon
+					vm-toolbar-undelete-icon)
+			 ':enable (aref t-spec 2)
+			 ':button '(:toggle nil)
+			 ':image images))
+	     (define-key vm-mode-map (vector 'tool-bar 'undelete) item))
+	    ((eq sym 'help)
+	     (setq t-spec vm-toolbar-help-button)
+	     (setq name "help")
+	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
+			   name extension dir))
+	     (setq item
+		   (list 'menu-item
+			 (aref t-spec 3)
+			 (aref t-spec 1)
+			 ':visible '(eq vm-toolbar-helper-command 'vm-help)
+			 ':enable (aref t-spec 2)
+			 ':button '(:toggle nil)
+			 ':image images))
+	     (define-key vm-mode-map (vector 'tool-bar 'help-help) item)
+	     (setq name "recover")
+	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
+			   name extension dir))
+	     (setq item
+		   (list 'menu-item
+			 (aref t-spec 3)
+			 (aref t-spec 1)
+			 ':visible '(eq vm-toolbar-helper-command
+					'recover-file)
+			 ':enable (aref t-spec 2)
+			 ':button '(:toggle nil)
+			 ':image images))
+	     (define-key vm-mode-map (vector 'tool-bar 'help-recover) item)
+	     (setq name "getmail")
+	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
+			   name extension dir))
+	     (setq item
+		   (list 'menu-item
+			 (aref t-spec 3)
+			 (aref t-spec 1)
+			 ':visible '(eq vm-toolbar-helper-command
+					'vm-get-new-mail)
+			 ':enable (aref t-spec 2)
+			 ':button '(:toggle nil)
+			 ':image images))
+	     (define-key vm-mode-map (vector 'tool-bar 'help-getmail) item)
+	     (setq name "mime-colorful")
+	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
+			   name extension dir))
+	     (setq item
+		   (list 'menu-item
+			 (aref t-spec 3)
+			 (aref t-spec 1)
+			 ':visible '(eq vm-toolbar-helper-command
+					'vm-decode-mime-message)
+			 ':enable (aref t-spec 2)
+			 ':button '(:toggle nil)
+			 ':image images))
+	     (define-key vm-mode-map (vector 'tool-bar 'help-mime) item)))
+      (setq button-list (cdr button-list)))))
+
+(defun vm-toolbar-make-fsfemacs-toolbar-image-spec (name extension dir)
+  (if (string= extension "xpm")
+      (vector
+       (list 'image
+	     ':type (intern extension)
+	     ':file (expand-file-name
+		     (format "%s-dn.%s"
+			     name extension)
+		     dir))
+       (list 'image
+	     ':type (intern extension)
+	     ':file (expand-file-name
+		     (format "%s-up.%s"
+			     name extension)
+		     dir))
+       (list 'image
+	     ':type (intern extension)
+	     ':file (expand-file-name
+		     (format "%s-dn.%s"
+			     name extension)
+		     dir))
+       (list 'image
+	     ':type (intern extension)
+	     ':file (expand-file-name
+		     (format "%s-dn.%s"
+			     name extension)
+		     dir)))
+    (vector
+     (list 'image
+	   ':type (intern extension)
+	   ':file (expand-file-name
+		   (format "%s-dn.%s"
+			   name extension)
+		   dir))
+     (list 'image
+	   ':type (intern extension)
+	   ':file (expand-file-name
+		   (format "%s-up.%s"
+			   name extension)
+		   dir))
+     (list 'image
+	   ':type (intern extension)
+	   ':file (expand-file-name
+		   (format "%s-xx.%s"
+			   name extension)
+		   dir))
+     (list 'image
+	   ':type (intern extension)
+	   ':file (expand-file-name
+		   (format "%s-xx.%s"
+			   name extension)
+		   dir)))))
 a newline, otherwise the message pointer will not be displayed correctly
 in the summary window.")
 
-(defvar vm-folders-summary-directories nil
+(defvar vm-folders-summary-directories
+      (list (or vm-folder-directory (file-name-directory vm-primary-inbox)))
   "*List of directories containing folders to be listed in the folders summary.
 List the directories in the order you wish them to appear in the summary.")
 
   "Where to send VM bug reports.")
 
 (defvar vm-mode-map
-  (let ((map (make-sparse-keymap)))
+  (let ((map (make-keymap)))
 ;; unneeded now that VM buffers all have buffer-read-only == t.
 ;;    (suppress-keymap map)
     (define-key map "h" 'vm-summarize)
     (define-key map "!" 'shell-command)
     (define-key map "<" 'vm-beginning-of-message)
     (define-key map ">" 'vm-end-of-message)
+    (define-key map "[" 'vm-move-to-previous-button)
+    (define-key map "]" 'vm-move-to-next-button)
     (define-key map "\M-s" 'vm-isearch-forward)
     (define-key map "=" 'vm-summarize)
     (define-key map "L" 'vm-load-init-file)
     ("vm-expunge-folder")
     ("vm-expunge-imap-messages")
     ("vm-expunge-pop-messages")
+    ("vm-folders-summarize")
     ("vm-followup")
     ("vm-followup-include-text")
     ("vm-followup-include-text-other-frame")
     ("vm-move-message-backward-physically")
     ("vm-move-message-forward")
     ("vm-move-message-forward-physically")
+    ("vm-move-to-previous-button")
+    ("vm-move-to-next-button")
     ("vm-next-command-uses-marks")
     ("vm-next-message")
     ("vm-next-message-no-skip")
     ("vm-show-no-warranty")
     ("vm-sort-messages")
     ("vm-submit-bug-report")
-    ("vm-folders-summarize")
     ("vm-summarize")
     ("vm-summarize-other-frame")
     ("vm-toggle-all-marks")
 
 (provide 'vm-version)
 
-(defconst vm-version "6.84"
+(defconst vm-version "6.85"
   "Version number of VM.")
 
 (defun vm-version ()
 	 (fboundp 'menu-bar-mode))))
  
 (defun vm-toolbar-support-possible-p ()
-  (and vm-xemacs-p (featurep 'toolbar)))
+  (or (and vm-xemacs-p (featurep 'toolbar))
+      (and vm-fsfemacs-p (fboundp 'tool-bar-mode))))
 
 (defun vm-multiple-fonts-possible-p ()
   (cond (vm-xemacs-p
 	 (memq window-system '(x w32 win32)))))
 
 (defun vm-images-possible-here-p ()
-  (and vm-xemacs-p (memq (device-type) '(x mswindows))))
+  (or (and vm-xemacs-p (memq (device-type) '(x mswindows)))
+      (and vm-fsfemacs-p window-system (fboundp 'image-type-available-p))))
 
+(defun vm-image-type-available-p (type)
+  (if (fboundp 'image-type-available-p)
+      (image-type-available-p type)
+    (featurep type)))