Implement CLOSE-FOLDER method for file folders, by discarding the

messages in the folder.  The messages are automatically reloaded when
needed.

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index ba81d03d65a5632579e4e24e67eae2fc1eea3ebb..fac6cf89ba9412662955bdae1a8d48ac321361ac 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.12 2000/05/02 21:42:07 cph Exp $
+;;; $Id: imail-file.scm,v 1.13 2000/05/02 22:02:33 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -58,9 +58,16 @@
 ;;;; Folder
 
 (define-class <file-folder> (<folder>)
-  (messages define standard initial-value '())
+  (messages define standard
+           accessor %file-folder-messages
+           initial-value 'UNKNOWN)
   (modification-time define standard initial-value #f))
 
+(define (file-folder-messages folder)
+  (if (eq? 'UNKNOWN (%file-folder-messages folder))
+      (%revert-folder folder))
+  (%file-folder-messages folder))
+
 (define (file-folder-pathname folder)
   (file-url-pathname (folder-url folder)))
 
@@ -71,8 +78,13 @@
   (folder-not-modified! folder))
 
 (define-method %close-folder ((folder <file-folder>))
-  folder
-  unspecific)
+  (without-interrupts
+   (lambda ()
+     (let ((messages (%file-folder-messages folder)))
+       (if (not (eq? 'UNKNOWN messages))
+          (begin
+            (set-file-folder-messages! folder 'UNKNOWN)
+            (for-each detach-message messages)))))))
 
 (define-method %folder-valid? ((folder <file-folder>))
   (file-exists? (file-folder-pathname folder)))
@@ -103,7 +115,7 @@
                (set-message-index! message 0)
                (list message)))))
        (message-modified! message)))))
-
+\f
 (define-method expunge-deleted-messages ((folder <file-folder>))
   (without-interrupts
    (lambda ()
@@ -125,7 +137,7 @@
              (loop (cdr messages)
                    (fix:+ index 1)
                    (cons (car messages) messages*))))))))
-\f
+
 (define-method search-folder ((folder <file-folder>) criteria)
   (cond ((string? criteria)
         (let ((n (folder-length folder)))

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 6fb28bad8fc5b111c06b4a86328e7b46ecee24e4..78fcbd98004330d59da719a85f3a0f411ed79f12 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.19 2000/04/27 02:16:41 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.20 2000/05/02 22:02:49 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -38,10 +38,15 @@
 ;;;; Server operations
 
 (define-method %open-folder ((url <rmail-url>))
-  (read-rmail-file (file-url-pathname url)))
+  (if (not (file-readable? (file-url-pathname url)))
+      (error:bad-range-argument url 'OPEN-FOLDER))
+  (make-rmail-folder url))
 
 (define-method %new-folder ((url <rmail-url>))
+  (if (file-exists? (file-url-pathname url))
+      (error:bad-range-argument url 'NEW-FOLDER))
   (let ((folder (make-rmail-folder url)))
+    (set-file-folder-messages! folder '())
     (set-rmail-folder-header-fields!
      folder
      (compute-rmail-folder-header-fields folder))
@@ -77,11 +82,6 @@
 \f
 ;;;; Read RMAIL file
 
-(define (read-rmail-file pathname)
-  (let ((folder (make-rmail-folder (make-rmail-url pathname))))
-    (%revert-folder folder)
-    folder))
-
 (define-method %revert-folder ((folder <rmail-folder>))
   (call-with-binary-input-file (file-folder-pathname folder)
     (lambda (port)

diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index c16bb6bebfb0f2db342708204ef6e52a979d6924..4aacbde9ed655a48eb5216f0058b94221b9d84c5 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.13 2000/05/02 21:09:08 cph Exp $
+;;; $Id: imail-umail.scm,v 1.14 2000/05/02 22:02:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -38,13 +38,21 @@
 ;;;; Server operations
 
 (define-method %open-folder ((url <umail-url>))
-  (read-umail-file (file-url-pathname url)))
+  (if (not (file-readable? (file-url-pathname url)))
+      (error:bad-range-argument url 'OPEN-FOLDER))
+  (make-umail-folder url))
 
 (define-method %new-folder ((url <umail-url>))
+  (if (file-exists? (file-url-pathname url))
+      (error:bad-range-argument url 'NEW-FOLDER))
   (let ((folder (make-umail-folder url)))
+    (set-file-folder-messages! folder '())
     (save-folder folder)
     folder))
 
+(define (read-umail-file pathname)
+  (make-umail-folder (make-umail-url pathname)))
+
 ;;;; Folder
 
 (define-class (<umail-folder> (constructor (url))) (<file-folder>))
@@ -60,11 +68,6 @@
 \f
 ;;;; Read unix mail file
 
-(define (read-umail-file pathname)
-  (let ((folder (make-umail-folder (make-umail-url pathname))))
-    (%revert-folder folder)
-    folder))
-
 (define-method %revert-folder ((folder <umail-folder>))
   (set-file-folder-messages!
    folder