Commits

Anonymous committed f3dc71c

2001-11-30 Steve Youngs <youngs@xemacs.org>

* Makefile (ELCS): Add vm-crypto.elc

* Sync with VM-6.99

  • Participants
  • Parent commits c731aef
  • Tags vm-6_99

Comments (0)

Files changed (20)

+2001-11-30  Steve Youngs  <youngs@xemacs.org>
+
+	* Makefile (ELCS): Add vm-crypto.elc
+
+	* Sync with VM-6.99
+
 2001-09-08  Steve Youngs  <youngs@xemacs.org>
 
 	* Makefile (MAINTAINER): Change to Kyle's address.
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 6.96
-AUTHOR_VERSION = 6.96
+VERSION = 6.99
+AUTHOR_VERSION = 6.99
 MAINTAINER = Kyle Jones <kyle_jones@wonderworks.com>
 PACKAGE = vm
 PKG_TYPE = regular
 	vm-motion.elc vm-mouse.elc vm-page.elc vm-pop.elc vm-reply.elc \
 	vm-save.elc vm-search.elc vm-sort.elc vm-startup.elc \
 	vm-summary.elc vm-thread.elc vm-toolbar.elc vm-undo.elc \
-	vm-user.elc vm-vars.elc vm-virtual.elc vm-window.elc
+	vm-user.elc vm-vars.elc vm-virtual.elc vm-window.elc \
+	vm-crypto.elc
 
 EXTRA_SOURCES = vm.elc vm-autoload.el vm-autoload.elc Makefile-kj \
 	README.bytecompile
 
 (defun print-autoloads ()
   (let ((files (cdr (member "print-autoloads" command-line-args)))
-	;; kludge for broken v19 emacs.  It's supposed to accept
+	;; kludge for broken v19 emacs.  it's supposed to accept
 	;; t in autoloads to mean 'macro but it doesn't.  this
 	;; kludge will screw people who try to byte-compile VM
 	;; with emacs18 for emacs19.
 	  (while t
 	    (setq sexp (read (current-buffer)))
 	    (if (and (consp sexp) (cdr sexp)
-		     (memq (car sexp) '(defun defmacro defsubst)))
+		     (memq (car sexp) '(defun defmacro defsubst fset)))
 		(progn
 		  (if (memq (car sexp) '(defmacro defsubst))
 		      (setq macro macro-flag)
 		    (setq macro nil))
-		  (setq sexp (cdr sexp)
-			function (car sexp)
-			sexp (cdr (cdr sexp)))
-		  (if (stringp (car sexp))
-		      (setq doc (car sexp)
-			    sexp (cdr sexp))
-		    (setq doc nil))
-		  (if (and (consp (car sexp))
-			   (eq (car (car sexp)) 'interactive))
-		      (setq interactive t)
-		    (setq interactive nil))
+		  (if (eq (car sexp) 'fset)
+		      (setq sexp (cdr sexp)
+			    function (eval (car sexp))
+			    interactive nil
+			    doc nil)
+		    (setq sexp (cdr sexp)
+			  function (car sexp)
+			  sexp (cdr (cdr sexp)))
+		    (if (stringp (car sexp))
+			(setq doc (car sexp)
+			      sexp (cdr sexp))
+		      (setq doc nil))
+		    (if (and (consp (car sexp))
+			     (eq (car (car sexp)) 'interactive))
+			(setq interactive t)
+		      (setq interactive nil)))
 		  (if (string-match "\\.el$" (car files))
 		      (setq file (substring (car files) 0 -3))
 		    (setq file (car files)))
+;;; Encryption and related functions for VM
+;;; Copyright (C) 2001 Kyle E. Jones
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 1, or (at your option)
+;;; any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;; compatibility
+(fset 'vm-pop-md5 'vm-md5-string)
+
+(defun vm-md5-region (start end)
+  (if (fboundp 'md5)
+      (md5 (current-buffer) start end)
+    (let ((buffer nil)
+	  (retval nil)
+	  (curbuf (current-buffer)))
+      (unwind-protect
+	  (save-excursion
+	    (setq buffer (vm-make-work-buffer))
+	    (set-buffer buffer)
+	    (insert-buffer-substring curbuf start end)
+	    ;; call-process-region calls write-region.
+	    ;; don't let it do CR -> LF translation.
+	    (setq selective-display nil)
+	    (setq retval
+		  (call-process-region (point-min) (point-max)
+				       vm-pop-md5-program
+				       t buffer nil))
+	    (if (not (equal retval 0))
+		(progn
+		  (error "%s failed: exited with code %s"
+			 vm-pop-md5-program retval)))
+	    ;; md5sum generates extra output even when summing stdin.
+	    (goto-char (point-min))
+	    (if (search-forward " -\n" nil t)
+		(replace-match ""))
+
+	    (goto-char (point-min))
+	    (if (or (re-search-forward "[^0-9a-f\n]" nil t)
+		    (< (point-max) 32))
+		(error "%s produced bogus MD5 digest '%s'"
+		       vm-pop-md5-program 
+		       (vm-buffer-substring-no-properties (point-min) 
+							  (point-max))))
+	    ;; MD5 digest is 32 chars long
+	    ;; mddriver adds a newline to make neaten output for tty
+	    ;; viewing, make sure we leave it behind.
+	    (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32)))
+	(and buffer (kill-buffer buffer))))))
+
+;; output is in hex
+(defun vm-md5-string (string)
+  (if (fboundp 'md5)
+      (md5 string)
+    (vm-with-string-as-temp-buffer
+     string (function
+	     (lambda ()
+	       (goto-char (point-min))
+	       (insert (vm-md5-region (point-min) (point-max)))
+	       (delete-region (point) (point-max)))))))
+
+;; output is the raw digest bits, not hex
+(defun vm-md5-raw-string (s)
+  (setq s (vm-md5-string s))
+  (let ((raw (make-string 16 0))
+	(i 0) n
+	(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)
+			   ;; 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))))
+    (while (< i 32)
+      (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16)
+		 (cdr (assoc (aref s (1+ i)) hex-digit-alist))))
+      (aset raw (/ i 2) n)
+      (setq i (+ i 2)))
+    raw ))
+
+(defun vm-xor-string (s1 s2)
+  (let ((len (length s1))
+	result (i 0))
+    (if (/= len (length s2))
+	(error "strings not of equal length"))
+    (setq result (make-string len 0))
+    (while (< i len)
+      (aset result i (logxor (aref s1 i) (aref s2 i)))
+      (setq i (1+ i)))
+    result ))
+
+(defun vm-setup-ssh-tunnel (host port)
+  (let (local-port process done)
+    (while (not done)
+      (setq local-port (+ 1025 (random (- 65536 1025)))
+	    process nil)
+      (condition-case nil
+	  (progn
+	    (setq process
+		  (open-network-stream "TEST-CONNECTION" nil
+				       "127.0.0.1" local-port))
+	    (process-kill-without-query process))
+	(error nil))
+      (cond ((null process)
+	     (setq process
+		   (apply 'start-process
+			  (format "SSH tunnel to %s:%s" host port)
+			  (vm-make-work-buffer)
+			  vm-ssh-program
+			  (nconc
+			   (list "-L"
+				 (format "%d:%s:%s" local-port host port))
+			   vm-ssh-program-switches
+			   (list host vm-ssh-remote-command)))
+		   done t)
+	     (process-kill-without-query process)
+	     (set-process-sentinel process 'vm-process-sentinel-kill-buffer))
+	    (t
+	     (delete-process process))))
+
+    ;; wait for some output from vm-ssh-remote-command.  this
+    ;; ensures that when we return the ssh connection is ready to
+    ;; do port-forwarding.
+    (accept-process-output process)
+
+    local-port ))
+
+(defun vm-generate-random-data-file (n-octets)
+  (let ((file (vm-make-tempfile))
+	work-buffer (i n-octets))
+    (unwind-protect
+	(save-excursion
+	  (setq work-buffer (vm-make-work-buffer))
+	  (set-buffer work-buffer)
+	  (while (> i 0)
+	    (insert-char (random 256) 1)
+	    (setq i (1- i)))
+	  (write-region (point-min) (point-max) file nil 0))
+      (and work-buffer (kill-buffer work-buffer)))
+    file ))
+
+(defun vm-setup-stunnel-random-data-if-needed ()
+  (cond ((null vm-stunnel-random-data-method) nil)
+	((eq vm-stunnel-random-data-method 'generate)
+	 (if (and (stringp vm-stunnel-random-data-file)
+		  (file-readable-p vm-stunnel-random-data-file))
+	     nil
+	   (setq vm-stunnel-random-data-file
+		 (vm-generate-random-data-file (* 4 1024)))))))
+
+(defun vm-tear-down-stunnel-random-data ()
+  (if (stringp vm-stunnel-random-data-file)
+      (vm-error-free-call 'delete-file vm-stunnel-random-data-file))
+  (setq vm-stunnel-random-data-file nil))
+
+(defun vm-stunnel-random-data-args ()
+  (cond ((null vm-stunnel-random-data-method) nil)
+	((eq vm-stunnel-random-data-method 'generate)
+	 (list "-R" vm-stunnel-random-data-file))
+	(t nil)))
 	    ;; into the folder's message list.
 	    (setq vm-message-pointer (list (car mp))
 		  vm-mail-buffer folder-buffer
-		  vm-system-state 'editing)
+		  vm-system-state 'editing
+		  buffer-offer-save t)
 	    (run-hooks 'vm-edit-message-hook)
 	    (message 
 	     (substitute-command-keys
 	  (vm-global-block-new-mail t)
 	  (vm-pop-ok-to-ask interactive)
 	  (vm-imap-ok-to-ask interactive)
+	  ;; for string-match calls below
+	  (case-fold-search nil)
 	  this-buffer crash in maildrop meth
 	  (mail-waiting nil))
       (while triples
 	  (vm-global-block-new-mail t)
 	  (vm-pop-ok-to-ask interactive)
 	  (vm-imap-ok-to-ask interactive)
+	  ;; for string-match calls below
+	  (case-fold-search nil)
 	  non-file-maildrop crash in safe-maildrop maildrop popdrop
 	  retrieval-function
 	  (got-mail nil))
 	got-mail ))))
 
 (defun vm-safe-popdrop-string (drop)
-  (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)
-	   (concat (substring drop (match-beginning 2) (match-end 2))
+  (or (and (string-match "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)
+	   (concat (substring drop (match-beginning 3) (match-end 3))
 		   "@"
-		   (substring drop (match-beginning 1) (match-end 1))))
+		   (substring drop (match-beginning 2) (match-end 2))))
       "???"))
 
 (defun vm-safe-imapdrop-string (drop)
-  (or (and (string-match "^imap:\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+" drop)
-	   (concat (substring drop (match-beginning 3) (match-end 3))
+  (or (and (string-match "^\\(imap\\|imap-ssl\\|imap-ssh\\):\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+:\\([^:]+\\):[^:]+" drop)
+	   (concat (substring drop (match-beginning 4) (match-end 4))
 		   "@"
-		   (substring drop (match-beginning 1) (match-end 1))
+		   (substring drop (match-beginning 2) (match-end 2))
 		   " ["
-		   (substring drop (match-beginning 2) (match-end 2))
+		   (substring drop (match-beginning 3) (match-end 3))
 		   "]"))
       "???"))
 
       (narrow-to-region (point-min) (vm-text-end-of (car vm-message-pointer))))
   (vm-display nil nil '(vm-change-folder-type) '(vm-change-folder-type)))
 
+(defun vm-register-global-garbage-files (files)
+  (while files
+    (setq vm-global-garbage-alist
+	  (cons (cons (car files) 'delete-file)
+		vm-global-garbage-alist)
+	  files (cdr files))))
+
+(defun vm-register-folder-garbage-files (files)
+  (vm-register-global-garbage-files files)
+  (save-excursion
+    (vm-select-folder-buffer)
+    (while files
+      (setq vm-folder-garbage-alist
+	    (cons (cons (car files) 'delete-file)
+		  vm-folder-garbage-alist)
+	    files (cdr files)))))
+
+(defun vm-register-folder-garbage (action garbage)
+  (save-excursion
+    (vm-select-folder-buffer)
+    (setq vm-folder-garbage-alist
+	  (cons (cons garbage action)
+		vm-folder-garbage-alist))))
+
+(defun vm-register-message-garbage-files (files)
+  (vm-register-folder-garbage-files files)
+  (save-excursion
+    (vm-select-folder-buffer)
+    (while files
+      (setq vm-message-garbage-alist
+	    (cons (cons (car files) 'delete-file)
+		  vm-message-garbage-alist)
+	    files (cdr files)))))
+
+(defun vm-register-message-garbage (action garbage)
+  (vm-register-folder-garbage action garbage)
+  (save-excursion
+    (vm-select-folder-buffer)
+    (setq vm-message-garbage-alist
+	  (cons (cons garbage action)
+		vm-message-garbage-alist))))
+
+(defun vm-garbage-collect-global ()
+  (save-excursion
+    (while vm-global-garbage-alist
+      (condition-case nil
+	  (funcall (cdr (car vm-global-garbage-alist))
+		   (car (car vm-global-garbage-alist)))
+	(error nil))
+      (setq vm-global-garbage-alist (cdr vm-global-garbage-alist)))))
+
 (defun vm-garbage-collect-folder ()
   (save-excursion
     (while vm-folder-garbage-alist
 	(imapdrop (vm-safe-imapdrop-string source))
 	(coding-system-for-read (vm-binary-coding-system))
 	(coding-system-for-write (vm-binary-coding-system))
+	(use-ssl nil)
+	(use-ssh nil)
+	(session-name "IMAP")
+	(process-connection-type nil)
 	greeting timestamp
 	host port mailbox auth user pass source-list process-buffer
 	source-nopwd-nombox)
 		pass (nth 6 source-list)
 		source-nopwd-nombox
 		(vm-imapdrop-sans-password-and-mailbox source))
+	  (cond ((equal "imap-ssl" (car source-list))
+		 (setq use-ssl t
+		       session-name "IMAP over SSL")
+		 (if (null vm-stunnel-program)
+		     (error "vm-stunnel-program must be non-nil to use IMAP over SSL.")))
+		((equal "imap-ssh" (car source-list))
+		 (setq use-ssh t
+		       session-name "IMAP over SSH")
+		 (if (null vm-ssh-program)
+		     (error "vm-ssh-program must be non-nil to use IMAP over SSH."))))
 	  ;; carp if parts are missing
 	  (if (null host)
 	      (error "No host in IMAP maildrop specification, \"%s\""
 					    vm-imap-passwords)))
 	  ;; get the trace buffer
 	  (setq process-buffer
-		(vm-make-work-buffer (format "trace of IMAP session to %s"
+		(vm-make-work-buffer (format "trace of %s session to %s"
+					     session-name
 					     host)))
 	  (save-excursion
 	    (set-buffer process-buffer)
 	    (buffer-disable-undo process-buffer)
+	    (make-local-variable 'vm-imap-read-point)
 	    ;; clear the trace buffer of old output
 	    (erase-buffer)
 	    ;; Tell MULE not to mess with the text.
 							user pass)))
 	    (if (processp process)
 		(set-process-buffer process (current-buffer))
-	      (insert "starting IMAP session " (current-time-string) "\n")
+	      (insert "starting " session-name
+		      " 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))
+	      (cond (use-ssl
+		     (vm-setup-stunnel-random-data-if-needed)
+		     (setq process
+			   (apply 'start-process session-name process-buffer
+				  vm-stunnel-program
+				  (nconc (vm-stunnel-random-data-args)
+					 (list "-W" "-c" "-r"
+					       (format "%s:%s" host port))
+					 vm-stunnel-program-switches))))
+		    (use-ssh
+		     (setq process (open-network-stream
+				    session-name process-buffer
+				    "127.0.0.1"
+				    (vm-setup-ssh-tunnel host port))))
+		    (t
+		     (setq process (open-network-stream session-name
+							process-buffer
+							host port))))
 	      (and (null process) (throw 'end-of-session nil))
-	      (insert "connected\n"))
+	      (insert-before-markers "connected\n"))
+	    (setq vm-imap-read-point (point))
 	    (process-kill-without-query process)
-	    (make-local-variable 'vm-imap-read-point)
-	    (setq vm-imap-read-point (point))
 	    (if (null (setq greeting (vm-imap-read-greeting process)))
 		(progn (delete-process process)
 		       (throw 'end-of-session nil)))
 	    (setq process-to-shutdown nil)
 	    process ))
       (if process-to-shutdown
-	  (vm-imap-end-session process-to-shutdown t)))))
+	  (vm-imap-end-session process-to-shutdown t))
+      (vm-tear-down-stunnel-random-data))))
 
 (defun vm-imap-end-session (process &optional keep-buffer)
   (save-excursion
 			    (vm-imap-stat-x-need o)
 			    (if (eq (vm-imap-stat-x-got o)
 				    (vm-imap-stat-y-got o))
-				" (stalled)"
+				(cond ((>= (vm-imap-stat-x-got o)
+					   (vm-imap-stat-x-need o))
+				       "(post processing)")
+				      (t " (stalled)"))
 			      "")))))
   (vm-set-imap-stat-y-box o (vm-imap-stat-x-box o))
   (vm-set-imap-stat-y-currmsg o (vm-imap-stat-x-currmsg o))
     retval ))
 
 (defun vm-imap-cleanup-region (start end)
-  (if (> (- end start) 30000)
-      (message "CRLF conversion and char unstuffing..."))
   (setq end (vm-marker end))
   (save-excursion
     (goto-char start)
     ;; CRLF -> LF
     (while (and (< (point) end) (search-forward "\r\n"  end t))
       (replace-match "\n" t t)))
-  (if (> (- end start) 30000)
-      (message "CRLF conversion and char unstuffing... done"))
   (set-marker end nil))
 
 (defun vm-imapdrop-sans-password (source)
     (set s m)
     s ))
 
+(defun vm-mime-make-cache-symbol ()
+  (let ((s (make-symbol "<<c>>")))
+    (set s s)
+    s ))
+
 (defun vm-mm-layout (m)
   (or (vm-mime-layout-of m)
       (progn (vm-set-mime-layout-of m (vm-mime-parse-entity-safe m))
 (defun vm-decode-mime-message-headers (m)
   (let ((case-fold-search t)
 	(buffer-read-only nil)
-	charset encoding match-start match-end start end)
+	charset need-conversion encoding match-start match-end start end)
     (save-excursion
       (goto-char (vm-headers-of m))
       (while (re-search-forward vm-mime-encoded-word-regexp (vm-text-of m) t)
 	      end (vm-marker (match-end 5)))
 	;; don't change anything if we can't display the
 	;; character set properly.
-	(if (not (vm-mime-charset-internally-displayable-p charset))
+	(if (and (not (vm-mime-charset-internally-displayable-p charset))
+		 (not (setq need-conversion
+			    (vm-mime-can-convert-charset charset))))
 	    nil
 	  (delete-region end match-end)
 	  (condition-case data
 			   (goto-char start)
 			   (insert "**invalid encoded word**")
 			   (delete-region (point) end)))
+	  (and need-conversion
+	       (setq charset (vm-mime-charset-convert-region
+			      charset start end)))
 	  (vm-mime-charset-decode-region charset start end)
 	  (goto-char end)
 	  (delete-region match-start start))))))
 		  (setq version (vm-get-header-contents m "MIME-Version:")
 			version (car (vm-mime-parse-content-header version))
 			type (vm-get-header-contents m "Content-Type:")
+			version (if (or version
+					vm-mime-require-mime-version-header)
+				    version
+				  (if type "1.0" nil)) 
 			qtype (vm-mime-parse-content-header type ?\; t)
 			type (vm-mime-parse-content-header type ?\;)
-			encoding (or (vm-get-header-contents
-				      m "Content-Transfer-Encoding:")
-				     "7bit")
+			encoding (vm-get-header-contents
+				  m "Content-Transfer-Encoding:")
+			version (if (or version
+					vm-mime-require-mime-version-header)
+				    version
+				  (if encoding "1.0" nil)) 
+			encoding (or encoding "7bit")
 			encoding (or (car
 				      (vm-mime-parse-content-header encoding))
 				     "7bit")
 				  (vm-marker (1- (vm-text-of m)))
 				  (vm-text-of m)
 				  (vm-text-end-of m)
-				  nil nil
+				  nil
+				  (vm-mime-make-cache-symbol)
 				  (vm-mime-make-message-symbol m)
 				  nil )))
 		  ((null type)
 			   (vm-marker (1- (point)))
 			   (vm-marker (point))
 			   (vm-marker (point-max))
-			   nil nil
+			   nil
+			   (vm-mime-make-cache-symbol)
 			   (vm-mime-make-message-symbol m)
 			   nil ))
 		  ((null (string-match "[^/ ]+/[^/ ]+" (car type)))
 				     (narrow-to-region (point) (point-max))
 				     (vm-mime-parse-entity-safe m c-t
 								c-t-e t)))
-				  nil
+				  (vm-mime-make-cache-symbol)
 				  (vm-mime-make-message-symbol m)
 				  nil )))
 		  (t
 				  (vm-marker (1- (point)))
 				  (vm-marker (point))
 				  (vm-marker (point-max))
-				  nil nil
+				  nil
+				  (vm-mime-make-cache-symbol)
 				  (vm-mime-make-message-symbol m)
 				  nil ))))
 	    (setq p (cdr type)
 		    (vm-marker (point))
 		    (vm-marker (point-max))
 		    (nreverse multipart-list)
-		    nil
+		    (vm-mime-make-cache-symbol)
 		    (vm-mime-make-message-symbol m)
 		    nil )))))))
 
 	     (vm-marker (1- text))
 	     text
 	     text-end
-	     nil nil
+	     nil
+	     (vm-mime-make-cache-symbol)
 	     (vm-mime-make-message-symbol m)
 	     nil)))))
 
-(defun vm-mime-get-xxx-parameter (layout name param-list)
+(defun vm-mime-get-xxx-parameter (name param-list)
   (let ((match-end (1+ (length name)))
 	(name-regexp (concat (regexp-quote name) "="))
 	(case-fold-search t)
 	 (substring (car param-list) match-end))))
 
 (defun vm-mime-get-parameter (layout name)
-  (vm-mime-get-xxx-parameter layout name (cdr (vm-mm-layout-type layout))))
+  (vm-mime-get-xxx-parameter name (cdr (vm-mm-layout-type layout))))
 
 (defun vm-mime-get-disposition-parameter (layout name)
-  (vm-mime-get-xxx-parameter layout name
-			     (cdr (vm-mm-layout-disposition layout))))
+  (vm-mime-get-xxx-parameter name (cdr (vm-mm-layout-disposition layout))))
+
+(defun vm-mime-set-xxx-parameter (name value param-list)
+  (let ((match-end (1+ (length name)))
+	(name-regexp (concat (regexp-quote name) "="))
+	(case-fold-search t)
+	(done nil))
+    (while (and param-list (not done))
+      (if (and (string-match name-regexp (car param-list))
+	       (= (match-end 0) match-end))
+	  (setq done t)
+	(setq param-list (cdr param-list))))
+    (and (car param-list)
+	 (setcar param-list (concat "charset=" value)))))
+
+(defun vm-mime-set-parameter (layout name value)
+  (vm-mime-set-xxx-parameter name value (cdr (vm-mm-layout-type layout))))
+
+(defun vm-mime-set-qparameter (layout name value)
+  (setq value (concat "\"" value "\""))
+  (vm-mime-set-xxx-parameter name value (cdr (vm-mm-layout-qtype layout))))
 
 (defun vm-mime-insert-mime-body (layout)
   (vm-insert-region-from-buffer (marker-buffer (vm-mm-layout-body-start layout))
 		      (vm-multiple-frames-possible-p))
 		 (vm-set-hooks-for-frame-deletion))
 	     (use-local-map vm-mode-map)
-	     (and (vm-toolbar-support-possible-p) vm-use-toolbar
-		  (vm-toolbar-install-toolbar))
+	     (vm-toolbar-install-or-uninstall-toolbar)
 	     (and (vm-menu-support-possible-p)
 		  (vm-menu-install-menus))
 	     (run-hooks 'vm-presentation-mode-hook))
 	   (and (vm-image-type-available-p 'png) (vm-images-possible-here-p)))
 	  ((vm-mime-types-match "image/tiff" type)
 	   (and (vm-image-type-available-p 'tiff) (vm-images-possible-here-p)))
+	  ((vm-mime-types-match "image/xpm" type)
+	   (and (vm-image-type-available-p 'xpm) (vm-images-possible-here-p)))
+	  ((vm-mime-types-match "image/pbm" type)
+	   (and (vm-image-type-available-p 'pbm) (vm-images-possible-here-p)))
+	  ((vm-mime-types-match "image/xbm" type)
+	   (and (vm-image-type-available-p 'xbm) (vm-images-possible-here-p)))
 	  ((vm-mime-types-match "audio/basic" type)
 	   (and vm-xemacs-p
 		(or (featurep 'native-sound)
 	  ((vm-mime-types-match "text" type)
 	   (let ((charset (or (vm-mime-get-parameter layout "charset")
 			      "us-ascii")))
-	     (vm-mime-charset-internally-displayable-p charset)))
+	     (or (vm-mime-charset-internally-displayable-p charset)
+		 (vm-mime-can-convert-charset charset))))
 	  (t nil))))
 
 (defun vm-mime-can-convert (type)
-  (let ((alist vm-mime-type-converter-alist)
+  (or (vm-mime-can-convert-0 type vm-mime-type-converter-alist)
+      (vm-mime-can-convert-0 type vm-mime-image-type-converter-alist)))
+
+(defun vm-mime-can-convert-0 (type alist)
+  (let (
 	;; fake layout. make it the wrong length so an error will
 	;; be signaled if vm-mime-can-display-internal ever asks
 	;; for one of the other fields
     (and alist (car alist))))
 
 (defun vm-mime-convert-undisplayable-layout (layout)
-  (let ((ooo (vm-mime-can-convert (car (vm-mm-layout-type layout)))))
-    (message "Converting %s to %s..."
-	     (car (vm-mm-layout-type layout))
+  (catch 'done
+    (let ((ooo (vm-mime-can-convert (car (vm-mm-layout-type layout))))
+	  ex work-buffer)
+      (message "Converting %s to %s..."
+	       (car (vm-mm-layout-type layout))
+	       (nth 1 ooo))
+      (save-excursion
+	(setq work-buffer (vm-make-work-buffer " *mime object*"))
+	(vm-register-message-garbage 'kill-buffer work-buffer)
+	(set-buffer work-buffer)
+	;; call-process-region calls write-region.
+	;; don't let it do CR -> LF translation.
+	(setq selective-display nil)
+	(vm-mime-insert-mime-body layout)
+	(vm-mime-transfer-decode-region layout (point-min) (point-max))
+	(setq ex (call-process-region (point-min) (point-max) shell-file-name
+				      t t nil shell-command-switch (nth 2 ooo)))
+	(if (not (eq ex 0))
+	    (progn
+	      (message "Conversion from %s to %s failed (exit code %s)"
+		       (car (vm-mm-layout-type layout))
+		       (nth 1 ooo)
+		       ex)
+	      (throw 'done nil)))
+	(goto-char (point-min))
+	(insert "Content-Type: " (nth 1 ooo) "\n")
+	(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))
+	(vector (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout)))
+		(append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout)))
+		"binary"
+		(vm-mm-layout-id layout)
+		(vm-mm-layout-description layout)
+		(vm-mm-layout-disposition layout)
+		(vm-mm-layout-qdisposition layout)
+		(vm-marker (point-min))
+		(vm-marker (1- (point)))
+		(vm-marker (point))
+		(vm-marker (point-max))
+		nil
+		(vm-mime-make-cache-symbol)
+		(vm-mime-make-message-symbol (vm-mm-layout-message layout))
+		nil)))))
+
+(defun vm-mime-can-convert-charset (charset)
+  (vm-mime-can-convert-charset-0 charset vm-mime-charset-converter-alist))
+
+(defun vm-mime-can-convert-charset-0 (charset alist)
+  (let ((done nil))
+    (while (and alist (not done))
+      (cond ((and (vm-string-equal-ignore-case (car (car alist)) charset)
+		  (vm-mime-charset-internally-displayable-p
+		   (nth 1 (car alist))))
+	     (setq done t))
+	    (t (setq alist (cdr alist)))))
+    (and alist (car alist))))
+
+(defun vm-mime-convert-undisplayable-charset (layout)
+  (let ((charset (vm-mime-get-parameter layout "charset"))
+	ooo work-buffer)
+    (setq ooo (vm-mime-can-convert-charset charset))
+    (message "Converting charset %s to %s..."
+	     charset
 	     (nth 1 ooo))
     (save-excursion
-      (set-buffer (vm-make-work-buffer " *mime object*"))
-      (setq vm-message-garbage-alist
-	    (cons (cons (current-buffer) 'kill-buffer)
-		  vm-message-garbage-alist))
+      (setq work-buffer (vm-make-work-buffer " *mime object*"))
+      (vm-register-message-garbage 'kill-buffer work-buffer)
+      (set-buffer work-buffer)
       ;; call-process-region calls write-region.
       ;; don't let it do CR -> LF translation.
       (setq selective-display nil)
       (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))
+      (setq layout
+	    (vector (copy-sequence (vm-mm-layout-type layout))
+		    (copy-sequence (vm-mm-layout-type layout))
+		    "binary"
+		    (vm-mm-layout-id layout)
+		    (vm-mm-layout-description layout)
+		    (vm-mm-layout-disposition layout)
+		    (vm-mm-layout-qdisposition layout)
+		    (vm-marker (point-min))
+		    (vm-marker (1- (point)))
+		    (vm-marker (point))
+		    (vm-marker (point-max))
+		    nil
+		    (vm-mime-make-cache-symbol)
+		    (vm-mime-make-message-symbol (vm-mm-layout-message layout))
+		    nil))
+      (vm-mime-set-parameter layout "charset" (nth 1 ooo))
+      (vm-mime-set-qparameter layout "charset" (nth 1 ooo))
       (goto-char (point-min))
-      (insert "Content-Type: " (nth 1 ooo) "\n")
-      (insert "Content-Transfer-Encoding: binary\n\n")
+      (insert-before-markers "Content-Type: " (car (vm-mm-layout-type layout)))
+      (insert-before-markers ";\n\t"
+			     (mapconcat 'identity
+					(car (vm-mm-layout-type layout))
+					";\n\t")
+			     "\n")
+      (insert-before-markers "Content-Transfer-Encoding: binary\n\n")
       (set-buffer-modified-p nil)
-      (message "Converting %s to %s... done"
-	       (car (vm-mm-layout-type layout))
+      (message "Converting charset %s to %s... done"
+	       charset
 	       (nth 1 ooo))
-      (vector (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout)))
-	      (append (list (nth 1 ooo)) (cdr (vm-mm-layout-type layout)))
-	      "binary"
-	      (vm-mm-layout-id layout)
-	      (vm-mm-layout-description layout)
-	      (vm-mm-layout-disposition layout)
-	      (vm-mm-layout-qdisposition layout)
-	      (vm-marker (point-min))
-	      (vm-marker (1- (point)))
-	      (vm-marker (point))
-	      (vm-marker (point-max))
-	      nil
-	      nil
-	      (vm-mime-make-message-symbol (vm-mm-layout-message layout))
-	      nil))))
+      layout)))
+
+(defun vm-mime-charset-convert-region (charset b-start b-end)
+  (let ((b (current-buffer))
+	start end oldsize work-buffer ooo)
+    (setq ooo (vm-mime-can-convert-charset charset))
+    (unwind-protect
+	(save-excursion
+	  (setq work-buffer (vm-make-work-buffer " *mime object*"))
+	  (setq oldsize (- b-end b-start))
+	  (set-buffer work-buffer)
+	  (insert-buffer-substring b b-start b-end)
+	  ;; call-process-region calls write-region.
+	  ;; don't let it do CR -> LF translation.
+	  (setq selective-display nil)
+	  (call-process-region (point-min) (point-max) shell-file-name
+			       t t nil shell-command-switch (nth 2 ooo))
+	  (and vm-fsfemacs-mule-p (set-buffer-multibyte t))
+	  (setq start (point-min) end (point-max))
+	  (save-excursion
+	    (set-buffer b)
+	    (goto-char b-start)
+	    (insert-buffer-substring work-buffer start end)
+	    (delete-region (point) (+ (point) oldsize)))
+	  (nth 1 ooo))
+      (and work-buffer (kill-buffer work-buffer)))))
 
 (defun vm-mime-should-display-button (layout dont-honor-content-disposition)
   (if (and vm-honor-mime-content-disposition
 
 (defun vm-decode-mime-layout (layout &optional dont-honor-c-d)
   (let ((modified (buffer-modified-p))
-	file type type2 type-no-subtype (extent nil))
+	new-layout file type type2 type-no-subtype (extent nil))
     (unwind-protect
 	(progn
 	  (if (not (vectorp layout))
 		      (vm-mime-display-external-generic layout))
 		 (and extent (vm-set-extent-property
 			      extent 'vm-mime-disposable nil)))
-		((vm-mime-can-convert type)
-		 (vm-decode-mime-layout
-		  (vm-mime-convert-undisplayable-layout layout)))
+		((and (vm-mime-can-convert type)
+		      (setq new-layout
+			    (vm-mime-convert-undisplayable-layout layout)))
+		 (vm-decode-mime-layout new-layout))
 		(t (and extent (vm-mime-rewrite-failed-button
 				extent
 				(or (vm-mm-layout-display-error layout)
     nil ))
 
 (defun vm-mime-display-internal-text/plain (layout &optional no-highlighting)
-  (let ((start (point)) end
+  (let ((start (point)) end need-conversion
 	(buffer-read-only nil)
 	(m (vm-mm-layout-message layout))
 	(charset (or (vm-mime-get-parameter layout "charset") "us-ascii")))
-    (if (not (vm-mime-charset-internally-displayable-p charset))
+    (if (and (not (vm-mime-charset-internally-displayable-p charset))
+	     (not (setq need-conversion (vm-mime-can-convert-charset charset))))
 	(progn
 	  (vm-set-mm-layout-display-error
 	   layout (concat "Undisplayable charset: " charset))
       (vm-mime-insert-mime-body layout)
       (setq end (point-marker))
       (vm-mime-transfer-decode-region layout start end)
+      (and need-conversion
+	   (setq charset (vm-mime-charset-convert-region charset start end)))
       (vm-mime-charset-decode-region charset start end)
       (or no-highlighting (vm-energize-urls-in-message-region start end))
       (if (and vm-fill-paragraphs-containing-long-lines
 	(coding-system-for-write (vm-binary-coding-system))
 	(append-file t)
 	process	tempfile cache end suffix)
-    (setq cache (cdr (assq 'vm-mime-display-external-generic
-			   (vm-mm-layout-cache layout)))
+    (setq cache (get (vm-mm-layout-cache layout)
+		     'vm-mime-display-external-generic)
 	  process (nth 0 cache)
 	  tempfile (nth 1 cache))
     (if (and (processp process) (eq (process-status process) 'run))
 	     (cond (vm-fsfemacs-mule-p
 		    (let (work-buffer (target (current-buffer)))
 		      (unwind-protect
-			  (progn
+			  (save-excursion
 			    (setq work-buffer (vm-make-work-buffer))
 			    (set-buffer work-buffer)
 			    (vm-mime-insert-mime-body layout)
 	     (setq suffix (vm-mime-extract-filename-suffix layout)
 		   suffix (or suffix
 			      (vm-mime-find-filename-suffix-for-type layout)))
-	     (setq tempfile (vm-make-tempfile-name suffix))
+	     (setq tempfile (vm-make-tempfile suffix))
+	     (vm-register-message-garbage-files (list tempfile))
 	     (let ((buffer-file-type buffer-file-type)
 		   (selective-display nil)
 		   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))))))
+	       (delete-region start end))))
 
       ;; expand % specs
       (let ((p program-list)
 						 program-list
 						 " "))
       (if vm-mime-delete-viewer-processes
-	  (save-excursion
-	    (vm-select-folder-buffer)
-	    (setq vm-message-garbage-alist
-		  (cons (cons process 'delete-process)
-			vm-message-garbage-alist))))
-      (vm-set-mm-layout-cache
-       layout
-       (nconc (vm-mm-layout-cache layout)
-	      (list (cons 'vm-mime-display-external-generic
-			  (list process tempfile)))))))
+	  (vm-register-message-garbage 'delete-process process))
+      (put (vm-mm-layout-cache layout)
+	   'vm-mime-display-external-generic
+	   (list process tempfile))))
   t )
 
 (defun vm-mime-display-internal-application/octet-stream (layout)
 						   vm-wget-program
 						   "-q" "-O" "-" url)
 		       (error nil))))
+	       ((and (memq 'w3m vm-url-retrieval-methods)
+		     (condition-case data
+			 (vm-run-command-on-region (point) (point)
+						   buffer
+						   vm-w3m-program
+						   "-dump_source" url)
+		       (error nil))))
 	       ((and (memq 'lynx vm-url-retrieval-methods)
 		     (condition-case data
 			 (vm-run-command-on-region (point) (point)
   (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))))
+   ((and vm-fsfemacs-p (fboundp 'image-type-available-p))
+    (vm-mime-display-internal-image-fsfemacs-21-xxxx layout image-type name))
+   (vm-fsfemacs-p 
+    (vm-mime-display-internal-image-fsfemacs-19-xxxx layout image-type name))))
 
 (defun vm-mime-display-internal-image-xemacs-xxxx (layout image-type name)
   (if (and (vm-images-possible-here-p)
 	   (vm-image-type-available-p image-type))
       (let ((start (point-marker)) end tempfile g e
 	    (selective-display nil)
+	    (incremental vm-mime-display-image-strips-incrementally)
+	    do-strips
 	    (buffer-read-only nil))
-	(if (setq g (cdr (assq 'vm-mime-display-internal-image-xxxx
-			       (vm-mm-layout-cache layout))))
+	(if (setq tempfile (get (vm-mm-layout-cache layout)
+				'vm-mime-display-internal-image-xxxx))
 	    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)
+	  (setq tempfile (vm-make-tempfile))
+	  (vm-register-folder-garbage-files (list tempfile))
 	  ;; 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)))
+	  (put (vm-mm-layout-cache layout)
+	       'vm-mime-display-internal-image-xxxx
+	       tempfile)
 	  (delete-region start end))
+	(if (or (not (bolp))
+		(bobp)
+		(map-extents 'extent-property nil (1- (point)) (point)
+			     'begin-glyph))
+	    (insert "\n"))
+	(setq do-strips (and (stringp vm-imagemagick-convert-program)
+			     vm-mime-use-image-strips))
+	(cond (do-strips
+	       (condition-case error-data
+		   (let ((strips (vm-make-image-strips tempfile
+						       (font-height
+							(face-font 'default))
+						       image-type
+						       t incremental))
+			 process image-list extent-list
+			 (first t))
+		     (setq process (car strips)
+			   strips (cdr strips)
+			   image-list strips)
+		     (vm-register-message-garbage-files strips)
+		     (while strips
+		       (setq g (make-glyph
+				(list
+				 (cons nil
+				       (vector 'string
+					       ':data
+					       (if (or first
+						       (null (cdr strips)))
+						   (progn
+						     (setq first nil)
+						     "+-----+")
+						 "|image|"))))))
+		       (setq e (vm-make-extent (1- (point)) (point)))
+		       (if (cdr strips) (insert "\n"))
+		       (vm-set-extent-property e 'begin-glyph g)
+		       (vm-set-extent-property e 'start-open t)
+		       (setq extent-list (cons e extent-list))
+		       (setq strips (cdr strips)))
+		     (save-excursion
+		       (set-buffer (process-buffer process))
+		       (set (make-local-variable 'vm-image-list) image-list)
+		       (set (make-local-variable 'vm-image-type) image-type)
+		       (set (make-local-variable 'vm-image-type-name)
+			    name)
+		       (set (make-local-variable 'vm-extent-list)
+			    (nreverse extent-list)))
+		     (if incremental
+			 (set-process-filter
+			  process
+			  'vm-process-filter-display-some-image-strips))
+		     (set-process-sentinel
+		      process
+		      'vm-process-sentinel-display-image-strips))
+		 (vm-image-too-small
+		  (setq do-strips nil))
+		 (error
+		  (message "Failed making image strips: %s" error-data)
+		  ;; fallback to the non-strips way
+		  (setq do-strips nil)))))
+	(cond ((not do-strips)
+	       (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 (sort of)
+	       ;; if the entire image is above the baseline.
+	       (set-glyph-baseline g 100)
+	       (set-glyph-face g 'vm-monochrome-image)
+	       (setq e (vm-make-extent (1- (point)) (point)))
+	       (vm-set-extent-property e 'begin-glyph g)
+	       (vm-set-extent-property e 'start-open t)))
+	t )))
+
+(defun vm-mime-display-internal-image-fsfemacs-21-xxxx (layout image-type name)
+  (if (and (vm-images-possible-here-p)
+	   (vm-image-type-available-p image-type))
+      (let (start end tempfile image work-buffer
+	    (selective-display nil)
+	    (incremental vm-mime-display-image-strips-incrementally)
+	    do-strips
+	    (buffer-read-only nil))
+	(if (setq tempfile (get (vm-mm-layout-cache layout)
+				'vm-mime-display-internal-image-xxxx))
+	    nil
+	  (unwind-protect
+	      (progn
+		(save-excursion
+		  (setq work-buffer (vm-make-work-buffer))
+		  (set-buffer work-buffer)
+		  (setq start (point))
+		  (vm-mime-insert-mime-body layout)
+		  (setq end (point-marker))
+		  (vm-mime-transfer-decode-region layout start end)
+		  (setq tempfile (vm-make-tempfile))
+		  (let ((coding-system-for-write (vm-binary-coding-system)))
+		    (write-region start end tempfile nil 0))
+		  (put (vm-mm-layout-cache layout)
+		       'vm-mime-display-internal-image-xxxx
+		       tempfile))
+		(vm-register-folder-garbage-files (list tempfile)))
+	    (and work-buffer (kill-buffer work-buffer))))
 	(if (not (bolp))
-	    (insert-char ?\n 2)
-	  (insert-char ?\n 1))
-	(setq e (vm-make-extent (1- (point)) (point)))
-	(vm-set-extent-property e 'begin-glyph g)
-	(vm-set-extent-property e 'start-open t)
-	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
-	    (coding-system-for-write (vm-binary-coding-system))
-	    (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)
-	(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))
+	    (insert-char ?\n 1))
+	(setq do-strips (and (stringp vm-imagemagick-convert-program)
+			     vm-mime-use-image-strips))
+	(cond (do-strips
+	       (condition-case error-data
+		   (let ((strips (vm-make-image-strips
+				  tempfile
+				  (* 2 (frame-char-height))
+				  image-type t incremental))
+			 (first t)
+			 o process image-list overlay-list)
+		     (setq process (car strips)
+			   strips (cdr strips)
+			   image-list strips)
+		     (vm-register-message-garbage-files strips)
+		     (while strips
+		       (if (or first (null (cdr strips)))
+			   (progn
+			     (setq first nil)
+			     (insert "+-----+"))
+			 (insert "|image|"))
+		       (setq o (make-overlay (- (point) 7) (point)))
+		       (overlay-put o 'evaporate t)
+		       (setq overlay-list (cons o overlay-list))
+		       (insert "\n")
+		       (setq strips (cdr strips)))
+		     (save-excursion
+		       (set-buffer (process-buffer process))
+		       (set (make-local-variable 'vm-image-list) image-list)
+		       (set (make-local-variable 'vm-image-type) image-type)
+		       (set (make-local-variable 'vm-image-type-name)
+			    name)
+		       (set (make-local-variable 'vm-overlay-list)
+			    (nreverse overlay-list)))
+		     (if incremental
+			 (set-process-filter
+			  process
+			  'vm-process-filter-display-some-image-strips))
+		     (set-process-sentinel
+		      process
+		      'vm-process-sentinel-display-image-strips))
+		 (vm-image-too-small
+		  (setq do-strips nil))
+		 (x-error
+		  (message "Failed making image strips: %s" error-data)
+		  ;; fallback to the non-strips way
+		  (setq do-strips nil)))))
+	(cond ((not do-strips)
+	       (setq image (list 'image ':type image-type ':file tempfile))
+	       ;; insert one char so we can attach the image to it.
+	       (insert "z")
+	       (put-text-property (1- (point)) (point) 'display image)))
 	t )
     nil ))
 
+(defun vm-mime-display-internal-image-fsfemacs-19-xxxx (layout image-type name)
+  (if (and (vm-images-possible-here-p)
+	   (vm-image-type-available-p image-type))
+      (catch 'done
+	(let ((selective-display nil)
+	      start end tempfile image work-buffer
+	      (hroll (if vm-fsfemacs-mule-p
+			 (+ (cdr (assq 'internal-border-width
+				       (frame-parameters)))
+			    (if (memq (cdr (assq 'vertical-scroll-bars
+						 (frame-parameters)))
+				      '(t left))
+				(vm-fsfemacs-scroll-bar-width)
+			      0))
+		       (cdr (assq 'internal-border-width
+				  (frame-parameters)))))
+	      (vroll (cdr (assq 'internal-border-width (frame-parameters))))
+	      (reverse (eq (cdr (assq 'background-mode (frame-parameters)))
+			   'dark))
+	      blob strips
+	      dims width height char-width char-height
+	      horiz-pad vert-pad
+	      (buffer-read-only nil))
+	  (if (and (setq blob (get (vm-mm-layout-cache layout)
+				   'vm-mime-display-internal-image-xxxx))
+		   (file-exists-p (car blob))
+		   (progn
+		     (setq tempfile (car blob)
+			   width (nth 1 blob)
+			   height (nth 2 blob)
+			   char-width (nth 3 blob)
+			   char-height (nth 4 blob))
+		     (and (= char-width (frame-char-width))
+			  (= char-height (frame-char-height)))))
+	      (setq strips (nth 5 blob))
+	    (unwind-protect
+		(progn
+		  (save-excursion
+		    (setq work-buffer (vm-make-work-buffer))
+		    (set-buffer work-buffer)
+		    (setq start (point))
+		    (vm-mime-insert-mime-body layout)
+		    (setq end (point-marker))
+		    (vm-mime-transfer-decode-region layout start end)
+		    (setq tempfile (vm-make-tempfile))
+		    (let ((coding-system-for-write (vm-binary-coding-system)))
+		      (write-region start end tempfile nil 0))
+		    (setq dims (condition-case error-data
+				   (vm-get-image-dimensions tempfile)
+				 (error
+				  (message "Failed getting image dimensions: %s"
+					   error-data)
+				  (throw 'done nil)))
+			  width (nth 0 dims)
+			  height (nth 1 dims)
+			  char-width (frame-char-width)
+			  char-height (frame-char-height)
+			  horiz-pad (if (< width char-width)
+					(- char-width width)
+				      (% width char-width))
+			  horiz-pad (if (zerop horiz-pad)
+					horiz-pad
+				      (- char-width horiz-pad))
+			  vert-pad (if (< height char-height)
+				       (- char-height height)
+				     (% height char-height))
+			  vert-pad (if (zerop vert-pad)
+				       vert-pad
+				     (- char-height vert-pad)))
+		    ;; crop one line from the bottom of the image
+		    ;; if vertical padding needed is odd so that
+		    ;; the image height plus the padding will be an
+		    ;; exact multiple of the char height.
+		    (if (not (zerop (% vert-pad 2)))
+			(setq height (1- height)
+			      vert-pad (1+ vert-pad)))
+		    (call-process-region start end
+					 vm-imagemagick-convert-program
+					 t t nil
+					 (if reverse "-negate" "-matte")
+					 "-crop"
+					 (format "%dx%d+0+0" width height)
+					 "-mattecolor" "white"
+					 "-frame"
+					 (format "%dx%d+0+0"
+						 (/ (1+ horiz-pad) 2)
+						 (/ vert-pad 2))
+					 "-"
+					 "-")
+		    (setq width (+ width (* 2 (/ (1+ horiz-pad) 2)))
+			  height (+ height (* 2 (/ vert-pad 2))))
+		    (let ((coding-system-for-write (vm-binary-coding-system)))
+		      (write-region (point-min) (point-max) tempfile nil 0))
+		    (put (vm-mm-layout-cache layout)
+			 'vm-mime-display-internal-image-xxxx
+			 (list tempfile width height char-width char-height)))
+		  (vm-register-folder-garbage-files (list tempfile)))
+	      (and work-buffer (kill-buffer work-buffer))))
+	  (if (not (bolp))
+	      (insert-char ?\n 1))
+	  (condition-case error-data
+	      (let (o start process image-list overlay-list)
+		(if (and strips (file-exists-p (car strips)))
+		    (setq image-list strips)
+		  (setq strips (vm-make-image-strips tempfile char-height
+						     image-type t nil
+						     hroll vroll)
+			process (car strips)
+			strips (cdr strips)
+			image-list strips)
+		  (put (vm-mm-layout-cache layout)
+		       'vm-mime-display-internal-image-xxxx
+		       (list tempfile width height char-width char-height
+			     strips))
+		  (vm-register-message-garbage-files strips))
+		(while strips
+		  (setq start (point))
+		  (insert-char ?\  (/ width char-width))
+		  (put-text-property start (point) 'face 'vm-image-placeholder)
+		  (setq o (make-overlay start (point) nil t))
+		  (overlay-put o 'evaporate t)
+		  (setq overlay-list (cons o overlay-list))
+		  (insert "\n")
+		  (setq strips (cdr strips)))
+		(if process
+		    (save-excursion
+		      (set-buffer (process-buffer process))
+		      (set (make-local-variable 'vm-image-list) image-list)
+		      (set (make-local-variable 'vm-image-type) image-type)
+		      (set (make-local-variable 'vm-image-type-name)
+			   name)
+		      (set (make-local-variable 'vm-overlay-list)
+			   (nreverse overlay-list))
+		      ;; incremental strip display intentionally
+		      ;; omitted because it makes the Emacs 19
+		      ;; display completely repaint for each new
+		      ;; strip.
+		      (set-process-sentinel
+		       process
+		       'vm-process-sentinel-display-image-strips))
+		  (vm-display-image-strips-on-overlay-regions image-list
+							      (nreverse
+							       overlay-list)
+							      image-type)))
+	    (error
+	     (message "Failed making image strips: %s" error-data)))
+	  t ))
+    nil ))
+
+(defun vm-get-image-dimensions (file)
+  (let (work-buffer width height)
+    (unwind-protect
+	(save-excursion
+	  (setq work-buffer (vm-make-work-buffer))
+	  (set-buffer work-buffer)
+	  (call-process vm-imagemagick-identify-program nil t nil file)
+	  (goto-char (point-min))
+	  (or (search-forward file nil t)
+	      (error "file name missing from 'identify' output: %s"
+		     (buffer-string)))
+	  (if (not (re-search-forward "\\b\\([0-9]+\\)x\\([0-9]+\\)\\b" nil t))
+	      (error "file dimensions missing from 'identify' output: %s"
+		     (buffer-string)))
+	  (setq width (string-to-int (match-string 1))
+		height (string-to-int (match-string 2))))
+      (and work-buffer (kill-buffer work-buffer)))
+    (list width height)))
+
+(defun vm-imagemagick-type-indicator-for (image-type)
+  (cond ((eq image-type 'jpeg) "jpeg:")
+	((eq image-type 'gif) "gif:")
+	((eq image-type 'png) "png:")
+	((eq image-type 'tiff) "tiff:")
+	((eq image-type 'xpm) "xpm:")
+	((eq image-type 'pbm) "pbm:")
+	((eq image-type 'xbm) "xbm:")
+	(t "")))
+
+(defun vm-make-image-strips (file min-height image-type async incremental
+				  &optional hroll vroll)
+  (or hroll (setq hroll 0))
+  (or vroll (setq vroll 0))
+  (let ((process-connection-type nil)
+	(i 0)
+	(output-type (vm-imagemagick-type-indicator-for image-type))
+	image-list dimensions width height starty newfile work-buffer
+	quotient remainder adjustment process)
+    (setq dimensions (vm-get-image-dimensions file)
+	  width (car dimensions)
+	  height (car (cdr dimensions)))
+    (if (< height min-height)
+	(signal 'vm-image-too-small nil))
+    (setq quotient (/ height min-height)
+	  remainder (% height min-height)
+	  adjustment (/ remainder quotient)
+	  remainder (% remainder quotient)
+	  starty 0)
+    (unwind-protect
+	(save-excursion
+	  (setq work-buffer (vm-make-work-buffer))
+	  (set-buffer work-buffer)
+	  (goto-char (point-min))
+	  (while (< starty height)
+	    (setq newfile (vm-make-tempfile))
+	    (if async
+		(progn
+		  (insert vm-imagemagick-convert-program
+			  " -crop"
+			  (format " %dx%d+0+%d"
+				  width
+				  (+ min-height adjustment
+				     (if (zerop remainder) 0 1))
+				  starty)
+			  (format " -roll +%d+%d" hroll vroll)
+			  " '" file "' '" output-type newfile "'\n")
+		  (if incremental
+		      (progn
+			(insert "echo XZXX" (int-to-string i) "XZXX\n")))
+		  (setq i (1+ i)))
+	      (call-process vm-imagemagick-convert-program nil nil nil
+			    "-crop"
+			    (format "%dx%d+0+%d"
+				    width
+				    (+ min-height adjustment
+				       (if (zerop remainder) 0 1))
+				    starty)
+			    "-roll"
+			    (format "+%d+%d" hroll vroll)
+			    file (concat output-type newfile)))
+	    (setq image-list (cons newfile image-list)
+		  starty (+ starty min-height adjustment
+			    (if (zerop remainder) 0 1))
+		  remainder (if (= 0 remainder) 0 (1- remainder))))
+	  (if (not async)
+	      nil
+	    (goto-char (point-max))
+	    (insert "exit\n")
+	    (setq process
+		  (start-process (format "image strip maker for %s" file)
+				 (current-buffer)
+				 shell-file-name))
+	    (process-send-string process (buffer-string))
+	    (setq work-buffer nil))
+	  (if async
+	      (cons process (nreverse image-list))
+	    (nreverse image-list)))
+      (and work-buffer (kill-buffer work-buffer)))))
+
+(defvar vm-image-list)
+(defvar vm-image-type)
+(defvar vm-image-type-name)
+(defvar vm-extent-list)
+(defvar vm-overlay-list)
+(defun vm-process-sentinel-display-image-strips (process what-happened)
+  (save-excursion
+    (set-buffer (process-buffer process))
+    (cond ((and (boundp 'vm-extent-list)
+		(boundp 'vm-image-list))
+	   (let ((strips vm-image-list)
+		 (extents vm-extent-list)
+		 (image-type vm-image-type)
+		 (type-name vm-image-type-name))
+	     (vm-display-image-strips-on-extents strips extents image-type
+						 type-name)))
+	  ((and (boundp 'vm-overlay-list)
+		(overlay-buffer (car vm-overlay-list))
+		(boundp 'vm-image-list))
+	   (let ((strips vm-image-list)
+		 (overlays vm-overlay-list)
+		 (image-type vm-image-type))
+	     (vm-display-image-strips-on-overlay-regions strips overlays
+							 image-type))))
+    (kill-buffer (current-buffer))))
+
+(defun vm-display-image-strips-on-extents (strips extents image-type type-name)
+  (let (g)
+    (while (and strips
+		(file-exists-p (car strips))
+		(extent-live-p (car extents))
+		(extent-object (car extents)))
+      (setq g (make-glyph
+	       (list
+		(cons (list 'win)
+		      (vector image-type ':file (car strips)))
+		(cons (list 'win)
+		      (vector
+		       'string
+		       ':data
+		       (format "[Unknown/Bad %s image encoding]"
+			       type-name)))
+		(cons nil
+		      (vector 'string
+			      ':data
+			      (format "[%s image]\n" type-name))))))
+      (set-glyph-baseline g 50)
+      (set-glyph-face g 'vm-monochrome-image)
+      (set-extent-begin-glyph (car extents) g)
+      (setq strips (cdr strips)
+	    extents (cdr extents)))))
+
+(defun vm-display-image-strips-on-overlay-regions (strips overlays image-type)
+  (let (prop value omodified)
+    (save-excursion
+      (set-buffer (overlay-buffer (car vm-overlay-list)))
+      (setq omodified (buffer-modified-p))
+      (save-restriction
+	(widen)
+	(unwind-protect
+	    (let ((buffer-read-only nil))
+	      (if (fboundp 'image-type-available-p)
+		  (setq prop 'display)
+		(setq prop 'face))
+	      (while (and strips
+			  (file-exists-p (car strips))
+			  (overlay-end (car overlays)))
+		(if (fboundp 'image-type-available-p)
+		    (setq value (list 'image ':type image-type
+				      ':file (car strips)
+				      ':ascent 50))
+		  (setq value (make-face (make-symbol "<face>")))
+		  (set-face-stipple value (car strips)))
+		(put-text-property (overlay-start (car overlays))
+				   (overlay-end (car overlays))
+				   prop value)
+		(setq strips (cdr strips)
+		      overlays (cdr overlays))))
+	  (set-buffer-modified-p omodified))))))
+
+(defun vm-process-filter-display-some-image-strips (process output)
+  (let (which-strips (i 0))
+    (while (string-match "XZXX\\([0-9]+\\)XZXX" output i)
+      (setq which-strips (cons (string-to-int (match-string 1 output))
+			       which-strips)
+	    i (match-end 0)))
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (cond ((and (boundp 'vm-extent-list)
+		  (boundp 'vm-image-list))
+	     (let ((strips vm-image-list)
+		   (extents vm-extent-list)
+		   (image-type vm-image-type)
+		   (type-name vm-image-type-name))
+	       (vm-display-some-image-strips-on-extents strips extents
+							image-type
+							type-name
+							which-strips)))
+	    ((and (boundp 'vm-overlay-list)
+		  (overlay-buffer (car vm-overlay-list))
+		  (boundp 'vm-image-list))
+	     (let ((strips vm-image-list)
+		   (overlays vm-overlay-list)
+		   (image-type vm-image-type))
+	       (vm-display-some-image-strips-on-overlay-regions
+		strips overlays image-type which-strips)))))))
+
+(defun vm-display-some-image-strips-on-extents
+  (strips extents image-type type-name which-strips)
+  (let (g sss eee)
+    (while which-strips
+      (setq sss (nthcdr (car which-strips) strips)
+	    eee (nthcdr (car which-strips) extents))
+      (cond ((and sss
+		  (file-exists-p (car sss))
+		  (extent-live-p (car eee))
+		  (extent-object (car eee)))
+	     (setq g (make-glyph
+		      (list
+		       (cons (list 'win)
+			     (vector image-type ':file (car sss)))
+		       (cons (list 'win)
+			     (vector
+			      'string
+			      ':data
+			      (format "[Unknown/Bad %s image encoding]"
+				      type-name)))
+		       (cons nil
+			     (vector 'string
+				     ':data
+				     (format "[%s image]\n" type-name))))))
+	     (set-glyph-baseline g 50)
+	     (set-glyph-face g 'vm-monochrome-image)
+	     (set-extent-begin-glyph (car eee) g)))
+      (setq which-strips (cdr which-strips)))))
+
+(defun vm-display-some-image-strips-on-overlay-regions
+  (strips overlays image-type which-strips)
+  (let (sss ooo prop value omodified)
+    (save-excursion
+      (set-buffer (overlay-buffer (car vm-overlay-list)))
+      (setq omodified (buffer-modified-p))
+      (save-restriction
+	(widen)
+	(unwind-protect
+	    (let ((buffer-read-only nil))
+	      (if (fboundp 'image-type-available-p)
+		  (setq prop 'display)
+		(setq prop 'face))
+	      (while which-strips
+		(setq sss (nthcdr (car which-strips) strips)
+		      ooo (nthcdr (car which-strips) overlays))
+		(cond ((and sss
+			    (file-exists-p (car sss))
+			    (overlay-end (car ooo)))
+		       (if (fboundp 'image-type-available-p)
+			   (setq value (list 'image ':type image-type
+					     ':file (car sss)
+					     ':ascent 50))
+			 (setq value (make-face (make-symbol "<face>")))
+			 (set-face-stipple value (car sss)))
+		       (put-text-property (overlay-start (car ooo))
+					  (overlay-end (car ooo))
+					  prop value)))
+		(setq which-strips (cdr which-strips))))
+	  (set-buffer-modified-p omodified))))))
+
 (defun vm-mime-display-internal-image/gif (layout)
   (vm-mime-display-internal-image-xxxx layout 'gif "GIF"))
 
 (defun vm-mime-display-internal-image/tiff (layout)
   (vm-mime-display-internal-image-xxxx layout 'tiff "TIFF"))
 
+(defun vm-mime-display-internal-image/xpm (layout)
+  (vm-mime-display-internal-image-xxxx layout 'xpm "XPM"))
+
+(defun vm-mime-display-internal-image/pbm (layout)
+  (vm-mime-display-internal-image-xxxx layout 'pbm "PBM"))
+
+(defun vm-mime-display-internal-image/xbm (layout)
+  (vm-mime-display-internal-image-xxxx layout 'xbm "XBM"))
+
 (defun vm-mime-display-internal-audio/basic (layout)
   (if (and vm-xemacs-p
 	   (or (featurep 'native-sound)
       (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))))
+	(if (setq tempfile (get (vm-mm-layout-cache layout)
+				'vm-mime-display-internal-audio/basic))
 	    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)
+	  (setq tempfile (vm-make-tempfile))
+	  (vm-register-folder-garbage-files (list tempfile))
 	  ;; 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)))
+	  (put (vm-mm-layout-cache layout)
+	       'vm-mime-display-internal-audio/basic
+	       tempfile)
 	  (delete-region start end))
 	(start-itimer "audioplayer"
 		      (list 'lambda nil (list 'play-sound-file tempfile))
   (interactive)
   (vm-mime-run-display-function-at-point 'vm-mime-display-body-as-text))
 
+(defun vm-mime-reader-map-display-object-as-type ()
+  (interactive)
+  (vm-mime-run-display-function-at-point 'vm-mime-display-object-as-type))
+
 ;; for the karking compiler
 (defvar vm-menu-mime-dispose-menu)
 
     (goto-char (vm-extent-start-position button))
     (vm-decode-mime-layout button t)))
 
+(defun vm-mime-display-object-as-type (button)
+  (let ((vm-auto-displayed-mime-content-types t)
+	(vm-auto-displayed-mime-content-type-exceptions nil)
+	(old-layout (vm-extent-property button 'vm-mime-layout))
+	layout
+	(type (read-string "View as MIME type: ")))
+    (setq layout (copy-sequence old-layout))
+    (vm-set-extent-property button 'vm-mime-layout layout)
+    ;; not universally correct, but close enough.
+    (setcar (vm-mm-layout-type layout) type)
+    (goto-char (vm-extent-start-position button))
+    (vm-decode-mime-layout button t)))
+
 (defun vm-mime-display-body-using-external-viewer (button)
   (let ((layout (vm-extent-property button 'vm-mime-layout))
 	(vm-mime-external-content-type-exceptions nil))
 (defun vm-mime-convert-body-then-display (button)
   (let ((layout (vm-mime-convert-undisplayable-layout
 		 (vm-extent-property button 'vm-mime-layout))))
-    (vm-set-extent-property button 'vm-mime-disposable t)
-    (vm-set-extent-property button 'vm-mime-layout layout)
-    (goto-char (vm-extent-start-position button))
-    (vm-decode-mime-layout button t)))
+    (if (null layout)
+	nil
+      (vm-set-extent-property button 'vm-mime-disposable t)
+      (vm-set-extent-property button 'vm-mime-layout layout)
+      (goto-char (vm-extent-start-position button))
+      (vm-decode-mime-layout button t))))
 
 (defun vm-mime-get-button-layout (e)
   (vm-mime-run-display-function-at-point
 
 (defun vm-mime-extract-filename-suffix (layout)
   (let ((filename (or (vm-mime-get-disposition-parameter layout "filename")
-		      (and (vm-mime-types-match
-			    "application" (car (vm-mm-layout-type layout)))
-			   (vm-mime-get-parameter layout "name"))))
+		      (vm-mime-get-parameter layout "name")))
 	(suffix nil) i)
     (if (and filename (string-match "\\.[^.]+$" filename))
 	(setq suffix (substring filename (match-beginning 0) (match-end 0))))
 	       (vm-set-mm-layout-disposition layout nil)
 	       (vm-set-mm-layout-qdisposition layout nil)
 	       (vm-set-mm-layout-parts layout nil)
-	       (vm-set-mm-layout-cache layout nil)
 	       (vm-set-mm-layout-display-error layout nil)))))))
 
 (defun vm-mime-encode-composition ()
 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-p
-	 (vm-mime-xemacs-encode-composition))
-	(vm-fsfemacs-p
-	 (vm-mime-fsfemacs-encode-composition))
-	(t
-	 (error "don't know how to MIME encode composition for %s"
-		(emacs-version)))))
+  (buffer-enable-undo)
+  (let ((unwind-needed t)
+	(mybuffer (current-buffer)))
+    (unwind-protect
+	(progn
+	  (cond (vm-xemacs-p
+		 (vm-mime-xemacs-encode-composition))
+		(vm-fsfemacs-p
+		 (vm-mime-fsfemacs-encode-composition))
+		(t
+		 (error "don't know how to MIME encode composition for %s"
+			(emacs-version))))
+	  (setq unwind-needed nil))
+      (and unwind-needed (consp buffer-undo-list)
+	   (eq mybuffer (current-buffer))
+	   (setq buffer-undo-list (primitive-undo 1 buffer-undo-list))))))
 
 (defvar enriched-mode)
 
 (defun vm-mf-attachment-file (layout)
   (or vm-mf-attachment-file ;; for %f expansion in external viewer arg lists
       (vm-mime-get-disposition-parameter layout "filename")
-      (and (vm-mime-types-match "application" (car (vm-mm-layout-type layout)))
-	   (vm-mime-get-parameter layout "name"))
+      (vm-mime-get-parameter layout "name")
       "<no suggested filename>"))
 
 (defun vm-mf-event-for-default-action (layout)
       (vm-set-extent-property ee (car props) (car (cdr props)))
       (setq props (cdr (cdr props))))))
 
+(defun vm-make-tempfile (&optional filename-suffix)
+  (let ((modes (default-file-modes))
+	(file (vm-make-tempfile-name filename-suffix)))
+    (unwind-protect
+	(progn
+	  ;; mode 600
+	  (set-default-file-modes (* 6 8 8))
+	  (vm-error-free-call 'delete-file file)
+	  (write-region (point) (point) file nil 0))
+      (set-default-file-modes modes))
+    file ))
+
 (defun vm-make-tempfile-name (&optional filename-suffix)
   (let ((done nil) filename)
     (while (not done)
       (setq filename (convert-standard-filename
-		      (expand-file-name (format "vm%d%s"
+		      (expand-file-name (format "vm%d%d%s"
 						vm-tempfile-counter
-					       (or filename-suffix ""))
+						(random 100000000)
+						(or filename-suffix ""))
 					vm-temp-file-directory))
 	    vm-tempfile-counter (1+ vm-tempfile-counter)
 	    done (not (file-exists-p filename))))
 		     1)
 	(delete-region (- (point) 1) (- (point) 4))))))
 
-(defun vm-md5-region (start end)
-  (if (fboundp 'md5)
-      (md5 (current-buffer) start end)
-    (let ((buffer nil)
-	  (retval nil)
-	  (curbuf (current-buffer)))
-      (unwind-protect
-	  (save-excursion
-	    (setq buffer (vm-make-work-buffer))
-	    (set-buffer buffer)
-	    (insert-buffer-substring curbuf start end)
-	    ;; call-process-region calls write-region.
-	    ;; don't let it do CR -> LF translation.
-	    (setq selective-display nil)
-	    (setq retval
-		  (call-process-region (point-min) (point-max)
-				       (or shell-file-name "/bin/sh")
-				       t buffer nil
-				       shell-command-switch
-				       vm-pop-md5-program))
-	    (if (not (equal retval 0))
-		(progn
-		  (error "%s failed: exited with code %s"
-			 vm-pop-md5-program retval)))
-	    (goto-char (point-min))
-	    (if (or (re-search-forward "[^0-9a-f\n]" nil t)
-		    (< (point-max) 32))
-		(error "%s produced bogus MD5 digest '%s'"
-		       vm-pop-md5-program 
-		       (vm-buffer-substring-no-properties (point-min) 
-							  (point-max))))
-	    ;; MD5 digest is 32 chars long
-	    ;; mddriver adds a newline to make neaten output for tty
-	    ;; viewing, make sure we leave it behind.
-	    (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32)))
-	(and buffer (kill-buffer buffer))))))
+(defun vm-process-sentinel-kill-buffer (process what-happened)
+  (kill-buffer (process-buffer process)))
 
-;; output is in hex
-(defun vm-md5-string (string)
-  (if (fboundp 'md5)
-      (md5 string)
-    (vm-with-string-as-temp-buffer
-     string (function
-	     (lambda ()
-	       (goto-char (point-min))
-	       (insert (vm-md5-region (point-min) (point-max)))
-	       (delete-region (point) (point-max)))))))
-
-;; output is the raw digest bits, not hex
-(defun vm-md5-raw-string (s)
-  (setq s (vm-md5-string s))
-  (let ((raw (make-string 16 0))
-	(i 0) n
-	(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)
-			   ;; 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))))
-    (while (< i 32)
-      (setq n (+ (* (cdr (assoc (aref s i) hex-digit-alist)) 16)
-		 (cdr (assoc (aref s (1+ i)) hex-digit-alist))))
-      (aset raw (/ i 2) n)
-      (setq i (+ i 2)))
-    raw ))
-
-(defun vm-xor-string (s1 s2)
-  (let ((len (length s1))
-	result (i 0))
-    (if (/= len (length s2))
-	(error "strings not of equal length"))
-    (setq result (make-string len 0))
-    (while (< i len)
-      (aset result i (logxor (aref s1 i) (aref s2 i)))
-      (setq i (1+ i)))
-    result ))
+(defun vm-fsfemacs-scroll-bar-width ()
+  (or vm-fsfemacs-cached-scroll-bar-width
+      (let (size)
+	(setq size (frame-pixel-width))
+	(scroll-bar-mode nil)
+	(setq size (- size (frame-pixel-width)))
+	(scroll-bar-mode nil)
+	(setq vm-fsfemacs-cached-scroll-bar-width size))))
 			   ((symbolp arg) nil)
 			   (t arg))))
 
+(defun vm-scroll-forward-one-line ()
+  "Scroll forward one line."
+  (interactive)
+  (vm-scroll-forward 1))
+
+(defun vm-scroll-backward-one-line ()
+  "Scroll backward one line."
+  (interactive)
+  (vm-scroll-forward -1))
+
 (defun vm-highlight-headers ()
   (cond
    ((and vm-xemacs-p vm-use-lucid-highlighting)
 			  (vm-text-of (car vm-message-pointer)))
 	(vm-display-xface))))
 
-(defun vm-narrow-for-preview ()
+(defun vm-narrow-for-preview (&optional just-passing-through)
   (widen)
   ;; hide as much of the message body as vm-preview-lines specifies
   (narrow-to-region
 	     (forward-line (if (natnump vm-preview-lines) vm-preview-lines 0))
 	     ;; KLUDGE CITY: Under XEmacs, an extent's begin-glyph
 	     ;; will be displayed even if the extent is at the end
-	     ;; of a narrowed region.  Thus a message continaing
+	     ;; of a narrowed region.  Thus a message containing
 	     ;; only an image will have the image displayed at
 	     ;; preview time even if vm-preview-lines is 0 provided
 	     ;; vm-mime-decode-for-preview is non-nil.  We kludge
 	     ;; a fix for this by moving everything on the preview
 	     ;; cutoff line one character forward, but only if
 	     ;; we're doing MIME decode for preview.
-	     (if (and vm-xemacs-p
+	     (if (and (not just-passing-through)
+		      vm-xemacs-p
 		      vm-mail-buffer ; in presentation buffer
 		      vm-auto-decode-mime-messages
 		      vm-mime-decode-for-preview
 	 (t (vm-text-end-of (car vm-message-pointer))))))
 
 (defun vm-preview-current-message ()
-  (vm-save-buffer-excursion
-   (setq vm-system-state 'previewing
-	 vm-mime-decoded nil)
-   (if vm-real-buffers
-       (vm-make-virtual-copy (car vm-message-pointer)))
+  ;; Set just-passing-through if the user will never see the
+  ;; message in the previewed state.  Save some time later by not
+  ;; doing preview action that hte user will never see anyway.
+  (let ((just-passing-through
+	 (or (null vm-preview-lines)
+	     (and (not vm-preview-read-messages)
+		  (not (vm-new-flag (car vm-message-pointer)))
+		  (not (vm-unread-flag (car vm-message-pointer)))))))
+    (vm-save-buffer-excursion
+     (setq vm-system-state 'previewing
+	   vm-mime-decoded nil)
+     (if vm-real-buffers
+	 (vm-make-virtual-copy (car vm-message-pointer)))
 
-   ;; run the message select hooks.
-   (save-excursion
-     (vm-select-folder-buffer)
-     (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook)
-     (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer))
-	  (vm-run-message-hook (car vm-message-pointer)
-			       'vm-select-new-message-hook))
-     (and vm-select-unread-message-hook
-	  (vm-unread-flag (car vm-message-pointer))
-	  (vm-run-message-hook (car vm-message-pointer)
-			       'vm-select-unread-message-hook)))
+     ;; run the message select hooks.
+     (save-excursion
+       (vm-select-folder-buffer)
+       (vm-run-message-hook (car vm-message-pointer) 'vm-select-message-hook)
+       (and vm-select-new-message-hook (vm-new-flag (car vm-message-pointer))
+	    (vm-run-message-hook (car vm-message-pointer)
+				 'vm-select-new-message-hook))
+       (and vm-select-unread-message-hook
+	    (vm-unread-flag (car vm-message-pointer))
+	    (vm-run-message-hook (car vm-message-pointer)
+				 'vm-select-unread-message-hook)))
 
-   (vm-narrow-for-preview)
-   (if (or vm-mime-display-function
-	   (natnump vm-fill-paragraphs-containing-long-lines)
-	   (and vm-display-using-mime
-		(not (vm-mime-plain-message-p (car vm-message-pointer)))))
-       (let ((layout (vm-mm-layout (car vm-message-pointer))))
-	 (vm-make-presentation-copy (car vm-message-pointer))
-	 (vm-save-buffer-excursion
-	  (vm-replace-buffer-in-windows (current-buffer)
-					vm-presentation-buffer))
-	 (set-buffer vm-presentation-buffer)
-	 (setq vm-system-state 'previewing)
-	 (vm-narrow-for-preview))
-     (setq vm-presentation-buffer nil)
-     (and vm-presentation-buffer-handle
-	  (vm-replace-buffer-in-windows vm-presentation-buffer-handle
-					(current-buffer))))
+     (vm-narrow-for-preview just-passing-through)
+     (if (or vm-mime-display-function
+	     (natnump vm-fill-paragraphs-containing-long-lines)
+	     (and vm-display-using-mime
+		  (not (vm-mime-plain-message-p (car vm-message-pointer)))))
+	 (let ((layout (vm-mm-layout (car vm-message-pointer))))
+	   (vm-make-presentation-copy (car vm-message-pointer))
+	   (vm-save-buffer-excursion
+	    (vm-replace-buffer-in-windows (current-buffer)
+					  vm-presentation-buffer))
+	   (set-buffer vm-presentation-buffer)
+	   (setq vm-system-state 'previewing)
+	   (vm-narrow-for-preview))
+       (setq vm-presentation-buffer nil)
+       (and vm-presentation-buffer-handle
+	    (vm-replace-buffer-in-windows vm-presentation-buffer-handle
+					  (current-buffer))))
 
-   ;; at this point the current buffer is the presentation buffer
-   ;; if we're using one for this message.
-   (vm-unbury-buffer (current-buffer))
+     ;; at this point the current buffer is the presentation buffer
+     ;; if we're using one for this message.
+     (vm-unbury-buffer (current-buffer))
 
-   (if (and vm-display-using-mime
-	    vm-auto-decode-mime-messages
-	    vm-mime-decode-for-preview
-	    vm-preview-lines
-	    (if vm-mail-buffer
-		(not (vm-buffer-variable-value vm-mail-buffer
-					       'vm-mime-decoded))
-	      (not vm-mime-decoded))
-	    (not (vm-mime-plain-message-p (car vm-message-pointer))))
-       ;; restrict the things that are auto-displayed, since
-       ;; 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-type-exceptions
-	      (cons "message/external-body" vm-auto-displayed-mime-content-type-exceptions))
-	     (vm-mime-external-content-types-alist nil))
-	 (condition-case data
+     (if (and vm-display-using-mime
+	      vm-auto-decode-mime-messages
+	      vm-mime-decode-for-preview
+	      (not just-passing-through)
+	      (if vm-mail-buffer
+		  (not (vm-buffer-variable-value vm-mail-buffer
+						 'vm-mime-decoded))
+		(not vm-mime-decoded))
+	      (not (vm-mime-plain-message-p (car vm-message-pointer))))
+	 (if (eq vm-preview-lines 0)
 	     (progn
-	       (vm-decode-mime-message)
-	       ;; reset vm-mime-decoded so that when the user
-	       ;; opens the message completely, the full MIME
-	       ;; display will happen.
-	       (and vm-mail-buffer
-		    (vm-set-buffer-variable vm-mail-buffer
-					    'vm-mime-decoded nil)))
-	   (vm-mime-error (vm-set-mime-layout-of (car vm-message-pointer)
-						 (car (cdr data)))
-			  (message "%s" (car (cdr data)))))
-	 (vm-narrow-for-preview))
-     (vm-energize-urls-in-message-region)
-     (vm-highlight-headers-maybe)
-     (vm-energize-headers-and-xfaces))
+	       (vm-decode-mime-message-headers (car vm-message-pointer))
+	       (vm-energize-urls)
+	       (vm-highlight-headers-maybe)
+	       (vm-energize-headers-and-xfaces))
+	   ;; restrict the things that are auto-displayed, since
+	   ;; 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-type-exceptions
+		  (cons "message/external-body"
+			vm-auto-displayed-mime-content-type-exceptions))
+		 (vm-mime-external-content-types-alist nil))
+	     (condition-case data
+		 (progn
+		   (vm-decode-mime-message)
+		   ;; reset vm-mime-decoded so that when the user
+		   ;; opens the message completely, the full MIME
+		   ;; display will happen.
+		   (and vm-mail-buffer
+			(vm-set-buffer-variable vm-mail-buffer
+						'vm-mime-decoded nil)))
+	       (vm-mime-error (vm-set-mime-layout-of (car vm-message-pointer)
+						     (car (cdr data)))
+			      (message "%s" (car (cdr data)))))
+	     (vm-narrow-for-preview)))
+       (vm-energize-urls-in-message-region)
+       (vm-highlight-headers-maybe)
+       (vm-energize-headers-and-xfaces))
 
-   (if vm-honor-page-delimiters
-       (vm-narrow-to-page))
-   (goto-char (vm-text-of (car vm-message-pointer)))
-   ;; If we have a window, set window start appropriately.
-   (let ((w (vm-get-visible-buffer-window (current-buffer))))
-     (if w
-	 (progn (set-window-start w (point-min))
-		(set-window-point w (vm-text-of (car vm-message-pointer))))))
-   (if (or (null vm-preview-lines)
-	   (and (not vm-preview-read-messages)
-		(not (vm-new-flag (car vm-message-pointer)))
-		(not (vm-unread-flag (car vm-message-pointer)))))
-       (vm-show-current-message)
-     (vm-update-summary-and-mode-line))))
+     (if (and vm-honor-page-delimiters (not just-passing-through))
+	 (vm-narrow-to-page))