From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 23 Jun 2000 19:05:40 +0000 (+0000)
Subject: Fix bug: when IMAP mailbox simultaneously accessed from two places,
X-Git-Tag: 20090517-FFI~3454
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=04901efadb2f3090aae5bd324d61cb16cabacc3f;p=mit-scheme.git

Fix bug: when IMAP mailbox simultaneously accessed from two places,
IMAIL wouldn't correctly update the message buffer under a variety of
circumstances.  This turned out to be a confluence of several bugs in
the code.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 30c337a07..b56133f3d 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.124 2000/06/23 18:46:05 cph Exp $
+;;; $Id: imail-imap.scm,v 1.125 2000/06/23 19:05:37 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -664,7 +664,7 @@
 		     (lambda (interrupt-mask)
 		       interrupt-mask
 		       (read-message-headers! folder n)))
-		   (folder-modified! folder 'INCREASE-LENGTH))
+		   (folder-modified! folder 'INCREASE-LENGTH n count))
 		  ((= count n)
 		   (set-imap-folder-messages-synchronized?! folder #t))
 		  (else
@@ -710,7 +710,7 @@
 				     (imap-message-uid m*))
 				  (error "Message inserted into folder:" m*))
 			      (loop (fix:+ i 1) i*)))))))
-	      (folder-modified! folder 'SET-LENGTH)))))))
+	      (folder-modified! folder 'SET-LENGTH n count)))))))
 
 ;;;; Message datatype
 
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index b1e93a3ec..8be5f18db 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.184 2000/06/23 15:46:00 cph Exp $
+;;; $Id: imail-top.scm,v 1.185 2000/06/23 19:05:38 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1330,7 +1330,7 @@ A prefix argument says to prompt for a URL and append all messages
 		 => (lambda (unseen) (select-message folder unseen)))
 		((selected-message #f)
 		 (message "No unseen messages"))
-		((navigator/first-message folder)
+		((navigator/last-message folder)
 		 => (lambda (first) (select-message folder first)))
 		(else
 		 (message "No changes to mail folder")))))))
@@ -1684,16 +1684,9 @@ Negative argument means search in reverse."
 		       (let ((folder (selected-folder #f buffer)))
 			 (if (message-attached? message folder)
 			     message
-			     (let ((message
-				    (let ((index
-					   (and folder
-						(message-detached? message)
-						(message-index message))))
-				      (and index
-					   (< index (folder-length folder))
-					   (get-message folder index)))))
-			       (buffer-put! buffer 'IMAIL-MESSAGE message)
-			       message)))))))))
+			     (begin
+			       (buffer-put! buffer 'IMAIL-MESSAGE #f)
+			       #f)))))))))
       (and (if (default-object? error?) #t error?)
 	   (error "No selected IMAIL message."))))
 
@@ -1774,7 +1767,8 @@ Negative argument means search in reverse."
      (maybe-add-command-suffix! notice-message-expunge folder
 				(car parameters)))
     ((INCREASE-LENGTH SET-LENGTH)
-     (maybe-add-command-suffix! notice-message-expunge folder 0))
+     (maybe-add-command-suffix! notice-folder-length-change folder
+				(car parameters) (cadr parameters)))
     (else
      (maybe-add-command-suffix! notice-folder-modifications folder))))
 
@@ -1785,14 +1779,23 @@ Negative argument means search in reverse."
 	  (if (or (not m)
 		  (message-detached? m))
 	      (select-message folder
-			      (let ((length (folder-length folder)))
-				(and (> length 0)
-				     (if (< index length)
-					 index
-					 (- length 1))))
+			      (and index
+				   (< index (folder-length folder))
+				   index)
 			      #t)))))
   (notice-folder-modifications folder))
 
+(define (notice-folder-length-change folder old new)
+  (let ((buffer (imail-folder->buffer folder #f)))
+    (if buffer
+	(cond ((> new old)
+	       (select-message folder old #t))
+	      ((let ((m (selected-message #f buffer)))
+		 (or (not m)
+		     (message-detached? m)))
+	       (select-message folder #f #t)))))
+  (notice-folder-modifications folder))
+
 (define (notice-folder-modifications folder)
   (let ((buffer (imail-folder->buffer folder #f)))
     (if buffer
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index e138d96b3..c0f3ecfc3 100644
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,14 +1,9 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.94 2000/06/22 20:19:08 cph Exp $
+$Id: todo.txt,v 1.95 2000/06/23 19:05:40 cph Exp $
 
 Bug fixes
 ---------
 
-* If a folder has message N selected, the folder is simultaneously
-  opened somewhere else, one new message is added, and message N is
-  deleted, then the display is _not_ updated to reflect the new
-  message.
-
 * Preserve internal-date when copying to rmail folder from any other
   type of folder, by writing a distinguished header field into the
   rmail file.