From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 23 May 2001 23:23:48 +0000 (+0000)
Subject: Generalize folder operations:
X-Git-Tag: 20090517-FFI~2800
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ca29c03bae75927fceca5eb7421b3016acdf8dbf;p=mit-scheme.git

Generalize folder operations:

	open-folder	=>	open-resource
	close-folder	=>	close-resource
	save-folder	=>	save-resource

Add methods to each of these renamed operations so that they can
handle containers.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index e15028aff..e9ac81cb6 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.128 2001/05/23 21:29:50 cph Exp $
+;;; $Id: imail-core.scm,v 1.129 2001/05/23 23:23:18 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -380,24 +380,24 @@
 ;;;; Folder operations
 
 ;; -------------------------------------------------------------------
-;; Open the folder named URL.
+;; Open the resource named URL.
 
-(define (open-folder url)
+(define (open-resource url)
   (or (get-memoized-resource url)
-      (memoize-resource (%open-folder url) close-folder)))
+      (memoize-resource (%open-resource url) close-resource)))
 
-(define-generic %open-folder (url))
+(define-generic %open-resource (url))
 
 ;; -------------------------------------------------------------------
-;; Close FOLDER, freeing up connections, memory, etc.  Subsequent use
-;; of the folder must work, but may incur a significant time or space
+;; Close RESOURCE, freeing up connections, memory, etc.  Subsequent use
+;; of the resource must work, but may incur a significant time or space
 ;; penalty.
 
-(define (close-folder folder)
-  (save-folder folder)
-  (%close-folder folder))
+(define (close-resource resource)
+  (save-resource resource)
+  (%close-resource resource))
 
-(define-generic %close-folder (folder))
+(define-generic %close-resource (resource))
 
 ;; -------------------------------------------------------------------
 ;; Return the number of messages in FOLDER.
@@ -437,10 +437,10 @@
 (define-generic folder-sync-status (folder))
 
 ;; -------------------------------------------------------------------
-;; Save any cached changes made to FOLDER.  Returns a boolean
+;; Save any cached changes made to RESOURCE.  Returns a boolean
 ;; indicating whether anything was saved.
 
-(define-generic save-folder (folder))
+(define-generic save-resource (resource))
 
 ;; -------------------------------------------------------------------
 ;; Discard cached contents of FOLDER.  Subsequent use of FOLDER will
diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 103a8368b..9a216f525 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.69 2001/05/23 21:29:54 cph Exp $
+;;; $Id: imail-file.scm,v 1.70 2001/05/23 23:23:23 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -273,7 +273,7 @@
 (define (file-folder-pathname folder)
   (pathname-url-pathname (resource-locator folder)))
 
-(define-method %close-folder ((folder <file-folder>))
+(define-method %close-resource ((folder <file-folder>))
   (discard-file-folder-messages folder)
   (discard-file-folder-xstring folder))
 
@@ -390,7 +390,7 @@
 	    'PERSISTENT-DELETED)
 	'UNSYNCHRONIZED)))
 
-(define-method save-folder ((folder <file-folder>))
+(define-method save-resource ((folder <file-folder>))
   (and (let ((status (folder-sync-status folder)))
 	 (or (memq status '(FOLDER-MODIFIED PERSISTENT-DELETED))
 	     (and (eq? status 'BOTH-MODIFIED)
@@ -442,7 +442,7 @@
       (call-with-input-xstring (file-folder-xstring folder) 0 reader)))))
 
 (define-method discard-folder-cache ((folder <file-folder>))
-  (close-folder folder))
+  (close-resource folder))
 
 (define-method probe-folder ((folder <file-folder>))
   folder
@@ -472,6 +472,17 @@
 
 (define-class (<file-container> (constructor (locator))) (<container>))
 
+(define-method %open-resource ((url <directory-url>))
+  (make-file-container url))
+
+(define-method %close-resource ((container <file-container>))
+  container
+  unspecific)
+
+(define-method save-resource ((container <file-container>))
+  container
+  #f)
+
 (define-method container-contents ((container <file-container>))
   (simple-directory-read (pathname-url-pathname (resource-locator container))
     (lambda (name directory result)
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index d035380ae..6ea8fe337 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.157 2001/05/23 21:30:02 cph Exp $
+;;; $Id: imail-imap.scm,v 1.158 2001/05/23 23:23:31 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -581,11 +581,6 @@
 
 ;;;; Folder and container datatypes
 
-(define-class (<imap-container> (constructor (locator))) (<container>))
-
-(define-method container-contents ((container <imap-container>))
-  (imap-container-url-contents (resource-locator container)))
-
 (define-class (<imap-folder> (constructor (locator connection))) (<folder>)
   (connection define accessor)
   (read-only? define standard)
@@ -599,6 +594,8 @@
   (n-messages define standard initial-value 0)
   (messages define standard initial-value '#()))
 
+(define-class (<imap-container> (constructor (locator))) (<container>))
+
 (define (reset-imap-folder! folder)
   (without-interrupts
    (lambda ()
@@ -1297,7 +1294,7 @@
 
 ;;;; Folder operations
 
-(define-method %open-folder ((url <imap-folder-url>))
+(define-method %open-resource ((url <imap-folder-url>))
   (let ((folder
 	 (make-imap-folder url
 			   (or (search-imap-connections
@@ -1308,7 +1305,7 @@
     (guarantee-imap-folder-open folder)
     folder))
 
-(define-method %close-folder ((folder <imap-folder>))
+(define-method %close-resource ((folder <imap-folder>))
   (let ((connection (imap-folder-connection folder)))
     (maybe-close-imap-connection connection)
     (set-imap-connection-folder! connection #f))
@@ -1344,13 +1341,13 @@
   folder
   'SYNCHRONIZED)
 
-(define-method save-folder ((folder <imap-folder>))
+(define-method save-resource ((folder <imap-folder>))
   ;; Changes are always written through.
   folder
   #f)
 
 (define-method discard-folder-cache ((folder <imap-folder>))
-  (close-folder folder)
+  (close-resource folder)
   (reset-imap-folder! folder))
 
 (define-method probe-folder ((folder <imap-folder>))
@@ -1363,12 +1360,28 @@
       'OFFLINE))
 
 (define-method disconnect-folder ((folder <imap-folder>))
-  (close-folder folder))
+  (close-resource folder))
 
 (define-method folder-supports-mime? ((folder <imap-folder>))
   folder
   #t)
 
+;;;; Container operations
+
+(define-method %open-resource ((url <imap-container-url>))
+  (make-imap-container url))
+
+(define-method %close-resource ((container <imap-container>))
+  container
+  unspecific)
+
+(define-method save-resource ((container <imap-container>))
+  container
+  #f)
+
+(define-method container-contents ((container <imap-container>))
+  (imap-container-url-contents (resource-locator container)))
+
 ;;;; IMAP command invocation
 
 (define (imap:command:capability connection)
diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index e049d03d7..91a2a82a4 100644
--- 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.65 2001/05/23 05:05:11 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.66 2001/05/23 23:23:34 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -38,9 +38,9 @@
 
 ;;;; Server operations
 
-(define-method %open-folder ((url <rmail-url>))
+(define-method %open-resource ((url <rmail-url>))
   (if (not (file-readable? (pathname-url-pathname url)))
-      (error:bad-range-argument url 'OPEN-FOLDER))
+      (error:bad-range-argument url 'OPEN-RESOURCE))
   (make-rmail-folder url))
 
 (define-method %create-folder ((url <rmail-url>))
@@ -55,7 +55,7 @@
     (set-file-folder-file-modification-count!
      folder
      (object-modification-count folder))
-    (save-folder folder)))
+    (save-resource folder)))
 
 ;;;; Folder
 
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 44c41b167..2a80081a4 100644
--- 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.244 2001/05/23 21:20:28 cph Exp $
+;;; $Id: imail-top.scm,v 1.245 2001/05/23 23:23:45 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -231,7 +231,7 @@ regardless of the folder type."
 					     'REQUIRE-MATCH? #t))))
   (lambda (url-string)
     (let ((folder
-	   (open-folder
+	   (open-resource
 	    (if url-string
 		(imail-parse-partial-url url-string)
 		(imail-primary-url #f)))))
@@ -826,7 +826,7 @@ With prefix argument N, removes FLAG from next N messages,
 					'REQUIRE-MATCH? #t)))
   (lambda (url-string)
     (let ((url (imail-parse-partial-url url-string)))
-      (copy-folder (open-folder url)
+      (copy-folder (open-resource url)
 		   (resource-locator (selected-folder))
 		   (lambda () ((ref-command imail-get-new-mail) #f))
 		   (string-append "from " (url->string url))))))
@@ -1390,7 +1390,7 @@ If it doesn't exist, it is created first."
 	      (url-base-name (imail-parse-partial-url from)))
 	     'HISTORY 'IMAIL-COPY-FOLDER-TARGET))))
   (lambda (from to)
-    (let ((folder (open-folder (imail-parse-partial-url from)))
+    (let ((folder (open-resource (imail-parse-partial-url from)))
 	  (to (imail-parse-partial-url to)))
       (if (eq? (resource-locator folder) to)
 	  (editor-error "Can't copy folder to itself:" to))
@@ -1426,7 +1426,7 @@ With prefix argument, closes and buries only selected IMAIL folder."
   (lambda (selected-only?)
     (let ((quit
 	   (lambda (folder)
-	     (close-folder folder)
+	     (close-resource folder)
 	     (imail-bury folder))))
       (if selected-only?
 	  (quit (selected-folder))
@@ -1482,7 +1482,7 @@ With prefix argument, closes and buries only selected IMAIL folder."
   ()
   (lambda ()
     (message
-     (if (save-folder (selected-folder))
+     (if (save-resource (selected-folder))
 	 "Folder saved"
 	 "No changes need to be saved."))))
 
diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 50bdb8243..5f59e324b 100644
--- 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.46 2001/05/23 05:05:29 cph Exp $
+;;; $Id: imail-umail.scm,v 1.47 2001/05/23 23:23:48 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -35,9 +35,9 @@
 
 ;;;; Server operations
 
-(define-method %open-folder ((url <umail-url>))
+(define-method %open-resource ((url <umail-url>))
   (if (not (file-readable? (pathname-url-pathname url)))
-      (error:bad-range-argument url 'OPEN-FOLDER))
+      (error:bad-range-argument url 'OPEN-RESOURCE))
   (make-umail-folder url))
 
 (define-method %create-folder ((url <umail-url>))
@@ -49,7 +49,7 @@
     (set-file-folder-file-modification-count!
      folder
      (object-modification-count folder))
-    (save-folder folder)))
+    (save-resource folder)))
 
 ;;;; Folder