From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 19 Mar 2001 19:31:12 +0000 (+0000)
Subject: Generalize IMAIL-UI:PROGRESS-METER to be able to show progress when
X-Git-Tag: 20090517-FFI~2893
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=031934b3efe69b49becdc1028a9f961907d84f76;p=mit-scheme.git

Generalize IMAIL-UI:PROGRESS-METER to be able to show progress when
total number of items isn't known.  Memoize value computed by
COUNT-UNSEEN-MESSAGES, to speed up navigation in very large folders.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 40a305376..6426d9140 100644
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.233 2001/01/25 00:15:55 cph Exp $
+;;; $Id: imail-top.scm,v 1.234 2001/03/19 19:31:12 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -16,7 +16,8 @@
 ;;;
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with this program; if not, write to the Free Software
-;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;;; 02111-1307, USA.
 
 ;;;; IMAIL mail reader: top level
 
@@ -1666,14 +1667,19 @@ Negative argument means search in reverse."
 	  v)))))
 
 (define (imail-ui:progress-meter current total)
-  (if (and *imail-message-wrapper-prefix* (< 0 current total))
-      (message *imail-message-wrapper-prefix*
-	       (string-pad-left
-		(number->string (round->exact (* (/ current total) 100)))
-		3)
-	       "% (of "
-	       (number->string total)
-	       ")")))
+  (if (and *imail-message-wrapper-prefix* (< 0 current))
+      (if total
+	  (if (< current total)
+	      (message *imail-message-wrapper-prefix*
+		       (string-pad-left
+			(number->string
+			 (round->exact (* (/ current total) 100)))
+			3)
+		       "% (of "
+		       (number->string total)
+		       ")"))
+	  (message *imail-message-wrapper-prefix*
+		   (number->string current)))))
 
 (define *imail-message-wrapper-prefix* #f)
 
@@ -1976,15 +1982,26 @@ Negative argument means search in reverse."
 	  (buffer-modeline-event! buffer 'PROCESS-STATUS)))))
 
 (define (count-unseen-messages folder)
-  (let ((n (folder-length folder)))
-    (do ((i 0 (+ i 1))
-	 (unseen 0
-		 (if (let ((m (get-message folder i)))
-		       (or (message-seen? m)
-			   (message-deleted? m)))
-		     unseen
-		     (+ unseen 1))))
-	((= i n) unseen))))
+  (let ((count (get-property folder 'COUNT-UNSEEN-MESSAGES #f))
+	(mod-count (folder-modification-count folder)))
+    (if (and count (= (cdr count) mod-count))
+	(car count)
+	(let ((n (folder-length folder)))
+	  (do ((i 0 (+ i 1))
+	       (unseen 0
+		       (if (let loop
+			       ((flags (message-flags (get-message folder i))))
+			     (and (pair? flags)
+				  (or (string-ci=? "seen" (car flags))
+				      (string-ci=? "deleted" (car flags))
+				      (loop (cdr flags)))))
+			   unseen
+			   (+ unseen 1))))
+	      ((= i n)
+	       (store-property! folder
+				'COUNT-UNSEEN-MESSAGES
+				(cons unseen mod-count))
+	       unseen))))))
 
 ;;;; Probe-folder thread