--- a/lisp/vm/vm-pop.el	Mon Aug 13 08:51:58 2007 +0200
+++ b/lisp/vm/vm-pop.el	Mon Aug 13 08:52:29 2007 +0200
@@ -1,5 +1,5 @@
-;;; Simple POP (RFC 1460) client for VM
-;;; Copyright (C) 1993, 1994 Kyle E. Jones
+;;; Simple POP (RFC 1939) client for VM
+;;; Copyright (C) 1993, 1994, 1997 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
@@ -32,6 +32,7 @@
 			(wrong-number-of-arguments
 			  (find-file-name-handler source)))))
 	(popdrop (vm-safe-popdrop-string source))
+	(statblob nil)
 	mailbox-count mailbox-size message-size response
 	n retrieved retrieved-bytes process-buffer)
     (unwind-protect
@@ -58,17 +59,18 @@
 	    ;; loop through the maildrop retrieving and deleting
 	    ;; messages as we go.
 	    (setq n 1 retrieved 0 retrieved-bytes 0)
+	    (setq statblob (vm-pop-start-status-timer))
+	    (vm-set-pop-stat-x-box statblob popdrop)
+	    (vm-set-pop-stat-x-maxmsg statblob mailbox-count)
 	    (while (and (<= n mailbox-count)
 			(or (not (natnump m-per-session))
 			    (< retrieved m-per-session))
 			(or (not (natnump b-per-session))
 			    (< retrieved-bytes b-per-session)))
-	      (if (or vm-pop-max-message-size
-		      b-per-session)
-		  (progn
-		    (vm-pop-send-command process (format "LIST %d" n))
-		    (setq message-size
-			  (vm-pop-read-list-response process))))
+	      (vm-set-pop-stat-x-currmsg statblob n)
+	      (vm-pop-send-command process (format "LIST %d" n))
+	      (setq message-size (vm-pop-read-list-response process))
+	      (vm-set-pop-stat-x-need statblob message-size)
 	      (if (and (integerp vm-pop-max-message-size)
 		       (> message-size vm-pop-max-message-size)
 		       (progn
@@ -94,7 +96,8 @@
 		(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))
+		(and (null (vm-pop-retrieve-to-crashbox process destination
+							statblob))
 		     (throw 'done (not (equal retrieved 0))))
 		(vm-increment retrieved)
 		(and b-per-session
@@ -107,6 +110,7 @@
 		     (throw 'done (not (equal retrieved 0)))))
 	      (vm-increment n))
 	     (not (equal retrieved 0)) ))
+      (and statblob (vm-pop-stop-status-timer statblob))
       (if process
 	  (vm-pop-end-session process)))))
 
@@ -240,7 +244,7 @@
 			    (vm-pop-md5 (concat timestamp pass))))
 		   (and (null (vm-pop-read-response process))
 			(throw 'done nil)))
-		  (t (error "Don't know how to authenticate with %s" auth)))
+		  (t (error "Don't know how to authenticate using %s" auth)))
 	    (setq process-to-shutdown nil)
 	    process ))
       (if process-to-shutdown
@@ -255,6 +259,68 @@
 	(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-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-pop-start-status-timer ()
+  (let ((blob (make-vector 11 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 (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)
+  (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)
+	((not (eq (vm-pop-stat-x-currmsg o) (vm-pop-stat-y-currmsg o))) t)
+	(t (message "Retrieving message %d (of %d) from %s, %s..."
+		    (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))
+				" (stalled)"
+			      "")))))
+  (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))
+  (vm-set-pop-stat-y-got o (vm-pop-stat-x-got o))
+  (vm-set-pop-stat-y-need o (vm-pop-stat-x-need o)))
+
 (defun vm-pop-send-command (process command)
   (goto-char (point-max))
   (if (= (aref command 0) ?P)
@@ -283,7 +349,7 @@
 (defun vm-pop-read-past-dot-sentinel-line (process)
   (let ((case-fold-search nil))
     (goto-char vm-pop-read-point)
-    (while (not (search-forward "^.\r\n" nil 0))
+    (while (not (re-search-forward "^\\.\r\n" nil 0))
       (beginning-of-line)
       ;; save-excursion doesn't work right
       (let ((opoint (point)))
@@ -337,15 +403,26 @@
 		'skip))))
       (and work-buffer (kill-buffer work-buffer)))))
 
-(defun vm-pop-retrieve-to-crashbox (process crash)
+(defun vm-pop-retrieve-to-crashbox (process crash statblob)
   (let ((start vm-pop-read-point) end)
     (goto-char start)
+    (vm-set-pop-stat-x-got statblob 0)
     (while (not (re-search-forward "^\\.\r\n" nil 0))
       (beginning-of-line)
       ;; save-excursion doesn't work right
-      (let ((opoint (point)))
+      (let* ((opoint (point))
+	     (func
+	      (function
+	       (lambda (beg end len)
+		 (if vm-pop-read-point
+		     (progn
+		       (vm-set-pop-stat-x-got statblob (- end start))
+		       (if (zerop (% (random) 10))
+			   (vm-pop-report-retrieval-status statblob)))))))
+	     (after-change-functions (cons func after-change-functions)))
 	(accept-process-output process)
 	(goto-char opoint)))
+    (vm-set-pop-stat-x-got statblob nil)
     (setq vm-pop-read-point (point-marker))
     (goto-char (match-beginning 0))
     (setq end (point-marker))
@@ -389,6 +466,8 @@
     t ))
 
 (defun vm-pop-cleanup-region (start end)
+  (if (> (- end start) 30000)
+      (message "CRLF conversion and char unstuffing..."))
   (setq end (vm-marker end))
   (save-excursion
     (goto-char start)
@@ -400,6 +479,8 @@
     (while (and (< (point) end) (re-search-forward "^\\."  end t))
       (replace-match "" t t)
       (forward-char)))
+  (if (> (- end start) 30000)
+      (message "CRLF conversion and dot unstuffing... done"))
   (set-marker end nil))
 
 (defun vm-pop-md5 (string)