Commits

youngs  committed 538d208

2001-12-09 Steve Youngs <youngs@xemacs.org>

* Sync with vm-7.00

  • Participants
  • Parent commits f3dc71c
  • Tags XEMACS_BEFORE_MOVE_TO_SUNSITE_DK, sumo-2001-12-11 3
    1. sumo-2001-12-13
    2. sumo-2001-12-16
    3. vm-7_00

Comments (0)

Files changed (14)

+2001-12-09  Steve Youngs  <youngs@xemacs.org>
+
+	* Sync with vm-7.00
+
 2001-11-30  Steve Youngs  <youngs@xemacs.org>
 
 	* Makefile (ELCS): Add vm-crypto.elc
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 6.99
-AUTHOR_VERSION = 6.99
+VERSION = 7.00
+AUTHOR_VERSION = 7.00
 MAINTAINER = Kyle Jones <kyle_jones@wonderworks.com>
 PACKAGE = vm
 PKG_TYPE = regular

File vm-delete.el

 	       (if (= 1 del-count) "" "s")))
     (vm-update-summary-and-mode-line)))
 
-(defun vm-expunge-folder (&optional shaddap)
+(defun vm-expunge-folder (&optional shaddap just-these-messages
+				    messages-to-expunge)
   "Expunge messages with the `deleted' attribute.
 For normal folders this means that the deleted messages are
 removed from the message list and the message contents are
   (vm-update-summary-and-mode-line)
   (if (not shaddap)
       (message "Expunging..."))
-  (let ((use-marks (eq last-command 'vm-next-command-uses-marks))
+  (let ((use-marks (and (eq last-command 'vm-next-command-uses-marks)
+			(null just-these-messages)))
 	(mp vm-message-list)
 	(virtual (eq major-mode 'vm-virtual-mode))
 	(buffers-altered (make-vector 29 0))
 	prev virtual-messages)
     (while mp
       (cond
-       ((and (vm-deleted-flag (car mp))
-	     (or (not use-marks)
-		 (vm-mark-of (car mp))))
+       ((if just-these-messages
+	    (memq (car mp) messages-to-expunge)
+	  (and (vm-deleted-flag (car mp))
+	       (or (not use-marks)
+		   (vm-mark-of (car mp)))))
 	;; remove the message from the thread tree.
 	(if vm-thread-obarray
 	    (vm-unthread-message (vm-real-message-of (car mp))))
 		(vm-attributes-of (vm-real-message-of (car mp))))
 	    (save-excursion
 	      (set-buffer (vm-buffer-of (vm-real-message-of (car mp))))
+	      (cond ((eq vm-folder-access-method 'pop)
+		     (setq vm-pop-messages-to-expunge
+			   (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
+			   ;; 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.
+			   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-increment vm-modification-counter)
 	      (vm-save-restriction
 	       (widen)

File vm-folder.el

       (while (vm-find-leading-message-separator)
 	(setq message (vm-make-message))
 	(vm-set-message-type-of message vm-folder-type)
+	(vm-set-message-access-method-of message vm-folder-access-method)
 	(vm-set-start-of message (vm-marker (point)))
 	(vm-skip-past-leading-message-separator)
 	(vm-set-headers-of message (vm-marker (point)))
 	  (vm-stuff-attributes (vm-real-message-of message))))))
 
 (defun vm-stuff-labels ()
-  (if vm-message-pointer
+  (if vm-message-list
       (save-excursion
 	(vm-save-restriction
 	 (widen)
 
 ;; Insert a bookmark into the first message in the folder.
 (defun vm-stuff-bookmark ()
-  (if vm-message-pointer
+  (if vm-message-list
       (save-excursion
 	(vm-save-restriction
 	 (widen)
 	   (set-buffer-modified-p old-buffer-modified-p))))))
 
 (defun vm-stuff-last-modified ()
-  (if vm-message-pointer
+  (if vm-message-list
       (save-excursion
 	(vm-save-restriction
 	 (widen)
 	   (set-buffer-modified-p old-buffer-modified-p))))))
 
 (defun vm-stuff-pop-retrieved ()
-  (if vm-message-pointer
+  (if vm-message-list
       (save-excursion
 	(vm-save-restriction
 	 (widen)
 	   (set-buffer-modified-p old-buffer-modified-p))))))
 
 (defun vm-stuff-imap-retrieved ()
-  (if vm-message-pointer
+  (if vm-message-list
       (save-excursion
 	(vm-save-restriction
 	 (widen)
 
 ;; Insert the summary format variable header into the first message.
 (defun vm-stuff-summary ()
-  (if vm-message-pointer
+  (if vm-message-list
       (save-excursion
 	(vm-save-restriction
 	 (widen)
 
 ;; stuff the current values of the header variables for future messages.
 (defun vm-stuff-header-variables ()
-  (if vm-message-pointer
+  (if vm-message-list
       (save-excursion
 	(vm-save-restriction
 	 (widen)
 	  (set-buffer (car b-list))
 	  (if (and (eq major-mode 'vm-mode)
 		   (setq found-one t)
-		   (not (and (not (buffer-modified-p))
+		   (not vm-global-block-new-mail)
+		   (not vm-block-new-mail)
+		   (not vm-folder-read-only)
+ 		   (not (and (not (buffer-modified-p))
 			     buffer-file-name
 			     (file-newer-than-file-p
 			      (make-auto-save-file-name)
 			      buffer-file-name)))
-		   (not vm-global-block-new-mail)
-		   (not vm-folder-read-only)
-		   (vm-get-spooled-mail nil)
-		   (vm-assimilate-new-messages t))
+		   (vm-get-spooled-mail nil))
 	      (progn
 		;; don't move the message pointer unless the folder
 		;; was empty.
       (vm-virtual-save-folder prefix)
     (if (buffer-modified-p)
 	(let (mp (newlist nil))
+	  (cond ((eq vm-folder-access-method 'pop)
+		 (vm-pop-synchronize-folder t t t nil)))
 	  ;; stuff the attributes of messages that need it.
 	  (message "Stuffing attributes...")
 	  (vm-stuff-folder-attributes nil)
 	    (save-buffer prefix))
 	  (vm-set-buffer-modified-p nil)
 	  ;; clear the modified flag in virtual folders if all the
-	  ;; real buffers assocaited with them are unmodified.
+	  ;; real buffers associated with them are unmodified.
 	  (let ((b-list vm-virtual-buffers) rb-list one-modified)
 	    (save-excursion
 	      (while b-list
   ;; and the disk don't match.
   (if recovery
       (setq vm-block-new-mail t))
-  (vm buffer-file-name))
+  (let ((name (cond ((eq vm-folder-access-method 'pop)
+		     (vm-pop-find-name-for-buffer (current-buffer))))))
+    (vm (or name buffer-file-name) nil vm-folder-access-method)))
 
 ;; detect if a recover-file is being performed
 ;; and handle things properly.
 (defun vm-handle-file-recovery ()
   (if (and (buffer-modified-p)
 	   (eq major-mode 'vm-mode)
-	   vm-message-list
-	   (= (vm-end-of (car vm-message-list)) 1))
+	   (or (null vm-message-list)
+	       (= (vm-end-of (car vm-message-list)) 1)))
       (vm-handle-file-recovery-or-reversion t)))
 
 ;; detect if a revert-buffer is being performed
 (defun vm-handle-file-reversion ()
   (if (and (not (buffer-modified-p))
 	   (eq major-mode 'vm-mode)
-	   vm-message-list
-	   (= (vm-end-of (car vm-message-list)) 1))
+	   (or (null vm-message-list)
+	       (= (vm-end-of (car vm-message-list)) 1)))
       (vm-handle-file-recovery-or-reversion nil)))
 
 ;; FSF v19.23 revert-buffer doesn't mash all the markers together
 (defun vm-check-for-spooled-mail (&optional interactive this-buffer-only)
   (if vm-global-block-new-mail
       nil
-    (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
-	  ;; before we finish.  block these attempts.
-	  (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
-	(setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory)
-	      maildrop (nth 1 (car triples))
-	      crash (nth 2 (car triples)))
-	(if (vm-movemail-specific-spool-file-p maildrop)
-	    ;; spool file is accessible only with movemail
-	    ;; so skip it.
-	    nil
-	  (setq this-buffer (eq (current-buffer) (vm-get-file-buffer in)))
-	  (if (or this-buffer (not this-buffer-only))
-	      (progn
-		(if (file-exists-p crash)
-		    (progn
-		      (setq mail-waiting t))
-		  (cond ((and vm-recognize-imap-maildrops
-			      (string-match vm-recognize-imap-maildrops
-					    maildrop))
-			 (setq meth 'vm-imap-check-mail))
-			((and vm-recognize-pop-maildrops
-			      (string-match vm-recognize-pop-maildrops
-					    maildrop))
-			 (setq meth 'vm-pop-check-mail))
-			(t (setq meth 'vm-spool-check-mail)))
-		  (if (not interactive)
-		      ;; allow no error to be signaled
-		      (condition-case nil
-			  (setq mail-waiting
-				(or mail-waiting
-				    (funcall meth maildrop)))
-			(error nil))
-		    (setq mail-waiting
-			  (or mail-waiting
-			      (funcall meth maildrop))))))))
-	(setq triples (cdr triples)))
-      mail-waiting )))
+    (if (and vm-folder-access-method this-buffer-only)
+	(cond ((eq vm-folder-access-method 'pop)
+	       (vm-pop-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
+	    ;; before we finish.  block these attempts.
+	    (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
+	  (setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory)
+		maildrop (nth 1 (car triples))
+		crash (nth 2 (car triples)))
+	  (if (vm-movemail-specific-spool-file-p maildrop)
+	      ;; spool file is accessible only with movemail
+	      ;; so skip it.
+	      nil
+	    (setq this-buffer (eq (current-buffer) (vm-get-file-buffer in)))
+	    (if (or this-buffer (not this-buffer-only))
+		(progn
+		  (if (file-exists-p crash)
+		      (progn
+			(setq mail-waiting t))
+		    (cond ((and vm-recognize-imap-maildrops
+				(string-match vm-recognize-imap-maildrops
+					      maildrop))
+			   (setq meth 'vm-imap-check-mail))
+			  ((and vm-recognize-pop-maildrops
+				(string-match vm-recognize-pop-maildrops
+					      maildrop))
+			   (setq meth 'vm-pop-check-mail))
+			  (t (setq meth 'vm-spool-check-mail)))
+		    (if (not interactive)
+			;; allow no error to be signaled
+			(condition-case nil
+			    (setq mail-waiting
+				  (or mail-waiting
+				      (funcall meth maildrop)))
+			  (error nil))
+		      (setq mail-waiting
+			    (or mail-waiting
+				(funcall meth maildrop))))))))
+	  (setq triples (cdr triples)))
+	mail-waiting ))))
 
 (defun vm-get-spooled-mail (&optional interactive)
   (if vm-block-new-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))
+	(t (vm-get-spooled-mail-normal interactive))))
+
+(defun vm-get-spooled-mail-normal (&optional interactive)
   (if vm-global-block-new-mail
       nil
     (let ((triples (vm-compute-spool-files))
 			      (progn
 				(setq got-mail t)
 				(if (not non-file-maildrop)
-				    (vm-store-folder-totals maildrop '(0 0 0 0)))
+				    (vm-store-folder-totals maildrop
+							    '(0 0 0 0)))
 				(message "Got mail from %s."
 					 safe-maildrop))))))))
 	  (setq triples (cdr triples)))
 	(vm-update-summary-and-mode-line)
 	(if got-mail
 	    (run-hooks 'vm-retrieved-spooled-mail-hook))
-	got-mail ))))
+	(and got-mail (vm-assimilate-new-messages t))))))
 
 (defun vm-safe-popdrop-string (drop)
   (or (and (string-match "^\\(pop:\\|pop-ssl:\\|pop-ssh:\\)?\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)
 		      (or buffer-file-name (buffer-name)))
 	   (message "Checking for new mail..."))
 	 (let (totals-blurb)
-	   (if (and (vm-get-spooled-mail t) (vm-assimilate-new-messages t))
+	   (if (vm-get-spooled-mail t)
 	       (progn
 		 ;; say this NOW, before the non-previewers read
 		 ;; a message, alter the new message count and
     ;; not be mangled.
     (setq new-messages (copy-sequence new-messages))
     ;; add the labels
-    (if (and labels vm-burst-digest-messages-inherit-labels)
+    (if (and new-messages labels vm-burst-digest-messages-inherit-labels)
 	(let ((mp new-messages))
 	  (while mp
 	    (vm-set-labels-of (car mp) (copy-sequence labels))
 	    (setq mp (cdr mp)))))
-    (if vm-summary-show-threads
+    (if (and new-messages vm-summary-show-threads)
 	(progn
 	  ;; get numbering and summary of new messages done now
 	  ;; so that the sort code only has to worry about the
 	  ;; changes it needs to make.
 	  (vm-update-summary-and-mode-line)
 	  (vm-sort-messages "thread")))
-    (if (and (or vm-arrived-message-hook vm-arrived-messages-hook)
-	     new-messages
+    (if (and new-messages
+	     (or vm-arrived-message-hook vm-arrived-messages-hook)
 	     ;; Run the hooks only if this is not the first
 	     ;; time vm-assimilate-new-messages has been called
 	     ;; in this folder. 
 (defvar scroll-in-place)
 
 ;; this does the real major mode scutwork.
-(defun vm-mode-internal ()
+(defun vm-mode-internal (&optional access-method)
   (widen)
   (make-local-variable 'require-final-newline)
   ;; don't kill local variables, as there is some state we'd like to
    vm-undo-record-pointer nil
    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))))
   (use-local-map vm-mode-map)
   ;; if the user saves after M-x recover-file, let them get new
   ;; mail again.
       (run-at-time 2 nil 'delete-process process))))
 
 (defun vm-imap-stat-timer (o) (aref o 0))
-(defun vm-imap-stat-x-box (o) (aref o 1))
-(defun vm-imap-stat-x-currmsg (o) (aref o 2))
-(defun vm-imap-stat-x-maxmsg (o) (aref o 3))
-(defun vm-imap-stat-x-got (o) (aref o 4))
-(defun vm-imap-stat-x-need (o) (aref o 5))
-(defun vm-imap-stat-y-box (o) (aref o 6))
-(defun vm-imap-stat-y-currmsg (o) (aref o 7))
-(defun vm-imap-stat-y-maxmsg (o) (aref o 8))
-(defun vm-imap-stat-y-got (o) (aref o 9))
-(defun vm-imap-stat-y-need (o) (aref o 10))
+(defun vm-imap-stat-did-report (o) (aref o 1))
+(defun vm-imap-stat-x-box (o) (aref o 2))
+(defun vm-imap-stat-x-currmsg (o) (aref o 3))
+(defun vm-imap-stat-x-maxmsg (o) (aref o 4))
+(defun vm-imap-stat-x-got (o) (aref o 5))
+(defun vm-imap-stat-x-need (o) (aref o 6))
+(defun vm-imap-stat-y-box (o) (aref o 7))
+(defun vm-imap-stat-y-currmsg (o) (aref o 8))
+(defun vm-imap-stat-y-maxmsg (o) (aref o 9))
+(defun vm-imap-stat-y-got (o) (aref o 10))
+(defun vm-imap-stat-y-need (o) (aref o 11))
 
 (defun vm-set-imap-stat-timer (o val) (aset o 0 val))
-(defun vm-set-imap-stat-x-box (o val) (aset o 1 val))
-(defun vm-set-imap-stat-x-currmsg (o val) (aset o 2 val))
-(defun vm-set-imap-stat-x-maxmsg (o val) (aset o 3 val))
-(defun vm-set-imap-stat-x-got (o val) (aset o 4 val))
-(defun vm-set-imap-stat-x-need (o val) (aset o 5 val))
-(defun vm-set-imap-stat-y-box (o val) (aset o 6 val))
-(defun vm-set-imap-stat-y-currmsg (o val) (aset o 7 val))
-(defun vm-set-imap-stat-y-maxmsg (o val) (aset o 8 val))
-(defun vm-set-imap-stat-y-got (o val) (aset o 9 val))
-(defun vm-set-imap-stat-y-need (o val) (aset o 10 val))
+(defun vm-set-imap-stat-did-report (o val) (aset o 1 val))
+(defun vm-set-imap-stat-x-box (o val) (aset o 2 val))
+(defun vm-set-imap-stat-x-currmsg (o val) (aset o 3 val))
+(defun vm-set-imap-stat-x-maxmsg (o val) (aset o 4 val))
+(defun vm-set-imap-stat-x-got (o val) (aset o 5 val))
+(defun vm-set-imap-stat-x-need (o val) (aset o 6 val))
+(defun vm-set-imap-stat-y-box (o val) (aset o 7 val))
+(defun vm-set-imap-stat-y-currmsg (o val) (aset o 8 val))
+(defun vm-set-imap-stat-y-maxmsg (o val) (aset o 9 val))
+(defun vm-set-imap-stat-y-got (o val) (aset o 10 val))
+(defun vm-set-imap-stat-y-need (o val) (aset o 11 val))
 
 (defun vm-imap-start-status-timer ()
-  (let ((blob (make-vector 11 nil))
+  (let ((blob (make-vector 12 nil))
 	timer)
     (setq timer (add-timeout 5 'vm-imap-report-retrieval-status blob 5))
     (vm-set-imap-stat-timer blob timer)
     blob ))
 
 (defun vm-imap-stop-status-timer (status-blob)
+  (if (vm-imap-stat-did-report status-blob)
+      (message ""))
   (if (fboundp 'disable-timeout)
       (disable-timeout (vm-imap-stat-timer status-blob))
     (cancel-timer (vm-imap-stat-timer status-blob))))
 
 (defun vm-imap-report-retrieval-status (o)
+  (vm-set-imap-stat-did-report o t)
   (cond ((null (vm-imap-stat-x-got o)) t)
 	;; should not be possible, but better safe...
 	((not (eq (vm-imap-stat-x-box o) (vm-imap-stat-y-box o))) t)
 		    (vm-imap-stat-x-currmsg o)
 		    (vm-imap-stat-x-maxmsg o)
 		    (vm-imap-stat-x-box o)
-		    (format "%d%s of %d%s"
-			    (vm-imap-stat-x-got o)
-			    (if (> (vm-imap-stat-x-got o)
-				   (vm-imap-stat-x-need o))
-				"!"
-			      "")
-			    (vm-imap-stat-x-need o)
-			    (if (eq (vm-imap-stat-x-got o)
-				    (vm-imap-stat-y-got o))
-				(cond ((>= (vm-imap-stat-x-got o)
-					   (vm-imap-stat-x-need o))
-				       "(post processing)")
-				      (t " (stalled)"))
-			      "")))))
+		    (if (vm-imap-stat-x-need o)
+			(format "%d%s of %d%s"
+				(vm-imap-stat-x-got o)
+				(if (> (vm-imap-stat-x-got o)
+				       (vm-imap-stat-x-need o))
+				    "!"
+				  "")
+				(vm-imap-stat-x-need o)
+				(if (eq (vm-imap-stat-x-got o)
+					(vm-imap-stat-y-got o))
+				    " (stalled)"
+				  ""))
+		      "post processing"))))
   (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))
   (vm-set-imap-stat-y-maxmsg o (vm-imap-stat-x-maxmsg o))
     ;; must make the read point a marker so that it stays fixed
     ;; relative to the text when we modify things below.
     (setq vm-imap-read-point (point-marker))
-    (vm-set-imap-stat-x-got statblob nil)
     (setq list (cdr (nth 3 fetch-response)))
     (cond
      (bodypeek
 	    start (nth 1 p))))
     (goto-char (nth 2 p))
     (setq end (point-marker))
+    (vm-set-imap-stat-x-need statblob nil)
     (vm-imap-cleanup-region start end)
     (vm-munge-message-separators vm-folder-type start end)
     (goto-char start)
+    (vm-set-imap-stat-x-got statblob nil)
     ;; avoid the consing and stat() call for all but babyl
     ;; files, since this will probably slow things down.
     ;; only babyl files have the folder header, and we
    ["Expunge POP Messages" vm-expunge-pop-messages t]
    "---"
    ["Visit Folder" vm-visit-folder t]
+   ["Visit POP Folder" vm-visit-pop-folder t]
    ["Revert Folder (back to disk version)" revert-buffer (vm-menu-can-revert-p)]
    ["Recover Folder (from auto-save file)" recover-file (vm-menu-can-recover-p)]
    ["Save" vm-save-folder (vm-menu-can-save-p)]
 (defun vm-menu-install-visited-folders-menu ()
   (let ((folders (vm-delete-duplicates (copy-sequence vm-folder-history)))
 	(menu nil)
-	tail
+	tail foo
 	spool-files
 	(i 0)
 	;; special string indicating tail of Folder menu
 	(special "-------"))
     (while (and folders (< i 10))
-      (setq menu (cons (vector "    "
-			       (list 'vm-menu-run-command
-				     ''vm-visit-folder (car folders))
-			       t
-			       (car folders))
+      (setq menu (cons
+		  (vector "    "
+			  (cond
+			   ((and (stringp vm-recognize-pop-maildrops)
+				 (string-match vm-recognize-pop-maildrops
+					       (car folders))
+				 (setq foo (vm-pop-find-name-for-spec
+					    (car folders))))
+			    (list 'vm-menu-run-command
+				  ''vm-visit-pop-folder foo))
+			   (t
+			    (list 'vm-menu-run-command
+				  ''vm-visit-folder (car folders))))
+			  t
+			  (car folders))
 		       menu)
 	    folders (cdr folders)
 	    i (1+ i)))

File vm-message.el

   (list 'aref (list 'aref message 1) 17))
 (defmacro vm-su-summary-mouse-track-overlay-of (message)
   (list 'aref (list 'aref message 1) 18))
+(defmacro vm-message-access-method (message)
+  (list 'aref (list 'aref message 1) 19))
 ;; message attribute vector
 (defmacro vm-attributes-of (message) (list 'aref message 2))
 (defmacro vm-new-flag (message) (list 'aref (list 'aref message 2) 0))
 ;; message IDs parsed from References header
 (defmacro vm-references-of (message)
   (list 'aref (list 'aref message 3) 20))
+;; have we retrieved the headers of this message?
+;; only valid for remote folder access methods
+(defmacro vm-retrieved-headers-of (message)
+  (list 'aref (list 'aref message 3) 21))
+;; have we retrieved the body of this message?
+;; only valid for remote folder access methods
+(defmacro vm-retrieved-body-of (message)
+  (list 'aref (list 'aref message 3) 22))
+;; pop UIDL value for message
+(defmacro vm-pop-uidl-of (message)
+  (list 'aref (list 'aref message 3) 23))
 ;; extra data shared by virtual messages if vm-virtual-mirror is non-nil
 (defmacro vm-mirror-data-of (message) (list 'aref message 4))
 ;; if message is being edited, this is the buffer being used.
   (list 'aset (list 'aref message 1) 17 flag))
 (defmacro vm-set-su-summary-mouse-track-overlay-of (message overlay)
   (list 'aset (list 'aref message 1) 18 overlay))
+(defmacro vm-set-message-access-method-of (message method)
+  (list 'aset (list 'aref message 1) 19 method))
 (defmacro vm-set-attributes-of (message attrs) (list 'aset message 2 attrs))
 ;; The other routines in attributes group are part of the undo system.
 (defun vm-set-edited-flag-of (message flag)
   (list 'aset (list 'aref message 3) 19 val))
 (defmacro vm-set-references-of (message val)
   (list 'aset (list 'aref message 3) 20 val))
+(defmacro vm-set-retrieved-header-of (message val)
+  (list 'aset (list 'aref message 3) 21 val))
+(defmacro vm-set-retrieved-body-of (message val)
+  (list 'aset (list 'aref message 3) 22 val))
+(defmacro vm-set-pop-uidl-of (message val)
+  (list 'aset (list 'aref message 3) 23 val))
 (defmacro vm-set-mirror-data-of (message data)
   (list 'aset message 4 data))
 (defmacro vm-set-edit-buffer-of (message buf)
 	  (delete-region start end))
 	(if (or (not (bolp))
 		(bobp)
+		(= (point) (vm-text-of (vm-mm-layout-message layout)))
 		(map-extents 'extent-property nil (1- (point)) (point)
 			     'begin-glyph))
 	    (insert "\n"))
 	  (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"
+	  (or (search-forward " " nil t)
+	      (error "no spaces in '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"
 		    (setq value (list 'image ':type image-type
 				      ':file (car strips)
 				      ':ascent 50))
-		  (setq value (make-face (make-symbol "<face>")))
+		  (setq value (make-face (make-symbol "<vm-image-face>")))
 		  (set-face-stipple value (car strips)))
 		(put-text-property (overlay-start (car overlays))
 				   (overlay-end (car overlays))
 			   (setq value (list 'image ':type image-type
 					     ':file (car sss)
 					     ':ascent 50))
-			 (setq value (make-face (make-symbol "<face>")))
+			 (setq value (make-face (make-symbol
+						 "<vm-image-face>")))
 			 (set-face-stipple value (car sss)))
 		       (put-text-property (overlay-start (car ooo))
 					  (overlay-end (car ooo))
   (put 'vm-uidl-failed 'error-conditions '(vm-uidl-failed error))
   (put 'vm-uidl-failed 'error-message "UIDL command failed"))
 
+(defsubst vm-folder-pop-maildrop-spec ()
+  (aref vm-folder-access-data 0))
+(defsubst vm-folder-pop-process ()
+  (aref vm-folder-access-data 1))
+
+(defsubst vm-set-folder-pop-maildrop-spec (val)
+  (aset vm-folder-access-data 0 val))
+(defsubst vm-set-folder-pop-process (val)
+  (aset vm-folder-access-data 1 val))
+
 ;; Our goal is to drag the mail from the POP 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-pop-move-mail (source destination)
   (let ((process nil)
-	(folder-type vm-folder-type)
 	(m-per-session vm-pop-messages-per-session)
 	(b-per-session vm-pop-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.
 	    (vm-pop-send-command process "STAT")
 	    (setq response (vm-pop-read-stat-response process)
 		(vm-pop-send-command process (format "RETR %d" n))
 		(and (null (vm-pop-read-response process))
 		     (throw 'done (not (equal retrieved 0))))
-		(and (null (vm-pop-retrieve-to-crashbox process destination
-							statblob))
+		(and (null (vm-pop-retrieve-to-target process destination
+						      statblob))
 		     (throw 'done (not (equal retrieved 0))))
 		(vm-increment retrieved)
 		(and b-per-session
     (unwind-protect
 	(save-excursion
 	  (setq vm-pop-retrieved-messages
+		(delq nil vm-pop-retrieved-messages))
+	  (setq vm-pop-retrieved-messages
 		(sort vm-pop-retrieved-messages
 		      (function (lambda (a b)
 				  (cond ((string-lessp (nth 1 a) (nth 1 b)) t)
 					     (format "DELE %s" (car match)))
 			(if (null (vm-pop-read-response process))
 			    (signal 'vm-dele-failed nil))
+			(setcar mp nil)
 			(vm-increment delete-count)))
 		  (setq mp (cdr mp)))
 	      (vm-dele-failed
 		     (if (zerop delete-count) "No" delete-count)
 		     (if (= delete-count 1) "" "s"))))
       (and process (vm-pop-end-session process)))
-    (or trouble (setq vm-pop-retrieved-messages nil))))
+    (setq vm-pop-retrieved-messages
+	  (delq nil vm-pop-retrieved-messages))))
 
 (defun vm-pop-make-session (source)
   (let ((process-to-shutdown nil)
 	process
+	(folder-type vm-folder-type)
 	(popdrop (vm-safe-popdrop-string source))
 	(coding-system-for-read (vm-binary-coding-system))
 	(coding-system-for-write (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-pop-read-point)
 	    ;; clear the trace buffer of old output
       (vm-tear-down-stunnel-random-data))))
 
 (defun vm-pop-end-session (process &optional keep-buffer verbose)
-  (save-excursion
-    (set-buffer (process-buffer process))
-    (vm-pop-send-command process "QUIT")
-    ;; Previously we did not read the QUIT response because of
-    ;; TCP shutdown problems (under Windows?) that made it
-    ;; better if we just closed the connection.  Microsoft
-    ;; Exchange apparently fails to expunge messages if we shut
-    ;; down the connection without reading the QUIT response.
-    ;; So we provide an option and let the user decide what
-    ;; works best for them.
-    (if vm-pop-read-quit-response
-	(progn
-	  (and verbose
-	       (message "Waiting for response to POP QUIT command..."))
-	  (vm-pop-read-response process)
-	  (and verbose
-	       (message "Waiting for response to POP QUIT command... done"))))
-    (if (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-pop-buffers
-			     vm-pop-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-pop-send-command process "QUIT")
+	;; Previously we did not read the QUIT response because of
+	;; TCP shutdown problems (under Windows?) that made it
+	;; better if we just closed the connection.  Microsoft
+	;; Exchange apparently fails to expunge messages if we shut
+	;; down the connection without reading the QUIT response.
+	;; So we provide an option and let the user decide what
+	;; works best for them.
+	(if vm-pop-read-quit-response
+	    (progn
+	      (and verbose
+		   (message "Waiting for response to POP QUIT command..."))
+	      (vm-pop-read-response process)
+	      (and verbose
+		   (message
+		    "Waiting for response to POP QUIT command... done"))))))
+  (if (not keep-buffer)
+      (if (buffer-live-p (process-buffer process))
+	  (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-pop-buffers
+			    vm-pop-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-pop-stat-timer (o) (aref o 0))
-(defun vm-pop-stat-x-box (o) (aref o 1))
-(defun vm-pop-stat-x-currmsg (o) (aref o 2))
-(defun vm-pop-stat-x-maxmsg (o) (aref o 3))
-(defun vm-pop-stat-x-got (o) (aref o 4))
-(defun vm-pop-stat-x-need (o) (aref o 5))
-(defun vm-pop-stat-y-box (o) (aref o 6))
-(defun vm-pop-stat-y-currmsg (o) (aref o 7))
-(defun vm-pop-stat-y-maxmsg (o) (aref o 8))
-(defun vm-pop-stat-y-got (o) (aref o 9))
-(defun vm-pop-stat-y-need (o) (aref o 10))
+(defun vm-pop-stat-did-report (o) (aref o 1))
+(defun vm-pop-stat-x-box (o) (aref o 2))
+(defun vm-pop-stat-x-currmsg (o) (aref o 3))
+(defun vm-pop-stat-x-maxmsg (o) (aref o 4))
+(defun vm-pop-stat-x-got (o) (aref o 5))
+(defun vm-pop-stat-x-need (o) (aref o 6))
+(defun vm-pop-stat-y-box (o) (aref o 7))
+(defun vm-pop-stat-y-currmsg (o) (aref o 8))
+(defun vm-pop-stat-y-maxmsg (o) (aref o 9))
+(defun vm-pop-stat-y-got (o) (aref o 10))
+(defun vm-pop-stat-y-need (o) (aref o 11))
 
 (defun vm-set-pop-stat-timer (o val) (aset o 0 val))
-(defun vm-set-pop-stat-x-box (o val) (aset o 1 val))
-(defun vm-set-pop-stat-x-currmsg (o val) (aset o 2 val))
-(defun vm-set-pop-stat-x-maxmsg (o val) (aset o 3 val))
-(defun vm-set-pop-stat-x-got (o val) (aset o 4 val))
-(defun vm-set-pop-stat-x-need (o val) (aset o 5 val))
-(defun vm-set-pop-stat-y-box (o val) (aset o 6 val))
-(defun vm-set-pop-stat-y-currmsg (o val) (aset o 7 val))
-(defun vm-set-pop-stat-y-maxmsg (o val) (aset o 8 val))
-(defun vm-set-pop-stat-y-got (o val) (aset o 9 val))
-(defun vm-set-pop-stat-y-need (o val) (aset o 10 val))
+(defun vm-set-pop-stat-did-report (o val) (aset o 1 val))
+(defun vm-set-pop-stat-x-box (o val) (aset o 2 val))
+(defun vm-set-pop-stat-x-currmsg (o val) (aset o 3 val))
+(defun vm-set-pop-stat-x-maxmsg (o val) (aset o 4 val))
+(defun vm-set-pop-stat-x-got (o val) (aset o 5 val))
+(defun vm-set-pop-stat-x-need (o val) (aset o 6 val))
+(defun vm-set-pop-stat-y-box (o val) (aset o 7 val))
+(defun vm-set-pop-stat-y-currmsg (o val) (aset o 8 val))
+(defun vm-set-pop-stat-y-maxmsg (o val) (aset o 9 val))
+(defun vm-set-pop-stat-y-got (o val) (aset o 10 val))
+(defun vm-set-pop-stat-y-need (o val) (aset o 11 val))
 
 (defun vm-pop-start-status-timer ()
-  (let ((blob (make-vector 11 nil))
+  (let ((blob (make-vector 12 nil))
 	timer)
     (setq timer (add-timeout 5 'vm-pop-report-retrieval-status blob 5))
     (vm-set-pop-stat-timer blob timer)
     blob ))
 
 (defun vm-pop-stop-status-timer (status-blob)
+  (if (vm-pop-stat-did-report status-blob)
+      (message ""))
   (if (fboundp 'disable-timeout)
       (disable-timeout (vm-pop-stat-timer status-blob))
     (cancel-timer (vm-pop-stat-timer status-blob))))
 
 (defun vm-pop-report-retrieval-status (o)
+  (vm-set-pop-stat-did-report o t)
   (cond ((null (vm-pop-stat-x-got o)) t)
 	;; should not be possible, but better safe...
 	((not (eq (vm-pop-stat-x-box o) (vm-pop-stat-y-box o))) t)
 		    (vm-pop-stat-x-currmsg o)
 		    (vm-pop-stat-x-maxmsg o)
 		    (vm-pop-stat-x-box o)
-		    (format "%d%s of %d%s"
-			    (vm-pop-stat-x-got o)
-			    (if (> (vm-pop-stat-x-got o)
-				   (vm-pop-stat-x-need o))
-				"!"
-			      "")
-			    (vm-pop-stat-x-need o)
-			    (if (eq (vm-pop-stat-x-got o)
-				    (vm-pop-stat-y-got o))
-				(cond ((>= (vm-pop-stat-x-got o)
-					   (vm-pop-stat-x-need o))
-				       "(post processing)")
-				      (t " (stalled)"))
-			      "")))))
+		    (if (vm-pop-stat-x-need o)
+			(format "%d%s of %d%s"
+				(vm-pop-stat-x-got o)
+				(if (> (vm-pop-stat-x-got o)
+				       (vm-pop-stat-x-need o))
+				    "!"
+				  "")
+				(vm-pop-stat-x-need o)
+				(if (eq (vm-pop-stat-x-got o)
+					(vm-pop-stat-y-got o))
+				    " (stalled)"
+				  ""))
+		      "post processing"))))
   (vm-set-pop-stat-y-box o (vm-pop-stat-x-box o))
   (vm-set-pop-stat-y-currmsg o (vm-pop-stat-x-currmsg o))
   (vm-set-pop-stat-y-maxmsg o (vm-pop-stat-x-maxmsg o))
 	    (yes-or-no-p "Continue retrieving anyway? ")))
       (and work-buffer (kill-buffer work-buffer)))))
 
-(defun vm-pop-retrieve-to-crashbox (process crash statblob)
+(defun vm-pop-retrieve-to-target (process target statblob)
   (let ((start vm-pop-read-point) end)
     (goto-char start)
     (vm-set-pop-stat-x-got statblob 0)
 	     (after-change-functions (cons func after-change-functions)))
 	(accept-process-output process)
 	(goto-char opoint)))
+    (vm-set-pop-stat-x-need statblob nil)
     (setq vm-pop-read-point (point-marker))
     (goto-char (match-beginning 0))
     (setq end (point-marker))
 	  ;; avoid the consing and stat() call for all but babyl
 	  ;; files, since this will probably slow things down.
 	  ;; only babyl files have the folder header, and we
-	  ;; should only insert it if the crash box is empty.
+	  ;; should only insert it if the target folder 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
 	    (vm-convert-folder-type-headers 'baremessage vm-folder-type))
 	  (goto-char end)
 	  (insert-before-markers (vm-trailing-message-separator))))
-    ;; 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 ))
 
 	    (nth 1 source-list) ":"
 	    (nth 2 source-list) ":"
 	    (nth 3 source-list) ":*")))
+
+(defun vm-establish-new-folder-pop-session (&optional interactive)
+  (let ((process (vm-folder-pop-process))
+	(vm-pop-ok-to-ask interactive))
+    (if (processp process)
+	(vm-pop-end-session process))
+    (setq process (vm-pop-make-session (vm-folder-pop-maildrop-spec)))
+    (vm-set-folder-pop-process process)
+    process ))
+
+(defun vm-pop-get-uidl-data ()
+  (let ((there (make-vector 67 0))
+	(process (vm-folder-pop-process)))
+    (save-excursion
+      (set-buffer (process-buffer process))
+      (vm-pop-send-command process "UIDL")
+      (let ((start vm-pop-read-point)
+	    n uidl)
+	(catch 'done
+	  (goto-char start)
+	  (while (not (re-search-forward "^\\.\r\n\\|^-ERR .*$" nil 0))
+	    (beginning-of-line)
+	    ;; save-excursion doesn't work right
+	    (let ((opoint (point)))
+	      (accept-process-output process)
+	      (goto-char opoint)))
+	  (setq vm-pop-read-point (point-marker))
+	  (goto-char start)
+	  ;; no uidl support, bail.
+	  (if (not (looking-at "\\+OK"))
+	      (throw 'done nil))
+	  (forward-line 1)
+	  (while (not (eq (char-after (point)) ?.))
+	    ;; not loking at a number, bail.
+	    (if (not (looking-at "[0-9]"))
+		(throw 'done nil))
+	    (setq n (int-to-string (read (current-buffer))))
+	    (skip-chars-forward " ")
+	    (setq start (point))
+	    (skip-chars-forward "\041-\176")
+	    ;; no tag after the message number, bail.
+	    (if (= start (point))
+		(throw 'done nil))
+	    (setq uidl (buffer-substring start (point)))
+	    (set (intern uidl there) n)
+	    (forward-line 1))
+	  there )))))
+
+(defun vm-pop-get-synchronization-data ()
+  (let ((here (make-vector 67 0))
+	(there (vm-pop-get-uidl-data))
+	(process (vm-folder-pop-process))
+	retrieve-list expunge-list
+	mp)
+    (setq mp vm-message-list)
+    (while mp
+      (if (null (vm-pop-uidl-of (car mp)))
+	  nil
+	(set (intern (vm-pop-uidl-of (car mp)) here) (car mp))
+	(if (not (boundp (intern (vm-pop-uidl-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-pop-retrieved-messages)))
+		     (setq retrieve-list (cons
+					  (cons (symbol-name sym)
+						(symbol-value sym))
+					  retrieve-list)))))
+	      there)
+    (list retrieve-list expunge-list)))
+
+(defun vm-pop-synchronize-folder (&optional interactive
+					    do-remote-expunges
+					    do-local-expunges
+					    do-retrieves)
+  (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-pop-session interactive)))
+      nil
+    (if do-retrieves
+	(vm-assimilate-new-messages))
+    (let* ((sync-data (vm-pop-get-synchronization-data))
+	   (retrieve-list (car sync-data))
+	   (local-expunge-list (nth 1 sync-data))
+	   (process (vm-folder-pop-process))
+	   (n 1)
+	   (statblob nil)
+	   (popdrop (vm-folder-pop-maildrop-spec))
+	   (safe-popdrop (vm-safe-popdrop-string popdrop))
+	   r-list mp got-some pr-list 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-pop-start-status-timer))
+		   (vm-set-pop-stat-x-box statblob safe-popdrop)
+		   (vm-set-pop-stat-x-maxmsg statblob
+					     (length retrieve-list))
+		   (setq r-list retrieve-list)
+		   (while r-list
+		     (vm-set-pop-stat-x-currmsg statblob n)
+		     (vm-pop-send-command process (format "LIST %s"
+							  (cdr (car r-list))))
+		     (setq message-size (vm-pop-read-list-response process))
+		     (vm-set-pop-stat-x-need statblob message-size)
+		     (vm-pop-send-command process
+					  (format "RETR %s"
+						  (cdr (car r-list))))
+		     (and (null (vm-pop-read-response process))
+			  (error "server didn't say +OK to RETR %s command"
+				 (cdr (car r-list))))
+		     (vm-pop-retrieve-to-target process folder-buffer
+						statblob)
+		     (setq r-list (cdr r-list))))
+	       (error
+		(message "Retrieval from %s signaled: %s" safe-popdrop
+			 error-data))
+	       (quit
+		(message "Quit received during retrieval from %s"
+			 safe-popdrop)))
+	     (and statblob (vm-pop-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-pop-uidl-of (car mp) (car (car r-list)))
+	       (vm-set-modflag-of (car mp) t)
+	       (setq mp (cdr mp)
+		     r-list (cdr r-list))))))
+      (if do-local-expunges
+	  (vm-expunge-folder t t local-expunge-list))
+      (if (and do-remote-expunges
+	       vm-pop-messages-to-expunge)
+	  (let ((process (vm-folder-pop-process)))
+	    ;; POP servers usually allow only one remote accessor
+	    ;; at a time vm-expunge-pop-messages will set up its
+	    ;; own connection so we get out of its way by closing
+	    ;; our connection.
+	    (if (and (processp process)
+		     (memq (process-status process) '(open run)))
+		(vm-pop-end-session process))
+	    (setq vm-pop-retrieved-messages
+		  (mapcar (function (lambda (x) (list x popdrop 'uidl)))
+			  vm-pop-messages-to-expunge))
+	    (vm-expunge-pop-messages)
+	    (setq vm-pop-messages-to-expunge
+		  (mapcar (function (lambda (x) (car x)))
+			  vm-pop-retrieved-messages))))
+      got-some)))
+
+(defun vm-pop-folder-check-for-mail (&optional interactive)
+  (if (or vm-global-block-new-mail
+	  (null (vm-establish-new-folder-pop-session interactive)))
+      nil
+    (let ((result (car (vm-pop-get-synchronization-data))))
+      (vm-pop-end-session (vm-folder-pop-process))
+      result )))
+
+(defun vm-pop-find-spec-for-name (name)
+  (let ((list vm-pop-folder-alist)
+	(done nil))
+    (while (and (not done) list)
+      (if (equal name (nth 1 (car list)))
+	  (setq done t)
+	(setq list (cdr list))))
+    (and list (car (car list)))))
+
+(defun vm-pop-find-name-for-spec (spec)
+  (let ((list vm-pop-folder-alist)
+	(done nil))
+    (while (and (not done) list)
+      (if (equal spec (car (car list)))
+	  (setq done t)
+	(setq list (cdr list))))
+    (and list (nth 1 (car list)))))
+
+(defun vm-pop-find-name-for-buffer (buffer)
+  (let ((list vm-pop-folder-alist)
+	(done nil))
+    (while (and (not done) list)
+      (if (eq buffer (vm-get-file-buffer (vm-pop-make-filename-for-spec
+					  (car (car list)))))
+	  (setq done t)
+	(setq list (cdr list))))
+    (and list (nth 1 (car list)))))
+
+(defun vm-pop-make-filename-for-spec (spec)
+  (expand-file-name
+   (concat "pop-cache-" (vm-md5-string spec))
+   (or vm-pop-folder-cache-directory
+       vm-folder-directory
+       (getenv "HOME"))))

File vm-startup.el

 (defvar enable-multibyte-characters)
 
 ;;;###autoload
-(defun vm (&optional folder read-only)
+(defun vm (&optional folder read-only access-method)
   "Read mail under Emacs.
 Optional first arg FOLDER specifies the folder to visit.  It defaults
 to the value of vm-primary-inbox.  The folder buffer is put into VM
     (let ((full-startup (not (bufferp folder)))
 	  (did-read-index-file nil)
 	  folder-buffer first-time totals-blurb
+	  folder-name remote-spec
 	  preserve-auto-save-file)
+      (cond ((eq access-method 'pop)
+	     (setq remote-spec (vm-pop-find-spec-for-name folder))
+	     (if (null remote-spec)
+		 (error "No such POP folder: %s" folder))
+	     (setq folder-name folder
+		   folder (vm-pop-make-filename-for-spec remote-spec))))
       (setq folder-buffer
 	    (if (bufferp folder)
 		folder
 			(message "Reading %s..." file)
 			(prog1 (find-file-noselect file)
 			  ;; update folder history
-			  (let ((item (or folder vm-primary-inbox)))
+			  (let ((item (or remote-spec folder
+					  vm-primary-inbox)))
 			    (if (not (equal item (car vm-folder-history)))
 				(setq vm-folder-history
 				      (cons item vm-folder-history))))
 			  (message "Reading %s... done" file))))))))
       (set-buffer folder-buffer)
+      (cond ((eq access-method 'pop)
+	     (if (not (equal folder-name (buffer-name)))
+		 (rename-buffer folder-name t))))
       (if (and vm-fsfemacs-mule-p enable-multibyte-characters)
 	  (set-buffer-multibyte nil))
       ;; for MULE
 	    ;; user's default face charset, rather than as octal
 	    ;; escapes.
 	    (vm-fsfemacs-nonmule-display-8bit-chars)
-	    (vm-mode-internal)
+	    (vm-mode-internal access-method)
+	    (cond ((eq access-method 'pop)
+		   (vm-set-folder-pop-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
 
       (run-hooks 'vm-visit-folder-hook)
 
-      (if full-startup
-	  (message totals-blurb))
       ;; Warn user about auto save file, if appropriate.
       (if (and full-startup preserve-auto-save-file)
 	  (message 
       ;; stop here.
       (if (or (not full-startup) preserve-auto-save-file)
 	  (throw 'done t))
+      
+      (if full-startup
+	  (message totals-blurb))
+
       (if (and vm-auto-get-new-mail
 	       (not vm-block-new-mail)
 	       (not vm-folder-read-only))
 	  (progn
 	    (message "Checking for new mail for %s..."
 		     (or buffer-file-name (buffer-name)))
-	    (if (and (vm-get-spooled-mail t) (vm-assimilate-new-messages t))
+	    (if (vm-get-spooled-mail t)
 		(progn
 		  (setq totals-blurb (vm-emit-totals-blurb))
 		  (if (vm-thoughtfully-select-message)
 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 6.99.
+This is VM 7.00.
 
 Commands:
    h - summarize folder contents
    vm-pop-auto-expunge-alist
    vm-pop-bytes-per-session
    vm-pop-expunge-after-retrieving
+   vm-pop-folder-alist
    vm-pop-max-message-size
    vm-pop-md5-program
    vm-pop-messages-per-session
   (vm-select-folder-buffer-if-possible)
   (vm-check-for-killed-summary)
   (setq vm-last-visit-folder folder)
-  (let ((default-directory (or vm-folder-directory default-directory)))
-    (setq folder (expand-file-name folder)))
-  (vm folder read-only))
+  (let ((access-method nil) foo)
+    (cond ((and (stringp vm-recognize-pop-maildrops)
+		(string-match vm-recognize-pop-maildrops folder)
+		(setq foo (vm-pop-find-name-for-spec folder)))
+	   (setq folder foo
+		 access-method 'pop))
+	  (t
+	   (let ((default-directory (or vm-folder-directory default-directory)))
+	     (setq folder (expand-file-name folder)))))
+    (vm folder read-only access-method)))
 
 ;;;###autoload
 (defun vm-visit-folder-other-frame (folder &optional read-only)
 	(vm-search-other-frames nil))
     (vm-visit-folder folder read-only)))
 
+;;;###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.
+
+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'.
+When this command is called interactively the mailbox name is 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 ((completion-list (mapcar (function (lambda (x) (nth 1 x)))
+				    vm-pop-folder-alist))
+	   (default vm-last-visit-pop-folder)
+	   (this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-string
+	      (format "Visit%s POP folder:%s "
+		      (if current-prefix-arg " read only" "")
+		      (if default
+			  (format " (default %s)" default)
+			""))
+	      completion-list)
+	     current-prefix-arg))))
+  (vm-session-initialization)
+  (vm-check-for-killed-folder)
+  (vm-select-folder-buffer-if-possible)
+  (vm-check-for-killed-summary)
+  (if (null (vm-pop-find-spec-for-name folder))
+      (error "No such POP folder: %s" folder))
+  (setq vm-last-visit-pop-folder folder)
+  (vm folder read-only 'pop))
+
+;;;###autoload
+(defun vm-visit-pop-folder-other-frame (folder &optional read-only)
+  "Like vm-visit-pop-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 ((completion-list (mapcar (function (lambda (x) (nth 1 x)))
+				    vm-pop-folder-alist))
+	   (default vm-last-visit-pop-folder)
+	   (this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-string
+	      (format "Visit%s POP folder:%s "
+		      (if current-prefix-arg " read only" "")
+		      (if default
+			  (format " (default %s)" default)
+			""))
+	      completion-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-pop-folder folder read-only))
+  (if (vm-multiple-frames-possible-p)
+      (vm-set-hooks-for-frame-deletion)))
+
+;;;###autoload
+(defun vm-visit-pop-folder-other-window (folder &optional read-only)
+  "Like vm-visit-pop-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 ((completion-list (mapcar (function (lambda (x) (nth 1 x)))
+				    vm-pop-folder-alist))
+	   (default vm-last-visit-pop-folder)
+	   (this-command this-command)
+	   (last-command last-command))
+       (list (vm-read-string
+	      (format "Visit%s POP folder:%s "
+		      (if current-prefix-arg " read only" "")
+		      (if default
+			  (format " (default %s)" default)
+			""))
+	      completion-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-pop-folder folder read-only)))
+
 (put 'vm-virtual-mode 'mode-class 'special)
 
 (defun vm-virtual-mode (&rest ignored)
 ;;      'vm-pop-auto-expunge-alist
       'vm-pop-bytes-per-session
       'vm-pop-expunge-after-retrieving
+;; POP passwords might be listed here
+;;      'vm-pop-folder-alist
       'vm-pop-max-message-size
       'vm-pop-messages-per-session
       'vm-pop-md5-program
 	  (set-face-foreground 'vm-monochrome-image "black"))
 	(if (or (not vm-fsfemacs-p)
 		;; don't need this face under Emacs 21.
-		(fboundp 'vm-image-type-available-p)
+		(fboundp 'image-type-available-p)
 		(facep 'vm-image-placeholder))
 	    nil
 	  (make-face 'vm-image-placeholder)

File vm-summary.el

 	   (setq timezone (substring date (match-beginning 0) (match-end 0)))))
     (while (and (or (zerop (length monthday))
 		    (zerop (length year)))
-		(string-match " \\([0-9]+\\) " date start))
-      (setq string (substring date (match-beginning 1) (match-end 1))
+		(string-match "\\(^\\| \\)\\([0-9]+\\) " date start))
+      (setq string (substring date (match-beginning 2) (match-end 2))
 	    start (match-end 0))
-      (cond ((zerop (length monthday))
+      (cond ((and (zerop (length monthday))
+		  (<= (length string) 2))
 	     (setq monthday string))
 	    ((= (length string) 2)
 	     (if (< (string-to-int string) 70)
 This file is written and overwritten by VM and is not meant for
 users to edit directly.")
 
+(defvar vm-folder-directory nil
+  "*Directory where folders of mail are kept.")
+
 (defvar vm-primary-inbox "~/INBOX"
   "*Mail is moved from the system mailbox to this file for reading.")
 
 maildrops.  A nil value tells VM that all the spool names are to
 be considered files except those matched by `vm-recognize-imap-maildrops'.")
 
+(defvar vm-pop-folder-alist nil
+  "*Alist of POP maildrop specifications and names that refer to them.
+The alist format is:
+
+ ((POPDROP NAME) ...)
+
+POPDROP is a POP maildrop specification in the same format used
+by vm-spool-files (which see).
+
+NAME is a string that should give a less cumbersome name that you
+will use to refer to this maildrop when using `vm-visit-pop-folder'.")
+
+(defvar vm-pop-folder-cache-directory nil
+  "*Directory where VM stores cached copies of POP folders.
+When VM visits a POP folder (really just a POP 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.")
+
 (defvar 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.
 only when there are unsaved changes to message attributes, or when messages
 will be unwittingly lost.")
 
-(defvar vm-folder-directory nil
-  "*Directory where folders of mail are kept.")
-
 (defvar vm-confirm-new-folders nil
   "*Non-nil value causes interactive calls to `vm-save-message'
 to ask for confirmation before creating a new folder.")
 ;; internal vars
 (defvar vm-folder-type nil)
 (make-variable-buffer-local 'vm-folder-type)
+(defvar vm-folder-access-method nil)
+(make-variable-buffer-local 'vm-folder-access-method)
+(defvar vm-folder-access-data nil)
+(make-variable-buffer-local 'vm-folder-access-data)
 (defvar vm-message-list nil)
 (make-variable-buffer-local 'vm-message-list)
 (defvar vm-virtual-folder-definition nil)
 (defvar vm-last-written-file nil)
 (make-variable-buffer-local 'vm-last-written-file)
 (defvar vm-last-visit-folder nil)
+(defvar vm-last-visit-pop-folder nil)
 (defvar vm-last-pipe-command nil)
 (make-variable-buffer-local 'vm-last-pipe-command)
 (defvar vm-messages-not-on-disk 0)
     ("vm-save-message")
     ("vm-save-message-sans-headers")
     ("vm-scroll-backward")
+    ("vm-scroll-backward-one-line")
     ("vm-scroll-forward")
+    ("vm-scroll-forward-one-line")
     ("vm-send-digest")
     ("vm-send-digest-other-frame")
     ("vm-send-mime-digest")
     ("vm-visit-folder")
     ("vm-visit-folder-other-frame")
     ("vm-visit-folder-other-window")
+    ("vm-visit-pop-folder")
+    ("vm-visit-pop-folder-other-frame")
+    ("vm-visit-pop-folder-other-window")
     ("vm-visit-virtual-folder")
     ("vm-visit-virtual-folder-other-frame")
     ("vm-visit-virtual-folder-other-window")
   "Non-nil value means that vm-minibuffer-complete-word should automatically
 append a space to words that complete unambiguously.")
 (defconst vm-attributes-vector-length 9)
-(defconst vm-cache-vector-length 21)
-(defconst vm-softdata-vector-length 19)
+(defconst vm-cache-vector-length 24)
+(defconst vm-softdata-vector-length 20)
 (defconst vm-location-data-vector-length 6)
 (defconst vm-mirror-data-vector-length 5)
 (defconst vm-folder-summary-vector-length 15)
 (defvar vm-pop-passwords nil)
 (defvar vm-pop-retrieved-messages nil)
 (make-variable-buffer-local 'vm-pop-retrieved-messages)
+(defvar vm-pop-messages-to-expunge nil)
+(make-variable-buffer-local 'vm-pop-messages-to-expunge)
 (defvar vm-imap-read-point nil)
 (defvar vm-imap-ok-to-ask nil)
 (defvar vm-imap-passwords nil)

File vm-version.el

 
 (provide 'vm-version)
 
-(defconst vm-version "6.99"
+(defconst vm-version "7.00"
   "Version number of VM.")
 
 (defun vm-version ()

File vm-virtual.el

 		     message
 		     (vm-real-message-sym-of (car mp)))
 		    (vm-set-message-type-of message vm-folder-type)
+		    (vm-set-message-access-method-of
+		     message vm-folder-access-method)
 		    (vm-set-message-id-number-of message
 						 vm-message-id-number)
 		    (vm-increment vm-message-id-number)