Fix various bugs found during debugging of IMAP folders.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 7d32af5e3df4a53304bceaa08feccac4e31b20bc..cf88683b942c34fd992bbd1c05dfcbcf3685d1ba 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.32 2000/04/28 16:14:32 cph Exp $
+;;; $Id: imail-core.scm,v 1.33 2000/04/28 18:43:53 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -437,7 +437,8 @@
 \f
 ;;;; Message Navigation
 
-(define (first-unseen-message folder)
+(define-generic first-unseen-message (folder))
+(define-method first-unseen-message ((folder <folder>))
   (let ((message (first-message folder)))
     (and message
         (let loop ((message message))

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 11e6c980db4f53e64d79318e2f20a716fd6693c7..7cd242284339c33a100b10cfda2674578ca95bcc 100644 (file)
--- 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.24 2000/04/27 02:16:43 cph Exp $
+;;; $Id: imail-top.scm,v 1.25 2000/04/28 18:43:32 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -94,7 +94,7 @@ May be called with an IMAIL folder URL as argument;
           (or (imail-folder->buffer folder #f)
               (let ((buffer (new-buffer (imail-url->buffer-name url))))
                 (associate-imail-folder-with-buffer folder buffer)
-                (select-message folder (first-unseen-message folder))
+                (select-message folder (first-unseen-message folder) #t)
                 buffer))))))
     (if (not url-string)
        ((ref-command imail-get-new-mail) #f))))
@@ -123,7 +123,13 @@ May be called with an IMAIL folder URL as argument;
                       notice-folder-modifications))
 
 (define (imail-folder->buffer folder error?)
-  (or (folder-get folder 'BUFFER #f)
+  (or (let ((buffer (folder-get folder 'BUFFER #f)))
+       (and buffer
+            (if (buffer-alive? buffer)
+                buffer
+                (begin
+                  (folder-remove! folder 'BUFFER)
+                  #f))))
       (and error? (error:bad-range-argument folder 'IMAIL-FOLDER->BUFFER))))
 
 (define (notice-folder-modifications folder)
@@ -506,36 +512,23 @@ With prefix argument N moves backward N messages with these flags."
               " 0/0")))))
 
 (define (maybe-reformat-headers message buffer)
-  (let ((displayed
-        (get-message-property message
-                              "displayed-header-fields"
-                              'NONE)))
-    (if (eq? 'NONE displayed)
-       (let ((trimmed
-              (let ((headers
-                     (let ((headers (message-header-fields message))
-                           (regexp
-                            (ref-variable imail-ignored-headers buffer)))
-                       (if regexp
-                           (list-search-negative headers
-                             (lambda (header)
-                               (re-string-match regexp
-                                                (header-field-name header))))
-                           headers)))
-                    (filter (ref-variable rmail-message-filter buffer)))
-                (if filter
-                    (map (lambda (n.v)
-                           (make-header-field (car n.v) (cdr n.v)))
-                         (filter (map (lambda (header)
-                                        (cons (header-field-name header)
-                                              (header-field-value header)))
-                                      headers)))
-                    headers))))
-         (set-message-property message
-                               "displayed-header-fields"
-                               trimmed)
-         trimmed)
-       displayed)))
+  (let ((headers
+        (let ((headers (message-header-fields message))
+              (regexp (ref-variable imail-ignored-headers buffer)))
+          (if regexp
+              (list-transform-negative headers
+                (lambda (header)
+                  (re-string-match regexp (header-field-name header) #t)))
+              headers)))
+       (filter (ref-variable imail-message-filter buffer)))
+    (if filter
+       (map (lambda (n.v)
+              (make-header-field (car n.v) (cdr n.v)))
+            (filter (map (lambda (header)
+                           (cons (header-field-name header)
+                                 (header-field-value header)))
+                         headers)))
+       headers)))
 \f
 ;;;; Message deletion
 

diff --git a/v7/src/imail/imap-response.scm b/v7/src/imail/imap-response.scm
index 2f89284cf930e23f72a8d6a22df7cad9374c5f36..73b7652e805b250f0f3319d46e63bfdb60db999f 100644 (file)
--- a/v7/src/imail/imap-response.scm
+++ b/v7/src/imail/imap-response.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-response.scm,v 1.9 2000/04/28 16:48:30 cph Exp $
+;;; $Id: imap-response.scm,v 1.10 2000/04/28 18:43:46 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -23,7 +23,7 @@
 (declare (usual-integrations))
 \f
 (define (imap:read-server-response port)
-  (let ((tag (read-string char-set:space port)))
+  (let ((tag (read-string-internal char-set:space port)))
     (if (eof-object? tag)
        tag
        (begin
@@ -258,7 +258,14 @@
     (discard-known-char #\return port)
     (discard-known-char #\linefeed port)
     (let ((s (make-string n)))
-      (read-string! s port)
+      (let loop ((start 0))
+       (let ((m (read-substring! s start n port)))
+         (if (fix:= m 0)
+             (error "Premature EOF:" port))
+         (if (fix:< m (fix:- n start))
+             (loop (fix:+ start m)))))
+      (if trace-imap-server-responses?
+         (write-string s (notification-output-port)))
       s)))
 \f
 (define (read-list port #!optional read-item)
@@ -298,7 +305,7 @@
 
 (define (read-bracketed-string port)
   (discard-known-char #\[ port)
-  (let ((s (read-string char-set:close-bracket port)))
+  (let ((s (read-string-internal char-set:close-bracket port)))
     (discard-known-char #\] port)
     s))
 
@@ -322,7 +329,7 @@
 (define (string-reader constituents)
   (let ((delimiters (char-set-invert constituents)))
     (lambda (port)
-      (read-string delimiters port))))
+      (read-string-internal delimiters port))))
 
 (define (non-null-string-reader constituents)
   (let ((reader (string-reader constituents)))
@@ -426,9 +433,15 @@
 (define (read-char-internal port)
   (let ((char (read-char port)))
     (if trace-imap-server-responses?
-       (write-char char))
+       (write-char char (notification-output-port)))
     char))
 
+(define (read-string-internal delimiters port)
+  (let ((s (read-string delimiters port)))
+    (if trace-imap-server-responses?
+       (write-string s (notification-output-port)))
+    s))
+
 (define trace-imap-server-responses? #f)
 \f
 (define (imap:response:bad? response) (eq? (car response) 'BAD))