From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 19 May 2000 21:02:20 +0000 (+0000)
Subject: Change SET-MESSAGE-FLAGS! so that a folder event is generated when the
X-Git-Tag: 20090517-FFI~3784
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=00993a3c635c85adb38aa9e3440ad622f0568991;p=mit-scheme.git

Change SET-MESSAGE-FLAGS! so that a folder event is generated when the
flags are stored, rather than when the the storage request is
initiated.  IMAP can sometimes set the flags when no request has been
initiated.
---

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 1bcb93edb..f71854a52 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.75 2000/05/19 20:03:12 cph Exp $
+;;; $Id: imail-core.scm,v 1.76 2000/05/19 21:02:00 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -306,8 +306,7 @@
     (<imail-object>)
   (header-fields define accessor)
   (body define accessor)
-  (flags define standard
-	 modifier %set-message-flags!)
+  (flags define accessor)
   (folder define standard
 	  initial-value #f)
   (index define standard
@@ -325,6 +324,19 @@
   (if (not (message? message))
       (error:wrong-type-argument message "IMAIL message" procedure)))
 
+(define-generic set-message-flags! (message flags))
+
+(define-method set-message-flags! ((message <message>) flags)
+  (%set-message-flags! message flags))
+
+(define %set-message-flags!
+  (let ((modifier (slot-modifier <message> 'FLAGS)))
+    (lambda (message flags)
+      (modifier message flags)
+      (let ((folder (message-folder message)))
+	(if folder
+	    (folder-modified! folder 'FLAGS message))))))
+
 (define (message-attached? message #!optional folder)
   (let ((folder (if (default-object? folder) #f folder)))
     (if folder
@@ -466,12 +478,6 @@
        (if (flags-member? flag flags)
 	   (set-message-flags! message (flags-delete! flag flags)))))))
 
-(define (set-message-flags! message flags)
-  (%set-message-flags! message flags)
-  (let ((folder (message-folder message)))
-    (if folder
-	(folder-modified! folder 'FLAGS message))))
-
 (define (folder-flags folder)
   (let ((n (folder-length folder)))
     (do ((index 0 (+ index 1))
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 36634164f..2a2d0bf5c 100644
--- 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.60 2000/05/19 20:08:25 cph Exp $
+;;; $Id: imail-imap.scm,v 1.61 2000/05/19 21:02:20 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -492,7 +492,7 @@
 			   ;; Flags might have been updated while
 			   ;; reading the UIDs.
 			   (if (%message-flags-initialized? m*)
-			       (%%set-message-flags! m (message-flags m*)))
+			       (%set-message-flags! m (message-flags m*)))
 			   (detach-message! m*)
 			   (attach-message! m folder i*)
 			   (vector-set! v* i* m)
@@ -514,7 +514,7 @@
 (define (imap-message-connection message)
   (imap-folder-connection (message-folder message)))
 
-(define-method %set-message-flags! ((message <imap-message>) flags)
+(define-method set-message-flags! ((message <imap-message>) flags)
   (imap:command:uid-store-flags (imap-message-connection message)
 				(imap-message-uid message)
 				(map imail-flag->imap-flag
@@ -1144,7 +1144,7 @@
 (define (process-fetch-attribute message keyword datum)
   (case keyword
     ((FLAGS)
-     (%%set-message-flags! message (map imap-flag->imail-flag datum))
+     (%set-message-flags! message (map imap-flag->imail-flag datum))
      #t)
     ((RFC822.HEADER)
      (%set-message-header-fields! message
@@ -1172,9 +1172,6 @@
 (define %set-message-body!
   (slot-modifier <imap-message> 'BODY))
 
-(define %%set-message-flags!
-  (slot-modifier <imap-message> 'FLAGS))
-
 (define %message-flags-initialized?
   (slot-initpred <imap-message> 'FLAGS))