Don't attempt to set arbitrary flags unless the server says it's OK.
authorChris Hanson <org/chris-hanson/cph>
Sat, 16 Jun 2001 04:12:02 +0000 (04:12 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 16 Jun 2001 04:12:02 +0000 (04:12 +0000)
v7/src/imail/imail-imap.scm

index 257147e8387a484df4b4be65161a90483e11229b..0436e5b44fdab5a5f3ef0bb297498f34ccf09c65 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.180 2001/06/12 00:47:32 cph Exp $
+;;; $Id: imail-imap.scm,v 1.181 2001/06/16 04:12:02 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
 (define-method set-message-flags! ((message <imap-message>) flags)
   (with-imap-message-open message
     (lambda (connection)
-      (imap:command:uid-store-flags connection
-                                   (imap-message-uid message)
-                                   (map imail-flag->imap-flag
-                                        (flags-delete "recent" flags))))))
+      (imap:command:uid-store-flags
+       connection
+       (imap-message-uid message)
+       (map imail-flag->imap-flag
+           (let ((flags (flags-delete "recent" flags))
+                 (folder (message-folder message)))
+             (if (imap-folder-permanent-keywords? folder)
+                 flags
+                 (list-transform-positive flags
+                   (let ((allowed-flags (imap-folder-allowed-flags folder)))
+                     (lambda (flag)
+                       (flags-member? flag allowed-flags)))))))))))
 
 (define (imap-flag->imail-flag flag)
   (let ((entry (assq flag standard-imap-flags)))