From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 23 May 2001 21:30:02 +0000 (+0000)
Subject: Eliminate CONTAINER-URL-CONTENTS in favor of CONTAINER-CONTENTS.
X-Git-Tag: 20090517-FFI~2801
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=20ea4e35c81a5edd1354320314d0e1c380179af1;p=mit-scheme.git

Eliminate CONTAINER-URL-CONTENTS in favor of CONTAINER-CONTENTS.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 912122d24..e15028aff 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.127 2001/05/23 21:20:05 cph Exp $
+;;; $Id: imail-core.scm,v 1.128 2001/05/23 21:29:50 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -139,11 +139,6 @@
 ;; may be affected by the NAMESPACE prefix information).
 (define-generic container-url (url))
 
-;; Return a list of URLs referring to the contents of CONTAINER-URL.
-;; The result can contain both folder and container URLs.
-;; The result is not sorted.
-(define-generic container-url-contents (container-url))
-
 ;; Return the base name of FOLDER-URL.  This is the PATHNAME-NAME of a
 ;; file-based folder, and for IMAP it's the part of the mailbox name
 ;; following the rightmost delimiter.
@@ -486,6 +481,13 @@
 ;; enhancement.
 
 (define-generic preload-folder-outlines (folder))
+
+;; -------------------------------------------------------------------
+;; Return a list of URLs referring to the contents of CONTAINER.
+;; The result can contain both folder and container URLs.
+;; The result is not sorted.
+
+(define-generic container-contents (container))
 
 ;;;; Message type
 
diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index ea35904e9..103a8368b 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.68 2001/05/23 21:20:09 cph Exp $
+;;; $Id: imail-file.scm,v 1.69 2001/05/23 21:29:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -204,18 +204,6 @@
 
 ;;;; Server operations
 
-(define-method container-url-contents ((url <directory-url>))
-  (simple-directory-read (pathname-url-pathname url)
-    (lambda (name directory result)
-      (if (or (string=? name ".") (string=? name ".."))
-	  result
-	  (let* ((pathname
-		  (parse-namestring (string-append directory name) #f #f))
-		 (constructor (pathname-url-filter pathname)))
-	    (if constructor
-		(cons (constructor pathname) result)
-		result))))))
-
 (define-method %url-complete-string
     ((string <string>) (default-url <pathname-url>)
 		       if-unique if-not-unique if-not-found)
@@ -480,6 +468,22 @@
   folder
   0)
 
+;;;; Container
+
+(define-class (<file-container> (constructor (locator))) (<container>))
+
+(define-method container-contents ((container <file-container>))
+  (simple-directory-read (pathname-url-pathname (resource-locator container))
+    (lambda (name directory result)
+      (if (or (string=? name ".") (string=? name ".."))
+	  result
+	  (let* ((pathname
+		  (parse-namestring (string-append directory name) #f #f))
+		 (constructor (pathname-url-filter pathname)))
+	    (if constructor
+		(cons (constructor pathname) result)
+		result))))))
+
 ;;;; Message
 
 (define-class <file-message> (<message>)
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index d7be4b0f4..d035380ae 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.156 2001/05/23 21:20:17 cph Exp $
+;;; $Id: imail-imap.scm,v 1.157 2001/05/23 21:30:02 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -215,7 +215,7 @@
 			  (string-replace prefix (string-ref delimiter 0) #\/))
 		      prefix)))))))
 
-(define-method container-url-contents ((url <imap-container-url>))
+(define (imap-container-url-contents url)
   (with-open-imap-connection url
     (lambda (connection)
       (map (lambda (response)
@@ -579,7 +579,12 @@
 	    (imap:command:logout connection))
 	(close-imap-connection connection))))
 
-;;;; Folder datatype
+;;;; 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)