From: Taylor R. Campbell <net/mumble/campbell>
Date: Fri, 29 Aug 2008 20:14:50 +0000 (+0000)
Subject: Change EXPUNGE folder modification event so that it includes the
X-Git-Tag: 20090517-FFI~205
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ac5b1de3dfaa3e108e17742671ae4db55d953832;p=mit-scheme.git

Change EXPUNGE folder modification event so that it includes the
message object and its mapped index.  This is necessary to find
information about the message by identity, which will be needed by
future implementation of incremental updates to summary buffers.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 5365e30c3..b9d0cde71 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.172 2008/08/11 22:27:26 riastradh Exp $
+$Id: imail-core.scm,v 1.173 2008/08/29 20:14:50 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -886,10 +886,13 @@ USA.
 	     ((EXPUNGE)
 	      (let ((tree (folder-order-tree order)))
 		(if tree
-		    (let ((index (car arguments))
-			  (key (cadr arguments)))
+		    (let ((message (car arguments))
+			  (%index (cadr arguments))
+			  (index (caddr arguments))
+			  (key (cadddr arguments)))
+		      message index	;ignore
 		      (let ((cache (folder-order-cache order)))
-			(if cache (hash-table/remove! cache index)))
+			(if cache (hash-table/remove! cache %index)))
 		      (wt-tree/delete! tree key)))))))))))
 
 ;;;; Message flags
diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index d021ca3f4..26699be56 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.95 2008/07/03 20:08:09 cph Exp $
+$Id: imail-file.scm,v 1.96 2008/08/29 20:14:50 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,9 +349,11 @@ USA.
 		       (let ((m (vector-ref messages i)))
 			 (if (message-deleted? m)
 			     (begin
-			       (let ((key (message-order-key m)))
-                                 (detach-message! m)
-                                 (object-modified! folder 'EXPUNGE i* key))
+			       (let ((index (message-index m))
+                                     (key (message-order-key m)))
+				 (detach-message! m)
+				 (object-modified! folder 'EXPUNGE
+						   m i* index 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 7ce923e4b..a2f1cd81c 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.227 2008/08/27 14:22:09 riastradh Exp $
+$Id: imail-imap.scm,v 1.228 2008/08/29 20:14:50 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -899,27 +899,29 @@ USA.
 				   start #f '(UID FLAGS))))))
 
 (define (remove-imap-folder-message folder 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))))))
+  (let ((message (%get-message folder index)))
+    (let ((unmapped-index (message-index message))
+	  (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
+			     message index unmapped-index key)))))))
 
 (define (initial-messages)
   (make-vector 64 #f))