From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 24 Jun 2000 01:39:16 +0000 (+0000)
Subject: Fix bug: when current message and subsequent messages simultaneously
X-Git-Tag: 20090517-FFI~3449
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=82e03f96aaa04e9e43fa6f55e816995ef8e2dbad;p=mit-scheme.git

Fix bug: when current message and subsequent messages simultaneously
deleted, was signalling an error, because the EXPUNGE responses were
being processed one at a time, and the local model of the folder was
out of sync with the server's model.  New strategy defers dealing with
all of these changes until all of the responses have been processed,
at which time both models are again synchronized.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index f087baf3b..30f28ff70 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.109 2000/06/23 17:58:28 cph Exp $
+;;; $Id: imail-core.scm,v 1.110 2000/06/24 01:37:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -282,15 +282,31 @@
   (apply folder-event folder type parameters))
 
 (define (folder-event folder type . parameters)
-  (if (and imap-trace-port (imap-folder? folder))
+  (if *deferred-folder-events*
+      (set-cdr! *deferred-folder-events*
+		(cons (cons* folder type parameters)
+		      (cdr *deferred-folder-events*)))
       (begin
-	(write-line (cons* 'FOLDER-EVENT folder type parameters)
-		    imap-trace-port)
-	(flush-output imap-trace-port)))
-  (event-distributor/invoke! (folder-modification-event folder)
-			     folder
-			     type
-			     parameters))
+	(if (and imap-trace-port (imap-folder? folder))
+	    (begin
+	      (write-line (cons* 'FOLDER-EVENT folder type parameters)
+			  imap-trace-port)
+	      (flush-output imap-trace-port)))
+	(event-distributor/invoke! (folder-modification-event folder)
+				   folder
+				   type
+				   parameters))))
+
+(define (with-folder-events-deferred thunk)
+  (let ((events (list 'EVENTS)))
+    (let ((v
+	   (fluid-let ((*deferred-folder-events* events))
+	     (thunk))))
+      (for-each (lambda (event) (apply folder-event event))
+		(reverse! (cdr events)))
+      v)))
+
+(define *deferred-folder-events* #f)
 
 (define (get-memoized-folder url)
   (let ((folder (hash-table/get memoized-folders url #f)))
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index b56133f3d..04536bdb5 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.125 2000/06/23 19:05:37 cph Exp $
+;;; $Id: imail-imap.scm,v 1.126 2000/06/24 01:37:56 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1485,12 +1485,14 @@
        thunk))))
 
 (define (process-responses connection command responses)
-  (if (pair? responses)
-      (if (process-response connection command (car responses))
-	  (cons (car responses)
-		(process-responses connection command (cdr responses)))
-	  (process-responses connection command (cdr responses)))
-      '()))
+  (with-folder-events-deferred
+    (lambda ()
+      (if (pair? responses)
+	  (if (process-response connection command (car responses))
+	      (cons (car responses)
+		    (process-responses connection command (cdr responses)))
+	      (process-responses connection command (cdr responses)))
+	  '()))))
 
 (define (process-response connection command response)
   (cond ((imap:response:status-response? response)
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index c3de8c82a..a3a1cdeae 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.187 2000/06/24 01:35:41 cph Exp $
+;;; $Id: imail-top.scm,v 1.188 2000/06/24 01:39:16 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1762,6 +1762,7 @@ Negative argument means search in reverse."
 ;;;; Folder-event handling
 
 (define (notice-folder-event folder type parameters)
+  type parameters
   (maybe-add-command-suffix! notice-folder-modifications folder))
 
 (define (notice-folder-modifications folder)