From: Taylor R. Campbell <net/mumble/campbell>
Date: Sun, 11 Mar 2007 17:33:37 +0000 (+0000)
Subject: Don't record the folder's cached modification count in folder orders;
X-Git-Tag: 20090517-FFI~711
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=492d6946521731accbfa4625fe008754570ffc9b;p=mit-scheme.git

Don't record the folder's cached modification count in folder orders;
simply check that it has not changed since we built the tree.

New procedure MESSAGE-ORDER-KEY computes a message's key into the
folder order tree, if the message's folder is ordered.  This must be
computed before a message is actually expunged, because the key may
require information that is destroyed when expunging the message.
EXPUNGE modification events on folders now accept an extra parameter,
the key of the message being expunged.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 49dfec57a..e7269f887 100644
--- a/v7/src/imail/imail-core.scm
+++ b/v7/src/imail/imail-core.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: imail-core.scm,v 1.163 2007/03/11 15:49:44 riastradh Exp $
+$Id: imail-core.scm,v 1.164 2007/03/11 17:33:37 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -733,8 +733,7 @@ USA.
 		   (constructor make-folder-order (predicate selector)))
   (predicate #f read-only #t)
   (selector #f read-only #t)
-  (tree #f)
-  (modification-count -1))
+  (tree #f))
 
 (define (map-folder-index folder index)
   (let ((order (folder-order folder)))
@@ -766,17 +765,29 @@ USA.
       (or (key<? (car a) (car b))
           (and (not (key<? (car b) (car a)))
                (< (cdr a) (cdr b))))))))
+
+(define (message-order-key message)
+  (let ((folder (message-folder message)))
+    (if (not folder)
+        (error "Message has no ordering key:" message))
+    (let ((order (folder-order folder)))
+      (if (not order)
+          #f
+          (cons ((folder-order-selector order) message)
+                (%message-index message))))))
 
 (define (memoize-folder-order order folder)
-  (let loop ()
-    (let ((modification-count (folder-order-modification-count order)))
-      (if (not (= modification-count (object-modification-count folder)))
-          (begin
-            (set-folder-order-tree!
-             order
-             (build-folder-order-tree order folder))
-            (set-folder-order-modification-count! order modification-count)
-            (loop))))))
+  (let loop ((modification-count (object-modification-count folder)))
+    (if (not (folder-order-tree order))
+        (begin
+          (set-folder-order-tree!
+           order
+           (build-folder-order-tree order folder))
+          (let ((modification-count* (object-modification-count folder)))
+            (if (not (= modification-count modification-count*))
+                (begin
+                  (imail-ui:message "Folder changed; resorting")
+                  (loop modification-count*))))))))
 
 (define (build-folder-order-tree order folder)
   (preload-folder-outlines folder)
@@ -818,12 +829,8 @@ USA.
              ((EXPUNGE)
               (let ((tree (folder-order-tree order)))
                 (if tree
-                    (let ((index (car arguments))
-                          (selector (folder-order-selector order)))
-                      (wt-tree/delete!
-                       tree
-                       (cons (selector (%get-message folder index))
-                             index))))))))))))
+                    (let ((key (cadr arguments)))
+                      (wt-tree/delete! tree key)))))))))))
 
 ;;;; Message flags
 
diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 0dbbd4c35..7eaf86685 100644
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: imail-file.scm,v 1.89 2007/01/05 21:19:25 cph Exp $
+$Id: imail-file.scm,v 1.90 2007/03/11 17:33:37 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -349,8 +349,9 @@ USA.
 		       (let ((m (vector-ref messages i)))
 			 (if (message-deleted? m)
 			     (begin
-			       (detach-message! m)
-			       (object-modified! folder 'EXPUNGE i*)
+			       (let ((key (message-order-key m)))
+                                 (detach-message! m)
+                                 (object-modified! folder 'EXPUNGE i* key))
 			       (loop (fix:+ i 1) i*))
 			     (begin
 			       (set-message-index! m i*)
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 9dd229275..5602519cb 100644
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: imail-imap.scm,v 1.209 2007/03/10 17:35:57 riastradh Exp $
+$Id: imail-imap.scm,v 1.210 2007/03/11 17:33:37 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -869,25 +869,27 @@ USA.
 				   start #f '(UID FLAGS))))))
 
 (define (remove-imap-folder-message folder index)
-  (delete-cached-message (%get-message folder index))
-  (without-interrupts
-   (lambda ()
-     (let ((v (imap-folder-messages folder))
-	   (n (fix:- (folder-length folder) 1)))
-       (detach-message! (vector-ref v index))
-       (do ((i index (fix:+ i 1)))
-	   ((fix:= i n))
-	 (let ((m (vector-ref v (fix:+ i 1))))
-	   (set-message-index! m i)
-	   (vector-set! v i m)))
-       (vector-set! v n #f)
-       (set-imap-folder-length! folder n)
-       (set-imap-folder-unseen! folder #f)
-       (let ((new-length (compute-messages-length v n)))
-	 (if new-length
-	     (set-imap-folder-messages! folder
-					(vector-head v new-length))))
-       (object-modified! folder 'EXPUNGE index)))))
+  (let* ((message (%get-message folder index))
+         (key (message-order-key message)))
+    (delete-cached-message message)
+    (without-interrupts
+     (lambda ()
+       (let ((v (imap-folder-messages folder))
+             (n (fix:- (folder-length folder) 1)))
+         (detach-message! (vector-ref v index))
+         (do ((i index (fix:+ i 1)))
+             ((fix:= i n))
+           (let ((m (vector-ref v (fix:+ i 1))))
+             (set-message-index! m i)
+             (vector-set! v i m)))
+         (vector-set! v n #f)
+         (set-imap-folder-length! folder n)
+         (set-imap-folder-unseen! folder #f)
+         (let ((new-length (compute-messages-length v n)))
+           (if new-length
+               (set-imap-folder-messages! folder
+                                          (vector-head v new-length))))
+         (object-modified! folder 'EXPUNGE index key))))))
 
 (define (initial-messages)
   (make-vector 64 #f))