From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 24 May 2001 01:14:07 +0000 (+0000)
Subject: Rename the following server operations, then add methods to them to
X-Git-Tag: 20090517-FFI~2796
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f7c79a46e69ede9d823cc06f66f33c054623d5ea;p=mit-scheme.git

Rename the following server operations, then add methods to them to
support containers as well as folders:

    create-folder	=>	create-resource
    delete-folder	=>	delete-resource
    rename-folder	=>	rename-resource
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index ee4debf07..b4b134900 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.130 2001/05/24 01:01:11 cph Exp $
+;;; $Id: imail-core.scm,v 1.131 2001/05/24 01:13:39 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -261,23 +261,23 @@
 ;; Create a new folder named URL.  Signal an error if the folder
 ;; already exists or can't be created.
 
-(define (create-folder url)
-  (let ((folder (%create-folder url)))
-    (container-modified! url 'CREATE-FOLDER)
+(define (create-resource url)
+  (let ((folder (%create-resource url)))
+    (container-modified! url 'CREATE-RESOURCE)
     folder))
 
-(define-generic %create-folder (url))
+(define-generic %create-resource (url))
 
 ;; -------------------------------------------------------------------
 ;; Delete the folder named URL.  Signal an error if the folder doesn't
 ;; exist or if it can't be deleted.
 
-(define (delete-folder url)
-  (%delete-folder url)
+(define (delete-resource url)
+  (%delete-resource url)
   (unmemoize-resource url)
-  (container-modified! url 'DELETE-FOLDER))
+  (container-modified! url 'DELETE-RESOURCE))
 
-(define-generic %delete-folder (url))
+(define-generic %delete-resource (url))
 
 ;; -------------------------------------------------------------------
 ;; Rename the folder named URL to NEW-URL.  Signal an error if the
@@ -286,13 +286,13 @@
 ;; NOT do format conversion, or move a folder from one place to
 ;; another.  It only allows changing the name of an existing folder.
 
-(define (rename-folder url new-url)
-  (%rename-folder url new-url)
+(define (rename-resource url new-url)
+  (%rename-resource url new-url)
   (unmemoize-resource url)
-  (container-modified! url 'DELETE-FOLDER)
-  (container-modified! new-url 'CREATE-FOLDER))
+  (container-modified! url 'DELETE-RESOURCE)
+  (container-modified! new-url 'CREATE-RESOURCE))
 
-(define-generic %rename-folder (url new-url))
+(define-generic %rename-resource (url new-url))
 
 ;; -------------------------------------------------------------------
 ;; Insert a copy of MESSAGE in FOLDER at the end of the existing
@@ -300,7 +300,7 @@
 
 (define (append-message message url)
   (if (%append-message message url)
-      (container-modified! url 'CREATE-FOLDER)))
+      (container-modified! url 'CREATE-RESOURCE)))
 
 (define-generic %append-message (message url))
 
diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 9a216f525..0dde1e8eb 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.70 2001/05/23 23:23:23 cph Exp $
+;;; $Id: imail-file.scm,v 1.71 2001/05/24 01:13:44 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -235,17 +235,17 @@
       (and (eq? type 'DIRECTORY)
 	   make-directory-url))))
 
-(define-method %delete-folder ((url <file-url>))
+(define-method %create-resource ((url <directory-url>))
+  (make-directory (pathname-url-pathname url)))
+
+(define-method %delete-resource ((url <file-url>))
   (delete-file (pathname-url-pathname url)))
 
-;;; The next method only works when operating on two URLs of the same
-;;; class, and is restricted to cases where RENAME-FILE works.
+(define-method %delete-resource ((url <directory-url>))
+  (delete-directory (pathname-url-pathname url)))
 
-(define-computed-method %rename-folder ((uc1 <file-url>) (uc2 <file-url>))
-  (and (eq? uc1 uc2)
-       (lambda (url new-url)
-	 (rename-file (pathname-url-pathname url)
-		      (pathname-url-pathname new-url)))))
+(define-method %rename-resource ((url <pathname-url>) (new-url <pathname-url>))
+  (rename-file (pathname-url-pathname url) (pathname-url-pathname new-url)))
 
 (define-method with-open-connection ((url <file-url>) thunk)
   url
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 6ea8fe337..6da35502b 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.158 2001/05/23 23:23:31 cph Exp $
+;;; $Id: imail-imap.scm,v 1.159 2001/05/24 01:13:53 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -1226,17 +1226,17 @@
 
 ;;;; Server operations
 
-(define-method %create-folder ((url <imap-url>))
+(define-method %create-resource ((url <imap-url>))
   (with-open-imap-connection url
     (lambda (connection)
       (imap:command:create connection (imap-url-server-mailbox url)))))
 
-(define-method %delete-folder ((url <imap-url>))
+(define-method %delete-resource ((url <imap-url>))
   (with-open-imap-connection url
     (lambda (connection)
       (imap:command:delete connection (imap-url-server-mailbox url)))))
 
-(define-method %rename-folder ((url <imap-url>) (new-url <imap-url>))
+(define-method %rename-resource ((url <imap-url>) (new-url <imap-url>))
   (if (compatible-imap-urls? url new-url)
       (with-open-imap-connection url
 	(lambda (connection)
diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 91a2a82a4..e81cffb50 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.66 2001/05/23 23:23:34 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.67 2001/05/24 01:13:57 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -43,9 +43,9 @@
       (error:bad-range-argument url 'OPEN-RESOURCE))
   (make-rmail-folder url))
 
-(define-method %create-folder ((url <rmail-url>))
+(define-method %create-resource ((url <rmail-url>))
   (if (file-exists? (pathname-url-pathname url))
-      (error:bad-range-argument url 'CREATE-FOLDER))
+      (error:bad-range-argument url 'CREATE-RESOURCE))
   (let ((folder (make-rmail-folder url)))
     (set-file-folder-messages! folder '#())
     (set-rmail-folder-header-fields!
diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index e2229593f..1088aea33 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.247 2001/05/24 00:26:32 cph Exp $
+;;; $Id: imail-top.scm,v 1.248 2001/05/24 01:14:07 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -1324,7 +1324,7 @@ An error if signalled if the folder already exists."
 			     'HISTORY 'IMAIL-CREATE-FOLDER)))
   (lambda (url-string)
     (let ((url (imail-parse-partial-url url-string)))
-      (create-folder url)
+      (create-resource url)
       (message "Created folder " (url->string url)))))
 
 (define-command imail-delete-folder
@@ -1338,7 +1338,7 @@ An error if signalled if the folder already exists."
       (if (prompt-for-yes-or-no?
 	   (string-append "Delete folder " (url->string url)))
 	  (begin
-	    (delete-folder url)
+	    (delete-resource url)
 	    (message "Deleted folder " (url->string url)))
 	  (message "Folder not deleted")))))
 
@@ -1358,7 +1358,7 @@ The folder's type may not be changed."
   (lambda (from to)
     (let ((from (imail-parse-partial-url from))
 	  (to (imail-parse-partial-url to)))
-      (rename-folder from to)
+      (rename-resource from to)
       (message "Folder renamed to " (url->string to)))))
 
 (define-command imail-copy-folder