Associate a connection with an open IMAP container. Add code to

browser to guarantee that the resource is closed at appropriate times.

diff --git a/v7/src/imail/imail-browser.scm b/v7/src/imail/imail-browser.scm
index a309fd7e7a346d5d081331fec3dd7a2dcd2da7b4..8e3b9f96edc99b10ea21a75c19d40286fda9493c 100644 (file)
--- a/v7/src/imail/imail-browser.scm
+++ b/v7/src/imail/imail-browser.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-browser.scm,v 1.4 2001/06/02 05:55:41 cph Exp $
+;;; $Id: imail-browser.scm,v 1.5 2001/06/03 01:37:57 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -50,11 +50,17 @@ To do:
             (string-append (url-presentation-name url)
                            "-browser"))))
       (set-buffer-imail-container! buffer container)
+      (add-kill-buffer-hook buffer close-browser-container)
       (set-buffer-imail-url-selector! buffer browser-selected-url)
       (receive-modification-events container notice-container-events)
       (rebuild-imail-browser-buffer buffer)
       (select-buffer buffer))))
 
+(define (close-browser-container buffer)
+  (let ((container (selected-container #f buffer)))
+    (if container
+       (close-resource container #t))))
+
 (define (browser-selected-url mark)
   (let ((info (browser-line-info #f mark)))
     (and info
@@ -197,18 +203,25 @@ To do:
 (define (browser-expanded-containers buffer)
   (buffer-get buffer 'IMAIL-BROWSER-EXPANDED-CONTAINERS '()))
 
-(define (add-browser-expanded-container! buffer container)
-  (buffer-put! buffer
-              'IMAIL-BROWSER-EXPANDED-CONTAINERS
-              (let ((containers (browser-expanded-containers buffer)))
-                (if (memq container containers)
-                    containers
-                    (cons container containers)))))
-
-(define (remove-browser-expanded-container! buffer container)
-  (buffer-put! buffer
-              'IMAIL-BROWSER-EXPANDED-CONTAINERS
-              (delq! container (browser-expanded-containers buffer))))
+(define (add-browser-expanded-container! buffer url)
+  (let ((container (open-resource url)))
+    (receive-modification-events container notice-container-events)
+    (buffer-put! buffer
+                'IMAIL-BROWSER-EXPANDED-CONTAINERS
+                (let ((containers (browser-expanded-containers buffer)))
+                  (if (memq container containers)
+                      containers
+                      (cons container containers))))))
+
+(define (remove-browser-expanded-container! buffer url)
+  (let ((container (get-memoized-resource url #f)))
+    (if container
+       (begin
+         (close-resource container #f)
+         (buffer-put! buffer
+                      'IMAIL-BROWSER-EXPANDED-CONTAINERS
+                      (delq! container
+                             (browser-expanded-containers buffer)))))))
 
 (define (find-browser-line-for url buffer)
   (let loop ((mark (buffer-start buffer)))
@@ -345,9 +358,7 @@ Each line summarizes a single mail folder.
                        (loop (line-start end 1 'LIMIT))
                        (delete-string start end)))
                  (update-container-line-marker mark #\+)
-                 (let ((container (get-memoized-resource container #f)))
-                   (if container
-                       (remove-browser-expanded-container! buffer container)))
+                 (remove-browser-expanded-container! buffer container)
                  (browser-line-info-container-collapsed! info))
                (begin
                  (let ((mark
@@ -358,10 +369,7 @@ Each line summarizes a single mail folder.
                                          mark)
                    (mark-temporary! mark))
                  (update-container-line-marker mark #\-)
-                 (let ((container (open-resource container)))
-                   (receive-modification-events container
-                                                notice-container-events)
-                 (add-browser-expanded-container! buffer container))
+                 (add-browser-expanded-container! buffer container)
                  (browser-line-info-container-expanded! info)))))))))
 
 (define-command imail-browser-revert

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 7afeeb9a14701a877c194fe2c7bdbf06be8acd51..042df648b8a35e56a9032e4c2e0af5c475d06a32 100644 (file)
--- 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.176 2001/06/03 01:22:45 cph Exp $
+;;; $Id: imail-imap.scm,v 1.177 2001/06/03 01:39:30 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -764,7 +764,9 @@
   (messages define standard
            initial-value '#()))
 
-(define-class (<imap-container> (constructor (locator))) (<container>))
+(define-class (<imap-container> (constructor (locator))) (<container>)
+  (connection define standard
+             initial-value #f))
 
 (define (reset-imap-folder! folder)
   (without-interrupts
@@ -1556,11 +1558,30 @@
 ;;;; Container operations
 
 (define-method %open-resource ((url <imap-container-url>))
-  (make-imap-container url))
+  (let ((container (make-imap-container url)))
+    (guarantee-imap-connection-open
+     (without-interrupts
+      (lambda ()
+       (let ((connection (get-compatible-imap-connection url)))
+         (set-imap-container-connection! container connection)
+         (increment-connection-reference-count! connection)
+         connection))))
+    container))
 
 (define-method %close-resource ((container <imap-container>) no-defer?)
-  container no-defer?
-  unspecific)
+  (let ((connection
+        (without-interrupts
+         (lambda ()
+           (let ((connection (imap-container-connection container)))
+             (if connection
+                 (begin
+                   (set-imap-container-connection! container #f)
+                   (decrement-connection-reference-count! connection)))
+             connection)))))
+    (if connection
+       (begin
+         (maybe-close-imap-connection connection 0 no-defer?)
+         (object-modified! container 'STATUS)))))
 
 (define-method save-resource ((container <imap-container>))
   container

diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 55c37d8e2aea23add405721cc7eede3df29034c3..c7bcf4d444d321fc69b4d6702e2d28486f0e7658 100644 (file)
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,5 +1,5 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.126 2001/06/03 01:23:54 cph Exp $
+$Id: todo.txt,v 1.127 2001/06/03 01:41:49 cph Exp $
 
 Bug fixes
 ---------
@@ -18,12 +18,6 @@ Bug fixes
   around.  It should be started when the connection is established,
   and stopped when the connection is dropped.
 
-* M-x imail-browse-container should open a connection to the IMAP
-  server and leave it open as long as the buffer is around.  The
-  connection need not be "owned", as is true for folder buffers,
-  because server operations do not require selection.  Merely
-  incrementing the reference count is sufficient.
-
 * The RENAME-FOLDER operation must change the folder object to refer
   to the new URL rather than the old.  The operation must close the
   folder if it is open, then discard all the state, and finally