From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 8 May 2000 15:30:49 +0000 (+0000)
Subject: Change handling of FIRST-UNSEEN-MESSAGE; ignore IMAP's UNSEEN response
X-Git-Tag: 20090517-FFI~3918
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b78f40cb0aa53db929d95ec5575fb68b66dae9da;p=mit-scheme.git

Change handling of FIRST-UNSEEN-MESSAGE; ignore IMAP's UNSEEN response
as it is insufficiently constrained to be useful.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index a9aac0c9e..080a0dece 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.42 2000/05/08 14:59:06 cph Exp $
+;;; $Id: imail-core.scm,v 1.43 2000/05/08 15:30:45 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -405,15 +405,19 @@
 
 ;;;; Message Navigation
 
-(define-generic first-unseen-message (folder))
-(define-method first-unseen-message ((folder <folder>))
-  (let ((message (first-message folder)))
-    (and message
-	 (let loop ((message message))
-	   (let ((next (next-message message)))
-	     (cond ((not next) message)
-		   ((message-seen? next) (loop next))
-		   (else next)))))))
+(define (first-unseen-message folder)
+  (let ((end (folder-length folder)))
+    (and (> end 0)
+	 (let loop ((start (first-unseen-message-index folder)))
+	   (let ((message (get-message folder start)))
+	     (if (and (message-seen? message) (< (+ start 1) end))
+		 (loop (+ start 1))
+		 message))))))
+
+(define-generic first-unseen-message-index (folder))
+(define-method first-unseen-message-index ((folder <folder>))
+  folder
+  0)
 
 (define (first-message folder)
   (and (> (folder-length folder) 0)
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 29d6f04fe..b95cc48b2 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.20 2000/05/08 15:04:01 cph Exp $
+;;; $Id: imail-imap.scm,v 1.21 2000/05/08 15:30:49 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -395,11 +395,13 @@
   (guarantee-imap-folder-open folder)
   (vector-ref (imap-folder-messages folder) index))
 
-(define-method unseen-message ((folder <imap-folder>))
+#|
+;; There's no guarantee that UNSEEN is kept up to date by the server.
+;; So unless we want to manually update it, it's useless.
+(define-method first-unseen-message-index ((folder <imap-folder>))
   (guarantee-imap-folder-open folder)
-  (let ((unseen (imap-folder-unseen folder)))
-    (and unseen
-	 (get-message folder unseen))))
+  (or (imap-folder-unseen folder) 0))
+|#
 
 (define-method append-message ((folder <imap-folder>) (message <message>))
   (guarantee-imap-folder-open folder)
@@ -450,7 +452,7 @@
 				connection 'FETCH (+ index 1) items))
 
 (define (imap:command:fetch-range connection start end items)
-  (if (fix:< start end)
+  (if (< start end)
       (imap:command:multiple-response imap:response:fetch?
 				      connection 'FETCH
 				      (cons 'ATOM
@@ -645,7 +647,7 @@
 	((imap:response:fetch? response)
 	 (process-fetch-attributes
 	  (get-message (selected-imap-folder connection)
-		       (fix:- (imap:response:fetch-index response) 1))
+		       (- (imap:response:fetch-index response) 1))
 	  response)
 	 (eq? command 'FETCH))
 	(else