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 49dfec57a6a8e7958478125d5120cb4ec2c4a407..e7269f887c0c6c9a70ae171af5295bea9f67e6f3 100644 (file)
--- 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))))))
 \f
 (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)))))))))))
 \f
 ;;;; Message flags
 

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 0dbbd4c35b9eab202ac02944657c93ddd2b33339..7eaf8668551956f4b1d8e6af5a4a66499194f617 100644 (file)
--- 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 9dd2292751bc4566a8f14e985db549bf469ce3a3..5602519cb63abe0a0286ca0d35b716d1294fb621 100644 (file)
--- 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))))))
 \f
 (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))