From: Chris Hanson Date: Mon, 7 Feb 2000 22:31:56 +0000 (+0000) Subject: Add bit to say whether folder or message has been modified. X-Git-Tag: 20090517-FFI~4259 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9f4621a1f73127a152368b2d17259d97b9c46be6;p=mit-scheme.git 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 407aae530..0ad0a381d 100644 --- 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 () + (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)) - + ;; Remove all messages in FOLDER that are marked for deletion. ;; Unspecified result. (define-generic expunge-deleted-messages (folder)) - + ;; 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 945a5ddc9..c9ec910c7 100644 --- 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-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 526e9ce7e..918c2ed54 100644 --- 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 ) (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-get-new-mail folder)) diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm index eeb16c22e..0c5dd5f9a 100644 --- 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 ) (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 )) folder