Add a handful of methods to allow containers to be used in place of
authorChris Hanson <org/chris-hanson/cph>
Thu, 24 May 2001 01:01:11 +0000 (01:01 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 24 May 2001 01:01:11 +0000 (01:01 +0000)
container URLs in operations where it seems useful.

v7/src/imail/imail-core.scm

index e9ac81cb6ff8cf4a4958ec92317359295ad33c50..ee4debf07d2bbda50b10a2a116ae409ae4e41844 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-core.scm,v 1.129 2001/05/23 23:23:18 cph Exp $
+;;; $Id: imail-core.scm,v 1.130 2001/05/24 01:01:11 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
 (define-class <resource> (<property-mixin> <modification-event-mixin>)
   (locator define accessor))
 
-(define-class <folder> (<resource>))
-(define-class <container> (<resource>))
-
 (define-method write-instance ((r <resource>) port)
   (write-instance-helper (resource-type-name r) r port
     (lambda ()
 
 (define-generic resource-type-name (resource))
 (define-method resource-type-name ((r <resource>)) r 'RESOURCE)
+
+(define-generic url-protocol ((resource <resource>))
+  (url-protocol (resource-locator resource)))
+
+(define-generic url-body ((resource <resource>))
+  (url-body (resource-locator resource)))
+
+(define-method container-url ((resource <resource>))
+  (container-url (resource-locator resource)))
+
+(define-class <folder> (<resource>))
+(define-class <container> (<resource>))
+
 (define-method resource-type-name ((r <folder>)) r 'FOLDER)
 (define-method resource-type-name ((r <container>)) r 'CONTAINER)
 
+(define-method make-child-url ((container <container>) name)
+  (make-child-url (resource-locator container) name))
+
+(define (guarantee-folder folder procedure)
+  (if (not (folder? folder))
+      (error:wrong-type-argument folder "IMAIL folder" procedure)))
+
+(define (guarantee-container container procedure)
+  (if (not (container? container))
+      (error:wrong-type-argument container "IMAIL container" procedure)))
+\f
 (define (get-memoized-resource url)
   (let ((resource (hash-table/get memoized-resources url #f)))
     (and resource
 
 (define memoized-resources
   (make-eq-hash-table))
-
-(define (guarantee-folder folder procedure)
-  (if (not (folder? folder))
-      (error:wrong-type-argument folder "IMAIL folder" procedure)))
-
-(define (guarantee-container container procedure)
-  (if (not (container? container))
-      (error:wrong-type-argument container "IMAIL container" procedure)))
 \f
 ;;;; Folder operations