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 ee4debf07d2bbda50b10a2a116ae409ae4e41844..b4b13490096063e27523a04e53aa5d176f98c595 100644 (file)
--- 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 9a216f52544716a29d16f9de09d77ea6f8ec764c..0dde1e8eb2327bf9cf5ac298f3a979698a31d924 100644 (file)
--- 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 6ea8fe33776db31f29e4b2d56dd80034f2cd9771..6da35502b25fac6622030fb8906e7997876101fb 100644 (file)
--- 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 @@
 \f
 ;;;; 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 91a2a82a48058ea0a2d89e5a13f150f0e77f00d6..e81cffb50acb62096accdc4be60d63ac4f9f9fc1 100644 (file)
--- 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 e2229593f35dfdcf9331d49b2fa9eb8a06b4210e..1088aea335b15901634314c13294f7f5e84ea78d 100644 (file)
--- 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)))))
 \f
 (define-command imail-copy-folder