Anonymous avatar Anonymous committed 46ea0aa

Sync with VM-6.89

Comments (0)

Files changed (23)

+2001-01-10  Steve Youngs  <youngs@xemacs.org>
+
+	* Sync with VM-6.89.
+
 2000-11-26  Steve Youngs  <youngs@xemacs.org>
 
 	* Sync with VM-6.85
 # what emacs is called on your system
 EMACS = emacs
 
+# top of the installation
+prefix = /usr/local
+
 # where the Info file should go
-INFODIR = /usr/local/lib/emacs/info
+INFODIR = ${prefix}/lib/emacs/info
 
 # where the vm.elc, tapestry.elc, etc. files should go
-LISPDIR = /usr/local/lib/emacs/site-lisp
+LISPDIR = ${prefix}/lib/emacs/site-lisp
 
 # where the toolbar pixmaps should go.
 # vm-toolbar-pixmap-directory must point to the same place.
 # vm-image-directory must point to the same place.
-PIXMAPDIR = /usr/local/lib/emacs/etc/vm
+PIXMAPDIR = ${prefix}/lib/emacs/etc/vm
 
 # where the binaries should be go.
-# only used if you 'make install-utils'
-BINDIR = /usr/local/bin
+BINDIR = ${prefix}/bin
 
 ############## no user servicable parts beyond this point ###################
 
 base64-encode: base64-encode.c
 	$(CC) $(CFLAGS) -o base64-encode base64-encode.c
 
-install:	all
+install: all install-info install-vm install-pixmaps install-utils
+
+install-info: vm.info
+	test -d $(INFODIR) || mkdir -p $(INFODIR)
 	cp vm.info vm.info-* $(INFODIR)
+
+install-vm: vm.elc
+	test -d $(LISPDIR) || mkdir -p $(LISPDIR)
 	cp *.elc $(LISPDIR)
-	cp pixmaps/*.xpm $(PIXMAPDIR)
+
+install-pixmaps:
+	test -d $(PIXMAPDIR) || mkdir -p $(PIXMAPDIR)
+	cp pixmaps/*.x[pb]m $(PIXMAPDIR)
+
+install-utils: $(UTILS)
+	test -d $(BINDIR) || mkdir -p $(BINDIR)
 	cp $(UTILS) $(BINDIR)
 
 clean:
-	rm -f $(UTILS) vm-autoload.el vm-autoload.elc $(OBJECTS) tapestry.elc
+	rm -f $(UTILS) vm.info vm.info-* vm-autoload.el vm-autoload.elc $(OBJECTS) tapestry.elc
 
 vm.info:	vm.texinfo
 	@echo "making vm.info..."
 How to setup VM:
 
 0) Look at the Makefile and review the values of EMACS, INFODIR,
-   LISPDIR, and PIXMAPDIR.  If they are not right for your system,
-   change them.
+   LISPDIR, BINDIR and PIXMAPDIR.  If they are not right for your
+   system, change them.
 
 1) Your build options:
      `make' to build a usable VM.
    Emacs load-path.  If you've already set LISPDIR to this
    directory, just `make install'.
 
-3) If you're using XEmacs and you want toolbar support, make a
-   directory called `vm' in the XEmacs `etc' directory.  Copy
-   the files in pixmaps directory into the directory you just
-   created.  VM will look for the pixmaps there by default.
+3) If you're using XEmacs or Emacs 21 and you want toolbar
+   support, make a directory called `vm' in the XEmacs `etc'
+   directory.  Copy the files in pixmaps directory into the
+   directory you just created.  VM will look for the pixmaps
+   there by default.
 
    Alternately you can put the pixmap files in any directory you
    want or just leave them where they are.  Be sure to point the
-   variable vm-toolbar-pixmap-directory at the direrctory where
-   you put the files.  That is
+   variables vm-toolbar-pixmap-directory and vm-image-directory at
+   the direrctory where you put the files.  That is
 
       (setq vm-toolbar-pixmap-directory "/path/to/pixmaps")
+      (setq vm-image-directory "/path/to/pixmaps")
 
-   in your .emacs or .vm file.
+   in your .emacs or .vm file.  If you've set PIXMAPDIR, 'make
+   install' will copy the files to that directory.
 
 4) If you built the Info document, copy the file vm.info* files
-   into the Emacs' info.  You may need to edit the "dir" file in
+   into the Emacs' info.  ('make install' will do this for you if
+   you've set INFODIR). You may need to edit the "dir" file in
    that directory and add a menu entry for VM.  It should look
    like this:
 
Add a comment to this file

etc/getmail-xx.xbm

Old
Old image
New
New image
 the current message and the previous |COUNT| - 1 messages are
 deleted.
 
-When invoked on marked messages (via vm-next-command-uses-marks),
+When invoked on marked messages (via `vm-next-command-uses-marks'),
 only marked messages are deleted, other messages are ignored."
   (interactive "p")
   (if (interactive-p)
 the current message and the previous |COUNT| - 1 messages are
 deleted.
 
-When invoked on marked messages (via vm-next-command-uses-marks),
+When invoked on marked messages (via `vm-next-command-uses-marks'),
 only marked messages are undeleted, other messages are ignored."
   (interactive "p")
   (if (interactive-p)
 				      (eq vm-move-after-killing t))))
 	(vm-next-message arg t executing-kbd-macro))))
 
+(defun vm-delete-duplicate-messages ()
+  "Delete duplicate messages in the current folder.
+This command works by computing an MD5 hash for the body ofeach
+non-deleted message in the folder and deleting messages that have
+a hash that has already been seen.  Messages that already deleted
+are never hashed, so VM will never delete the last copy of a
+message in a folder.  'Deleting' means flagging for deletion; you
+will have to expunge the messages with `vm-expunge-folder' to
+really get rid of them, as usual.
+
+When invoked on marked messages (via `vm-next-command-uses-marks'),
+only duplicate messages among the marked messages are deleted,
+unmarked messages are not hashed or considerd for deletion."
+  (interactive)
+  (vm-select-folder-buffer)
+  (vm-check-for-killed-summary)
+  (vm-error-if-folder-read-only)
+  (vm-error-if-folder-empty)
+  (let ((used-marks (eq last-command 'vm-next-command-uses-marks))
+	(mlist vm-message-list)
+	(table (make-vector 61 0))
+	hash
+	(del-count 0))
+    (if used-marks
+	(setq mlist (vm-select-marked-or-prefixed-messages 0)))
+    (save-excursion
+      (save-restriction
+	(widen)
+	(while mlist
+	  (if (vm-deleted-flag (car mlist))
+	      nil
+	    (setq hash (vm-md5-region (vm-text-of (car mlist))
+				      (vm-text-end-of (car mlist))))
+	    (if (intern-soft hash table)
+		(progn
+		  (vm-set-deleted-flag (car mlist) t)
+		  (vm-increment del-count))
+	      (intern hash table)))
+	  (setq mlist (cdr mlist)))))
+    (vm-display nil nil '(vm-delete-duplicate-messages)
+		(list this-command))
+    (if (zerop del-count)
+	(message "No messages deleted")
+      (message "%d message%s deleted"
+	       del-count
+	       (if (= 1 del-count) "" "s")))
+    (vm-update-summary-and-mode-line)))
+
 (defun vm-expunge-folder (&optional shaddap)
   "Expunge messages with the `deleted' attribute.
 For normal folders this means that the deleted messages are
 folder, the corresponding real messages are also removed from real
 message lists and the message contents are removed from real folders.
 
-When invoked on marked messages (via vm-next-command-uses-marks),
+When invoked on marked messages (via `vm-next-command-uses-marks'),
 only messages both marked and deleted are expunged, other messages are
 ignored."
   (interactive)
 by vm-match-header."
   (aref vm-matched-header-vector 5))
 
-(defun vm-get-folder-type (&optional file start end)
+(defun vm-get-folder-type (&optional file start end ignore-visited)
   "Return a symbol indicating the folder type of the current buffer.
 This function works by examining the beginning of a folder.
 If optional arg FILE is present the type of FILE is returned instead.
+If FILE is being visited, the type of the buffer is returned.
 If optional second and third arg START and END are provided,
 vm-get-folder-type will examine the text between those buffer
 positions.  START and END default to 1 and (buffer-size) + 1.
+If IGNORED-VISITED is non-nil, even if FILE is being visited, its
+buffer is ignored and the disk copy of FILE is examined.
 
 Returns
   nil       if folder has no type (empty)
 BellFrom_.  For folders that could be From_ or BellFrom_ folders,
 the value of vm-default-From_folder-type will be returned."
   (let ((temp-buffer nil)
-	b
+	(b nil)
 	(case-fold-search nil))
     (unwind-protect
 	(save-excursion
 	  (if file
 	      (progn
-		(setq b (vm-get-file-buffer file))
+		(if (not ignore-visited)
+		    (setq b (vm-get-file-buffer file)))
 		(if b
 		    (set-buffer b)
 		  (setq temp-buffer (vm-make-work-buffer))
 	   (setq vm-message-order-header-present nil)
 	   (set-buffer-modified-p old-buffer-modified-p))))))
 
+(defun vm-make-index-file-name ()
+  (concat buffer-file-name vm-index-file-suffix))
+
 (defun vm-read-index-file-maybe ()
   (catch 'done
     (if (or (not (stringp buffer-file-name))
 	    (not (stringp vm-index-file-suffix)))
 	(throw 'done nil))
-    (let ((index-file (concat buffer-file-name vm-index-file-suffix)))
+    (let ((index-file (vm-make-index-file-name)))
       (if (file-readable-p index-file)
 	  (vm-read-index-file index-file)
 	nil ))))
 	(throw 'done nil))
     (if (not (stringp vm-index-file-suffix))
 	(throw 'done nil))
-    (let ((index-file (concat buffer-file-name vm-index-file-suffix)))
+    (let ((index-file (vm-make-index-file-name)))
       (vm-write-index-file index-file))))
 
 (defun vm-write-index-file (index-file)
 
 (defun vm-delete-index-file ()
   (if (stringp vm-index-file-suffix)
-      (let ((index-file (concat buffer-file-name vm-index-file-suffix)))
+      (let ((index-file (vm-make-index-file-name)))
 	(vm-error-free-call 'delete-file index-file))))
 
 (defun vm-change-all-new-to-unread ()
 	(if (and (eq major-mode 'vm-mode)
 		 (setq found-one t)
 		 ;; to avoid reentrance into the pop and imap code
-		 (not vm-block-new-mail)
-		 ;; Don't bother checking if we already know from
-		 ;; a previous check that there's mail waiting
-		 ;; and the user hasn't retrieved it yet.  Not
-		 ;; completely accurate, but saves network
-		 ;; connection build and tear down which is slow
-		 ;; for some users.
-		 (not vm-spooled-mail-waiting))
+		 (not vm-global-block-new-mail))
 	    (progn
 	      (setq oldval vm-spooled-mail-waiting)
-	      (vm-check-for-spooled-mail nil)
+	      (setq vm-spooled-mail-waiting (vm-check-for-spooled-mail nil t))
 	      (if (not (eq oldval vm-spooled-mail-waiting))
 		  (progn
 		    (intern (buffer-name) vm-buffers-needing-display-update)
-		    (vm-update-summary-and-mode-line)
 		    (run-hooks 'vm-spooled-mail-waiting-hook))))))
       (setq b-list (cdr b-list)))
+    (vm-update-summary-and-mode-line)
     ;; make the timer go away if we didn't encounter a vm-mode buffer.
     (if (and (not found-one) (null b-list))
 	(if timer
 			   (file-newer-than-file-p
 			    (make-auto-save-file-name)
 			    buffer-file-name)))
-		 (not vm-block-new-mail)
+		 (not vm-global-block-new-mail)
 		 (not vm-folder-read-only)
 		 (vm-get-spooled-mail nil)
 		 (vm-assimilate-new-messages t))
 	   (rename-file crash-box name)))
        got-mail ))))
 
-(defun vm-compute-spool-files ()
+(defun vm-compute-spool-files (&optional all)
   (let ((fallback-triples nil)
+	file file-list
 	triples)
-    (cond ((and buffer-file-name
-		(consp vm-spool-file-suffixes)
-		(stringp vm-crash-box-suffix))
-	   (setq fallback-triples
-		 (mapcar (function
-			  (lambda (suffix)
-			    (list buffer-file-name
-				  (concat buffer-file-name suffix)
-				  (concat buffer-file-name
-					  vm-crash-box-suffix))))
-			 vm-spool-file-suffixes))))
-    (cond ((and buffer-file-name
-		vm-make-spool-file-name vm-make-crash-box-name)
-	   (setq fallback-triples
-		 (nconc fallback-triples
-			(list (list buffer-file-name
-				    (save-excursion
-				      (funcall vm-make-spool-file-name
-					       buffer-file-name))
-				    (save-excursion
-				      (funcall vm-make-crash-box-name
-					       buffer-file-name))))))))
     (cond ((null (vm-spool-files))
 	   (setq triples (list
 			  (list vm-primary-inbox
 			 (vm-spool-files))))
 	  ((consp (car (vm-spool-files)))
 	   (setq triples (vm-spool-files))))
+    (setq file-list (if all (mapcar 'car triples) (list buffer-file-name)))
+    (while file-list
+      (setq file (car file-list))
+      (setq file-list (cdr file-list))
+      (cond ((and file
+		  (consp vm-spool-file-suffixes)
+		  (stringp vm-crash-box-suffix))
+	     (setq fallback-triples
+		   (mapcar (function
+			    (lambda (suffix)
+			      (list file
+				    (concat file suffix)
+				    (concat file
+					    vm-crash-box-suffix))))
+			   vm-spool-file-suffixes))))
+      (cond ((and file
+		  vm-make-spool-file-name vm-make-crash-box-name)
+	     (setq fallback-triples
+		   (nconc fallback-triples
+			  (list (list file
+				      (save-excursion
+					(funcall vm-make-spool-file-name
+						 file))
+				      (save-excursion
+					(funcall vm-make-crash-box-name
+						 file)))))))))
     (setq triples (append triples fallback-triples))
     triples ))
 
 			 (find-file-name-handler source))))))
     (if handler
 	(funcall handler 'vm-spool-check-mail source)
-      (and (not (equal 0 (nth 7 (file-attributes source))))
-	   (file-readable-p source)))))
+      (let ((size (nth 7 (file-attributes source)))
+	    (hash vm-spool-file-message-count-hash)
+	    val)
+	(setq val (symbol-value (intern-soft source hash)))
+	(if (and val (equal size (car val)))
+	    (> (nth 1 val) 0)
+	  (let ((count (vm-count-messages-in-file source)))
+	    (if (null count)
+		nil
+	      (set (intern source hash) (list size count))
+	      (vm-store-folder-totals source (list count 0 0 0))
+	      (> count 0))))))))
+
+(defun vm-count-messages-in-file (file &optional quietly)
+  (let ((type (vm-get-folder-type file nil nil t))
+	(work-buffer nil)
+	count)
+    (if (or (memq type '(unknown nil)) (null vm-grep-program))
+	nil
+      (unwind-protect
+	  (let (regexp)
+	    (save-excursion
+	      (setq work-buffer (vm-make-work-buffer))
+	      (set-buffer work-buffer)
+	      (cond ((memq type '(From_ BellFrom_ From_-with-Content-Length))
+		     (setq regexp "^From "))
+		    ((eq type 'mmdf)
+		     (setq regexp "^\001\001\001\001"))
+		    ((eq type 'babyl)
+		     (setq regexp "^\037")))
+	      (condition-case data
+		  (progn
+		    (or quietly (message "Counting messages in %s..." file))
+		    (call-process vm-grep-program nil t nil "-c" regexp
+				  (expand-file-name file))
+		    (or quietly (message "Counting messages in %s... done" file)))
+		(error (message "Attempt to run %s on %s signaled: %s"
+				vm-grep-program file data)
+		       (sleep-for 2)
+		       (setq vm-grep-program nil)))
+	      (setq count (string-to-int (buffer-string)))
+	      (cond ((memq type '(From_ BellFrom_ From_-with-Content-Length))
+		     t )
+		    ((eq type 'mmdf)
+		     (setq count (/ count 2)))
+		    ((eq type 'babyl)
+		     (setq count (1- count))))
+	      count ))
+	(and work-buffer (kill-buffer work-buffer))))))
 
 (defun vm-movemail-specific-spool-file-p (file)
   (string-match "^po:[^:]+$" file))
 
-(defun vm-check-for-spooled-mail (&optional interactive)
-  (if vm-block-new-mail
+(defun vm-check-for-spooled-mail (&optional interactive this-buffer-only)
+  (if vm-global-block-new-mail
       nil
-    (let ((triples (vm-compute-spool-files))
+    (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-block-new-mail t)
+	  (vm-global-block-new-mail t)
 	  (vm-pop-ok-to-ask interactive)
 	  (vm-imap-ok-to-ask interactive)
-	  (done nil)
-	  crash in maildrop meth
+	  this-buffer crash in maildrop meth
 	  (mail-waiting nil))
-      (while (and triples (not done))
+      (while triples
 	(setq in (expand-file-name (nth 0 (car triples)) vm-folder-directory)
 	      maildrop (nth 1 (car triples))
 	      crash (nth 2 (car triples)))
 	    ;; spool file is accessible only with movemail
 	    ;; so skip it.
 	    nil
-	  (if (eq (current-buffer) (vm-get-file-buffer in))
+	  (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
-			    done t))
+		      (setq mail-waiting t))
 		  (cond ((and vm-recognize-imap-maildrops
 			      (string-match vm-recognize-imap-maildrops
 					    maildrop))
 			(error nil))
 		    (setq mail-waiting
 			  (or mail-waiting
-			      (funcall meth maildrop))))
-		  (if mail-waiting
-		      (setq done t))))))
+			      (funcall meth maildrop))))))))
 	(setq triples (cdr triples)))
-      (setq vm-spooled-mail-waiting mail-waiting)
       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."))
-  (let ((triples (vm-compute-spool-files))
-	;; 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-block-new-mail t)
-	(vm-pop-ok-to-ask interactive)
-	(vm-imap-ok-to-ask interactive)
-	non-file-maildrop crash in safe-maildrop maildrop popdrop
-	retrieval-function
-	(got-mail nil))
-    (if (and (not (verify-visited-file-modtime (current-buffer)))
-	     (or (null interactive)
-		 (not (yes-or-no-p
-		       (format
-			"Folder %s changed on disk, discard those changes? "
-			(buffer-name (current-buffer)))))))
-	(progn
-	  (message "Folder %s changed on disk, consider M-x revert-buffer"
-		   (buffer-name (current-buffer)))
-	  (sleep-for 2)
-	  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)))
-	(setq safe-maildrop maildrop
-	      non-file-maildrop nil)
-	(cond ((vm-movemail-specific-spool-file-p maildrop)
-	       (setq non-file-maildrop t)
-	       (setq retrieval-function 'vm-spool-move-mail))
-	      ((and vm-recognize-imap-maildrops
-		    (string-match vm-recognize-imap-maildrops
-				  maildrop))
-	       (setq non-file-maildrop t)
-	       (setq safe-maildrop (vm-safe-imapdrop-string maildrop))
-	       (setq retrieval-function 'vm-imap-move-mail))
-	      ((and vm-recognize-pop-maildrops
-		    (string-match vm-recognize-pop-maildrops
-				  maildrop))
-	       (setq non-file-maildrop t)
-	       (setq safe-maildrop (vm-safe-popdrop-string maildrop))
-	       (setq retrieval-function 'vm-pop-move-mail))
-	      (t (setq retrieval-function 'vm-spool-move-mail)))
-	(if (eq (current-buffer) (vm-get-file-buffer in))
-	    (progn
-	      (if (file-exists-p crash)
-		  (progn
-		    (message "Recovering messages from %s..." crash)
-		    (setq got-mail (or (vm-gobble-crash-box crash) got-mail))
-		    (message "Recovering messages from %s... done" crash)))
-	      (if (or non-file-maildrop
-		      (and (not (equal 0 (nth 7 (file-attributes maildrop))))
-			   (file-readable-p maildrop)))
-		  (progn
-		    (setq crash (expand-file-name crash vm-folder-directory))
-		    (if (not non-file-maildrop)
-			(setq maildrop (expand-file-name maildrop
-							 vm-folder-directory)))
-		    (if (if got-mail
-			    ;; don't allow errors to be signaled unless no
-			    ;; mail has been appended to the incore
-			    ;; copy of the folder.  otherwise the
-			    ;; user will wonder where the mail is,
-			    ;; since it is not in the crash box or
-			    ;; the spool file and doesn't _appear_ to
-			    ;; be in the folder either.
-			    (condition-case error-data
-				(funcall retrieval-function maildrop crash)
-			      (error (message "%s signaled: %s"
-					      retrieval-function
-					      error-data)
-				     (sleep-for 2)
-				     ;; we don't know if mail was
-				     ;; put into the crash box or
-				     ;; not, so return t just to be
-				     ;; safe.
-				     t )
-			      (quit (message "quitting from %s..."
-					     retrieval-function)
-				    (sleep-for 2)
-				    ;; we don't know if mail was
-				    ;; put into the crash box or
-				    ;; not, so return t just to be
-				    ;; safe.
-				    t ))
-			  (funcall retrieval-function maildrop crash))
-			(if (vm-gobble-crash-box crash)		      
-			    (progn
-			      (setq got-mail t)
-			      (message "Got mail from %s."
-				       safe-maildrop))))))))
-	(setq triples (cdr triples)))
-      ;; not really correct, but it is what the user expects to see.
-      (setq vm-spooled-mail-waiting nil)
-      (intern (buffer-name) vm-buffers-needing-display-update)
-      (vm-update-summary-and-mode-line)
-      (if got-mail
-	  (run-hooks 'vm-retrieved-spooled-mail-hook))
-      got-mail )))
+  (if vm-global-block-new-mail
+      nil
+    (let ((triples (vm-compute-spool-files))
+	  ;; 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)
+	  non-file-maildrop crash in safe-maildrop maildrop popdrop
+	  retrieval-function
+	  (got-mail nil))
+      (if (and (not (verify-visited-file-modtime (current-buffer)))
+	       (or (null interactive)
+		   (not (yes-or-no-p
+			 (format
+			  "Folder %s changed on disk, discard those changes? "
+			  (buffer-name (current-buffer)))))))
+	  (progn
+	    (message "Folder %s changed on disk, consider M-x revert-buffer"
+		     (buffer-name (current-buffer)))
+	    (sleep-for 2)
+	    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)))
+	  (setq safe-maildrop maildrop
+		non-file-maildrop nil)
+	  (cond ((vm-movemail-specific-spool-file-p maildrop)
+		 (setq non-file-maildrop t)
+		 (setq retrieval-function 'vm-spool-move-mail))
+		((and vm-recognize-imap-maildrops
+		      (string-match vm-recognize-imap-maildrops
+				    maildrop))
+		 (setq non-file-maildrop t)
+		 (setq safe-maildrop (vm-safe-imapdrop-string maildrop))
+		 (setq retrieval-function 'vm-imap-move-mail))
+		((and vm-recognize-pop-maildrops
+		      (string-match vm-recognize-pop-maildrops
+				    maildrop))
+		 (setq non-file-maildrop t)
+		 (setq safe-maildrop (vm-safe-popdrop-string maildrop))
+		 (setq retrieval-function 'vm-pop-move-mail))
+		(t (setq retrieval-function 'vm-spool-move-mail)))
+	  (if (eq (current-buffer) (vm-get-file-buffer in))
+	      (progn
+		(if (file-exists-p crash)
+		    (progn
+		      (message "Recovering messages from %s..." crash)
+		      (setq got-mail (or (vm-gobble-crash-box crash) got-mail))
+		      (message "Recovering messages from %s... done" crash)))
+		(if (or non-file-maildrop
+			(and (not (equal 0 (nth 7 (file-attributes maildrop))))
+			     (file-readable-p maildrop)))
+		    (progn
+		      (setq crash (expand-file-name crash vm-folder-directory))
+		      (if (not non-file-maildrop)
+			  (setq maildrop (expand-file-name maildrop
+							   vm-folder-directory)))
+		      (if (if got-mail
+			      ;; don't allow errors to be signaled unless no
+			      ;; mail has been appended to the incore
+			      ;; copy of the folder.  otherwise the
+			      ;; user will wonder where the mail is,
+			      ;; since it is not in the crash box or
+			      ;; the spool file and doesn't _appear_ to
+			      ;; be in the folder either.
+			      (condition-case error-data
+				  (funcall retrieval-function maildrop crash)
+				(error (message "%s signaled: %s"
+						retrieval-function
+						error-data)
+				       (sleep-for 2)
+				       ;; we don't know if mail was
+				       ;; put into the crash box or
+				       ;; not, so return t just to be
+				       ;; safe.
+				       t )
+				(quit (message "quitting from %s..."
+					       retrieval-function)
+				      (sleep-for 2)
+				      ;; we don't know if mail was
+				      ;; put into the crash box or
+				      ;; not, so return t just to be
+				      ;; safe.
+				      t ))
+			    (funcall retrieval-function maildrop crash))
+			  (if (vm-gobble-crash-box crash)
+			      (progn
+				(setq got-mail t)
+				(if (not non-file-maildrop)
+				    (vm-store-folder-totals maildrop '(0 0 0 0)))
+				(message "Got mail from %s."
+					 safe-maildrop))))))))
+	  (setq triples (cdr triples)))
+	;; not really correct, but it is what the user expects to see.
+	(setq vm-spooled-mail-waiting nil)
+	(intern (buffer-name) vm-buffers-needing-display-update)
+	(vm-update-summary-and-mode-line)
+	(if got-mail
+	    (run-hooks 'vm-retrieved-spooled-mail-hook))
+	got-mail ))))
 
 (defun vm-safe-popdrop-string (drop)
   (or (and (string-match "^\\([^:]+\\):[^:]+:[^:]+:\\([^:]+\\):[^:]+" drop)
 (defun vm-assimilate-new-messages (&optional
 				   dont-read-attributes
 				   gobble-order
-				   labels)
+				   labels first-time)
   (let ((tail-cons (vm-last vm-message-list))
 	b-list new-messages)
     (save-excursion
 	  (vm-sort-messages "thread")))
     (if (and (or vm-arrived-message-hook vm-arrived-messages-hook)
 	     new-messages
-	     ;; tail-cons == nil means vm-message-list was empty.
-	     ;; Thus new-messages == vm-message-list.  In this
-	     ;; case, run the hooks only if this is not the first
+	     ;; Run the hooks only if this is not the first
 	     ;; time vm-assimilate-new-messages has been called
-	     ;; in this folder.  gobble-order non-nil is a good
-	     ;; indicator that this is the first time because the
-	     ;; order is gobbled only once per visit and always
-	     ;; the first time vm-assimilate-new-messages is
-	     ;; called.
-	     (or tail-cons (null gobble-order)))
+	     ;; in this folder. 
+	     (not first-time))
 	(let ((new-messages new-messages))
 	  ;; seems wise to do this so that if the user runs VM
 	  ;; command here they start with as much of a clean
 		(message "Retrieving message %d (of %d) from %s..."
 			 n mailbox-count imapdrop)
 		(vm-imap-send-command process
-				      (format "FETCH %d (RFC822.PEEK)" n))
+				      (format "FETCH %d (BODY.PEEK[])" n))
 		(vm-imap-retrieve-to-crashbox process destination statblob)
 		(vm-increment retrieved)
 		(and b-per-session
 			 (find-file-name-handler source)))))
 	(retrieved vm-imap-retrieved-messages)
 	(imapdrop (vm-imapdrop-sans-password source))
+	(count 0)
 	msg-count uid-validity x response select mailbox source-list)
     (unwind-protect
 	(prog1
 		      msg-count (car select)
 		      uid-validity (nth 1 select))
 		(if (zerop msg-count)
-		    (throw 'end-of-session nil))
+		    (progn
+		      (vm-store-folder-totals source '(0 0 0 0))
+		      (throw 'end-of-session nil)))
 		;; sweep through the retrieval list, removing entries
 		;; that have been invalidated by the new UIDVALIDITY
 		;; value.
 		  (if (null (car response))
 		      ;; (nil . nil) is returned if there are no
 		      ;; messages in the mailbox.
-		      (throw 'end-of-session nil)
+		      (progn
+			(vm-store-folder-totals source '(0 0 0 0))
+			(throw 'end-of-session nil))
 		    (while response
 		      (if (not (and (setq x (assoc (cdr (car response))
 						   retrieved))
 				    (equal (nth 1 x) imapdrop)
 				    (eq (nth 2 x) 'uid)))
-			  (throw 'end-of-session t))
+			  (vm-increment count))
 		      (setq response (cdr response))))
-		  ;; all messages in the mailbox have already been retrieved
-		  (throw 'end-of-session nil))
+		  (vm-store-folder-totals source (list count 0 0 0))
+		  (throw 'done (not (eq count 0))))
 		(not (equal 0 (car select)))))
 	  (setq vm-imap-retrieved-messages retrieved))
       (and process (vm-imap-end-session process)))))
 	(source nil)
 	(trouble nil)
 	(delete-count 0)
-	(vm-block-new-mail t)
+	(vm-global-block-new-mail t)
 	(vm-imap-ok-to-ask t)
 	(did-delete nil)
 	msg-count can-delete read-write uid-validity
     (vm-imap-send-command process "LOGOUT")
     ;; we don't care about the response
     ;;(vm-imap-read-ok-response process)
-    (if (not keep-buffer)
+    (if (and (not vm-imap-keep-trace-buffer) (not keep-buffer))
 	(kill-buffer (process-buffer process))
       (save-excursion
        (set-buffer (process-buffer process))
     (setq vm-imap-read-point (point-marker))
     (vm-set-imap-stat-x-got statblob nil)
     (setq list (cdr (nth 3 fetch-response)))
-    (if (not (vm-imap-response-matches list 'RFC822 'string))
-	(vm-imap-protocol-error "expected (RFC822 string) in FETCH response"))
-    (setq p (nth 1 list)
+    (if (not (vm-imap-response-matches list 'BODY '(vector) 'string))
+	(vm-imap-protocol-error "expected (BODY[] string) in FETCH response"))
+    (setq p (nth 2 list)
 	  start (nth 1 p))
     (goto-char (nth 2 p))
     (setq end (point-marker))
 		   (accept-process-output process)
 		   (goto-char curpoint))
 	       (setq token (list 'string start (1- curpoint))))))
-	    ((looking-at "[\000-\040\177-\377]")
+	    ;; should be (looking-at "[\000-\040\177-\377]")
+	    ;; but Microsoft Exchange emits 8-bit chars.
+	    ((looking-at "[\000-\040\177]")
 	     (vm-imap-protocol-error "unexpected char (%d)"
 				     (char-after (point))))
 	    (t
 	     (let ((start (point))
 		   (curpoint (point))
-		   ;; \376 instead of \377 because Emacs 19.34
-		   ;; has a bug in the fastmap initialization
-		   ;; code that causes it to infloop
-		   (not-word-chars "^\000-\040\177-\376()[]{}")
-		   (not-word-regexp "[][\000-\040\177-\376(){}]"))
+		   ;; We should be considering 8-bit chars as
+		   ;; non-word chars also but Microsoft Exchange
+		   ;; uses them, despite the RFC 2060 prohibition.
+		   ;; If we ever resume disallowing 8-bit chars,
+		   ;; remember to write the range as \177-\376 ...
+		   ;; \376 instead of \377 because Emacs 19.34 has
+		   ;; a bug in the fastmap initialization code
+		   ;; that causes it to infloop.
+		   (not-word-chars "^\000-\040\177()[]{}")
+		   (not-word-regexp "[][\000-\040\177(){}]"))
 	       (while (not done)
 		 (skip-chars-forward not-word-chars)
 		 (setq curpoint (point))
 	    (vm-mouse-send-url-at-position (point)
 					   'vm-mouse-send-url-to-mosaic)
 	    t]
+	   ["mMosaic"
+	    (vm-mouse-send-url-at-position (point)
+					   'vm-mouse-send-url-to-mmosaic)
+	    t]
 	   ["Netscape"
 	    (vm-mouse-send-url-at-position (point)
 					   'vm-mouse-send-url-to-netscape)
 	(define-key map [rootmenu vm buffer] 'undefined)
 	(define-key map [rootmenu vm tools] 'undefined)
 	(define-key map [rootmenu vm help] 'undefined)
+	(define-key map [rootmenu vm mule] 'undefined)
 	;; 19.29 changed the tag for the Help menu.
 	(define-key map [rootmenu vm help-menu] 'undefined)
 	;; now build VM's menu tree.
 ;;; MIME support functions
-;;; Copyright (C) 1997-1998 Kyle E. Jones
+;;; Copyright (C) 1997-1998, 2000 Kyle E. Jones
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
 	(delete-region (point) (+ (point) oldsize))
 	;; Fixup the end point.  I have found no other way to
 	;; let the calling function know where the region ends
-	;; after encode-coding-region has the scrambled markers.
+	;; after encode-coding-region has scrambled the markers.
 	(and (markerp b-end)
 	     (set-marker b-end (point)))
 	(kill-buffer work-buffer)
 	(insert-buffer-substring work-buffer start end)
 	;; Fixup the end point.  I have found no other way to
 	;; let the calling function know where the region ends
-	;; after decode-coding-region has the scrambled markers.
+	;; after decode-coding-region has scrambled the markers.
 	(and (markerp b-end)
 	     (set-marker b-end (point)))
 	(kill-buffer work-buffer)
 	(save-excursion
 	  (cond
 	   ((and (featurep 'base64)
-		 (fboundp 'base64-decode-region))
-	    (base64-decode-region start end)
+		 (fboundp 'base64-decode-region)
+		 ;; W3 reportedly has a Lisp version of this, and
+		 ;; there's no point running it.
+		 (subrp (symbol-function 'base64-decode-region)))
+	    (condition-case data
+		(base64-decode-region start end)
+	      (error (vm-mime-error "%S" data)))
 	    (and crlf (vm-mime-crlf-to-lf-region start end)))
 	   (t
 	    (setq work-buffer (vm-make-work-buffer))
 	  (and crlf (vm-mime-lf-to-crlf-region start end))
 	  (cond
 	   ((and (featurep 'base64)
-		 (fboundp 'base64-encode-region))
-	    (base64-encode-region start end B-encoding))
+		 (fboundp 'base64-encode-region)
+		 ;; W3 reportedly has a Lisp version of this, and
+		 ;; there's no point running it.
+		 (subrp (symbol-function 'base64-encode-region)))
+	    (condition-case data
+		(base64-encode-region start end B-encoding)
+	      (error (vm-mime-error "%S" data))))
 	   (t
 	    (setq work-buffer (vm-make-work-buffer))
 	    (if vm-mime-base64-encoder-program
 		     ;; use binary coding system in FSF Emacs/MULE
 		     (coding-system-for-read (vm-binary-coding-system))
 		     (coding-system-for-write (vm-binary-coding-system))
-		     (process-coding-system-alist
-		      (list (cons "." (vm-binary-coding-system))))
 		     (status (apply 'vm-run-command-on-region
 				    (point-min) (point-max) nil
 				    vm-mime-uuencode-decoder-program
   (let ((mail-buffer (current-buffer))
 	b mm
 	(real-m (vm-real-message-of m))
-	(modified (buffer-modified-p))
-	(coding-system-for-read (vm-binary-coding-system))
-	(coding-system-for-write (vm-binary-coding-system)))
+	(modified (buffer-modified-p)))
     (cond ((or (null vm-presentation-buffer-handle)
 	       (null (buffer-name vm-presentation-buffer-handle)))
 	   (let ((default-enable-multibyte-characters t))
   (save-excursion
     (save-restriction
       (narrow-to-region beg end)
-      (vm-with-multibyte-buffer
-       (catch 'done
-	 (goto-char (point-min))
-	 (if (or vm-xemacs-mule-p vm-fsfemacs-mule-p)
-	     (let ((charsets (delq 'ascii (vm-charsets-in-region
-					   (point-min) (point-max)))))
-	       (cond ((null charsets)
-		      "us-ascii")
-		     ((cdr charsets)
-		      (or (car (cdr
-				(assq (vm-coding-system-name
-				       buffer-file-coding-system)
-				      vm-mime-mule-coding-to-charset-alist)))
-			  "iso-2022-jp"))
-		     (t
-		      (or (car (cdr
-				(assoc
-				 (car charsets)
-				 vm-mime-mule-charset-to-charset-alist)))
-			  "unknown"))))
-	   (and (re-search-forward "[^\000-\177]" nil t)
-		(throw 'done (or vm-mime-8bit-composition-charset
-				 "iso-8859-1")))
-	   (throw 'done vm-mime-7bit-composition-charset)))))))
+      (catch 'done
+	(goto-char (point-min))
+	(if (or vm-xemacs-mule-p 
+		(and vm-fsfemacs-mule-p enable-multibyte-characters))
+	    (let ((charsets (delq 'ascii (vm-charsets-in-region
+					  (point-min) (point-max)))))
+	      (cond ((null charsets)
+		     "us-ascii")
+		    ((cdr charsets)
+		     (or (car (cdr
+			       (assq (vm-coding-system-name
+				      buffer-file-coding-system)
+				     vm-mime-mule-coding-to-charset-alist)))
+			 "iso-2022-jp"))
+		    (t
+		     (or (car (cdr
+			       (assoc
+				(car charsets)
+				vm-mime-mule-charset-to-charset-alist)))
+			 "unknown"))))
+	  (and (re-search-forward "[^\000-\177]" nil t)
+	       (throw 'done (or vm-mime-8bit-composition-charset
+				"iso-8859-1")))
+	  (throw 'done vm-mime-7bit-composition-charset))))))
 
 (defun vm-determine-proper-content-transfer-encoding (beg end)
   (save-excursion
 	  (and toolong (throw 'done "binary")))
 	 
 	(goto-char (point-min))
-	(and (re-search-forward "[\200-\377]" nil t)
+	(and (re-search-forward "[^\000-\177]" nil t)
 	     (throw 'done "8bit"))
 
 	"7bit"))))
   (if (and (vm-images-possible-here-p)
 	   (image-type-available-p image-type))
       (let ((start (point-marker)) end tempfile
+	    (coding-system-for-write (vm-binary-coding-system))
 	    (selective-display nil)
 	    (buffer-read-only nil))
 	(vm-mime-insert-mime-body layout)
 	;; contents to tempfile.
 	(write-region start start tempfile nil 0)
 	(set-file-modes tempfile 384)
-	;; coding system for presentation buffer is binary so
-	;; we don't need to set it here.
 	(write-region start end tempfile nil 0)
 	;; keep one char so we can attach the image to it.
 	(delete-region start (1- end))
   ;; where it was when the user triggered the button.
   (save-excursion
     (cond (vm-fsfemacs-p
-	   (let (o-list o (found nil))
+	   (let (o-list o retval (found nil))
 	     (setq o-list (overlays-at (point)))
 	     (while (and o-list (not found))
 	       (cond ((overlay-get (car o-list) 'vm-mime-layout)
 		      (setq found t)
-		      (funcall (or function (overlay-get (car o-list)
-							 'vm-mime-function))
-			       (car o-list))))
-	       (setq o-list (cdr o-list)))))
+		      ;; return value is used by caller.
+		      (setq retval 
+			    (funcall (or function (overlay-get (car o-list)
+							       'vm-mime-function))
+				     (car o-list)))))
+	       (setq o-list (cdr o-list)))
+	     retval ))
 	  (vm-xemacs-p
 	   (let ((e (extent-at (point) nil 'vm-mime-layout)))
+	     ;; return value is used by caller.
 	     (funcall (or function (extent-property e 'vm-mime-function))
 		      e))))))
 
     (vm-set-extent-property e 'keymap keymap)
     (vm-set-extent-property e 'balloon-help 'vm-mouse-3-help)
     ;; for all
+    (vm-set-extent-property e 'vm-button t)
     (vm-set-extent-property e 'vm-mime-disposable disposable)
     (vm-set-extent-property e 'face vm-mime-button-face)
     (vm-set-extent-property e 'vm-mime-layout layout)
 		done t))))
     (save-excursion
       (unwind-protect
-	  (let ((coding-system-for-read (vm-binary-coding-system))
-		(coding-system-for-write (vm-binary-coding-system)))
+	  (let ((coding-system-for-read (vm-binary-coding-system)))
 	    (setq work-buffer (vm-make-work-buffer))
 	    (set-buffer work-buffer)
 	    (setq selective-display nil)
 	      (set-buffer work-buffer)
 	      (setq selective-display nil)
 	      ;; Tell DOS/Windows NT whether the file is binary
-	      (setq buffer-file-type (not (vm-mime-text-type-layout-p layout)))
+	      (setq buffer-file-type t)
 	      ;; Tell XEmacs/MULE not to mess with the bits unless
 	      ;; this is a text type.
 	      (if (fboundp 'set-buffer-file-coding-system)
-		  (if (vm-mime-text-type-layout-p layout)
-		      (set-buffer-file-coding-system
-		       (vm-line-ending-coding-system) nil)
-		    (set-buffer-file-coding-system (vm-binary-coding-system) t)))
+		  (set-buffer-file-coding-system
+		   (vm-line-ending-coding-system) nil))
 	      (vm-mime-insert-mime-body layout)
 	      (vm-mime-transfer-decode-region layout (point-min) (point-max))
 	      (goto-char (point-min))
 		       ;; by insert-file-contents.  The
 		       ;; value we bind to it to here isn't important.
 		       (buffer-file-coding-system (vm-binary-coding-system)))
-		   (insert-file-contents object))))
+		   (condition-case data
+		       (insert-file-contents object)
+		     (error
+		      ;; font-lock could signal this error in FSF
+		      ;; Emacs versions prior to 21.0.  Catch it
+		      ;; and ignore it.
+		      (if (equal data '(error "Invalid search bound (wrong side of point)"))
+			  nil
+			(signal (car data) (cdr data))))))))
 	  ;; gather information about the object from the extent.
 	  (if (setq already-mimed (extent-property e 'vm-mime-encoded))
 	      (setq layout (vm-mime-parse-entity
 	(let ((buffer-read-only nil))
 	  (insert string)))
     (let ((temp-buffer nil)
-	  (coding-system-for-read (vm-line-ending-coding-system))
 	  (coding-system-for-write (vm-line-ending-coding-system)))
       (unwind-protect
 	  (save-excursion
 (defun vm-delete-index-file-names (list)
   (vm-delete 'vm-index-file-name-p list))
 
+(defun vm-delete-directory-names (list)
+  (vm-delete 'file-directory-p list))
+
 (defun vm-index-file-name-p (file)
   (and (file-regular-p file)
        (stringp vm-index-file-suffix)
     (set-buffer target-buffer)))
 
 (if (not (fboundp 'vm-extent-property))
-    (if (fboundp 'overlay-get)
+    (if vm-fsfemacs-p
 	(fset 'vm-extent-property 'overlay-get)
       (fset 'vm-extent-property 'extent-property)))
 
 (if (not (fboundp 'vm-extent-object))
-    (if (fboundp 'overlay-buffer)
+    (if vm-fsfemacs-p
 	(fset 'vm-extent-object 'overlay-buffer)
       (fset 'vm-extent-object 'extent-object)))
 
 (if (not (fboundp 'vm-set-extent-property))
-    (if (fboundp 'overlay-put)
+    (if vm-fsfemacs-p
 	(fset 'vm-set-extent-property 'overlay-put)
       (fset 'vm-set-extent-property 'set-extent-property)))
 
 (if (not (fboundp 'vm-set-extent-endpoints))
-    (if (fboundp 'move-overlay)
+    (if vm-fsfemacs-p
 	(fset 'vm-set-extent-endpoints 'move-overlay)
       (fset 'vm-set-extent-endpoints 'set-extent-endpoints)))
 
 (if (not (fboundp 'vm-make-extent))
-    (if (fboundp 'make-overlay)
+    (if vm-fsfemacs-p
 	(fset 'vm-make-extent 'make-overlay)
       (fset 'vm-make-extent 'make-extent)))
 
 (if (not (fboundp 'vm-extent-end-position))
-    (if (fboundp 'overlay-end)
+    (if vm-fsfemacs-p
 	(fset 'vm-extent-end-position 'overlay-end)
       (fset 'vm-extent-end-position 'extent-end-position)))
 
 (if (not (fboundp 'vm-extent-start-position))
-    (if (fboundp 'overlay-start)
+    (if vm-fsfemacs-p
 	(fset 'vm-extent-start-position 'overlay-start)
       (fset 'vm-extent-start-position 'extent-start-position)))
 
 (if (not (fboundp 'vm-detach-extent))
-    (if (fboundp 'delete-overlay)
+    (if vm-fsfemacs-p
 	(fset 'vm-detach-extent 'delete-overlay)
       (fset 'vm-detach-extent 'detach-extent)))
 
 (if (not (fboundp 'vm-extent-properties))
-    (if (fboundp 'overlay-properties)
+    (if vm-fsfemacs-p
 	(fset 'vm-extent-properties 'overlay-properties)
       (fset 'vm-extent-properties 'extent-properties)))
 
+(defun vm-extent-at (pos &optional object property)
+  (if (fboundp 'extent-at)
+      (extent-at pos object property)
+    (let ((o-list (overlays-at pos))
+	  (o nil))
+      (if (null property)
+	  (car o-list)
+	(while o-list
+	  (if (overlay-get (car o-list) property)
+	      (setq o (car o-list)
+		    o-list nil)
+	    (setq o-list (cdr o-list))))
+	o ))))
+
 (defun vm-copy-extent (e)
   (let ((props (vm-extent-properties e))
 	(ee (vm-make-extent (vm-extent-start-position e)
 	(setq list (cdr list))))
     (car list)))
 
+(defun vm-nonneg-string (n)
+  (if (< n 0)
+      "?"
+    (int-to-string n)))
+
 (defun vm-string-member (elt list)
   (let ((case-fold-search t)
 	(found nil)
 				   hex-digit-alist)))
 		     1)
 	(delete-region (- (point) 1) (- (point) 4))))))
+
+(defun vm-md5-region (start end)
+  (if (fboundp 'md5)
+      (md5 (current-buffer) start end)
+    (let ((buffer nil)
+	  (curbuf (current-buffer)))
+      (unwind-protect
+	  (save-excursion
+	    (setq buffer (vm-make-work-buffer))
+	    (set-buffer buffer)
+	    (insert-buffer-substring curbuf start end)
+	    ;; call-process-region calls write-region.
+	    ;; don't let it do CR -> LF translation.
+	    (setq selective-display nil)
+	    (call-process-region (point-min) (point-max)
+				 (or shell-file-name "/bin/sh") t buffer nil
+				 shell-command-switch vm-pop-md5-program)
+	    ;; MD5 digest is 32 chars long
+	    ;; mddriver adds a newline to make neaten output for tty
+	    ;; viewing, make sure we leave it behind.
+	    (vm-buffer-substring-no-properties (point-min) (+ (point-min) 32)))
+	(and buffer (kill-buffer buffer))))))
 (defvar buffer-file-type)
 
 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window)
-  (message "Sending URL to Mosaic...")
-  (if (null new-mosaic)
-      (let ((pid-file "~/.mosaicpid")
-	    (work-buffer " *mosaic work*")
-	    (coding-system-for-read (vm-line-ending-coding-system))
-	    (coding-system-for-write (vm-line-ending-coding-system))
-	    pid)
-	(cond ((file-exists-p pid-file)
-	       (set-buffer (get-buffer-create work-buffer))
-	       (setq selective-display nil)
-	       (erase-buffer)
-	       (insert-file-contents pid-file)
-	       (setq pid (int-to-string (string-to-int (buffer-string))))
-	       (erase-buffer)
-	       (insert (if new-window "newwin" "goto") ?\n)
-	       (insert url ?\n)
-	       ;; newline convention used should be the local
-	       ;; one, whatever that is.
-	       (setq buffer-file-type nil)
-	       (if (fboundp 'set-buffer-file-coding-system)
-		   (set-buffer-file-coding-system
-		    (vm-line-ending-coding-system) nil))
-	       (write-region (point-min) (point-max)
-			     (concat "/tmp/Mosaic." pid)
-			     nil 0)
-	       (set-buffer-modified-p nil)
-	       (kill-buffer work-buffer)))
-	(cond ((or (null pid)
-		   (not (equal 0 (vm-run-command "kill" "-USR1" pid))))
-	       (setq new-mosaic t)))))
-  (if new-mosaic
-     (apply 'vm-run-background-command vm-mosaic-program
-	    (append vm-mosaic-program-switches (list url))))
-  (message "Sending URL to Mosaic... done"))
+  (vm-mouse-send-url-to-xxxx-mosaic 'mosaic url new-mosaic new-window))
+
+(defun vm-mouse-send-url-to-mmosaic (url &optional new-mosaic new-window)
+  (vm-mouse-send-url-to-xxxx-mosaic 'mmosaic url new-mosaic new-window))
+
+(defun vm-mouse-send-url-to-xxxx-mosaic (m-type url &optional
+					 new-mosaic new-window)
+  (let ((what (cond ((eq m-type 'mmosaic) "mMosaic")
+		    (t "Mosaic"))))
+    (message "Sending URL to %s..." what)
+    (if (null new-mosaic)
+	(let ((pid-file (cond ((eq m-type 'mmosaic)
+			       "~/.mMosaic/.mosaicpid")
+			      (t "~/.mosaicpid")))
+	      (work-buffer " *mosaic work*")
+	      (coding-system-for-read (vm-line-ending-coding-system))
+	      (coding-system-for-write (vm-line-ending-coding-system))
+	      pid)
+	  (cond ((file-exists-p pid-file)
+		 (set-buffer (get-buffer-create work-buffer))
+		 (setq selective-display nil)
+		 (erase-buffer)
+		 (insert-file-contents pid-file)
+		 (setq pid (int-to-string (string-to-int (buffer-string))))
+		 (erase-buffer)
+		 (insert (if new-window "newwin" "goto") ?\n)
+		 (insert url ?\n)
+		 ;; newline convention used should be the local
+		 ;; one, whatever that is.
+		 (setq buffer-file-type nil)
+		 (if (fboundp 'set-buffer-file-coding-system)
+		     (set-buffer-file-coding-system
+		      (vm-line-ending-coding-system) nil))
+		 (write-region (point-min) (point-max)
+			       (concat "/tmp/Mosaic." pid)
+			       nil 0)
+		 (set-buffer-modified-p nil)
+		 (kill-buffer work-buffer)))
+	  (cond ((or (null pid)
+		     (not (equal 0 (vm-run-command "kill" "-USR1" pid))))
+		 (setq new-mosaic t)))))
+    (if new-mosaic
+	(apply 'vm-run-background-command
+	       (cond ((eq m-type 'mmosaic) vm-mmosaic-program)
+		     (t vm-mosaic-program))
+	       (append (cond ((eq m-type 'mmosaic) vm-mmosaic-program-switches)
+			     (t vm-mosaic-program-switches))
+		       (list url))))
+    (message "Sending URL to %s... done" what)))
 
 (defun vm-mouse-send-url-to-mosaic-new-window (url)
   (vm-mouse-send-url-to-mosaic url nil t))
 	 (vm-emit-eom-blurb))))
 
 (defun vm-emit-eom-blurb ()
-  (if (vm-full-name-of (car vm-message-pointer))
-      (progn
-	(if (and (stringp vm-summary-uninteresting-senders)
-		 (string-match vm-summary-uninteresting-senders
-			       (vm-su-from (car vm-message-pointer))))
-	    (message "End of message %s to %s"
-		     (vm-number-of (car vm-message-pointer))
-		     (vm-su-to-names (car vm-message-pointer)))
-	  (message "End of message %s from %s"
-		   (vm-number-of (car vm-message-pointer))
-		   (vm-full-name-of (car vm-message-pointer)))))
-    (message "End of message %s"
-	     (vm-number-of (car vm-message-pointer)))))
+  (let ((vm-summary-uninteresting-senders-arrow ""))
+    (message (if (and (stringp vm-summary-uninteresting-senders)
+		      (string-match vm-summary-uninteresting-senders
+				    (vm-su-from (car vm-message-pointer))))
+		 "End of message %s to %s"
+	       "End of message %s from %s")
+	     (vm-number-of (car vm-message-pointer))
+	     (vm-summary-sprintf "%F" (car vm-message-pointer)))))
 
 (defun vm-scroll-backward (&optional arg)
   "Scroll backward a screenful of text.
 		  (define-key keymap "\r"
 		    (function (lambda () (interactive)
 				(vm-mouse-send-url-at-position (point)))))
+		  (set-extent-property e 'vm-button t)
 		  (set-extent-property e 'keymap keymap)
 		  (set-extent-property e 'balloon-help 'vm-url-help)
 		  (set-extent-property e 'highlight t))))
 			     (looking-at "mailto:"))
 			   'vm-menu-popup-mailto-url-browser-menu
 			 'vm-menu-popup-url-browser-menu)))
+		  (overlay-put o 'vm-button t)
 		  (overlay-put o 'mouse-face 'highlight)
 		  (setq keymap (nconc keymap (current-local-map)))
 		  (if vm-popup-menu-on-mouse-3
 	    vm-auto-decode-mime-messages
 	    vm-mime-decode-for-preview
 	    vm-preview-lines
-	    (not (equal vm-preview-lines 0))
 	    (if vm-mail-buffer
 		(not (vm-buffer-variable-value vm-mail-buffer
 					       'vm-mime-decoded))
 				 'overlay-start)))
 	(next-extent-change (if vm-xemacs-p
 				(if next
-				    'next-etent-change
+				    'next-extent-change
 				  'previous-extent-change)
 			      (if next
 				  'next-overlay-change
 				'previous-overlay-change)))
 	e)
-    (setq e (or (vm-extent-at (point) nil 'keymap)
-		(vm-extent-at (point) nil 'local-map)))
-    (and e (goto-char (funcall extent-end-position e)))
     (while (and (> count 0) (not (funcall endp)))
       (goto-char (funcall next-extent-change (+ (point) (if next 0 -1))))
       (setq e (vm-extent-at (point)))
       (if e
-	  (if (or (vm-extent-property e 'keymap)
-		  (vm-extent-property e 'local-map))
-	      (vm-decrement count)
-	    (goto-char (funcall extent-end-position e)))
-	(goto-char old-point)
-	(error "No more buttons")))
-    (and e (goto-char (vm-extent-start-position e)))))
+	  (progn
+	    (if (vm-extent-property e 'vm-button)
+		(vm-decrement count))
+	    (goto-char (funcall extent-end-position e)))))
+    (if e
+	(goto-char (vm-extent-start-position e))
+      (goto-char old-point)
+      (error "No more buttons"))))
 			 (find-file-name-handler source)))))
 	(retrieved vm-pop-retrieved-messages)
 	(popdrop (vm-popdrop-sans-password source))
+	(count 0)
 	x response)
     (unwind-protect
 	(save-excursion
 	      (if (null (car response))
 		  ;; (nil . nil) is returned if there are no
 		  ;; messages in the mailbox.
-		  (throw 'done nil)
+		  (progn
+		    (vm-store-folder-totals source '(0 0 0 0))
+		    (throw 'done nil))
 		(while response
 		  (if (not (and (setq x (assoc (cdr (car response)) retrieved))
 				(equal (nth 1 x) popdrop)
 				(eq (nth 2 x) 'uidl)))
-		      (throw 'done t))
+		      (vm-increment count))
 		  (setq response (cdr response))))
-	      ;; all messages in the mailbox have already been retrieved
-	      (throw 'done nil))
+	      (vm-store-folder-totals source (list count 0 0 0))
+	      (throw 'done (not (eq count 0))))
 	    (vm-pop-send-command process "STAT")
 	    (setq response (vm-pop-read-stat-response process))
 	    (if (null response)
 		nil
+	      (vm-store-folder-totals source (list (car response) 0 0 0))
 	      (not (equal 0 (car response))))))
-      (and process (vm-pop-end-session process)))))
+      (and process (vm-pop-end-session process nil vm-pop-ok-to-ask)))))
 
 (defun vm-expunge-pop-messages ()
   "Deletes all messages from POP mailbox that have already been retrieved
 	(source nil)
 	(trouble nil)
 	(delete-count 0)
-	(vm-block-new-mail t)
+	(vm-global-block-new-mail t)
 	(vm-pop-ok-to-ask t)
 	popdrop uidl-alist data mp match)
     (unwind-protect
       (if process-to-shutdown
 	  (vm-pop-end-session process-to-shutdown t)))))
 
-(defun vm-pop-end-session (process &optional keep-buffer)
+(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.
-    (vm-pop-read-response process)
+    ;; 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))
       (save-excursion
 	    (append-to-buffer b (vm-headers-of message)
 			      (vm-text-end-of message))
 	    (setq end (vm-marker (+ start (- (vm-text-end-of message)
-					     (vm-headers-of message))) b)))))
+					     (vm-headers-of message))) b))
+	    (if vm-display-using-mime
+		(progn
+		  (narrow-to-region start end)
+		  (vm-decode-mime-encoded-words))))))
       ;; get rid of read-only text properties on the text, as
       ;; they will only cause trouble.
       (let ((inhibit-read-only t))
 			(point)
 			(point-max))
 		       "\n")
-	       (insert "Content-Description: forwarded message\n"))
+	       (insert "Content-Description: forwarded message\n")
+	       ;; eight bit chars will get \201 prepended if we
+	       ;; don't do this.
+	       (if vm-fsfemacs-mule-p
+		   (set-buffer-multibyte t)))
 	      ((equal vm-forwarding-digest-type "rfc934")
 	       (vm-rfc934-encapsulate-messages
 		vm-forward-list vm-forwarded-headers
 
 (defun vm-mail-to-mailto-url (url)
   (let ((address (car (vm-parse url "^mailto:\\(.+\\)"))))
-    (setq address (vm-url-decode address))
+    (setq address (vm-url-decode-string address))
     (vm-select-folder-buffer)
     (vm-check-for-killed-summary)
     (vm-mail-internal nil address)
     ;; then disable threading and make sure the whole summary is
     ;; regenerated (to recalculate %I everywhere).
     (if (and vm-summary-show-threads
-	     (not (equal key-funcs '(vm-sort-compare-thread)))
+	     (not (equal key-funcs '(vm-sort-compare-thread))))
 	(progn
 	  (setq vm-summary-show-threads nil)
-	  (vm-set-summary-redo-start-point t))))
+	  (vm-set-summary-redo-start-point t)))
     (message "Sorting...")
     (let ((vm-key-functions (nreverse key-funcs)))
       (setq new-message-list (sort (copy-sequence old-message-list)
 	    (buffer-disable-undo (current-buffer))
 	    (abbrev-mode 0)
 	    (auto-fill-mode 0)
-	    ;; This needs to be here for two reasons:
-	    ;; 1. The summary and folder buffers must agree on
-	    ;;    the width of 8-bit chars (4 vs. 1) because
-	    ;;    string-width is used in the summary formatting
-	    ;;    routines at a time when the folder buffer is
-	    ;;    the current buffer.
-	    ;; 2. If an 8-bit message arrives undeclared the 8-bit
-	    ;;    characters in it should be displayed using the
-	    ;;    user's default face charset, rather than as
-	    ;;    octal escapes.
+	    ;; If an 8-bit message arrives undeclared the 8-bit
+	    ;; characters in it should be displayed using the
+	    ;; user's default face charset, rather than as octal
+	    ;; escapes.
 	    (vm-fsfemacs-nonmule-display-8bit-chars)
 	    (vm-mode-internal)
 	    ;; If the buffer is modified we don't know if the
 	    (if (not (buffer-modified-p))
 		(setq did-read-index-file (vm-read-index-file-maybe)))))
 
-      (vm-assimilate-new-messages nil (not did-read-index-file) nil)
+      ;; builds message list, reads attributes if they weren't
+      ;; read from an index file.
+      (vm-assimilate-new-messages nil (not did-read-index-file) nil t)
 
       (if (and first-time (not did-read-index-file))
 	  (progn
 (defun vm-mode (&optional read-only)
   "Major mode for reading mail.
 
-This is VM 6.85.
+This is VM 6.89.
 
 Commands:
    h - summarize folder contents
+   H - summarize contents of all folders
  C-t - toggle threads display
 
    n - go to next message
    > - go to end of current message
    [ - go to previous button
    ] - go to next button
+   D - decode MIME if not already decoded.  If already decoded,
+       display all MIME objects as tags.  If already displaying
+       tags, show raw unecoded MIME>
 
    d - delete message, prefix arg deletes messages forward
  C-d - delete message, prefix arg deletes messages backward
        M R - mark messages within the point/mark region in the summary
        M r - unmark messages within the point/mark region in the summary
        M V - toggle the marked-ness of all messages
-
+       M X - apply the selectors of a named virtual folder to the
+             messages in the current folder and mark all messages
+             that match those selectors.
+       M x - apply the selectors of a named virtual folder to the
+             messages in the current folder and unmark all messages
+             that match those selectors.
        M ? - partial help for mark commands
 
  W S - save the current window configuration to a name
  l a - add labels to message
  l d - delete labels from message
 
-  $ - prefix for MIME commands.  Position the cursor over a MIME
-      tag and use these keystrokes to operate on a MIME object.
+   $ - prefix for MIME commands.  Position the cursor over a MIME
+       tag and use these keystrokes to operate on a MIME object.
 
-      $ s - save the MIME object
-      $ p - print the MIME object
-      $ | - pipe the MIME object to a shell command.
-      $ RET - display the MIME object's text using the \"default\" face.
-      $ e - display the MIME object with an external viewer.
-      $ d - delete the MIME object from the message.
+       $ s - save the MIME object
+       $ p - print the MIME object
+       $ | - pipe the MIME object to a shell command.
+       $ RET - display the MIME object's text using the \"default\" face.
+       $ e - display the MIME object with an external viewer.
+       $ d - delete the MIME object from the message.
 
    L - reload your VM init file, ~/.vm
 
 	(vm-search-other-frames nil))
     (vm-mail to)))
 
+(fset 'vm-folders-summary-mode 'vm-mode)
+(put 'vm-folders-summary-mode 'mode-class 'special)
+
+;;;###autoload
+(defun vm-folders-summarize (&optional display raise)
+  "Generate a summary of the folders in your folder directories.
+Set `vm-folders-summary-directories' to specify the folder directories.
+Press RETURN or click mouse button 2 on an entry in the folders
+summary buffer to select a folder."
+  (interactive "p\np")
+  (vm-session-initialization)
+  (vm-check-for-killed-summary)
+  (if (not (featurep 'berkeley-db))
+      (error "Berkeley DB support needed to run this command"))
+  (if (null vm-folders-summary-database)
+      (error "'vm-folders-summary-database' must be non-nil to run this command"))
+  (if (null vm-folders-summary-buffer)
+      (let ((folder-buffer (and (eq major-mode 'vm-mode)
+				(current-buffer))))
+	(setq vm-folders-summary-buffer
+	      (let ((default-enable-multibyte-characters t))
+		(get-buffer-create "VM Folders Summary")))
+	(save-excursion
+	  (set-buffer vm-folders-summary-buffer)
+	  (abbrev-mode 0)
+	  (auto-fill-mode 0)
+	  (vm-fsfemacs-nonmule-display-8bit-chars)
+	  (if (fboundp 'buffer-disable-undo)
+	      (buffer-disable-undo (current-buffer))
+	    ;; obfuscation to make the v19 compiler not whine
+	    ;; about obsolete functions.
+	    (let ((x 'buffer-flush-undo))
+	      (funcall x (current-buffer))))
+	  (vm-folders-summary-mode-internal))
+	(vm-make-folders-summary-associative-hashes)
+	(vm-do-folders-summary)))
+  ;; if this command was run from a VM related buffer, select
+  ;; the folder buffer in the folders summary, but only if that
+  ;; folder has an entry there.
+  (and vm-mail-buffer
+       (vm-check-for-killed-folder))
+  (save-excursion
+    (and vm-mail-buffer
+	 (vm-select-folder-buffer))
+    (vm-check-for-killed-summary)
+    (let ((folder-buffer (and (eq major-mode 'vm-mode)
+			      (current-buffer)))
+	  fs )
+      (if (or (null vm-folders-summary-hash) (null folder-buffer)
+	      (null buffer-file-name))
+	  nil
+	(setq fs (symbol-value (intern-soft (vm-make-folders-summary-key
+					     buffer-file-name)
+					    vm-folders-summary-hash)))
+	(if (null fs)
+	    nil
+	  (vm-mark-for-folders-summary-update buffer-file-name)
+	  (set-buffer vm-folders-summary-buffer)
+	  (setq vm-mail-buffer folder-buffer)))))
+  (if display
+      (save-excursion
+	(vm-goto-new-folders-summary-frame-maybe)
+	(vm-display vm-folders-summary-buffer t
+		    '(vm-folders-summarize)
+		    (list this-command) (not raise))
+	;; need to do this after any frame creation because the
+	;; toolbar sets frame-specific height and width specifiers.
+	(set-buffer vm-folders-summary-buffer)
+	(and (vm-toolbar-support-possible-p) vm-use-toolbar
+	     (vm-toolbar-install-toolbar)))
+    (vm-display nil nil '(vm-folders-summarize)
+		(list this-command)))
+  (vm-update-summary-and-mode-line))
+
 ;;;###autoload
 (defun vm-submit-bug-report ()
   "Submit a bug report, with pertinent information to the VM bug list."
 ;;; Summary gathering and formatting routines for VM
-;;; Copyright (C) 1989-1995 Kyle E. Jones
+;;; Copyright (C) 1989-1995, 2000 Kyle E. Jones
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
 (defun vm-set-fs-short-folder-of (fs x) (aset fs 9 x))
 (defun vm-set-fs-modflag-of (fs x) (aset fs 10 x))
 
+(defun vm-fs-spooled (fs)
+  (let ((count 0)
+	(list (symbol-value
+	       (intern-soft (vm-fs-folder-key-of fs)
+			    vm-folders-summary-folder-hash))))
+    (while list
+      (setq count (+ count (car (vm-get-folder-totals (car list))))
+	    list (cdr list)))
+    (int-to-string count)))
+
 (defun vm-make-folders-summary-key (folder &optional dir)
-  (concat "folder-summary0:"
-	  (file-truename (expand-file-name folder
-					   (or dir vm-folder-directory)))))
+  (cond ((and (stringp vm-recognize-pop-maildrops)
+	      (string-match vm-recognize-pop-maildrops folder))
+	 (vm-safe-popdrop-string folder))
+	((and (stringp vm-recognize-imap-maildrops)
+	      (string-match vm-recognize-imap-maildrops folder))
+	 (vm-safe-imapdrop-string folder))
+	(t
+	 (concat "folder-summary0:"
+		 (file-truename
+		  (expand-file-name folder (or dir vm-folder-directory)))))))
 
 (defun vm-open-folders-summary-database (mode)
   (condition-case data
 	   (sleep-for 2)
 	   nil )))
 
+(defun vm-get-folder-totals (folder)
+  (let ((default "(0 0 0 0)") fs db key data)
+    (catch 'done
+      (if (null vm-folders-summary-database)
+	  (throw 'done (read default)))
+      (if (not (featurep 'berkeley-db))
+	  (throw 'done (read default)))
+      (if (null (setq db (vm-open-folders-summary-database "rw+")))
+	  (throw 'done (read default)))
+      (setq key (vm-make-folders-summary-key folder)
+	    data (read (get-database key db default)))
+      (close-database db)
+      data )))
+
 (defun vm-store-folder-totals (folder totals)
   (let (fs db key data)
     (catch 'done
 	       ;; messages are never saved with the deleted flag
 	       ;; set no need to check that.
 	       (setq c (cdr totals))
-	       (if (vm-new-flag m)
-		   (setcar c (+ (car c) arrived)))
-	       (setq c (cdr totals))
-	       (if (vm-unread-flag m)
-		   (setcar c (+ (car c) arrived))))))
+	       (if (eq (car c) -1)
+		   nil
+		 (if (vm-new-flag m)
+		     (setcar c (+ (car c) arrived))))
+	       (setq c (cdr c))
+	       (if (eq (car c) -1)
+		   nil
+		 (if (vm-unread-flag m)
+		     (setcar c (+ (car c) arrived)))))))
       (setq data (prin1-to-string totals))
       (if (null (setq db (vm-open-folders-summary-database "rw+")))
 	  (throw 'done nil))
       (while
 	  (and (not done)
 	       (string-match
-		"%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()dfntu%]\\)"
+		"%\\(-\\)?\\([0-9]+\\)?\\(\\.\\(-?[0-9]+\\)\\)?\\([()dfnstu%]\\)"
 		format last-match-end))
 	(setq conv-spec (aref format (match-beginning 5)))
 	(setq new-match-end (match-end 0))
-	(if (memq conv-spec '(?\( ?d ?f ?n ?t ?u))
+	(if (memq conv-spec '(?\( ?d ?f ?n ?s ?t ?u))
 	    (progn
 	      (cond ((= conv-spec ?\()
 		     (save-match-data
 		    ((= conv-spec ?t)
 		     (setq sexp (cons (list 'vm-fs-total-count-of
 					    'vm-folder-summary) sexp)))
+		    ((= conv-spec ?s)
+		     (setq sexp (cons (list 'vm-fs-spooled
+					    'vm-folder-summary) sexp)))
 		    ((= conv-spec ?u)
 		     (setq sexp (cons (list 'vm-fs-unread-count-of
 					    'vm-folder-summary) sexp))))
   (and (vm-menu-support-possible-p)
        (vm-menu-install-menus))
   (if (and vm-mutable-frames vm-frame-per-folders-summary)
-      (vm-set-hooks-for-frame-deletion)))
-
-(fset 'vm-folders-summary-mode 'vm-mode)
-(put 'vm-folders-summary-mode 'mode-class 'special)
-
-(defun vm-folders-summarize (&optional display raise)
-  "Generate a summary of the folders in your folder directories.
-Set `vm-folders-summary-directories' to specify the folder directories.
-Press RETURN or click mouse button 2 on an entry in the folders
-summary buffer to select a folder."
-  (interactive "p\np")
-  (vm-session-initialization)
-  (vm-select-folder-buffer)
-  (vm-check-for-killed-summary)
-  (if (not (featurep 'berkeley-db))
-      (error "Berkeley DB support needed to run this command"))
-  (if (null vm-folders-summary-database)
-      (error "'vm-folders-summary-database' must be non-nil to run this command"))
-  (if (null vm-folders-summary-buffer)
-      (let ((buffer-read-only nil)
-	    (folder-buffer (and (eq major-mode 'vm-mode)
-				(current-buffer))))
-	(setq vm-folders-summary-buffer
-	      (let ((default-enable-multibyte-characters t))
-		(get-buffer-create "VM Folders Summary")))
-	(save-excursion
-	  (set-buffer vm-folders-summary-buffer)
-	  (abbrev-mode 0)
-	  (auto-fill-mode 0)
-	  (vm-fsfemacs-nonmule-display-8bit-chars)
-	  (if (fboundp 'buffer-disable-undo)
-	      (buffer-disable-undo (current-buffer))
-	    ;; obfuscation to make the v19 compiler not whine
-	    ;; about obsolete functions.
-	    (let ((x 'buffer-flush-undo))
-	      (funcall x (current-buffer))))
-	  (setq vm-mail-buffer folder-buffer)
-	  (vm-folders-summary-mode-internal))
-	(vm-do-folders-summary)))
-  (if display
-      (save-excursion
-	(vm-goto-new-folders-summary-frame-maybe)
-	(vm-display vm-folders-summary-buffer t
-		    '(vm-folders-summarize)
-		    (list this-command) (not raise))
-	;; need to do this after any frame creation because the
-	;; toolbar sets frame-specific height and width specifiers.
-	(set-buffer vm-folders-summary-buffer)
-	(and (vm-toolbar-support-possible-p) vm-use-toolbar
-	     (vm-toolbar-install-toolbar)))
-    (vm-display nil nil '(vm-folders-summarize)
-		(list this-command)))
-  (vm-update-summary-and-mode-line))
+      (vm-set-hooks-for-frame-deletion))
+  (run-hooks 'vm-folders-summary-mode-hook))
 
 (defun vm-do-folders-summary ()
   (catch 'done
 	    (setq fp (sort (vm-delete-backup-file-names
 			    (vm-delete-auto-save-file-names
 			     (vm-delete-index-file-names
-			      (directory-files (car dp)))))
+			      (vm-delete-directory-names
+			       (directory-files (car dp))))))
 			   (function string-lessp)))
 	    (while fp
 	      (setq f (car fp)
 		    key (vm-make-folders-summary-key f (car dp))
 		    totals (get-database key db))
 	      (if (null totals)
+		  (let ((ff (expand-file-name f (car dp))))
+		    (setq totals (list (or (vm-count-messages-in-file ff) -1)
+				       -1 -1 -1))
+		    (if (eq (car totals) -1)
+			nil
+		      (vm-store-folder-totals ff totals)))
+		(setq totals (read totals)))
+	      (if (eq (car totals) -1)
 		  nil
-		(setq totals (read totals))
 		(setq fs (vm-make-folder-summary))
 		(vm-set-fs-folder-of fs (expand-file-name f (car dp)))
 		(vm-set-fs-short-folder-of fs f)
-		(vm-set-fs-total-count-of fs (int-to-string (car totals)))
-		(vm-set-fs-new-count-of fs (int-to-string (nth 1 totals)))
-		(vm-set-fs-unread-count-of fs (int-to-string (nth 2 totals)))
-		(vm-set-fs-deleted-count-of fs (int-to-string (nth 3 totals)))
+		(vm-set-fs-total-count-of fs (vm-nonneg-string (car totals)))
+		(vm-set-fs-new-count-of fs (vm-nonneg-string (nth 1 totals)))
+		(vm-set-fs-unread-count-of fs (vm-nonneg-string
+					       (nth 2 totals)))
+		(vm-set-fs-deleted-count-of fs (vm-nonneg-string
+						(nth 3 totals)))
 		(vm-set-fs-folder-key-of fs key)
 		(vm-set-fs-start-of fs (vm-marker (point)))
 		(insert (vm-folders-summary-sprintf format fs))
 	     (vm-set-extent-endpoints vm-folders-summary-overlay 1 1))
 	(setq vm-mail-buffer nil))
     (let ((ooo vm-folders-summary-overlay)
-	  (fs (symbol-value (intern (vm-make-folders-summary-key
-				     (buffer-file-name vm-mail-buffer))
-				    vm-folders-summary-hash))))
+	  (fs (symbol-value (intern-soft (vm-make-folders-summary-key
+					  (buffer-file-name vm-mail-buffer))
+					 vm-folders-summary-hash))))
       (if (and fs
 	       (or (null ooo)
 		   (null (vm-extent-object ooo))
 	 (function
 	  (lambda (sym)
 	    (let ((fs (symbol-value sym)))
-	      (vm-update-folders-summary-entry fs)
-	      (vm-set-fs-modflag-of fs nil))))
+	      (if (null (vm-fs-modflag-of fs))
+		  nil
+		(vm-update-folders-summary-entry fs)
+		(vm-set-fs-modflag-of fs nil)))))
 	  vm-folders-summary-hash)
 	(vm-update-folders-summary-highlight)
 	(setq vm-flushed-modification-counter vm-modification-counter)))))
 
-(defun vm-mark-for-folders-summary-update (folder)
+(defun vm-mark-for-folders-summary-update (folder &optional dont-descend)
   (let ((key (vm-make-folders-summary-key folder))
 	(hash vm-folders-summary-hash)
-	fs )
+	(spool-hash vm-folders-summary-spool-hash)
+	list fs )
     (setq fs (symbol-value (intern-soft key hash)))
     (if (not fs)
 	nil
       (vm-set-fs-modflag-of fs t)
+      (vm-check-for-killed-summary)
       (if vm-folders-summary-buffer
 	  (save-excursion
 	    (set-buffer vm-folders-summary-buffer)
-	    (vm-increment vm-modification-counter))))))
+	    (vm-increment vm-modification-counter))))
+    (if dont-descend
+	nil
+      (setq list (symbol-value (intern-soft key spool-hash)))
+      (while list
+	(vm-mark-for-folders-summary-update (car list) t)
+	(setq list (cdr list))))))
+
+(defun vm-make-folders-summary-associative-hashes ()
+  (let ((triples (vm-compute-spool-files t))
+	(spool-hash (make-vector 61 0))
+	(folder-hash (make-vector 61 0))
+	s-list f-list folder-key spool-key)
+    (while triples
+      (setq folder-key (vm-make-folders-summary-key (car (car triples)))
+	    spool-key (vm-make-folders-summary-key (nth 1 (car triples)))
+	    s-list (symbol-value (intern-soft spool-key spool-hash))
+	    s-list (cons (car (car triples)) s-list)
+	    f-list (symbol-value (intern-soft folder-key folder-hash))
+	    f-list (cons (nth 1 (car triples)) f-list)
+	    triples (cdr triples))
+      (set (intern spool-key spool-hash) s-list)
+      (set (intern folder-key folder-hash) f-list))
+    (setq vm-folders-summary-spool-hash spool-hash)
+    (setq vm-folders-summary-folder-hash folder-hash)))
 
 (defun vm-follow-folders-summary-cursor ()
   (if (or (not (eq major-mode 'vm-folders-summary-mode))
 ;;; Toolbar related functions and commands
-;;; Copyright (C) 1995-1997 Kyle E. Jones
+;;; Copyright (C) 1995-1997, 2000 Kyle E. Jones
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
    (vm-toolbar-can-help-p)
    "Don't Panic.\n
 VM uses this button to offer help if you're in trouble.
-Under normal circumstances, this button runs `vm-help'.\n
+Under normal circumstances, this button runs `vm-help'.
 If the current folder looks out-of-date relative to its auto-save
-file then this button will run `recover-file'."])
+file then this button will run `recover-file'
+If there is mail waiting in one of the spool files associated
+with the current folder, this button will run `vm-get-new-mail'.
+If the current message needs to be MIME decoded then this button
+will run 'vm-decode-mime-message'."])
 
 (defvar vm-toolbar-helper-command nil)
 (make-variable-buffer-local 'vm-toolbar-helper-command)
 
 (defun vm-toolbar-install-toolbar ()
   (if vm-fsfemacs-p
-      (vm-toolbar-fsfemacs-install-toolbar)
+      (if (not vm-fsfemacs-toolbar-installed-p)
+	  (vm-toolbar-fsfemacs-install-toolbar))
     (if (not (and (stringp vm-toolbar-pixmap-directory)
 		  (file-directory-p vm-toolbar-pixmap-directory)))
 	(progn
 (defun vm-toolbar-fsfemacs-install-toolbar ()
   (let ((button-list (reverse vm-use-toolbar))
 	(dir vm-toolbar-pixmap-directory)
-	(extension (if (image-type-available-p 'xpm) "xpm" "xbm"))
+	(extension (if (and (display-color-p)
+			    (image-type-available-p 'xpm))
+		       "xpm"
+		     "xbm"))
 	item t-spec sym name images)
     (defvar tool-bar-map)
     ;; hide the toolbar entries that are in the global keymap so
 	    ((memq sym '(autofile compose file getmail
 			 mime next previous print quit reply visit))
 	     (setq t-spec (symbol-value
-			   (intern (format "vm-toolbar-%s-button" sym))))
-	     (if (eq sym 'mime)
+			   (intern (format "vm-toolbar-%s-button"
+					   (if (eq sym 'mime)
+					       'decode-mime
+					     sym)))))
+	     (if (and (eq sym 'mime) (string= extension "xpm"))
 		 (setq name "mime-colorful")
 	       (setq name (symbol-name sym)))
 	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
 			 ':button '(:toggle nil)
 			 ':image images))
 	     (define-key vm-mode-map (vector 'tool-bar 'help-getmail) item)
-	     (setq name "mime-colorful")
+	     (if (string= extension "xpm")
+		 (setq name "mime-colorful")
+	       (setq name "mime"))
 	     (setq images (vm-toolbar-make-fsfemacs-toolbar-image-spec
 			   name extension dir))
 	     (setq item
 			 ':button '(:toggle nil)
 			 ':image images))
 	     (define-key vm-mode-map (vector 'tool-bar 'help-mime) item)))
-      (setq button-list (cdr button-list)))))
+      (setq button-list (cdr button-list))))
+  (setq vm-fsfemacs-toolbar-installed-p t))
 
 (defun vm-toolbar-make-fsfemacs-toolbar-image-spec (name extension dir)
   (if (string= extension "xpm")
       (vector
        (list 'image
 	     ':type (intern extension)
+	     ':mask 'heuristic
 	     ':file (expand-file-name
 		     (format "%s-dn.%s"
 			     name extension)
 		     dir))
        (list 'image
 	     ':type (intern extension)
+	     ':mask 'heuristic
 	     ':file (expand-file-name
 		     (format "%s-up.%s"
 			     name extension)
 		     dir))
        (list 'image
 	     ':type (intern extension)
+	     ':mask 'heuristic
 	     ':file (expand-file-name
 		     (format "%s-dn.%s"
 			     name extension)
 		     dir))
        (list 'image
 	     ':type (intern extension)
+	     ':mask 'heuristic
 	     ':file (expand-file-name
 		     (format "%s-dn.%s"
 			     name extension)
     (vector
      (list 'image
 	   ':type (intern extension)
+	   ':mask 'heuristic
 	   ':file (expand-file-name
 		   (format "%s-dn.%s"
 			   name extension)
 		   dir))
      (list 'image
 	   ':type (intern extension)
+	   ':mask 'heuristic
 	   ':file (expand-file-name
 		   (format "%s-up.%s"
 			   name extension)
 		   dir))
      (list 'image
 	   ':type (intern extension)
+	   ':mask 'heuristic
 	   ':file (expand-file-name
 		   (format "%s-xx.%s"
 			   name extension)
 		   dir))
      (list 'image
 	   ':type (intern extension)
+	   ':mask 'heuristic
 	   ':file (expand-file-name
 		   (format "%s-xx.%s"
 			   name extension)
-;;; Commands to undo message attribute changes in VM.
+;;; Commands to undo message attribute changes in VM
 ;;; Copyright (C) 1989-1995 Kyle E. Jones
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 names are compared case-insensitively.
 
 A numeric prefix argument COUNT causes the current message and
-the next COUNT-1 message to have the labels added.  A
+the next COUNT-1 messages to have the labels added.  A
 negative COUNT arg causes the current message and the previous
 COUNT-1 messages to be altered.  COUNT defaults to one."
   (interactive
   (let ((m-list (vm-select-marked-or-prefixed-messages count))
 	(action-labels (vm-parse string
 "[\000-\040,\177-\377]*\\([^\000-\040,\177-\377]+\\)[\000-\040,\177-\377]*"))
+	(ignored-labels nil)
 	labels act-labels m mm-list)
     (if (and add m-list)
 	(if (eq add 'all)
 	    (setq act-labels action-labels)
 	    (while act-labels
 	      (if (intern-soft (car act-labels) vm-label-obarray)
-		  (setq newlist (cons (car act-labels) newlist)))
+		  (setq newlist (cons (car act-labels) newlist))
+		(setq ignored-labels (cons (car act-labels) ignored-labels)))
 	      (setq act-labels (cdr act-labels)))
 	    (setq action-labels newlist))))
+    (if (null action-labels)
+	(setq m-list nil))
     (while m-list
       (setq m (car m-list))
       (if (and add (vm-virtual-message-p m))
       (if add
 	  (setq labels (vm-delete-duplicates labels)))
       (vm-set-labels (car m-list) labels)
-      (setq m-list (cdr m-list))))
-  (vm-update-summary-and-mode-line))
+      (setq m-list (cdr m-list)))
+    (vm-update-summary-and-mode-line)
+    ignored-labels))
 
 (defun vm-set-xxxx-flag (m flag norecord function attr-index)
   (let ((m-list nil) vmp)
 
   ((MAILBOX . VAL) (MAILBOX . VAL) ...)
 
-MAILBOX should be a pop mailbox specification as described in
+MAILBOX should be a POP mailbox specification as described in
 the documentation for the variable `vm-spool-files'.  If you have
 the POP password specified in the `vm-spool-files' entry, you do
 not have to specify it here as well.  Use `*' instead; VM will
 
 VM can only support a non-nil setting of this variable if the
 remote POP server supports the UIDL command.  If the server does
-not support UIDL and you've asked VM leave messages on the server,
+not support UIDL and you've asked to VM leave messages on the server,
 VM will complain about the lack of UIDL support and not retrieve
 messages from the server.")
 
+(defvar vm-pop-read-quit-response t
+  "*Non-nil value tells VM to read the response to the POP QUIT command.
+Sometimes, for reasons unknown, the QUIT response never arrives
+from some POP servers and VM will hang waiting for it.  So it is
+useful to be able to tell VM not to wait.  Some other
+servers will not expunge messages unless the QUIT response is
+read, so for these servers you should set the variable's value to
+t.")
+
 (defvar vm-recognize-pop-maildrops "^[^:]+:[^:]+:[^:]+:[^:]+:[^:]+"
   "*Value if non-nil should be a regular expression that matches
 spool names found in `vm-spool-files' that should be considered POP
 
 Note that mail if new mail is found, it is not retrieved.  The
 buffer local variable `vm-spooled-mail-waiting' is set non-nil in
-the buffers of those folders that have mail waiting.  VM uses
-the displays \"Mail\" in the mode line of folders that have mail
+the buffers of those folders that have mail waiting.  VM
+displays \"Mail\" in the mode line of folders that have mail
 waiting.")
 
 (defvar vm-spooled-mail-waiting nil
   "*Name of Berkeley DB file used to store summary information about folders.
 This file is consulted to produce the folders summary.")
 
-(defvar vm-folders-summary-format "  %12f %4t total, %n new, %u unread\n"
-  "*String which specifies the folders summary format.
+(defvar vm-folders-summary-format
+      "  %12f %4t total, %n new, %u unread, %s spooled\n"
+  "*String that specifies the folders summary format.
 The string may contain the printf-like `%' conversion specifiers which
 substitute information about the folder into the final summary line.
 
 truncated.  If the value is negative, the string is truncated on
 the left instead of the right.
 
-The summary format need not be one line per message but it must end with
-a newline, otherwise the message pointer will not be displayed correctly
-in the summary window.")
+The summary format need not be one line per folder, but it should end with
+a newline.")
 
 (defvar vm-folders-summary-directories
       (list (or vm-folder-directory (file-name-directory vm-primary-inbox)))
 appear in the toolbar with a width of N pixels for top/bottom
 toolbars, and a height of N for left/right toolbars.
 
-This variable only has meaning under XEmacs 19.12 and beyond.
+This variable only has meaning under XEmacs 19.12 and beyond, and under
+Emacs 21 and beyond.
+
 See also `vm-toolbar-orientation' to control where the toolbar is placed.")
 
 (defvar vm-toolbar-orientation 'left
 Legal values are `left', `right' `top' and `bottom'.  Any other
 value will be interpreted as `top'.
 
-This variable only has meaning under XEmacs 19.12 and beyond.")
+This variable only has meaning under XEmacs 19.12 and beyond.
+Under FSF Emacs 21 the toolbar is always at the top of the frame.")