From cc1fa9e8a58af04972d3170a5015b13318718dc8 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 3 Jun 2001 01:41:49 +0000 Subject: [PATCH] Associate a connection with an open IMAP container. Add code to browser to guarantee that the resource is closed at appropriate times. --- v7/src/imail/imail-browser.scm | 48 ++++++++++++++++++++-------------- v7/src/imail/imail-imap.scm | 31 ++++++++++++++++++---- v7/src/imail/todo.txt | 8 +----- 3 files changed, 55 insertions(+), 32 deletions(-) diff --git a/v7/src/imail/imail-browser.scm b/v7/src/imail/imail-browser.scm index a309fd7e7..8e3b9f96e 100644 --- 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 7afeeb9a1..042df648b 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.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 ( (constructor (locator))) ()) +(define-class ( (constructor (locator))) () + (connection define standard + initial-value #f)) (define (reset-imap-folder! folder) (without-interrupts @@ -1556,11 +1558,30 @@ ;;;; Container operations (define-method %open-resource ((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 ) 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 )) container diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt index 55c37d8e2..c7bcf4d44 100644 --- 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 -- 2.25.1