Add bit to say whether folder or message has been modified.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 407aae5306403de8357b6b3013a46e96c7e523a8..0ad0a381d322d3df85e0ca757694c80981b80168 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.21 2000/02/04 05:19:21 cph Exp $
+;;; $Id: imail-core.scm,v 1.22 2000/02/07 22:31:44 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -208,6 +208,8 @@
 ;;;; Folder type
 
 (define-class <folder> ()
+  (modified? define standard
+            initial-value #t)
   (properties define standard
              initializer make-1d-table))
 
@@ -240,6 +242,16 @@
 ;; Return the number of messages in FOLDER.
 (define-generic folder-length (folder))
 
+(define (folder-modified! folder)
+  (set-folder-modified?! folder #t))
+
+(define (folder-not-modified! folder)
+  (let ((count (folder-length folder)))
+    (do ((index 0 (+ index 1)))
+       ((= index count))
+      (message-not-modified! (get-message folder index))))
+  (set-folder-modified?! folder #f))
+
 ;; Get the INDEX'th message in FOLDER and return it.  Signal an
 ;; error for invalid INDEX.
 (define (get-message folder index)
@@ -258,7 +270,8 @@
   (if (not (<= index (folder-length folder)))
       (error:bad-range-argument index 'INSERT-MESSAGE))
   (guarantee-message message 'INSERT-MESSAGE)
-  (%insert-message folder index message))
+  (%insert-message folder index message)
+  (folder-modified! folder))
 
 (define-generic %insert-message (folder index message))
 
@@ -266,14 +279,15 @@
 ;;; messages.  Unspecified result.
 (define (append-message folder message)
   (guarantee-message message 'APPEND-MESSAGE)
-  (%append-message folder message))
+  (%append-message folder message)
+  (folder-modified! folder))
 
 (define-generic %append-message (folder message))
-
+\f
 ;; Remove all messages in FOLDER that are marked for deletion.
 ;; Unspecified result.
 (define-generic expunge-deleted-messages (folder))
-\f
+
 ;; Search FOLDER for messages matching CRITERIA, returning them in a
 ;; list.  [Possible values for CRITERIA not yet defined.]  Returns a
 ;; list of messages.
@@ -331,6 +345,8 @@
                 modifier set-header-fields!)
   (body define standard)
   (flags define standard)
+  (modified? define standard
+            initial-value #t)
   (properties define standard)
   (folder define standard)
   (index define standard))
@@ -373,12 +389,25 @@
                       (alist-copy (message-properties message))
                       folder)))
     (set-message-folder! message folder)
+    (if (message-modified? message)
+       (folder-modified! folder))
     message))
 
 (define (detach-message message)
   (set-message-folder! message #f)
   (set-message-index! message #f))
 
+(define (message-modified! message)
+  (without-interrupts
+   (lambda ()
+     (set-message-modified?! message #t)
+     (let ((folder (message-folder message)))
+       (if folder
+          (folder-modified! folder))))))
+
+(define (message-not-modified! message)
+  (set-message-modified?! message #f))
+
 (define (maybe-strip-imail-headers strip? headers)
   (if strip?
       (list-transform-negative headers
@@ -455,11 +484,13 @@
   (guarantee-message-flag flag 'SET-MESSAGE-FLAG)
   (let ((flags (message-flags message)))
     (if (not (flags-member? flag flags))
-       (set-message-flags! message (cons flag flags)))))
+       (set-message-flags! message (cons flag flags))))
+  (message-modified! message))
 
 (define (clear-message-flag message flag)
   (guarantee-message-flag flag 'SET-MESSAGE-FLAG)
-  (flags-delete! flag (message-flags message)))
+  (flags-delete! flag (message-flags message))
+  (message-modified! message))
 
 (define (folder-flags folder)
   (let ((n (folder-length folder)))
@@ -551,7 +582,8 @@
              (set-cdr! (car alist*) value)
              (loop (cdr alist*)))
          (set-message-properties! message
-                                  (cons (cons name value) alist))))))
+                                  (cons (cons name value) alist)))))
+  (message-modified! message))
 
 (define (message-property-name? object)
   (header-field-name? object))

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 945a5ddc9070fdf4689ecdbe3aa51347b89ee379..c9ec910c703928dac5271234e41753f4539a77db 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.7 2000/02/04 05:19:26 cph Exp $
+;;; $Id: imail-file.scm,v 1.8 2000/02/07 22:31:49 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -72,7 +72,8 @@
 (define (update-file-folder-modification-time! folder)
   (set-file-folder-modification-time!
    folder
-   (file-modification-time (file-folder-pathname folder))))
+   (file-modification-time (file-folder-pathname folder)))
+  (folder-not-modified! folder))
 
 (define-method %folder-valid? ((folder <file-folder>))
   (file-exists? (file-folder-pathname folder)))
@@ -139,9 +140,13 @@
              (set-file-folder-messages! folder (reverse! messages*)))
             ((message-deleted? (car messages))
              (detach-message (car messages))
+             (folder-modified! folder)
              (loop (cdr messages) index messages*))
             (else
-             (set-message-index! (car messages) index)
+             (if (not (eqv? index (message-index (car messages))))
+                 (begin
+                   (set-message-index! (car messages) index)
+                   (message-modified! (car messages))))
              (loop (cdr messages)
                    (fix:+ index 1)
                    (cons (car messages) messages*))))))))

diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 526e9ce7e4d60b86512b7776683b6d66bbf6835f..918c2ed5441bdfda00bd86fe2ff08ea4cd36ae98 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.12 2000/02/04 05:19:30 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.13 2000/02/07 22:31:53 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -58,7 +58,8 @@
 
 (define-method %write-folder ((folder <folder>) (url <rmail-url>))
   (write-rmail-file folder (file-url-pathname url) #f)
-  (update-file-folder-modification-time! folder))
+  (if (eq? url (folder-url 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 eeb16c22ef76f45d2e804d051ebc9d0475232c52..0c5dd5f9a689914b99c6c423d65cc14ec8c58fc8 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.8 2000/02/04 05:19:33 cph Exp $
+;;; $Id: imail-umail.scm,v 1.9 2000/02/07 22:31:56 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -51,7 +51,8 @@
 
 (define-method %write-folder ((folder <folder>) (url <umail-url>))
   (write-umail-file folder (file-url-pathname url) #f)
-  (update-file-folder-modification-time! folder))
+  (if (eq? url (folder-url folder))
+      (update-file-folder-modification-time! folder)))
 
 (define-method poll-folder ((folder <umail-folder>))
   folder