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 1bcb93edb3ed46c9800298fb874bc49520d3bc9c..f71854a529afd16be828a1fc6205ac3796f9b79a 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.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 36634164f16ef2fba87962f078d92067e7a31d73..2a2d0bf5c4d5a27d0651a8275182f5bb8b64c109 100644 (file)
--- 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))