Implement MAYBE-REVERT-FOLDER.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index a5398b3a358373e9ce9cc3bcd2723b5c7d5d9fdf..407aae5306403de8357b6b3013a46e96c7e523a8 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.20 2000/02/04 04:53:12 cph Exp $
+;;; $Id: imail-core.scm,v 1.21 2000/02/04 05:19:21 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -309,6 +309,7 @@
   (%maybe-revert-folder folder resolve-conflict))
 
 (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)

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index a351cfdf505e49678a0b0a19ff80cf23d86da434..945a5ddc9070fdf4689ecdbe3aa51347b89ee379 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.6 2000/02/04 04:53:08 cph Exp $
+;;; $Id: imail-file.scm,v 1.7 2000/02/04 05:19:26 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -63,10 +63,19 @@
 
 (define-class <file-folder> (<folder>)
   (url accessor folder-url)
-  (messages define standard))
+  (messages define standard initial-value '())
+  (modification-time define standard initial-value #f))
+
+(define (file-folder-pathname folder)
+  (file-url-pathname (folder-url folder)))
+
+(define (update-file-folder-modification-time! folder)
+  (set-file-folder-modification-time!
+   folder
+   (file-modification-time (file-folder-pathname folder))))
 
 (define-method %folder-valid? ((folder <file-folder>))
-  (file-exists? (file-url-pathname (folder-url folder))))
+  (file-exists? (file-folder-pathname folder)))
 
 (define-method folder-length ((folder <file-folder>))
   (length (file-folder-messages folder)))
@@ -158,6 +167,14 @@
   folder
   unspecific)
 
+(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)))
+         (or (not (folder-modified? folder))
+             (resolve-conflict folder))
+         (folder-modified? folder))
+      (%revert-folder folder)))
+
 (define-method subscribe-folder ((folder <file-folder>))
   folder
   (error "Unimplemented operation:" 'SUBSCRIBE-FOLDER))

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index d355ebdffceb37766ff02f29030e8f32afa61f39..526e9ce7e4d60b86512b7776683b6d66bbf6835f 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.11 2000/02/04 04:53:04 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.12 2000/02/04 05:19:30 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -41,15 +41,14 @@
   (read-rmail-file (file-url-pathname url) #f))
 
 (define-method %new-folder ((url <rmail-url>))
-  (let ((folder (make-rmail-folder url '())))
+  (let ((folder (make-rmail-folder url)))
     (set-header-fields! folder (compute-rmail-folder-header-fields folder))
     (save-folder folder)
     folder))
 
 ;;;; Folder
 
-(define-class (<rmail-folder> (constructor (url header-fields messages)))
-    (<file-folder>))
+(define-class (<rmail-folder> (constructor (url))) (<file-folder>))
 
 (define-method header-fields ((folder <rmail-folder>))
   (folder-get folder 'RMAIL-HEADER-FIELDS '()))
@@ -58,7 +57,8 @@
   (folder-put! folder 'RMAIL-HEADER-FIELDS headers))
 
 (define-method %write-folder ((folder <folder>) (url <rmail-url>))
-  (write-rmail-file folder (file-url-pathname url) #f))
+  (write-rmail-file folder (file-url-pathname url) #f)
+  (update-file-folder-modification-time! folder))
 
 (define-method poll-folder ((folder <rmail-folder>))
   (rmail-get-new-mail folder))
@@ -85,16 +85,20 @@
       (read-rmail-folder (make-rmail-url pathname) port import?))))
 
 (define (read-rmail-folder url port import?)
-  (let ((folder (make-rmail-folder url '())))
-    (set-header-fields! folder (read-rmail-prolog port))
-    (let loop ()
-      (let ((message (read-rmail-message port import?)))
-       (if message
-           (begin
-             (append-message folder message)
-             (loop)))))
+  (let ((folder (make-rmail-folder url)))
+    (%revert-folder folder)
     folder))
 
+(define-method %revert-folder ((folder <rmail-folder>))
+  (set-header-fields! folder (read-rmail-prolog port))
+  (let loop ()
+    (let ((message (read-rmail-message port import?)))
+      (if message
+         (begin
+           (append-message folder message)
+           (loop)))))
+  (update-file-folder-modification-time! folder))
+
 (define (read-rmail-prolog port)
   (if (not (string-prefix? "BABYL OPTIONS:" (read-required-line port)))
       (error "Not an RMAIL file:" port))
@@ -280,15 +284,15 @@
          (- (folder-length folder) initial-count)))))
 
 (define (rmail-folder-inbox-list folder)
-  (let ((url (folder-url folder))
-       (inboxes (get-first-header-field-value folder "mail" #f)))
+  (let ((inboxes (get-first-header-field-value folder "mail" #f)))
     (cond (inboxes
           (map (let ((directory
-                      (directory-pathname (file-url-pathname url))))
+                      (directory-pathname (file-folder-pathname folder))))
                  (lambda (filename)
                    (merge-pathnames (string-trim filename) directory)))
                (burst-string inboxes #\, #f)))
-         ((pathname=? (rmail-primary-folder-name) (url-body url))
+         ((pathname=? (rmail-primary-folder-name)
+                      (url-body (folder-url folder)))
           (rmail-primary-inbox-list))
          (else '()))))
 
@@ -309,8 +313,7 @@
                            (directory-pathname pathname))
                (rename-inbox-using-movemail
                 pathname
-                (directory-pathname
-                 (file-url-pathname (folder-url folder)))))
+                (directory-pathname (file-folder-pathname folder))))
               (else
                (rename-inbox-using-rename pathname)))))
     (and (file-exists? pathname)

diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index a867f5ae07b5583003d35548f6f7ae8e84f335ba..eeb16c22ef76f45d2e804d051ebc9d0475232c52 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.7 2000/01/19 05:38:46 cph Exp $
+;;; $Id: imail-umail.scm,v 1.8 2000/02/04 05:19:33 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -41,16 +41,17 @@
   (read-umail-file (file-url-pathname url) #f))
 
 (define-method %new-folder ((url <umail-url>))
-  (let ((folder (make-umail-folder url '())))
+  (let ((folder (make-umail-folder url)))
     (save-folder folder)
     folder))
 
 ;;;; Folder
 
-(define-class (<umail-folder> (constructor (url messages))) (<file-folder>))
+(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) #f))
+  (write-umail-file folder (file-url-pathname url) #f)
+  (update-file-folder-modification-time! folder))
 
 (define-method poll-folder ((folder <umail-folder>))
   folder
@@ -64,8 +65,13 @@
       (read-umail-folder (make-umail-url pathname) port import?))))
 
 (define (read-umail-folder url port import?)
-  (make-umail-folder
-   url
+  (let ((folder (make-umail-folder url)))
+    (%revert-folder folder)
+    folder))
+
+(define-method %revert-folder ((folder <umail-folder>))
+  (set-file-folder-messages!
+   folder
    (let ((from-line (read-line port)))
      (if (eof-object? from-line)
         '()
@@ -79,7 +85,8 @@
                 (let ((messages (cons message messages)))
                   (if from-line
                       (loop from-line messages)
-                      (reverse! messages)))))))))))
+                      (reverse! messages))))))))))
+    (update-file-folder-modification-time! folder))
 
 (define (read-umail-message from-line port import?)
   (let read-headers ((header-lines '()))