Eliminate troublesome WRITE-FOLDER operation. Change DELETE-FOLDER

and MOVE-FOLDER to close the old folders.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 361038b5a17829c71fa69cd6ced8aeea7c226d55..c557cbf9968fe796668e22e49717dad3720db715 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.35 2000/05/02 21:42:06 cph Exp $
+;;; $Id: imail-core.scm,v 1.36 2000/05/02 22:12:39 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -120,6 +120,9 @@
 
 (define (delete-folder url)
   (let ((url (->url url)))
+    (let ((folder (get-memoized-folder url)))
+      (if folder
+         (close-folder folder)))
     (unmemoize-folder url)
     (%delete-folder url)))
 
@@ -135,8 +138,11 @@
 (define (move-folder url new-url)
   (let ((url (->url url))
        (new-url (->url new-url)))
-    (unmemoize-folder url)
-    (%move-folder url new-url)))
+    (%move-folder url new-url)
+    (let ((folder (get-memoized-folder url)))
+      (if folder
+         (close-folder folder)))
+    (unmemoize-folder url)))
 
 (define-generic %move-folder (url new-url))
 
@@ -155,7 +161,13 @@
 (define-generic %copy-folder (url new-url))
 
 (define-method %copy-folder ((url <url>) (new-url <url>))
-  (%write-folder (open-folder url) new-url))
+  (let ((from (open-folder url))
+       (to (new-folder new-url)))
+    (let ((n (folder-length from)))
+      (do ((i 0 (+ i 1)))
+         ((= i n))
+       (append-message to (get-message from i))))
+    (save-folder to)))
 \f
 ;; -------------------------------------------------------------------
 ;; Return a list of URLs for folders that match URL-PATTERN.
@@ -362,14 +374,6 @@
 
 (define-generic %maybe-revert-folder (folder resolve-conflict))
 (define-generic %revert-folder (folder))
-
-;; -------------------------------------------------------------------
-;; Write the contents of FOLDER to URL.
-
-(define (write-folder folder url)
-  (%write-folder folder (->url url)))
-
-(define-generic %write-folder (folder url))
 \f
 ;;;; Message type
 

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index fac6cf89ba9412662955bdae1a8d48ac321361ac..7de1581bdc49df00b414807e8d6deae63437e2c1 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.13 2000/05/02 22:02:33 cph Exp $
+;;; $Id: imail-file.scm,v 1.14 2000/05/02 22:12:59 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -159,9 +159,6 @@
   folder
   unspecific)
 
-(define-method %save-folder ((folder <file-folder>))
-  (%write-folder folder (folder-url folder)))
-
 (define-method %maybe-revert-folder ((folder <file-folder>) resolve-conflict)
   (if (if (eqv? (file-folder-modification-time folder)
                (file-modification-time (file-folder-pathname folder)))

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index f2ad6e23c22e1bfc2269bde68770efb2c6cf0981..609e950f3188008a8dddd2a7f059b1b76bd37a33 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.10 2000/05/02 21:42:08 cph Exp $
+;;; $Id: imail-imap.scm,v 1.11 2000/05/02 22:13:00 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -392,9 +392,6 @@
 
 (define-method %revert-folder ((folder <imap-folder>))
   ???)
-
-(define-method %write-folder ((folder <folder>) (url <imap-url>))
-  ???)
 \f
 ;;;; IMAP command invocation
 

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 78fcbd98004330d59da719a85f3a0f411ed79f12..e581915af22954dd42baa30b6d5f1a0d1aceaf1f 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.20 2000/05/02 22:02:49 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.21 2000/05/02 22:13:01 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -61,10 +61,9 @@
 (define-method rmail-folder-header-fields ((folder <folder>))
   (compute-rmail-folder-header-fields folder))
 
-(define-method %write-folder ((folder <folder>) (url <rmail-url>))
-  (write-rmail-file folder (file-url-pathname url))
-  (if (eq? url (folder-url folder))
-      (update-file-folder-modification-time! folder)))
+(define-method %save-folder ((folder <rmail-folder>))
+  (write-rmail-file folder (file-folder-pathname folder))
+  (update-file-folder-modification-time! folder))
 
 (define-method poll-folder ((folder <rmail-folder>))
   (rmail-get-new-mail folder))

diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 4aacbde9ed655a48eb5216f0058b94221b9d84c5..5a1dc62f8a0e4ba7c817629d6f04ba542a9f68d9 100644 (file)
--- 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.14 2000/05/02 22:02:54 cph Exp $
+;;; $Id: imail-umail.scm,v 1.15 2000/05/02 22:13:03 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -57,10 +57,9 @@
 
 (define-class (<umail-folder> (constructor (url))) (<file-folder>))
 
-(define-method %write-folder ((folder <folder>) (url <umail-url>))
-  (write-umail-file folder (file-url-pathname url))
-  (if (eq? url (folder-url folder))
-      (update-file-folder-modification-time! folder)))
+(define-method %save-folder ((folder <umail-folder>))
+  (write-umail-file folder (file-folder-pathname folder))
+  (update-file-folder-modification-time! folder))
 
 (define-method poll-folder ((folder <umail-folder>))
   folder