Anonymous avatar Anonymous committed 3fd9929

2003-09-03 Steve Youngs <youngs@xemacs.org>;

* Sync to upstream version 7.17

* Makefile (AUTHOR_VERSION): Bump.
(VERSION): Set to 7.16 so that the automatic release process
increments it to 7.17 for the release.

Comments (0)

Files changed (24)

+2003-09-03  Steve Youngs  <youngs@xemacs.org>
+
+	* Sync to upstream version 7.17
+
+	* Makefile (AUTHOR_VERSION): Bump.
+	(VERSION): Set to 7.16 so that the automatic release process
+	increments it to 7.17 for the release.
+
 2003-04-02  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 7.14 released.
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 7.14
-AUTHOR_VERSION = 7.14
+VERSION = 7.16
+AUTHOR_VERSION = 7.17
 MAINTAINER = Kyle Jones <kyle_jones@wonderworks.com>
 PACKAGE = vm
 PKG_TYPE = regular
 # We use tr -d because Emacs under Cygwin apparently outputs CRLF
 # under Windows.  We remove the CRs.
 # Solaris 8's tr -d '\r' removes r's so we use '\015' instead.
+# the echo command can also emit CRs.
 vm-autoload.elc:	$(SOURCES)
 	@echo scanning sources to build autoload definitions...
-	@$(EMACS) $(BATCHFLAGS) -l ./make-autoloads -f print-autoloads $(SOURCES) | tr -d '\015' >> vm-autoload.el
-	@echo "(provide 'vm-autoload)" >> vm-autoload.el
+	@$(EMACS) $(BATCHFLAGS) -l ./make-autoloads -f print-autoloads $(SOURCES) | tr -d '\015' > vm-autoload.el
+	@echo "(provide 'vm-autoload)" | tr -d '\015' >> vm-autoload.el
 	@echo compiling vm-autoload.el...
 	@$(EMACS) $(BATCHFLAGS) -l $(BYTEOPTS) -f batch-byte-compile vm-autoload.el
 
    that directory and add a menu entry for VM.  It should look
    like this:
 
-* VM::		A mail reader.
+* VM:: (vm)		A mail reader.
 
 5) Put these lines in your .emacs file if they aren't there
    already:
 
 ;;(provide 'tapestry)
 
-(defvar tapestry-version "1.08")
+(defvar tapestry-version "1.09")
 
 ;; Pass state information between the tapestry-set-window-map
 ;; and tapestry-set-buffer-map stages.  UGH.  The reason for this
     (and left top right bottom (list left top right bottom))))
 
 (defun tapestry-window-edges (&optional window)
-  (if (fboundp 'window-pixel-edges)
+  (if (and (fboundp 'window-pixel-edges)
+	   (fboundp 'face-width)
+	   (fboundp 'face-height))
       (let ((edges (window-pixel-edges window))
 	    tmp)
 	(setq tmp edges)
 			   (cons (vm-pop-uidl-of (vm-real-message-of (car mp)))
 				 vm-pop-messages-to-expunge)
 			   ;; Set this so that if Emacs crashes or
-			   ;; the user quites without saving, we
+			   ;; the user quits without saving, we
 			   ;; have a record of messages that were
 			   ;; retrieved and expunged locally.
 			   ;; When the user does M-x recover-file
 			   ;; we won't re-retrieve messages the
-			   ;; user has already deal with.
+			   ;; user has already dealt with.
 			   vm-pop-retrieved-messages
 			   (cons (list (vm-pop-uidl-of
 					(vm-real-message-of (car mp)))
 				       (vm-folder-pop-maildrop-spec)
 				       'uidl)
-				 vm-pop-retrieved-messages))))
+				 vm-pop-retrieved-messages)))
+		    ((eq vm-folder-access-method 'imap)
+		     (setq vm-imap-messages-to-expunge
+			   (cons (cons
+				  (vm-imap-uid-of (vm-real-message-of (car mp)))
+				  (vm-imap-uid-validity-of
+				   (vm-real-message-of (car mp))))
+				 vm-imap-messages-to-expunge)
+			   ;; Set this so that if Emacs crashes or
+			   ;; the user quits without saving, we
+			   ;; have a record of messages that were
+			   ;; retrieved and expunged locally.
+			   ;; When the user does M-x recover-file
+			   ;; we won't re-retrieve messages the
+			   ;; user has already dealt with.
+			   vm-imap-retrieved-messages
+			   (cons (list (vm-imap-uid-of
+					(vm-real-message-of (car mp)))
+				       (vm-imap-uid-validity-of
+					(vm-real-message-of (car mp)))
+				       (vm-folder-imap-maildrop-spec)
+				       'uid)
+				 vm-imap-retrieved-messages))))
 	      (vm-increment vm-modification-counter)
 	      (vm-save-restriction
 	       (widen)
 		  (setq start (point))
 		  (vm-mime-insert-mime-body layout)
 		  (vm-munge-message-separators folder-type start (point))
+		  ;; remove any leading newlines as they will
+		  ;; make vm-reorder-message-headers think the
+		  ;; header section has ended.
+		  (save-excursion
+		    (goto-char start)
+		    (while (= (following-char) ?\n)
+		      (delete-char 1)))
 		  (insert (vm-trailing-message-separator folder-type)))
 		 ((vm-mime-types-match "multipart/digest"
 				       (car (vm-mm-layout-type layout)))
 		    (setq start (point))
 		    (vm-mime-insert-mime-body (car part-list))
 		    (vm-munge-message-separators folder-type start (point))
+		    ;; remove any leading newlines as they will
+		    ;; make vm-reorder-message-headers think the
+		    ;; header section has ended.
+		    (save-excursion
+		      (goto-char start)
+		      (while (= (following-char) ?\n)
+			(delete-char 1)))
 		    (insert (vm-trailing-message-separator folder-type))
 		    (setq part-list (cdr part-list))))
 		 (t (error
 		      (save-match-data
 			;; People who roll digests often think
 			;; any old format will do.  Adding blank
-			;; lines after teh message separator is
-			;; common.  Spaces on such lines are an
+			;; lines after the message separator is
+			;; common.  Spaces in such lines are an
 			;; added delight.
 			(skip-chars-forward " \n")
 			(or (and (vm-match-header)
       (error "This is not a VM message edit buffer."))
   (if (null (buffer-name (vm-buffer-of (car vm-message-pointer))))
       (error "The folder buffer for this message has been killed."))
-  ;; make sure the message ends with a newline
-  (goto-char (point-max))
-  (and (/= (preceding-char) ?\n) (insert ?\n))
-  ;; munge message separators found in the edited message to
-  ;; prevent message from being split into several messages.
-  (vm-munge-message-separators (vm-message-type-of (car vm-message-pointer))
-			       (point-min) (point-max))
-  ;; for From_-with-Content-Length recompute the Content-Length header
-  (if (eq (vm-message-type-of (car vm-message-pointer))
-	  'From_-with-Content-Length)
-      (let ((buffer-read-only nil)
-	    length)
-	(goto-char (point-min))
-	;; first delete all copies of Content-Length
-	(while (and (re-search-forward vm-content-length-search-regexp nil t)
-		    (null (match-beginning 1))
-		    (progn (goto-char (match-beginning 0))
-			   (vm-match-header vm-content-length-header)))
-	  (delete-region (vm-matched-header-start) (vm-matched-header-end)))
-	;; now compute the message body length
-	(goto-char (point-min))
-	(search-forward "\n\n" nil 0)
-	(setq length (- (point-max) (point)))
-	;; insert the header
-	(goto-char (point-min))
-	(insert vm-content-length-header " " (int-to-string length) "\n")))
-  (let ((edit-buf (current-buffer))
-	(mp vm-message-pointer))
-    (if (buffer-modified-p)
-	(progn
-	  (widen)
-	  (save-excursion
-	    (set-buffer (vm-buffer-of (vm-real-message-of (car mp))))
-	    (if (not (memq (vm-real-message-of (car mp)) vm-message-list))
-		(error "The original copy of this message has been expunged."))
-	    (vm-save-restriction
-	     (widen)
-	     (goto-char (vm-headers-of (vm-real-message-of (car mp))))
-	     (let ((vm-message-pointer mp)
-		   opoint
-		   (buffer-read-only nil))
-	       (setq opoint (point))
-	       (insert-buffer-substring edit-buf)
-	       (delete-region
-		(point) (vm-text-end-of (vm-real-message-of (car mp))))
-	       (vm-discard-cached-data))
-	     (vm-set-edited-flag-of (car mp) t)
-	     (vm-set-edit-buffer-of (car mp) nil))
-	    (set-buffer (vm-buffer-of (car mp)))
-	    (if (eq (vm-real-message-of (car mp))
-		    (vm-real-message-of (car vm-message-pointer)))
-		(vm-preview-current-message)
-	      (vm-update-summary-and-mode-line))))
-      (message "No change."))
-    (vm-display edit-buf nil '(vm-edit-message-end)
-		'(vm-edit-message-end reading-message startup))
-    (set-buffer-modified-p nil)
-    (kill-buffer edit-buf)))
+  (let ((pos-offset (- (point) (point-min))))
+    ;; make sure the message ends with a newline
+    (goto-char (point-max))
+    (and (/= (preceding-char) ?\n) (insert ?\n))
+    ;; munge message separators found in the edited message to
+    ;; prevent message from being split into several messages.
+    (vm-munge-message-separators (vm-message-type-of (car vm-message-pointer))
+				 (point-min) (point-max))
+    ;; for From_-with-Content-Length recompute the Content-Length header
+    (if (eq (vm-message-type-of (car vm-message-pointer))
+	    'From_-with-Content-Length)
+	(let ((buffer-read-only nil)
+	      length)
+	  (goto-char (point-min))
+	  ;; first delete all copies of Content-Length
+	  (while (and (re-search-forward vm-content-length-search-regexp nil t)
+		      (null (match-beginning 1))
+		      (progn (goto-char (match-beginning 0))
+			     (vm-match-header vm-content-length-header)))
+	    (delete-region (vm-matched-header-start) (vm-matched-header-end)))
+	  ;; now compute the message body length
+	  (goto-char (point-min))
+	  (search-forward "\n\n" nil 0)
+	  (setq length (- (point-max) (point)))
+	  ;; insert the header
+	  (goto-char (point-min))
+	  (insert vm-content-length-header " " (int-to-string length) "\n")))
+    (let ((edit-buf (current-buffer))
+	  (mp vm-message-pointer))
+      (if (buffer-modified-p)
+	  (progn
+	    (widen)
+	    (save-excursion
+	      (set-buffer (vm-buffer-of (vm-real-message-of (car mp))))
+	      (if (not (memq (vm-real-message-of (car mp)) vm-message-list))
+		  (error "The original copy of this message has been expunged."))
+	      (vm-save-restriction
+	       (widen)
+	       (goto-char (vm-headers-of (vm-real-message-of (car mp))))
+	       (let ((vm-message-pointer mp)
+		     opoint
+		     (buffer-read-only nil))
+		 (setq opoint (point))
+		 (insert-buffer-substring edit-buf)
+		 (delete-region
+		  (point) (vm-text-end-of (vm-real-message-of (car mp))))
+		 (vm-discard-cached-data))
+	       (vm-set-edited-flag-of (car mp) t)
+	       (vm-set-edit-buffer-of (car mp) nil))
+	      (set-buffer (vm-buffer-of (car mp)))
+	      (if (eq (vm-real-message-of (car mp))
+		      (vm-real-message-of (car vm-message-pointer)))
+		  (progn
+		    (vm-preview-current-message)
+		    ;; Try to position the cursor in the message
+		    ;; window close to where it was in the edit
+		    ;; window.  This works well for non MIME
+		    ;; messages, but the cursor drifts badly for
+		    ;; MIME and for refilled messages.
+		    (vm-save-buffer-excursion
+		     (and vm-presentation-buffer
+			  (set-buffer vm-presentation-buffer))
+		     (vm-save-restriction
+		      (vm-save-buffer-excursion
+		       (widen)
+		       (let ((osw (selected-window))
+			     (new-win (vm-get-visible-buffer-window
+				       (current-buffer))))
+			 (unwind-protect
+			     (if new-win
+				 (progn
+				   (select-window new-win)
+				   (goto-char (vm-headers-of
+					       (car vm-message-pointer)))
+				   (condition-case nil
+				       (forward-char pos-offset)
+				     (error nil))))
+			   (if (not (eq osw (selected-window)))
+			       (select-window osw))))))))
+		(vm-update-summary-and-mode-line))))
+	(message "No change."))
+      (vm-display edit-buf nil '(vm-edit-message-end)
+		  '(vm-edit-message-end reading-message startup))
+      (set-buffer-modified-p nil)
+      (kill-buffer edit-buf))))
 
 (defun vm-edit-message-abort ()
   "Abort the edit of a message, forgetting changes to the message."
 	    ;; support version 4 format
 	    (cond ((vectorp data)
 		   (setq data (vm-convert-v4-attributes data))
-		   ;; tink the message modflag so that if the
+		   ;; tink the message stuff flag so that if the
 		   ;; user saves we get rid of the old v4
 		   ;; attributes header.  otherwise we could be
 		   ;; dealing with these things for all eternity.
-		   (vm-set-modflag-of (car mp) t))
+		   (vm-set-stuff-flag-of (car mp) t))
 		  (t
 		   ;; extend vectors if necessary to accomodate
 		   ;; more caching and attributes without alienating
 		   ;; other version 5 folders.
 		   (cond ((< (length (car data))
 			     vm-attributes-vector-length)
-			  ;; tink the message modflag so that if
+			  ;; tink the message stuff flag so that if
 			  ;; the user saves we get rid of the old
 			  ;; short vector.  otherwise we could be
 			  ;; dealing with these things for all
 			  ;; eternity.
-			  (vm-set-modflag-of (car mp) t)
+			  (vm-set-stuff-flag-of (car mp) t)
 			  (setcar data (vm-extend-vector
 					(car data)
 					vm-attributes-vector-length))))
 		   (cond ((< (length (car (cdr data)))
 			     vm-cache-vector-length)
-			  ;; tink the message modflag so that if
+			  ;; tink the message stuff flag so that if
 			  ;; the user saves we get rid of the old
 			  ;; short vector.  otherwise we could be
 			  ;; dealing with these things for all
 			  ;; eternity.
-			  (vm-set-modflag-of (car mp) t)
+			  (vm-set-stuff-flag-of (car mp) t)
 			  (setcar (cdr data)
 				  (vm-extend-vector
 				   (car (cdr data))
       ;; because it asks for a summary update for the message.
       (vm-set-new-flag-of (car mp) t)
       ;; since this function is usually called in lieu of reading
-      ;; attributes from the buffer, the attributes may be
-      ;; untrustworthy.  tink the message modflag to force the
+      ;; attributes from the buffer, the buffer attributes may be
+      ;; untrustworthy.  tink the message stuff flag to force the
       ;; new attributes out if the user saves.
-      (vm-set-modflag-of (car mp) t)
+      (vm-set-stuff-flag-of (car mp) t)
       (setq mp (cdr mp)))))
 
 (defun vm-compute-totals ()
 	  (vm-set-summary-of (car mp) nil)
 	  ;; force restuffing of cache to clear old
 	  ;; summary entry cache.
-	  (vm-set-modflag-of (car mp) t)
+	  (vm-set-stuff-flag-of (car mp) t)
 	  (setq mp (cdr mp))))))
 
 ;; Stuff the message attributes back into the message as headers.
 			    (if (vm-unread-flag m) "" "R")
 			    "O\n")
 			   (set-marker (vm-headers-of m) opoint)))))
-	     (vm-set-modflag-of m (not for-other-folder)))
+	     (vm-set-stuff-flag-of m (not for-other-folder)))
 	 (set-buffer-modified-p old-buffer-modified-p))))))
 
 (defun vm-stuff-folder-attributes (&optional abort-if-input-pending quiet)
     ;; build a list of messages that need their attributes stuffed
     (setq mp vm-message-list)
     (while mp
-      (if (vm-modflag-of (car mp))
+      (if (vm-stuff-flag-of (car mp))
 	  (setq newlist (cons (car mp) newlist)))
       (setq mp (cdr mp)))
     (if (and newlist (not quiet))
     (if (buffer-modified-p)
 	(let (mp (newlist nil))
 	  (cond ((eq vm-folder-access-method 'pop)
-		 (vm-pop-synchronize-folder t t t nil)))
+		 (vm-pop-synchronize-folder t t t nil))
+		((eq vm-folder-access-method 'imap)
+		 (vm-imap-synchronize-folder t t t nil t)))
 	  ;; stuff the attributes of messages that need it.
 	  (message "Stuffing attributes...")
 	  (vm-stuff-folder-attributes nil)
   (if recovery
       (setq vm-block-new-mail t))
   (let ((name (cond ((eq vm-folder-access-method 'pop)
-		     (vm-pop-find-name-for-buffer (current-buffer))))))
+		     (vm-pop-find-name-for-buffer (current-buffer)))
+		    ((eq vm-folder-access-method 'imap)
+		     (vm-imap-find-spec-for-buffer (current-buffer))))))
     (vm (or name buffer-file-name) nil vm-folder-access-method)))
 
 ;; detect if a recover-file is being performed
       nil
     (if (and vm-folder-access-method this-buffer-only)
 	(cond ((eq vm-folder-access-method 'pop)
-	       (vm-pop-folder-check-for-mail interactive)))
+	       (vm-pop-folder-check-for-mail interactive))
+	      ((eq vm-folder-access-method 'imap)
+	       (vm-imap-folder-check-for-mail interactive)))
       (let ((triples (vm-compute-spool-files (not this-buffer-only)))
 	    ;; since we could accept-process-output here (POP code),
 	    ;; a timer process might try to start retrieving mail
       (error "Can't get new mail until you save this folder."))
   (cond ((eq vm-folder-access-method 'pop)
 	 (vm-pop-synchronize-folder interactive nil nil t))
+	((eq vm-folder-access-method 'imap)
+	 (vm-imap-synchronize-folder interactive nil nil t))
 	(t (vm-get-spooled-mail-normal interactive))))
 
 (defun vm-get-spooled-mail-normal (&optional interactive)
 			     mcount))))
 	     (message "No messages gathered."))))))
 
-;; returns non-nil if there were any new messages
+;; returns list of new messages if there were any new messages, nil otherwise
 (defun vm-assimilate-new-messages (&optional
 				   dont-read-attributes
 				   gobble-order
    vm-virtual-buffers (vm-link-to-virtual-buffers)
    vm-folder-type (vm-get-folder-type))
    (cond ((eq access-method 'pop)
-	 (setq vm-folder-access-method 'pop
-	       vm-folder-access-data (make-vector 2 nil))))
+	  (setq vm-folder-access-method 'pop
+		vm-folder-access-data (make-vector 2 nil)))
+	 ((eq access-method 'imap)
+	  (setq vm-folder-access-method 'imap
+		vm-folder-access-data (make-vector 9 nil))))
   (use-local-map vm-mode-map)
   ;; if the user saves after M-x recover-file, let them get new
   ;; mail again.
        '(vm-imap-protocol-error error))
   (put 'vm-imap-protocol-error 'error-message "IMAP protocol error"))
 
-(defun vm-imap-capability (cap)
-  (memq cap vm-imap-capabilities))
+(defun vm-imap-capability (cap &optional process)
+  (if process
+      (save-excursion
+	(set-buffer (process-buffer process))
+	(memq cap vm-imap-capabilities))
+    (memq cap vm-imap-capabilities)))
 
 (defun vm-imap-auth-method (auth)
   (memq auth vm-imap-auth-methods))
 
+(defsubst vm-folder-imap-maildrop-spec ()
+  (aref vm-folder-access-data 0))
+(defsubst vm-folder-imap-process ()
+  (aref vm-folder-access-data 1))
+(defsubst vm-folder-imap-uid-validity ()
+  (aref vm-folder-access-data 2))
+(defsubst vm-folder-imap-uid-list ()
+  (aref vm-folder-access-data 3))
+(defsubst vm-folder-imap-mailbox-count ()
+  (aref vm-folder-access-data 4))
+(defsubst vm-folder-imap-read-write ()
+  (aref vm-folder-access-data 5))
+(defsubst vm-folder-imap-can-delete ()
+  (aref vm-folder-access-data 6))
+(defsubst vm-folder-imap-body-peek ()
+  (aref vm-folder-access-data 7))
+(defsubst vm-folder-imap-permanent-flags ()
+  (aref vm-folder-access-data 8))
+
+(defsubst vm-set-folder-imap-maildrop-spec (val)
+  (aset vm-folder-access-data 0 val))
+(defsubst vm-set-folder-imap-process (val)
+  (aset vm-folder-access-data 1 val))
+(defsubst vm-set-folder-imap-uid-validity (val)
+  (aset vm-folder-access-data 2 val))
+(defsubst vm-set-folder-imap-uid-list (val)
+  (aset vm-folder-access-data 3 val))
+(defsubst vm-set-folder-imap-mailbox-count (val)
+  (aset vm-folder-access-data 4 val))
+(defsubst vm-set-folder-imap-read-write (val)
+  (aset vm-folder-access-data 5 val))
+(defsubst vm-set-folder-imap-can-delete (val)
+  (aset vm-folder-access-data 6 val))
+(defsubst vm-set-folder-imap-body-peek (val)
+  (aset vm-folder-access-data 7 val))
+(defsubst vm-set-folder-imap-permanent-flags (val)
+  (aset vm-folder-access-data 8 val))
+
 ;; Our goal is to drag the mail from the IMAP maildrop to the crash box.
 ;; just as if we were using movemail on a spool file.
 ;; We remember which messages we have retrieved so that we can
 ;; same messages again and again.
 (defun vm-imap-move-mail (source destination)
   (let ((process nil)
-	(folder-type vm-folder-type)
 	(m-per-session vm-imap-messages-per-session)
 	(b-per-session vm-imap-bytes-per-session)
 	(handler (and (fboundp 'find-file-name-handler)
 	  (setq process-buffer (process-buffer process))
 	  (save-excursion
 	    (set-buffer process-buffer)
-	    (setq vm-folder-type (or folder-type vm-default-folder-type))
 	    ;; find out how many messages are in the box.
 	    (setq source-list (vm-parse source "\\([^:]+\\):?")
 		  mailbox (nth 3 source-list))
 		      (vm-imap-send-command process
 					    (format "FETCH %d (BODY.PEEK[])"
 						    n))
-		      (vm-imap-retrieve-to-crashbox process destination
-						    statblob t))
+		      (vm-imap-retrieve-to-target process destination
+						  statblob t))
 		  (progn
 		       (vm-imap-send-command process
 					     (format
 					      "FETCH %d (RFC822.PEEK)" n))
-		       (vm-imap-retrieve-to-crashbox process destination
-						     statblob nil)))
+		       (vm-imap-retrieve-to-target process destination
+						   statblob nil)))
 		(vm-increment retrieved)
 		(and b-per-session
 		     (setq retrieved-bytes (+ retrieved-bytes message-size)))
 
 (defun vm-imap-make-session (source)
   (let ((process-to-shutdown nil)
+	(folder-type vm-folder-type)
 	process ooo
 	(imapdrop (vm-safe-imapdrop-string source))
 	(coding-system-for-read (vm-binary-coding-system))
 					     host)))
 	  (save-excursion
 	    (set-buffer process-buffer)
+	    (setq vm-folder-type (or folder-type vm-default-folder-type))
 	    (buffer-disable-undo process-buffer)
 	    (make-local-variable 'vm-imap-read-point)
 	    ;; clear the trace buffer of old output
 		(progn (delete-process process)
 		       (throw 'end-of-session nil)))
 	    (setq process-to-shutdown process)
+	    (set (make-local-variable 'vm-imap-session-done) nil)
 	    ;; record server capabilities
 	    (vm-imap-send-command process "CAPABILITY")
 	    (if (null (setq ooo (vm-imap-read-capability-response process)))
       (vm-tear-down-stunnel-random-data))))
 
 (defun vm-imap-end-session (process &optional keep-buffer)
-  (save-excursion
-    (set-buffer (process-buffer process))
-    (vm-imap-send-command process "LOGOUT")
-    ;; we don't care about the response.
-    ;; try reading it anyway and see who complains.
-    (vm-imap-read-ok-response process)
-    (if (and (not vm-imap-keep-trace-buffer) (not keep-buffer))
-	(kill-buffer (process-buffer process))
+  (if (and (memq (process-status process) '(open run))
+	   (buffer-live-p (process-buffer process)))
       (save-excursion
-       (set-buffer (process-buffer process))
-       (rename-buffer (concat "saved " (buffer-name)) t)
-       (vm-keep-some-buffers (current-buffer) 'vm-kept-imap-buffers
-			     vm-imap-keep-failed-trace-buffers)))
-    (if (fboundp 'add-async-timeout)
-	(add-async-timeout 2 'delete-process process)
-      (run-at-time 2 nil 'delete-process process))))
+	(set-buffer (process-buffer process))
+	;; vm-imap-end-session might have already been called on
+	;; this process, so don't logout and schedule the killing
+	;; the process again if it's already been done.
+	(if vm-imap-session-done
+	    nil
+	  (vm-imap-send-command process "LOGOUT")
+	  (setq vm-imap-session-done t)
+	  ;; we don't care about the response.
+	  ;; try reading it anyway and see who complains.
+	  (vm-imap-read-ok-response process)
+	  (if (and (not vm-imap-keep-trace-buffer) (not keep-buffer))
+	      (kill-buffer (process-buffer process))
+	    (save-excursion
+	      (set-buffer (process-buffer process))
+	      (rename-buffer (concat "saved " (buffer-name)) t)
+	      (vm-keep-some-buffers (current-buffer) 'vm-kept-imap-buffers
+				    vm-imap-keep-failed-trace-buffers)))
+	  (if (fboundp 'add-async-timeout)
+	      (add-async-timeout 2 'delete-process process)
+	    (run-at-time 2 nil 'delete-process process))))))
 
 (defun vm-imap-stat-timer (o) (aref o 0))
 (defun vm-imap-stat-did-report (o) (aref o 1))
   (vm-set-imap-stat-y-got o (vm-imap-stat-x-got o))
   (vm-set-imap-stat-y-need o (vm-imap-stat-x-need o)))
 
+(defun vm-imap-check-connection (process)
+  (cond ((not (memq (process-status process) '(open run)))
+	 (error "IMAP connection not open: %s" process))
+	((not (buffer-live-p (process-buffer process)))
+	 (error "IMAP process %s's buffer has been killed" process))))
+
 (defun vm-imap-send-command (process command &optional tag no-tag)
+  (vm-imap-check-connection process)
   (goto-char (point-max))
   (or no-tag (insert-before-markers (or tag "VM") " "))
   (let ((case-fold-search t))
     (if (null uid-validity)
 	(vm-imap-protocol-error "UIDVALIDITY missing from SELECT responses"))
     (setq can-delete (vm-imap-scan-list-for-flag flags "\\Deleted"))
-    (list msg-count uid-validity read-write can-delete) ))
+    (list msg-count uid-validity read-write can-delete permanent-flags) ))
 
 (defun vm-imap-get-uid-list (process first last)
   (let ((list nil)
 		'skip))))
       (and work-buffer (kill-buffer work-buffer)))))
 
-(defun vm-imap-retrieve-to-crashbox (process crash statblob bodypeek)
+(defun vm-imap-retrieve-to-target (process target statblob bodypeek)
   (let ((start vm-imap-read-point)
 	(need-msg t)
 	end fetch-response list p)
     ;; only babyl files have the folder header, and we
     ;; should only insert it if the crash box is empty.
     (if (and (eq vm-folder-type 'babyl)
-	     (let ((attrs (file-attributes crash)))
-	       (or (null attrs) (equal 0 (nth 7 attrs)))))
+	     (cond ((stringp target)
+		    (let ((attrs (file-attributes target)))
+		      (or (null attrs) (equal 0 (nth 7 attrs)))))
+		   ((bufferp target)
+		    (save-excursion
+		      (set-buffer target)
+		      (zerop (buffer-size))))))
 	(let ((opoint (point)))
 	  (vm-convert-folder-header nil vm-folder-type)
 	  ;; if start is a marker, then it was moved
     (if (and (not (eq ?\n (char-after (1- (point)))))
 	     (memq vm-folder-type '(From_-with-Content-Length BellFrom_)))
 	(insert-before-markers "\n"))
-    ;; Set file type to binary for DOS/Windows.  I don't know if
-    ;; this is correct to do or not; it depends on whether the
-    ;; the CRLF or the LF newline convention is used on the inbox
-    ;; associated with this crashbox.  This setting assumes the LF
-    ;; newline convention is used.
-    (let ((buffer-file-type t)
-	  (selective-display nil))
-      (write-region start end crash t 0))
+    (if (stringp target)
+	;; Set file type to binary for DOS/Windows.  I don't know if
+	;; this is correct to do or not; it depends on whether the
+	;; the CRLF or the LF newline convention is used on the inbox
+	;; associated with this crashbox.  This setting assumes the LF
+	;; newline convention is used.
+	(let ((buffer-file-type t)
+	      (selective-display nil))
+	  (write-region start end target t 0))
+      (let ((b (current-buffer)))
+	(save-excursion
+	  (set-buffer target)
+	  (let ((buffer-read-only nil))
+	    (insert-buffer-substring b start end)))))
     (delete-region start end)
     t ))
 
 		tail list)
 	(setcdr tail (cons obj nil))
 	(setq tail (cdr tail))))
-    (vm-imap-bail-if-server-says-farewell list)
     list ))
 
 (defun vm-imap-read-object (process &optional skip-eol)
       (skip-chars-forward " \t")
       (cond ((< (- (point-max) (point)) 2)
 	     (setq opoint (point))
+	     (vm-imap-check-connection process)
 	     (accept-process-output process)
 	     (goto-char opoint))
 	    ((looking-at "\r\n")
 		   (vm-imap-protocol-error "CRLF expected"))
 	       (setq start (point))
 	       (while (< (- (point-max) start) n-octets)
+		 (vm-imap-check-connection process)
 		 (accept-process-output process))
 	       (goto-char (+ start n-octets))
 	       (setq token (list 'string start (point))
 		     (progn
 		       (setq done t)
 		       (forward-char 1))
+		   (vm-imap-check-connection process)
 		   (accept-process-output process)
 		   (goto-char curpoint))
 	       (setq token (list 'string start curpoint)))))
 		 (setq curpoint (point))
 		 (if (looking-at not-word-regexp)
 		     (setq done t)
+		   (vm-imap-check-connection process)
 		   (accept-process-output process)
 		   (goto-char curpoint))
 		 (setq token (list 'atom start curpoint)))))))
       t )))
 
 (defun vm-imap-bail-if-server-says-farewell (response)
-  (if (vm-imap-response-matches response 'VM 'BYE)
+  (if (vm-imap-response-matches response '* 'BYE)
       (throw 'end-of-session t)))
 
 (defun vm-imap-protocol-error (&rest args)
 	(setq list (cdr list)))
       nil )))
 
+;; like Lisp get but for IMAP property lists like those returned by FETCH.
+(defun vm-imap-plist-get (list name)
+  (setq list (cdr list))
+  (let ((case-fold-search t) e)
+    (catch 'done
+      (while list
+	(setq e (car list))
+	(if (not (eq (car e) 'atom))
+	    nil
+	  (goto-char (nth 1 e))
+	  (if (eq (search-forward name (nth 2 e) t) (nth 2 e))
+	      (throw 'done (car (cdr list)))))
+	(setq list (cdr (cdr list))))
+      nil )))
+
 (defun vm-imap-clear-invalid-retrieval-entries (source-nopwd retrieved
 						uid-validity)
   (let ((x retrieved)
   (goto-char (point-max))
   (insert "\""))
 
+(defun vm-establish-new-folder-imap-session (&optional interactive)
+  (let ((process (vm-folder-imap-process))
+	mailbox select mailbox-count uid-validity permanent-flags
+	read-write can-delete body-peek
+	(vm-imap-ok-to-ask interactive))
+    (if (processp process)
+	(vm-imap-end-session process))
+    (setq process (vm-imap-make-session (vm-folder-imap-maildrop-spec)))
+    (vm-set-folder-imap-process process)
+    (setq mailbox (vm-imap-parse-spec-to-list (vm-folder-imap-maildrop-spec))
+	  mailbox (nth 3 mailbox))
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (setq select (vm-imap-select-mailbox process mailbox))
+      (setq mailbox-count (nth 0 select)
+	    uid-validity (nth 1 select)
+	    read-write (nth 2 select)
+	    can-delete (nth 3 select)
+	    permanent-flags (nth 4 select)
+	    body-peek (vm-imap-capability 'IMAP4REV1)))
+    (vm-set-folder-imap-uid-validity uid-validity)
+    (vm-set-folder-imap-mailbox-count mailbox-count)
+    (vm-set-folder-imap-read-write read-write)
+    (vm-set-folder-imap-can-delete can-delete)
+    (vm-set-folder-imap-body-peek body-peek)
+    (vm-set-folder-imap-permanent-flags permanent-flags)
+    process ))
+
+(defun vm-imap-get-uid-data ()
+  (if (eq 0 (vm-folder-imap-mailbox-count))
+      (make-vector 67 0)
+    (let ((there (make-vector 67 0))
+	  (process (vm-folder-imap-process))
+	  (mailbox-count (vm-folder-imap-mailbox-count))
+	  list)
+      (save-excursion
+	(set-buffer (process-buffer process))
+	(setq list (vm-imap-get-uid-list process 1 mailbox-count))
+	(while list
+	  (set (intern (cdr (car list)) there) (car (car list)))
+	  (setq list (cdr list)))
+	there ))))
+
+(defun vm-imap-get-message-flags (process m &optional norecord)
+  (let (need-ok p r flag response saw-seen)
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (vm-imap-send-command process
+			    (format "UID FETCH %s (FLAGS)"
+				    (vm-imap-uid-of m)))
+      (setq need-ok t)
+      (while need-ok
+	(setq response (vm-imap-read-response process))
+	(if (vm-imap-response-matches response 'VM 'NO)
+	    (error "server said NO to UID FETCH (FLAGS)"))
+	(if (vm-imap-response-matches response 'VM 'BAD)
+	    (vm-imap-protocol-error "server said BAD to UID FETCH (FLAGS)"))
+	(if (vm-imap-response-matches response '* 'BYE)
+	    (vm-imap-protocol-error "server said BYE to UID FETCH (FLAGS)"))
+	(cond ((vm-imap-response-matches response 'VM 'OK)
+	       (setq need-ok nil))
+	      ((vm-imap-response-matches response '* 'atom 'FETCH 'list)
+	       (setq r (nthcdr 3 response)
+		     r (car r)
+		     r (vm-imap-plist-get r "FLAGS")
+		     r (cdr r))
+	       (while r
+		 (setq p (car r))
+		 (if (not (eq (car p) 'atom))
+		     nil
+		   (setq flag (downcase (buffer-substring (nth 1 p) (nth 2 p))))
+		   (cond ((string= flag "\\answered")
+			  (vm-set-replied-flag m t norecord))
+			 ((string= flag "\\deleted")
+			  (vm-set-deleted-flag m t norecord))
+			 ((string= flag "\\seen")
+			  (vm-set-unread-flag m nil norecord)
+			  (vm-set-new-flag m nil norecord)
+			  (setq saw-seen t))
+			 ((string= flag "\\recent")
+			  (vm-set-new-flag m t norecord))))
+		 (setq r (cdr r)))
+	       (if (not saw-seen)
+		   (vm-set-unread-flag m t norecord))))))))
+
+(defun vm-imap-store-message-flags (process m perm-flags)
+  (let (need-ok flags response)
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (if (and (vm-replied-flag m)
+	       (vm-imap-scan-list-for-flag perm-flags "\\Answered"))
+	  (setq flags (cons (intern "\\Answered") flags)))
+      (if (and (not (vm-unread-flag m))
+	       (vm-imap-scan-list-for-flag perm-flags "\\Seen"))
+	  (setq flags (cons (intern "\\Seen") flags)))
+      (if (and (vm-deleted-flag m)
+	       (vm-imap-scan-list-for-flag perm-flags "\\Deleted"))
+	  (setq flags (cons (intern "\\Deleted") flags)))
+      (vm-imap-send-command process
+			    (format "UID STORE %s FLAGS %s"
+				    (vm-imap-uid-of m)
+				    (if flags flags "()")))
+      (setq need-ok t)
+      (while need-ok
+	(setq response (vm-imap-read-response process))
+	(if (vm-imap-response-matches response 'VM 'NO)
+	    (error "server said NO to UID FETCH (FLAGS)"))
+	(if (vm-imap-response-matches response 'VM 'BAD)
+	    (vm-imap-protocol-error "server said BAD to UID FETCH (FLAGS)"))
+	(if (vm-imap-response-matches response '* 'BYE)
+	    (vm-imap-protocol-error "server said BYE to UID FETCH (FLAGS)"))
+	(cond ((vm-imap-response-matches response 'VM 'OK)
+	       (setq need-ok nil))))
+      (vm-set-attribute-modflag-of m nil))))
+
+(defun vm-imap-save-message (process m mailbox)
+  (let (need-ok need-plus flags response string)
+    ;; save the message's flag along with it.
+    ;; don't save the deleted flag.
+    (if (vm-replied-flag m)
+	(setq flags (cons (intern "\\Answered") flags)))
+    (if (not (vm-unread-flag m))
+	(setq flags (cons (intern "\\Seen") flags)))
+    (save-excursion
+      (set-buffer (vm-buffer-of (vm-real-message-of m)))
+      (save-restriction
+	(widen)
+	(setq string (buffer-substring (vm-headers-of m) (vm-text-end-of m)))))
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (condition-case nil
+	  (vm-imap-create-mailbox process mailbox)
+	(error nil))
+      (vm-imap-send-command process
+			    (format "APPEND %s %s {%d}"
+				    (vm-imap-quote-string mailbox)
+				    (if flags flags "()")
+				    (length string)))
+      (setq need-plus t)
+      (while need-plus
+	(setq response (vm-imap-read-response process))
+	(if (vm-imap-response-matches response 'VM 'NO)
+	    (error "server said NO to APPEND command"))
+	(if (vm-imap-response-matches response 'VM 'BAD)
+	    (vm-imap-protocol-error "server said BAD to APPEND command"))
+	(if (vm-imap-response-matches response '* 'BYE)
+	    (vm-imap-protocol-error "server said BYE to APPEND command"))
+	(cond ((vm-imap-response-matches response '+)
+	       (setq need-plus nil))))
+      (vm-imap-send-command process string nil t)
+      (setq need-ok t)
+      (while need-ok
+	(setq response (vm-imap-read-response process))
+	(if (vm-imap-response-matches response 'VM 'NO)
+	    (error "server said NO to APPEND data"))
+	(if (vm-imap-response-matches response 'VM 'BAD)
+	    (vm-imap-protocol-error "server said BAD to APPEND data"))
+	(if (vm-imap-response-matches response '* 'BYE)
+	    (vm-imap-protocol-error "server said BYE to APPEND data"))
+	(cond ((vm-imap-response-matches response 'VM 'OK)
+	       (setq need-ok nil)))))))
+
+(defun vm-imap-get-synchronization-data ()
+  (let ((here (make-vector 67 0))
+	(there (vm-imap-get-uid-data))
+	(process (vm-folder-imap-process))
+	(uid-validity (vm-folder-imap-uid-validity))
+	retrieve-list expunge-list
+	mp)
+    (setq mp vm-message-list)
+    (while mp
+      (if (or (null (vm-imap-uid-of (car mp)))
+	      (not (equal (vm-imap-uid-validity-of (car mp)) uid-validity)))
+	  nil
+	(set (intern (vm-imap-uid-of (car mp)) here) (car mp))
+	(if (not (boundp (intern (vm-imap-uid-of (car mp)) there)))
+	    (setq expunge-list (cons (car mp) expunge-list))))
+      (setq mp (cdr mp)))
+    (mapatoms (function
+	       (lambda (sym)
+		 (if (and (not (boundp (intern (symbol-name sym) here)))
+			  (not (assoc (symbol-name sym)
+				      vm-imap-retrieved-messages)))
+		     (setq retrieve-list (cons
+					  (cons (symbol-name sym)
+						(symbol-value sym))
+					  retrieve-list)))))
+	      there)
+    (list retrieve-list expunge-list)))
+
+(defun vm-imap-synchronize-folder (&optional interactive
+					     do-remote-expunges
+					     do-local-expunges
+					     do-retrieves
+					     do-attributes)
+  (if (and do-retrieves vm-block-new-mail)
+      (error "Can't get new mail until you save this folder."))
+  (if (or vm-global-block-new-mail
+	  (null (vm-establish-new-folder-imap-session interactive)))
+      nil
+    (if do-retrieves
+	(vm-assimilate-new-messages))
+    (let* ((sync-data (vm-imap-get-synchronization-data))
+	   (retrieve-list (car sync-data))
+	   (local-expunge-list (nth 1 sync-data))
+	   (process (vm-folder-imap-process))
+	   (n 1)
+	   (statblob nil)
+	   (imapdrop (vm-folder-imap-maildrop-spec))
+	   (uid-validity (vm-folder-imap-uid-validity))
+	   (safe-imapdrop (vm-safe-imapdrop-string imapdrop))
+	   (use-body-peek (vm-folder-imap-body-peek))
+	   r-list mp got-some message-size
+	   (folder-buffer (current-buffer)))
+      (if (and do-retrieves retrieve-list)
+	  (save-excursion
+	    (vm-save-restriction
+	     (widen)
+	     (goto-char (point-max))
+	     (condition-case error-data
+		 (save-excursion
+		   (set-buffer (process-buffer process))
+		   (setq statblob (vm-imap-start-status-timer))
+		   (vm-set-imap-stat-x-box statblob safe-imapdrop)
+		   (vm-set-imap-stat-x-maxmsg statblob
+					      (length retrieve-list))
+		   (setq r-list retrieve-list)
+		   (while r-list
+		     (vm-set-imap-stat-x-currmsg statblob n)
+		     (setq message-size (vm-imap-get-message-size
+					 process (cdr (car r-list))))
+		     (vm-set-imap-stat-x-need statblob message-size)
+		     (if use-body-peek
+			 (progn
+			   (vm-imap-send-command process
+						 (format
+						  "FETCH %s (BODY.PEEK[])"
+						  (cdr (car r-list))))
+			   (vm-imap-retrieve-to-target process folder-buffer
+						       statblob t))
+		       (progn
+			 (vm-imap-send-command process
+					       (format
+						"FETCH %s (RFC822.PEEK)"
+						(cdr (car r-list))))
+			 (vm-imap-retrieve-to-target process folder-buffer
+						     statblob nil)))
+		     (setq r-list (cdr r-list)
+			   n (1+ n))))
+	       (error
+		(message "Retrieval from %s signaled: %s" safe-imapdrop
+			 error-data))
+	       (quit
+		(message "Quit received during retrieval from %s"
+			 safe-imapdrop)))
+	     (and statblob (vm-imap-stop-status-timer statblob))
+	     ;; to make the "Mail" indicator go away
+	     (setq vm-spooled-mail-waiting nil)
+	     (intern (buffer-name) vm-buffers-needing-display-update)
+	     (vm-increment vm-modification-counter)
+	     (vm-update-summary-and-mode-line)
+	     (setq mp (vm-assimilate-new-messages t))
+	     (setq got-some mp)
+	     (setq r-list retrieve-list)
+	     (while mp
+	       (vm-set-imap-uid-of (car mp) (car (car r-list)))
+	       (vm-set-imap-uid-validity-of (car mp) uid-validity)
+	       (condition-case nil
+		   (vm-imap-get-message-flags process (car mp) t)
+		 (error nil))
+	       (vm-set-stuff-flag-of (car mp) t)
+	       (setq mp (cdr mp)
+		     r-list (cdr r-list))))))
+      (if do-attributes
+	  (let ((mp vm-message-list)
+		(perm-flags (vm-folder-imap-permanent-flags)))
+	    (while mp
+	      (if (not (vm-attribute-modflag-of (car mp)))
+		  nil
+		(condition-case nil
+		    (vm-imap-store-message-flags process (car mp) perm-flags)
+		  (error nil)))
+	      (setq mp (cdr mp)))))
+      (if do-local-expunges
+	  (vm-expunge-folder t t local-expunge-list))
+      (if (and do-remote-expunges
+	       vm-imap-messages-to-expunge)
+	  (let ((process (vm-folder-imap-process)))
+	    (if (and (processp process)
+		     (memq (process-status process) '(open run)))
+		(vm-imap-end-session process))
+	    (setq vm-imap-retrieved-messages
+		  (mapcar (function (lambda (x) (list (car x) (cdr x)
+						      imapdrop 'uid)))
+			  vm-imap-messages-to-expunge))
+	    (vm-expunge-imap-messages)
+	    (setq vm-imap-messages-to-expunge
+		  (mapcar (function (lambda (x) (cons (car x) (car (cdr x)))))
+			  vm-imap-retrieved-messages))))
+      got-some)))
+
+(defun vm-imap-folder-check-for-mail (&optional interactive)
+  (if (or vm-global-block-new-mail
+	  (null (vm-establish-new-folder-imap-session interactive)))
+      nil
+    (let ((result (car (vm-imap-get-synchronization-data))))
+      (vm-imap-end-session (vm-folder-imap-process))
+      result )))
+
+(defun vm-imap-find-spec-for-buffer (buffer)
+  (let ((list vm-imap-server-list)
+	(done nil))
+    (while (and (not done) list)
+      (if (eq buffer (vm-get-file-buffer (vm-imap-make-filename-for-spec
+					  (car list))))
+	  (setq done t)
+	(setq list (cdr list))))
+    (and list (car list))))
+
+(defun vm-imap-make-filename-for-spec (spec)
+  (let (md5 list)
+    (setq spec (vm-imap-normalize-spec spec))
+    (setq md5 (vm-md5-string spec))
+    (expand-file-name (concat "imap-cache-" md5)
+		      (or vm-imap-folder-cache-directory
+			  vm-folder-directory
+			  (getenv "HOME")))))
+
+(defun vm-imap-normalize-spec (spec)
+  (let (list)
+    (setq list (vm-imap-parse-spec-to-list spec))
+    (setcar (vm-last list) "*")
+    (setcar list "imap")
+    (setcar (nthcdr 2 list) "*")
+    (setcar (nthcdr 4 list) "*")
+    (setq spec (mapconcat (function identity) list ":"))
+    spec ))
+
+(defun vm-imap-parse-spec-to-list (spec)
+  (vm-parse spec "\\([^:]+\\):?" 1 6))
+
+(defun vm-imap-spec-list-to-host-alist (spec-list)
+  (let (host-alist)
+    (while spec-list
+      (setq host-alist (cons
+			(cons
+			 (nth 1 (vm-imap-parse-spec-to-list (car spec-list)))
+			 (car spec-list))
+			host-alist)
+	    spec-list (cdr spec-list)))
+    host-alist ))
+
+(defun vm-read-imap-folder-name (prompt spec-list selectable-only)
+  "Read an IMAP server and mailbox, return an IMAP mailbox spec."
+  (let (host c-list spec process mailbox list
+	(vm-imap-ok-to-ask t)
+	(host-alist (vm-imap-spec-list-to-host-alist spec-list)))
+    (if (null host-alist)
+	(error "No known IMAP servers.  Please set vm-imap-server-list."))
+    (setq host (if (cdr host-alist)
+		   (completing-read "IMAP server: " host-alist nil t)
+		 (car (car host-alist)))
+	  spec (cdr (assoc host host-alist))
+	  process (vm-imap-make-session spec)
+	  c-list (and process (vm-imap-mailbox-list process selectable-only)))
+    (vm-imap-end-session process)
+    ;; evade the XEmacs dialog box.
+    (let ((use-dialog-box nil))
+      (setq mailbox (vm-read-string prompt c-list)))
+    (setq list (vm-imap-parse-spec-to-list spec))
+    (setcar (nthcdr 3 list) mailbox)
+    (mapconcat 'identity list ":")))
+
+(defun vm-imap-directory-separator (process ref)
+  (let ((c-list nil)
+	sep p r response need-ok)
+    (vm-imap-check-connection process)
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (vm-imap-send-command process (format "LIST %s \"\""
+					    (vm-imap-quote-string ref)))
+      (setq need-ok t)
+      (while need-ok
+	(setq response (vm-imap-read-response process))
+	(if (vm-imap-response-matches response 'VM 'NO)
+	    (error "server said NO to LIST"))
+	(if (vm-imap-response-matches response 'VM 'BAD)
+	    (vm-imap-protocol-error "server said BAD to LIST"))
+	(cond ((vm-imap-response-matches response 'VM 'OK)
+	       (setq need-ok nil))
+	      ((vm-imap-response-matches response '* 'LIST 'list 'string)
+	       (setq r (nthcdr 3 response)
+		     p (car r)
+		     sep (buffer-substring (nth 1 p) (nth 2 p))))
+	      ((vm-imap-response-matches response '* 'LIST 'list)
+	       (vm-imap-protocol-error "unexpedcted LIST response"))))
+      sep )))
+
+(defun vm-imap-mailbox-list (process selectable-only)
+  (let ((c-list nil)
+	p r response need-ok)
+    (vm-imap-check-connection process)
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (vm-imap-send-command process "LIST \"\" \"*\"")
+      (setq need-ok t)
+      (while need-ok
+	(setq response (vm-imap-read-response process))
+	(if (vm-imap-response-matches response 'VM 'NO)
+	    (error "server said NO to LIST"))
+	(if (vm-imap-response-matches response 'VM 'BAD)
+	    (vm-imap-protocol-error "server said BAD to LIST"))
+	(if (vm-imap-response-matches response '* 'BYE)
+	    (vm-imap-protocol-error "server said BYE to LIST"))
+	(cond ((vm-imap-response-matches response 'VM 'OK)
+	       (setq need-ok nil))
+	      ((vm-imap-response-matches response '* 'LIST 'list)
+	       (setq r (nthcdr 2 response)
+		     p (car r))
+	       (if (and selectable-only
+			(vm-imap-scan-list-for-flag p "\\Noselect"))
+		   nil
+		 (setq r (nthcdr 4 response)
+		       p (car r))
+		 (if (memq (car p) '(atom string))
+		     (setq c-list (cons (buffer-substring (nth 1 p) (nth 2 p))
+					c-list)))))))
+      c-list )))
+
+(defun vm-imap-read-boolean-response (process)
+  (let ((need-ok t) retval response)
+    (while need-ok
+      (vm-imap-check-connection process)
+      (setq response (vm-imap-read-response process))
+      (cond ((vm-imap-response-matches response 'VM 'OK)
+	     (setq need-ok nil retval t))
+	    ((vm-imap-response-matches response 'VM 'NO)
+	     (setq need-ok nil retval nil))
+	    ((vm-imap-response-matches response '* 'BYE)
+	     (vm-imap-protocol-error "server said BYE"))
+	    ((vm-imap-response-matches response 'VM 'BAD)
+	     (vm-imap-protocol-error "server said BAD"))))
+    retval ))
+
+(defun vm-imap-create-mailbox (process mailbox
+			       &optional dont-create-parent-directories)
+  (if (not dont-create-parent-directories)
+      (let (dir sep sep-regexp i)
+	(setq sep (vm-imap-directory-separator process "")
+	      sep-regexp (regexp-quote sep)
+	      i 0)
+	(while (string-match sep-regexp mailbox i)
+	  (setq dir (substring mailbox i (match-end 0)))
+	  (vm-imap-create-mailbox process dir t)
+	  ;; ignore command result since creating a directory will
+	  ;; routinely fail with "File exists".  We'll generate a
+	  ;; real error if the final mailbox creation fails.
+	  (vm-imap-read-boolean-response process)
+	  (setq i (match-end 0)))))
+  (vm-imap-send-command process (format "CREATE %s"
+					(vm-imap-quote-string mailbox)))
+  (if (null (vm-imap-read-boolean-response process))
+      (error "IMAP CREATE of %s failed" mailbox)))
+
+(defun vm-imap-delete-mailbox (process mailbox)
+  (vm-imap-send-command process (format "DELETE %s"
+					(vm-imap-quote-string mailbox)))
+  (if (null (vm-imap-read-boolean-response process))
+      (error "IMAP DELETE of %s failed" mailbox)))
+
+(defun vm-imap-rename-mailbox (process source dest)
+  (vm-imap-send-command process (format "RENAME %s %s"
+					(vm-imap-quote-string source)
+					(vm-imap-quote-string dest)))
+  (if (null (vm-imap-read-boolean-response process))
+      (error "IMAP RENAME of %s to %s failed" source dest)))
+
+(defun vm-create-imap-folder (folder)
+  "Create a folder on an IMAP server.
+First argument FOLDER is read from the minibuffer if called
+interactively.  Non-interactive callers must provide an IMAP
+maildrop specification for the folder as described in the
+documentation for `vm-spool-files'."
+  (interactive
+   (save-excursion
+     (vm-session-initialization)
+     (vm-check-for-killed-folder)
+     (vm-select-folder-buffer-if-possible)
+     (let ((this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-imap-folder-name "Create IMAP folder: "
+				       vm-imap-server-list nil)))))
+  (let ((vm-imap-ok-to-ask t)
+	process mailbox)
+    (save-excursion
+      (setq process (vm-imap-make-session folder))
+      (if (null process)
+	  (error "Couldn't open IMAP session for %s"
+		 (vm-safe-imapdrop-string folder)))
+      (set-buffer (process-buffer process))
+      (setq mailbox (nth 3 (vm-imap-parse-spec-to-list folder)))
+      (vm-imap-create-mailbox process mailbox)
+      (message "Folder %s created" (vm-safe-imapdrop-string folder)))))
+
+(defun vm-delete-imap-folder (folder)
+  "Delete a folder on an IMAP server.
+First argument FOLDER is read from the minibuffer if called
+interactively.  Non-interactive callers must provide an IMAP
+maildrop specification for the folder as described in the
+documentation for `vm-spool-files'."
+  (interactive
+   (save-excursion
+     (vm-session-initialization)
+     (vm-check-for-killed-folder)
+     (vm-select-folder-buffer-if-possible)
+     (let ((this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-imap-folder-name "Delete IMAP folder: "
+				       vm-imap-server-list nil)))))
+  (let ((vm-imap-ok-to-ask t)
+	process mailbox)
+    (setq process (vm-imap-make-session folder))
+    (if (null process)
+	(error "Couldn't open IMAP session for %s"
+	       (vm-safe-imapdrop-string folder)))
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (setq mailbox (nth 3 (vm-imap-parse-spec-to-list folder)))
+      (vm-imap-delete-mailbox process mailbox)
+      (message "Folder %s deleted" (vm-safe-imapdrop-string folder)))))
+
+(defun vm-rename-imap-folder (source dest)
+  "Rename a folder on an IMAP server.
+Argument SOURCE and DEST are read from the minibuffer if called
+interactively.  Non-interactive callers must provide full IMAP
+maildrop specifications for SOURCE and DEST as described in the
+documentation for `vm-spool-files'."
+  (interactive
+   (save-excursion
+     (vm-session-initialization)
+     (vm-check-for-killed-folder)
+     (vm-select-folder-buffer-if-possible)
+     (let ((this-command this-command)
+	   (last-command last-command)
+	   source dest)
+       (setq source (vm-read-imap-folder-name "Rename IMAP folder: "
+					      vm-imap-server-list t))
+       (setq dest (vm-read-imap-folder-name
+		   (format "Rename %s to: " (vm-safe-imapdrop-string source))
+		   (list source) nil))
+       (list source dest))))
+  (let ((vm-imap-ok-to-ask t)
+	process mailbox-source mailbox-dest)
+    (setq process (vm-imap-make-session source))
+    (if (null process)
+	(error "Couldn't open IMAP session for %s"
+	       (vm-safe-imapdrop-string source)))
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (setq mailbox-source (nth 3 (vm-imap-parse-spec-to-list source)))
+      (setq mailbox-dest (nth 3 (vm-imap-parse-spec-to-list dest)))
+      (vm-imap-rename-mailbox process mailbox-source mailbox-dest)
+      (message "Folder %s renamed to %s" (vm-safe-imapdrop-string source)
+	       (vm-safe-imapdrop-string dest)))))
+
 (provide 'vm-imap)
     ["Expunge" vm-expunge-folder vm-message-list]
     ["Expunge POP Messages" vm-expunge-pop-messages
      (vm-menu-can-expunge-pop-messages-p)]
+    ["Expunge IMAP Messages" vm-expunge-pop-messages
+     (vm-menu-can-expunge-imap-messages-p)]
     "---"
-    ["Visit Folder" vm-visit-folder t]
-    ["Visit POP Folder" vm-visit-pop-folder t]
+    ["Visit Local Folder" vm-visit-folder t]
+    ["Visit POP Folder" vm-visit-pop-folder vm-pop-folder-alist]
+    ["Visit IMAP Folder" vm-visit-imap-folder vm-imap-server-list]
     ["Revert Folder (back to disk version)" vm-revert-buffer
      (vm-menu-can-revert-p)]
     ["Recover Folder (from auto-save file)" vm-recover-file
 	(not (eq vm-folder-access-method 'pop)))
     (error nil)))
 
+(defun vm-menu-can-expunge-imap-messages-p ()
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	(not (eq vm-folder-access-method 'imap)))
+    (error nil)))
+
 (defun vm-menu-yank-original ()
   (interactive)
   (save-excursion
   (aref (aref message 1) 17))
 (defsubst vm-su-summary-mouse-track-overlay-of (message)
   (aref (aref message 1) 18))
-(defsubst vm-message-access-method (message)
+(defsubst vm-message-access-method-of (message)
   (aref (aref message 1) 19))
 ;; message attribute vector
 (defsubst vm-attributes-of (message) (aref message 2))
 ;; pop UIDL value for message
 (defsubst vm-pop-uidl-of (message)
   (aref (aref message 3) 23))
+;; imap UID value for message (shares same slot as pop-uidl-of)
+(defsubst vm-imap-uid-of (message)
+  (aref (aref message 3) 23))
+(defsubst vm-imap-uid-validity-of (message)
+  (aref (aref message 3) 24))
 ;; extra data shared by virtual messages if vm-virtual-mirror is non-nil
 (defsubst vm-mirror-data-of (message) (aref message 4))
 ;; if message is being edited, this is the buffer being used.
 ;; list of virtual messages mirroring the underlying real message
 (defsubst vm-virtual-messages-of (message)
   (symbol-value (aref (aref message 4) 1)))
-;; modification flag for this message
 ;; nil if all attribute changes have been stuffed into the folder buffer
-(defsubst vm-modflag-of (message) (aref (aref message 4) 2))
+(defsubst vm-stuff-flag-of (message) (aref (aref message 4) 2))
 ;; list of labels attached to this message
 (defsubst vm-labels-of (message) (aref (aref message 4) 3))
 ;; comma list of labels
 (defsubst vm-label-string-of (message) (aref (aref message 4) 4))
+;; attribute modification flag for this message
+;; non-nil if attributes need to be saved
+(defsubst vm-attribute-modflag-of (message) (aref (aref message 4) 5))
 
 (defsubst vm-set-location-data-of (message vdata) (aset message 0 vdata))
 (defsubst vm-set-start-of (message start)
   (vm-mark-for-summary-update message)
   (if (eq vm-flush-interval t)
       (vm-stuff-virtual-attributes message)
-    (vm-set-modflag-of message t))
+    (vm-set-stuff-flag-of message t))
   (and (not (buffer-modified-p)) (vm-set-buffer-modified-p t))
   (vm-clear-modification-flag-undos))
 (defsubst vm-set-cache-of (message cache) (aset message 3 cache))
   (aset (aref message 3) 22 val))
 (defsubst vm-set-pop-uidl-of (message val)
   (aset (aref message 3) 23 val))
+(defsubst vm-set-imap-uid-of (message val)
+  (aset (aref message 3) 23 val))
+(defsubst vm-set-imap-uid-validity-of (message val)
+  (aset (aref message 3) 24 val))
 (defsubst vm-set-mirror-data-of (message data)
   (aset message 4 data))
 (defsubst vm-set-edit-buffer-of (message buf)
   (set (aref (aref message 4) 1) list))
 (defsubst vm-set-virtual-messages-sym-of (message sym)
   (aset (aref message 4) 1 sym))
-(defsubst vm-set-modflag-of (message val)
+(defsubst vm-set-stuff-flag-of (message val)
   (aset (aref message 4) 2 val))
 (defsubst vm-set-labels-of (message labels)
   (aset (aref message 4) 3 labels))
 (defsubst vm-set-label-string-of (message string)
   (aset (aref message 4) 4 string))
+(defsubst vm-set-attribute-modflag-of (message flag)
+  (aset (aref message 4) 5 flag))
 
 (defun vm-make-message ()
   (let ((v (make-vector 5 nil)) sym)
 (defun vm-decode-mime-encoded-words ()
   (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 (point-min))
       (while (re-search-forward vm-mime-encoded-word-regexp nil 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 done t)
 	(setq param-list (cdr param-list))))
     (and (car param-list)
-	 (setcar param-list (concat "charset=" value)))))
+	 (setcar param-list (concat name "=" 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-display-internal-text/plain (layout &optional no-highlighting)
   (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 (and (not (vm-mime-charset-internally-displayable-p charset))
 	     (not (setq need-conversion (vm-mime-can-convert-charset charset))))
       (or no-highlighting (vm-energize-urls-in-message-region start end))
       (if (and vm-fill-paragraphs-containing-long-lines
 	       (not no-highlighting))
-	  (let ((needmsg (> (- (vm-text-end-of m)
-			       (vm-text-of m))
-			    12000)))
+	  (let ((needmsg (> (- end start) 12000)))
 	    (if needmsg
 		(message "Searching for paragraphs to fill..."))
 	    (vm-fill-paragraphs-containing-long-lines
 		      'vm-process-sentinel-display-image-strips))
 		 (vm-image-too-small
 		  (setq do-strips nil))
-		 (x-error
+		 (error
 		  (message "Failed making image strips: %s" error-data)
 		  ;; fallback to the non-strips way
 		  (setq do-strips nil)))))
 					 (if reverse "-negate" "-matte")
 					 "-crop"
 					 (format "%dx%d+0+0" width height)
+					 "-page"
+					 (format "%dx%d+0+0" width height)
 					 "-mattecolor" "white"
 					 "-frame"
 					 (format "%dx%d+0+0"
 				  (+ min-height adjustment
 				     (if (zerop remainder) 0 1))
 				  starty)
+			  " -page"
+			  (format " %dx%d+0+0"
+				  width
+				  (+ min-height adjustment
+				     (if (zerop remainder) 0 1)))
 			  (format " -roll +%d+%d" hroll vroll)
-			  " '" file "' '" output-type newfile "'\n")
+			  " \"" file "\" \"" output-type newfile "\"\n")
 		  (if incremental
 		      (progn
 			(insert "echo XZXX" (int-to-string i) "XZXX\n")))
 				    (+ min-height adjustment
 				       (if (zerop remainder) 0 1))
 				    starty)
+			    "-page"
+			    (format "%dx%d+0+0"
+				    width
+				    (+ min-height adjustment
+				       (if (zerop remainder) 0 1)))
 			    "-roll"
 			    (format "+%d+%d" hroll vroll)
 			    file (concat output-type newfile)))
 	  ;; we don't care if the delete fails
 	  (condition-case nil
 	      (vm-delete-mime-object (expand-file-name file))
-	    (error nil))))))
+	    (error nil))))
+    file ))
 
 (defun vm-mime-reader-map-save-message ()
   (interactive)
 	(and description (setq description
 			       (vm-mime-scrub-description description)))
 	(vm-mime-attach-object buf "message/rfc822" nil description nil)
+	(make-local-variable 'vm-forward-list)
+	(setq vm-system-state 'forwarding
+	      vm-forward-list (list message))
 	(add-hook 'kill-buffer-hook
 		  (list 'lambda ()
 			(list 'if (list 'eq (current-buffer) '(current-buffer))
       (vm-mime-attach-object buf "multipart/digest"
 			     (list (concat "boundary=\""
 					   boundary "\"")) nil t)
+      (make-local-variable 'vm-forward-list)
+      (setq vm-system-state 'forwarding
+	    vm-forward-list (copy-sequence message))
       (add-hook 'kill-buffer-hook
 		(list 'lambda ()
 		      (list 'if (list 'eq (current-buffer) '(current-buffer))
 	(vm-set-edited-flag-of m t)
 	(vm-set-byte-count-of m nil)
 	(vm-set-line-count-of m nil)
-	(vm-set-modflag-of m t)
+	(vm-set-stuff-flag-of m t)
 	;; For the dreaded From_-with-Content-Length folders recompute
 	;; the message length and make a new Content-Length header.
 	(if (eq (vm-message-type-of m) 'From_-with-Content-Length)
 
 (defun vm-mf-default-action (layout)
   (or vm-mf-default-action
-      (if (or (vm-mime-can-display-internal layout)
-	      (vm-mime-find-external-viewer (car (vm-mm-layout-type layout)))
-	      (vm-mime-can-convert (car (vm-mm-layout-type layout))))
-	  (let ((p vm-mime-default-action-string-alist)
-		(type (car (vm-mm-layout-type layout))))
-	    (catch 'done
-	      (while p
-		(if (vm-mime-types-match (car (car p)) type)
-		    (throw 'done (cdr (car p)))
-		  (setq p (cdr p))))
-	      nil ))
-	"save to a file")
+      (let (cons)
+	(cond ((or (vm-mime-can-display-internal layout)
+		   (vm-mime-find-external-viewer
+		    (car (vm-mm-layout-type layout))))
+	       (let ((p vm-mime-default-action-string-alist)
+		     (type (car (vm-mm-layout-type layout))))
+		 (catch 'done
+		   (while p
+		     (if (vm-mime-types-match (car (car p)) type)
+			 (throw 'done (cdr (car p)))
+		       (setq p (cdr p))))
+		   nil )))
+	      ((setq cons (vm-mime-can-convert
+			   (car (vm-mm-layout-type layout))))
+	       (format "convert to %s and display" (nth 1 cons)))
+	      (t "save to a file")))
       ;; should not be reached
       "burn in the raging fires of hell forever"))
 
 	(file (vm-make-tempfile-name filename-suffix)))
     (unwind-protect
 	(progn
-	  ;; mode 600
-	  (set-default-file-modes (* 6 8 8))
+	  (set-default-file-modes (vm-octal 600))
 	  (vm-error-free-call 'delete-file file)
 	  (write-region (point) (point) file nil 0))
       (set-default-file-modes modes))
   (vm-set-pop-stat-y-got o (vm-pop-stat-x-got o))
   (vm-set-pop-stat-y-need o (vm-pop-stat-x-need o)))
 
+(defun vm-pop-check-connection (process)
+  (cond ((not (memq (process-status process) '(open run)))
+	 (error "POP connection not open: %s" process))
+	((not (buffer-live-p (process-buffer process)))
+	 (error "POP process %s's buffer has been killed" process))))
+
 (defun vm-pop-send-command (process command)
+  (vm-pop-check-connection process)
   (goto-char (point-max))
   (if (= (aref command 0) ?P)
       (insert-before-markers "PASS <omitted>\r\n")
   (process-send-string process (format "%s\r\n" command)))
 
 (defun vm-pop-read-response (process &optional return-response-string)
+  (vm-pop-check-connection process)
   (let ((case-fold-search nil)
 	 match-end)
     (goto-char vm-pop-read-point)
     (while (not (search-forward "\r\n" nil t))
+      (vm-pop-check-connection process)
       (accept-process-output process)
       (goto-char vm-pop-read-point))
     (setq match-end (point))
 	t ))))
 
 (defun vm-pop-read-past-dot-sentinel-line (process)
+  (vm-pop-check-connection process)
   (let ((case-fold-search nil))
     (goto-char vm-pop-read-point)
     (while (not (re-search-forward "^\\.\r\n" nil 0))
       (beginning-of-line)
       ;; save-excursion doesn't work right
       (let ((opoint (point)))
+	(vm-pop-check-connection process)
 	(accept-process-output process)
 	(goto-char opoint)))
     (setq vm-pop-read-point (point))))
 	 (string-to-int (nth 2 (vm-parse response "\\([^ ]+\\) *"))))))
 
 (defun vm-pop-read-uidl-long-response (process)
+  (vm-pop-check-connection process)
   (let ((start vm-pop-read-point)
 	(list nil)
 	n uidl)
 	(beginning-of-line)
 	;; save-excursion doesn't work right
 	(let ((opoint (point)))
+	  (vm-pop-check-connection process)
 	  (accept-process-output process)
 	  (goto-char opoint)))
       (setq vm-pop-read-point (point-marker))
       (and work-buffer (kill-buffer work-buffer)))))
 
 (defun vm-pop-retrieve-to-target (process target statblob)
+  (vm-pop-check-connection process)
   (let ((start vm-pop-read-point) end)
     (goto-char start)
     (vm-set-pop-stat-x-got statblob 0)
 		       (if (zerop (% (random) 10))
 			   (vm-pop-report-retrieval-status statblob)))))))
 	     (after-change-functions (cons func after-change-functions)))
+	(vm-pop-check-connection process)
 	(accept-process-output process)
 	(goto-char opoint)))
     (vm-set-pop-stat-x-need statblob nil)
 	    (beginning-of-line)
 	    ;; save-excursion doesn't work right
 	    (let ((opoint (point)))
+	      (vm-pop-check-connection process)
 	      (accept-process-output process)
 	      (goto-char opoint)))
 	  (setq vm-pop-read-point (point-marker))
 	   (statblob nil)
 	   (popdrop (vm-folder-pop-maildrop-spec))
 	   (safe-popdrop (vm-safe-popdrop-string popdrop))
-	   r-list mp got-some pr-list message-size
+	   r-list mp got-some message-size
 	   (folder-buffer (current-buffer)))
       (if (and do-retrieves retrieve-list)
 	  (save-excursion
 	     (setq r-list retrieve-list)
 	     (while mp
 	       (vm-set-pop-uidl-of (car mp) (car (car r-list)))
-	       (vm-set-modflag-of (car mp) t)
+	       (vm-set-stuff-flag-of (car mp) t)
 	       (setq mp (cdr mp)
 		     r-list (cdr r-list))))))
       (if do-local-expunges
 	(setq list (cdr list))))
     (and list (nth 1 (car list)))))
 
-(defun vm-pop-make-filename-for-spec (spec &optional scrub-password)
+(defun vm-pop-make-filename-for-spec (spec &optional scrub-password scrub-spec)
   (let (md5 list)
-    (if (null scrub-password)
+    (if (and (null scrub-password) (null scrub-spec))
 	nil
       (setq list (vm-pop-parse-spec-to-list spec))
       (setcar (vm-last list) "*")
+      (if scrub-spec
+	  (progn
+	    (cond ((= (length list) 6)
+		   (setcar list "pop")
+		   (setcar (nthcdr 2 list) "*")
+		   (setcar (nthcdr 3 list) "*"))
+		  (t
+		   (setq list (cons "pop" list))
+		   (setcar (nthcdr 2 list) "*")
+		   (setcar (nthcdr 3 list) "*")))))
       (setq spec (mapconcat (function identity) list ":")))
     (setq md5 (vm-md5-string spec))
     (expand-file-name (concat "pop-cache-" md5)
 	    (mail-yank-hooks (run-hooks 'mail-yank-hooks))
 	    (t (vm-mail-yank-default message))))))
 
-(defun vm-mail-send-and-exit (arg)
-  "Just like mail-send-and-exit except that VM flags the appropriate message(s)
-as having been replied to, if appropriate."
+(defun vm-mail-send-and-exit (&rest ignored)
+  "Send message and maybe delete the composition buffer.
+The value of `vm-keep-sent-mesages' determines whether the composition buffer is deleted.  If the composition is a reply to a message ina currenttly visited folder, that message is marked as having been rpelied to."
   (interactive "P")
   (vm-check-for-killed-folder)
   (if (and (boundp 'mail-alias-file)
     (if (not (zerop (save-excursion (set-buffer buffer) (buffer-size))))
 	(display-buffer buffer))))
 
+(defun vm-save-message-to-imap-folder (folder &optional count)
+  "Save the current message to an IMAP folder.
+Prefix arg COUNT means save this message and the next COUNT-1
+messages.  A negative COUNT means save this message and the
+previous COUNT-1 messages.
+
+When invoked on marked messages (via vm-next-command-uses-marks),
+all marked messages in the current folder are saved; other messages are
+ignored.
+
+The saved messages are flagged as `filed'."
+  (interactive
+   (save-excursion
+     (vm-session-initialization)
+     (vm-check-for-killed-folder)
+     (vm-select-folder-buffer-if-possible)
+     (let ((this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-imap-folder-name "Save to IMAP folder: "
+				       vm-imap-server-list t)
+	     (prefix-numeric-value current-prefix-arg)))))
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-empty)
+  (vm-display nil nil '(vm-save-message-to-imap-folder)
+	      '(vm-save-message-to-imap-folder))
+  (or count (setq count 1))
+  (let ((mlist (vm-select-marked-or-prefixed-messages count))
+	process m 
+	(mailbox (nth 3 (vm-imap-parse-spec-to-list folder)))
+	(count 0))
+    (unwind-protect
+	(save-excursion
+	  (setq process (vm-imap-make-session folder))
+	  (set-buffer (process-buffer process))
+	  (while mlist
+	    (setq m (car mlist))
+	    (vm-imap-save-message process m mailbox)
+	    (if (null (vm-filed-flag m))
+		(vm-set-filed-flag m t))
+	    (vm-increment count)
+	    (vm-modify-folder-totals folder 'saved 1 m)
+	    (setq mlist (cdr mlist))))
+      (and process (vm-imap-end-session process)))
+    (vm-update-summary-and-mode-line)
+    (if (interactive-p)
+	(message "%d message%s saved to %s"
+		 count (if (/= 1 count) "s" "")
+		 (vm-safe-imapdrop-string folder)))
+    (if (and vm-delete-after-saving (not vm-folder-read-only))
+	(vm-delete-message count))
+    folder ))
+
 (provide 'vm-save)
 	      (or (vm-get-header-contents m "Date:")
 		  (vm-grok-From_-date m)
 		  "Thu, 1 Jan 1970 00:00:00 GMT"))
-	   (x-error "1970010100:00:00")))
+	   (error "1970010100:00:00")))
 	(vm-sortable-datestring-of m))))
 
 (defun vm-so-sortable-subject (m)
 changes, message additions or deletions will be allowed in the
 visited folder.
 
-Visiting the primary inbox causes any contents of the system mailbox to
-be moved and appended to the resulting buffer.
+Visiting the primary inbox normally causes any contents of the system mailbox to
+be moved and appended to the resulting buffer.  You can disable this automatic fetching of mail by setting `vm-auto-get-new-mail' to nil.
 
 All the messages can be read by repeatedly pressing SPC.  Use `n'ext and
 `p'revious to move about in the folder.  Messages are marked for
   ;; against letter bombs.
   ;; set enable-local-variables to nil for newer Emacses
   (catch 'done
+    ;; deduce the access method if none specified
+    (if (null access-method)
+	(let ((f (or folder vm-primary-inbox)))
+	  (cond ((and vm-recognize-imap-maildrops
+		      ;; f could be a buffer
+		      (stringp f)
+		      (string-match vm-recognize-imap-maildrops f))
+		 (setq access-method 'imap
+		       folder f))
+		((and vm-recognize-pop-maildrops
+		      ;; f could be a buffer
+		      (stringp f)
+		      (string-match vm-recognize-pop-maildrops f))
+		 (setq access-method 'pop
+		       folder f)))))
     (let ((full-startup (not (bufferp folder)))
 	  (did-read-index-file nil)
 	  folder-buffer first-time totals-blurb
 	     ;; based on the full POP spec including the password
 	     ;; if it was in the spec.  This meant that every
 	     ;; time the user changed his password, we'd start
-	     ;; visiting the wrong file.
+	     ;; visiting the wrong (and probably nonexistent)
+	     ;; cache file.
 	     ;;
 	     ;; To fix this we do two things.  First, migrate the
-	     ;; users caches to the filenames based in the POP
+	     ;; user's caches to the filenames based in the POP
 	     ;; sepc without the password.  Second, we visit the
 	     ;; old password based filename if it still exists
 	     ;; after trying to migrate it.
+	     ;;
+	     ;; For VM 7.16 we apply the same logic to the access
+	     ;; methods, pop, pop-ssh and pop-ssl and to
+	     ;; authentication method and service port, which can
+	     ;; also change and lead us to visit a nonexistent
+	     ;; cache file.  The assumption is that these
+	     ;; properties of the connection can change and we'll
+	     ;; still be accessing the same mailbox on the
+	     ;; server.
 	     (let ((f-pass (vm-pop-make-filename-for-spec remote-spec))
-		   (f-nopass (vm-pop-make-filename-for-spec remote-spec t)))
-	       (if (or (string= f-pass f-nopass) (file-exists-p f-nopass))
-		   nil
-		 ;; try to migrate
-		 (condition-case nil
-		     (rename-file f-pass f-nopass)
-		   (error nil)))
-	       ;; choose the one based on the password if it still exists.
-	       (if (file-exists-p f-pass)
-		   (setq folder f-pass)
-		 (setq folder f-nopass)))))
+		   (f-nopass (vm-pop-make-filename-for-spec remote-spec t))
+		   (f-nospec (vm-pop-make-filename-for-spec remote-spec t t)))
+	       (cond ((or (string= f-pass f-nospec)
+			  (file-exists-p f-nospec))
+		      nil )
+		     ((file-exists-p f-pass)
+		      ;; try to migrate
+		      (condition-case nil
+			  (rename-file f-pass f-nospec)
+			(error nil)))
+		     ((file-exists-p f-nopass)
+		      ;; try to migrate
+		      (condition-case nil
+			  (rename-file f-nopass f-nospec)
+			(error nil))))
+	       ;; choose the one that exists, password version,
+	       ;; nopass version and finally nopass+nospec
+	       ;; version.
+	       (cond ((file-exists-p f-pass)
+		      (setq folder f-pass))
+		     ((file-exists-p f-nopass)
+		      (setq folder f-nopass))
+		     (t
+		      (setq folder f-nospec)))))
+	    ((eq access-method 'imap)
+	     (setq remote-spec folder
+		   folder-name (or (nth 3 (vm-imap-parse-spec-to-list
+					   remote-spec))
+				   folder)
+		   folder (vm-imap-make-filename-for-spec remote-spec))))
       (setq folder-buffer
 	    (if (bufferp folder)
 		folder
 				      (cons item vm-folder-history))))
 			  (message "Reading %s... done" file))))))))
       (set-buffer folder-buffer)
-      (cond ((eq access-method 'pop)
+      (cond ((memq access-method '(pop imap))
 	     (if (not (equal folder-name (buffer-name)))
 		 (rename-buffer folder-name t))))
       (if (and vm-fsfemacs-mule-p enable-multibyte-characters)
 	    (vm-fsfemacs-nonmule-display-8bit-chars)
 	    (vm-mode-internal access-method)
 	    (cond ((eq access-method 'pop)
-		   (vm-set-folder-pop-maildrop-spec remote-spec)))
+		   (vm-set-folder-pop-maildrop-spec remote-spec))
+		  ((eq access-method 'imap)
+		   (vm-set-folder-imap-maildrop-spec remote-spec)))
 	    ;; If the buffer is modified we don't know if the
 	    ;; folder format has been changed to be different
 	    ;; from index file, so don't read the index file in
 		    (vm-update-summary-and-mode-line))))
 	    (message totals-blurb)))
 
-      ;; Display copyright and copying info unless
-      ;; user says no.
+      ;; Display copyright and copying info.
       (if (and (interactive-p) (not vm-startup-message-displayed))
 	  (progn
 	    (vm-display-startup-message)
 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 7.14.
+This is VM 7.17.
 
 Commands:
    h - summarize folder contents
    vm-mime-forward-local-external-bodies
    vm-mime-ignore-composite-type-opaque-transfer-encoding
    vm-mime-ignore-mime-version
-   vm-mime-ignore-missing-multiparty-boundary
+   vm-mime-ignore-missing-multipart-boundary
    vm-mime-internal-content-type-exceptions
    vm-mime-internal-content-types
    vm-mime-max-message-size
 		(setq foo (vm-pop-find-name-for-spec folder)))
 	   (setq folder foo
 		 access-method 'pop))
+	  ((and (stringp vm-recognize-imap-maildrops)
+		(string-match vm-recognize-imap-maildrops folder)
+		(setq foo (vm-imap-find-name-for-spec folder)))
+	   (setq folder foo
+		 access-method 'imap))
 	  (t
 	   (let ((default-directory (or vm-folder-directory default-directory)))
 	     (setq folder (expand-file-name folder)))))
 ;;;###autoload
 (defun vm-visit-pop-folder (folder &optional read-only)
   "Visit a POP mailbox.
-VM will parse and present its messages to you in the usual way.
+VM will present its messages to you in the usual way.  Messages
+found in the POP mailbox will be downloaded and stored in a local
+cache.  If you expunge messages from the cache, the corresponding
+messages will be expunged from the POP mailbox.
 
 First arg FOLDER specifies the name of the POP mailbox to visit.
 You can only visit mailboxes that are specified in `vm-pop-folder-alist'.
 	(vm-search-other-frames nil))
     (vm-visit-pop-folder folder read-only)))
 
+;;;###autoload
+(defun vm-visit-imap-folder (folder &optional read-only)
+  "Visit a IMAP mailbox.
+VM will present its messages to you in the usual way.  Messages
+found in the IMAP mailbox will be downloaded and stored in a local
+cache.  If you expunge messages from the cache, the corresponding
+messages will be expunged from the IMAP mailbox.
+
+First arg FOLDER specifies the IMAP mailbox to visit.  You can only
+visit mailboxes on servers that are listed in `vm-imap-server-list'.
+When this command is called interactively the server and mailbox
+names are read from the minibuffer.
+
+Prefix arg or optional second arg READ-ONLY non-nil indicates
+that the folder should be considered read only.  No attribute
+changes, messages additions or deletions will be allowed in the
+visited folder."
+  (interactive
+   (save-excursion
+     (vm-session-initialization)
+     (vm-check-for-killed-folder)
+     (vm-select-folder-buffer-if-possible)
+     (let ((this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-imap-folder-name
+	      (format "Visit%s IMAP folder: "
+		      (if current-prefix-arg " read only" ""))
+	      vm-imap-server-list t)
+	     current-prefix-arg))))
+  (vm-session-initialization)
+  (vm-check-for-killed-folder)
+  (vm-select-folder-buffer-if-possible)
+  (vm-check-for-killed-summary)
+  (vm folder read-only 'imap))
+
+;;;###autoload
+(defun vm-visit-imap-folder-other-frame (folder &optional read-only)
+  "Like vm-visit-imap-folder, but run in a newly created frame."
+  (interactive
+   (save-excursion
+     (vm-session-initialization)
+     (vm-check-for-killed-folder)
+     (vm-select-folder-buffer-if-possible)
+     (let ((this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-imap-folder-name
+	      (format "Visit%s IMAP folder: "
+		      (if current-prefix-arg " read only" ""))
+	      vm-imap-server-list)
+	     current-prefix-arg))))
+  (vm-session-initialization)
+  (if (vm-multiple-frames-possible-p)
+      (vm-goto-new-frame 'folder))
+  (let ((vm-frame-per-folder nil)
+	(vm-search-other-frames nil))
+    (vm-visit-imap-folder folder read-only))
+  (if (vm-multiple-frames-possible-p)
+      (vm-set-hooks-for-frame-deletion)))
+
+;;;###autoload
+(defun vm-visit-imap-folder-other-window (folder &optional read-only)
+  "Like vm-visit-imap-folder, but run in a different window."
+  (interactive
+   (save-excursion
+     (vm-session-initialization)
+     (vm-check-for-killed-folder)
+     (vm-select-folder-buffer-if-possible)
+     (let ((this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-imap-folder-name
+	      (format "Visit%s IMAP folder: "
+		      (if current-prefix-arg " read only" ""))
+	      vm-imap-server-list)
+	     current-prefix-arg))))
+  (vm-session-initialization)
+  (if (one-window-p t)
+      (split-window))
+  (other-window 1)
+  (let ((vm-frame-per-folder nil)
+	(vm-search-other-frames nil))
+    (vm-visit-imap-folder folder read-only)))
+
 (put 'vm-virtual-mode 'mode-class 'special)
 
 (defun vm-virtual-mode (&rest ignored)
       'vm-mime-forward-local-external-bodies
       'vm-mime-ignore-composite-type-opaque-transfer-encoding
       'vm-mime-ignore-mime-version
-      'vm-mime-ignore-missing-multiparty-boundary
+      'vm-mime-ignore-missing-multipart-boundary
       'vm-mime-internal-content-type-exceptions
       'vm-mime-internal-content-types
       'vm-mime-max-message-size
 (if (fboundp 'define-mail-user-agent)
     (define-mail-user-agent 'vm-user-agent
       (function vm-compose-mail)	; compose function
-      (function vm-send-mail-and-exit)	; send function
+      (function vm-mail-send-and-exit)	; send function
       nil				; abort function (kill-buffer)
       nil)				; hook variable (mail-send-hook)
 )
     (while mp
       (vm-set-summary-of (car mp) nil)
       (vm-mark-for-summary-update (car mp))
-      (vm-set-modflag-of (car mp) t)
+      (vm-set-stuff-flag-of (car mp) t)
       (setq mp (cdr mp)))
     (message "Stuffing attributes...")
     (vm-stuff-folder-attributes nil)
       (aset (vm-attributes-of m) attr-index flag)
       (vm-mark-for-summary-update m)
       (if (not norecord)
-	  (if (eq vm-flush-interval t)
-	      (vm-stuff-virtual-attributes m)
-	    (vm-set-modflag-of m t)))))))
+	  (progn
+	    (vm-set-attribute-modflag-of m t)
+	    (if (eq vm-flush-interval t)
+		(vm-stuff-virtual-attributes m)
+	      (vm-set-stuff-flag-of m t))))))))
 
 
 (defun vm-set-labels (m labels)
       (vm-mark-for-summary-update m)
       (if (eq vm-flush-interval t)
 	  (vm-stuff-virtual-attributes m)
-	(vm-set-modflag-of m t))))))
+	(vm-set-stuff-flag-of m t))))))
 
 
 (defun vm-set-new-flag (m flag &optional norecord)
   (vm-set-xxxx-flag m flag norecord 'vm-set-forwarded-flag 6))
 
 (defun vm-set-redistributed-flag (m flag &optional norecord)
-  (vm-set-xxxx-flag m flag norecord 'vm-set-forwarded-flag 8))
+  (vm-set-xxxx-flag m flag norecord 'vm-set-redistributed-flag 8))
 
 ;; use these to avoid undo and summary update.
 (defun vm-set-new-flag-of (m flag) (aset (aref m 2) 0 flag))
 
 ;;(provide 'vm-vars)
 
-;; Emacs 19.34 doens't have defcustom but we want to continue to
+;; Emacs 19.34 doesn't have defcustom but we want to continue to
 ;; supoprt that Emacs version.  So fake up some definitions if we
 ;; need them and erase them after we're done.
 
     (defmacro defcustom (var value doc &rest args) 
       (` (defvar (, var) (, value) (, doc))))))
 
+(defgroup vm nil
+  "The VM mail reader."
+  :group 'mail)
+
 (defcustom vm-init-file "~/.vm"
   "*Startup file for VM that is loaded the first time you run VM
 in an Emacs session."
 When VM uses `vm-spool-file-suffixes' to create a spool file name,
 it will append the value of `vm-crash-box-suffix' to the folder's
 file name to create a crash box name."
-  :type '(list string))
+  :type 'string)
 
 (defcustom vm-make-spool-file-name nil
   "*Non-nil value should be a function that returns a spool file name
 
 (defcustom vm-imap-max-message-size nil
   "*If VM is about to retrieve via IMAP a message larger than this size
-(in bytes) it will ask the you whether it should retrieve the message.
+(in bytes) it will ask you whether it should retrieve the message.
 
 If VM is retrieving mail automatically because `vm-auto-get-new-mail'
 is set to a numeric value then you will not be prompted about large
 be considered files except those matched by `vm-recognize-pop-maildrops'."
   :type 'regexp)
 
+(defcustom vm-imap-server-list nil
+  "*List of IMAP maildrop specifications that tell VM the IMAP servers
+you have access to and how to log into them.  The IMAP maildrop
+specification in the same format used by vm-spool-files (which
+see).  The mailbox part of the specifiation is ignored and should
+be asterisk or some other placeholder.
+
+Example:
+ (setq vm-imap-server-list
+      '(
+         \"imap-ssl:mail.foocorp.com:993:inbox:login:becky:*\"
+         \"imap:crickle.lex.ky.us:143:inbox:login:becky:*\"
+       )
+ )"
+  :type '(repeat string))
+
+(defcustom vm-imap-folder-cache-directory nil
+  "*Directory where VM stores cached copies of IMAP folders.
+When VM visits a IMAP folder (really just a IMAP server where you
+have a mailbox) it stores the retrieved message on your computer
+so that they need not be retrieved each time you visit the folder.
+The cached copies are stored in the directory specified by this
+variable."
+  :type '(choice (const nil) directory))
+
 (defcustom vm-auto-get-new-mail t
   "*Non-nil value causes VM to automatically move mail from spool files
 to a mail folder when the folder is first visited.  Nil means
 
 A nil value causes VM not to preview messages; no text lines are hidden and 
 messages are immediately flagged as read."
-  :type '(choice (const nil) integer))
+  :type '(choice boolean integer))
 
 (defcustom vm-preview-read-messages nil
   "*Non-nil value means to preview messages even if they've already been read.
 Any type that cannot be displayed internally or externally will
 be displayed as a button that allows you to save the body of the MIME
 object to a file."
-  :type '(repeat string))
+  :type '(choice (const t) (repeat string)))
 
 (defcustom vm-auto-displayed-mime-content-type-exceptions nil