Change OPEN-RESOURCE and CLOSE-RESOURCE so that all of their behavior

is pushed down into the type-dependent modules.  (Previously, they had
some type-independent code.)  This, plus one explicit call, now means
that the STATUS modification event is now consistently signalled
whenever the connection status changes.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index b8b80b457c8ee5f1252ee0069633ef822f4ed79d..3a7ab3d6b46441ead7f97b851273095e7741ed4c 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.143 2001/06/04 17:38:50 cph Exp $
+;;; $Id: imail-core.scm,v 1.144 2001/06/12 00:47:19 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -420,6 +420,10 @@
   (if (not (container? container))
       (error:wrong-type-argument container "IMAIL container" procedure)))
 \f
+(define (maybe-make-resource url constructor)
+  (or (get-memoized-resource url)
+      (memoize-resource (constructor url))))
+
 (define (get-memoized-resource url #!optional error?)
   (or (let ((resource (hash-table/get memoized-resources url #f)))
        (and resource
@@ -435,10 +439,12 @@
       (and (if (default-object? error?) #f error?)
           (error "URL has no associated resource:" url))))
 
-(define (memoize-resource resource close)
+(define (memoize-resource resource)
   (hash-table/put! memoized-resources
                   (resource-locator resource)
-                  (weak-cons resource close))
+                  (weak-cons resource
+                             (lambda (resource)
+                               (close-resource resource #t))))
   resource)
 
 (define (unmemoize-resource url)
@@ -463,12 +469,7 @@
 ;; -------------------------------------------------------------------
 ;; Open the resource named URL.
 
-(define (open-resource url)
-  (or (get-memoized-resource url)
-      (memoize-resource (%open-resource url)
-                       (lambda (resource) (close-resource resource #t)))))
-
-(define-generic %open-resource (url))
+(define-generic open-resource (url))
 
 (define (with-open-resource url procedure)
   (let ((resource #f))
@@ -489,11 +490,7 @@
 ;; space penalty.  NO-DEFER? means that the resource must be closed
 ;; immediately, and not deferred.
 
-(define (close-resource resource no-defer?)
-  (save-resource resource)
-  (%close-resource resource no-defer?))
-
-(define-generic %close-resource (resource no-defer?))
+(define-generic close-resource (resource no-defer?))
 
 ;; -------------------------------------------------------------------
 ;; Return the number of messages in FOLDER.

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 923b5e35de2fc572da27881d6af083e84b4437c1..ea87b8c15b22868ff535393f8424cb4e6034a513 100644 (file)
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.77 2001/06/03 01:42:31 cph Exp $
+;;; $Id: imail-file.scm,v 1.78 2001/06/12 00:47:24 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -289,8 +289,9 @@
 (define (file-folder-pathname folder)
   (pathname-url-pathname (resource-locator folder)))
 
-(define-method %close-resource ((folder <file-folder>) no-defer?)
+(define-method close-resource ((folder <file-folder>) no-defer?)
   no-defer?
+  (save-resource folder)
   (discard-file-folder-messages folder)
   (discard-file-folder-xstring folder))
 
@@ -489,10 +490,10 @@
 
 (define-class (<file-container> (constructor (locator))) (<container>))
 
-(define-method %open-resource ((url <directory-url>))
-  (make-file-container url))
+(define-method open-resource ((url <directory-url>))
+  (maybe-make-resource url make-file-container))
 
-(define-method %close-resource ((container <file-container>) no-defer?)
+(define-method close-resource ((container <file-container>) no-defer?)
   container no-defer?
   unspecific)
 

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index a850234bc1a5ba55cb6dc9e8936db6928f56b3ec..257147e8387a484df4b4be65161a90483e11229b 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.179 2001/06/03 06:00:18 cph Exp $
+;;; $Id: imail-imap.scm,v 1.180 2001/06/12 00:47:32 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -749,7 +749,7 @@
 \f
 ;;;; Folder and container datatypes
 
-(define-class (<imap-folder> (constructor (locator))) (<folder>)
+(define-class <imap-folder> (<folder>)
   (connection define standard
              initial-value #f)
   (read-only? define standard)
@@ -770,6 +770,13 @@
   (connection define standard
              initial-value #f))
 
+(define make-imap-folder
+  (let ((constructor (instance-constructor <imap-folder> '(LOCATOR))))
+    (lambda (url)
+      (let ((folder (constructor url)))
+       (reset-imap-folder! folder)
+       folder))))
+
 (define (reset-imap-folder! folder)
   (without-interrupts
    (lambda ()
@@ -1126,7 +1133,6 @@
                                  '(BODYSTRUCTURE)))))
 \f
 (define-method preload-folder-outlines ((folder <imap-folder>))
-  
   (let* ((connection (guarantee-imap-folder-open folder))
         (messages
          (messages-satisfying folder
@@ -1481,13 +1487,12 @@
 \f
 ;;;; Folder operations
 
-(define-method %open-resource ((url <imap-folder-url>))
-  (let ((folder (make-imap-folder url)))
-    (reset-imap-folder! folder)
+(define-method open-resource ((url <imap-folder-url>))
+  (let ((folder (maybe-make-resource url make-imap-folder)))
     (guarantee-imap-folder-open folder)
     folder))
 
-(define-method %close-resource ((folder <imap-folder>) no-defer?)
+(define-method close-resource ((folder <imap-folder>) no-defer?)
   (close-imap-folder folder no-defer?))
 
 (define (close-imap-folder folder no-defer?)
@@ -1559,18 +1564,20 @@
 \f
 ;;;; Container operations
 
-(define-method %open-resource ((url <imap-container-url>))
-  (let ((container (make-imap-container url)))
+(define-method open-resource ((url <imap-container-url>))
+  (let ((container (maybe-make-resource url make-imap-container)))
     (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))))
+       (or (imap-container-connection container)
+           (let ((connection (get-compatible-imap-connection url)))
+             (set-imap-container-connection! container connection)
+             (increment-connection-reference-count! connection)
+             connection)))))
+    (object-modified! container 'STATUS)
     container))
 
-(define-method %close-resource ((container <imap-container>) no-defer?)
+(define-method close-resource ((container <imap-container>) no-defer?)
   (let ((connection
         (without-interrupts
          (lambda ()

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index e81cffb50acb62096accdc4be60d63ac4f9f9fc1..52099ede8b59f984ece7d567fb48e96b2d769c98 100644 (file)
--- a/v7/src/imail/imail-rmail.scm
+++ b/v7/src/imail/imail-rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-rmail.scm,v 1.67 2001/05/24 01:13:57 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.68 2001/06/12 00:47:36 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -38,11 +38,6 @@
 
 ;;;; Server operations
 
-(define-method %open-resource ((url <rmail-url>))
-  (if (not (file-readable? (pathname-url-pathname url)))
-      (error:bad-range-argument url 'OPEN-RESOURCE))
-  (make-rmail-folder url))
-
 (define-method %create-resource ((url <rmail-url>))
   (if (file-exists? (pathname-url-pathname url))
       (error:bad-range-argument url 'CREATE-RESOURCE))
@@ -78,6 +73,13 @@
        (make-header-field "Note" "If you are seeing it in rmail,")
        (make-header-field "Note" "it means the file has no messages in it.")))
 
+(define-method open-resource ((url <rmail-url>))
+  (if (file-readable? (pathname-url-pathname url))
+      (maybe-make-resource url make-rmail-folder)
+      (begin
+       (unmemoize-resource url)
+       (error:bad-range-argument url 'OPEN-RESOURCE))))
+
 ;;;; Message
 
 (define-class (<rmail-message>

diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index edb0941db23524e940b507c2e2697e0c4df769d4..23f5496d29d07ef81646d48f4eb9d60b5568047d 100644 (file)
--- a/v7/src/imail/imail-umail.scm
+++ b/v7/src/imail/imail-umail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-umail.scm,v 1.48 2001/05/24 01:14:10 cph Exp $
+;;; $Id: imail-umail.scm,v 1.49 2001/06/12 00:47:39 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -35,11 +35,6 @@
 
 ;;;; Server operations
 
-(define-method %open-resource ((url <umail-url>))
-  (if (not (file-readable? (pathname-url-pathname url)))
-      (error:bad-range-argument url 'OPEN-RESOURCE))
-  (make-umail-folder url))
-
 (define-method %create-resource ((url <umail-url>))
   (if (file-exists? (pathname-url-pathname url))
       (error:bad-range-argument url 'CREATE-RESOURCE))
@@ -55,6 +50,13 @@
 
 (define-class (<umail-folder> (constructor (locator))) (<file-folder>))
 
+(define-method open-resource ((url <umail-url>))
+  (if (file-readable? (pathname-url-pathname url))
+      (maybe-make-resource url make-umail-folder)
+      (begin
+       (unmemoize-resource url)
+       (error:bad-range-argument url 'OPEN-RESOURCE))))
+
 ;;;; Message
 
 (define-class (<umail-message>