From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 3 Jun 2001 01:22:54 +0000 (+0000)
Subject: Add optional argument NO-DEFER? to CLOSE-RESOURCE.  If this argument
X-Git-Tag: 20090517-FFI~2739
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6d1e0446745afde837cdc2a0e96c762ebfb0888d;p=mit-scheme.git

Add optional argument NO-DEFER? to CLOSE-RESOURCE.  If this argument
is true, it tells the operation that the resource must be closed
immediately.  Otherwise, the operation may defer the closure.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 9e254e51a..e6594a672 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.140 2001/05/29 20:36:34 cph Exp $
+;;; $Id: imail-core.scm,v 1.141 2001/06/03 01:22:31 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -472,13 +472,14 @@
 ;; -------------------------------------------------------------------
 ;; Close RESOURCE, freeing up connections, memory, etc.  Subsequent use
 ;; of the resource must work, but may incur a significant time or space
-;; penalty.
+;; penalty.  Optional argument NO-DEFER? means that the resource must
+;; be closed immediately, and not deferred.
 
-(define (close-resource resource)
+(define (close-resource resource #!optional no-defer?)
   (save-resource resource)
-  (%close-resource resource))
+  (%close-resource resource (if (default-object? no-defer?) #f no-defer?)))
 
-(define-generic %close-resource (resource))
+(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 633fc3993..025c07845 100644
--- 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.75 2001/05/29 20:36:40 cph Exp $
+;;; $Id: imail-file.scm,v 1.76 2001/06/03 01:22:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -289,7 +289,8 @@
 (define (file-folder-pathname folder)
   (pathname-url-pathname (resource-locator folder)))
 
-(define-method %close-resource ((folder <file-folder>))
+(define-method %close-resource ((folder <file-folder>) no-defer?)
+  no-defer?
   (discard-file-folder-messages folder)
   (discard-file-folder-xstring folder))
 
@@ -491,8 +492,8 @@
 (define-method %open-resource ((url <directory-url>))
   (make-file-container url))
 
-(define-method %close-resource ((container <file-container>))
-  container
+(define-method %close-resource ((container <file-container>) no-defer?)
+  container no-defer?
   unspecific)
 
 (define-method save-resource ((container <file-container>))
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 88a847245..7afeeb9a1 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.175 2001/06/01 02:20:53 cph Exp $
+;;; $Id: imail-imap.scm,v 1.176 2001/06/03 01:22:45 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -622,7 +622,7 @@
 		  (lambda ()
 		    (guarantee-imap-connection-open connection)
 		    (let ((v (receiver connection)))
-		      (maybe-close-imap-connection connection 1)
+		      (maybe-close-imap-connection connection 1 #f)
 		      v))
 		  (lambda ()
 		    (decrement-connection-reference-count! connection)))))
@@ -669,15 +669,17 @@
 	(close-port port)))
   (reset-imap-connection connection))
 
-(define (maybe-close-imap-connection connection min-count)
+(define (maybe-close-imap-connection connection min-count no-defer?)
   (if (= (imap-connection-reference-count connection) min-count)
-      (if (search-imap-connections
-	   (let ((url (imap-connection-url connection)))
-	     (lambda (connection*)
-	       (and (not (eq? connection* connection))
-		    (compatible-imap-urls? (imap-connection-url connection*)
-					   url)
-		    0))))
+      (if (or no-defer?
+	      (search-imap-connections
+	       (let ((url (imap-connection-url connection)))
+		 (lambda (connection*)
+		   (and (not (eq? connection* connection))
+			(compatible-imap-urls?
+			 (imap-connection-url connection*)
+			 url)
+			0)))))
 	  (close-imap-connection-cleanly connection)
 	  (defer-closing-of-connection connection))))
 
@@ -1481,7 +1483,10 @@
     (guarantee-imap-folder-open folder)
     folder))
 
-(define-method %close-resource ((folder <imap-folder>))
+(define-method %close-resource ((folder <imap-folder>) no-defer?)
+  (close-imap-folder folder no-defer?))
+
+(define (close-imap-folder folder no-defer?)
   (let ((connection
 	 (without-interrupts
 	  (lambda ()
@@ -1494,7 +1499,7 @@
 	      connection)))))
     (if connection
 	(begin
-	  (maybe-close-imap-connection connection 0)
+	  (maybe-close-imap-connection connection 0 no-defer?)
 	  (object-modified! folder 'STATUS)))))
 
 (define-method %get-message ((folder <imap-folder>) index)
@@ -1553,8 +1558,8 @@
 (define-method %open-resource ((url <imap-container-url>))
   (make-imap-container url))
 
-(define-method %close-resource ((container <imap-container>))
-  container
+(define-method %close-resource ((container <imap-container>) no-defer?)
+  container no-defer?
   unspecific)
 
 (define-method save-resource ((container <imap-container>))