From 23ef9b0f1bfbe3e7fc3b13944d5b84d518382943 Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Sun, 31 Aug 2008 23:02:17 +0000
Subject: [PATCH] New generic procedure MESSAGE-PERMANENT-FLAGS returns the
 flags that remain permanently and are therefore useful to retain when
 appending messages to other folders.  All %APPEND-MESSAGE methods now use
 this rather than MESSAGE-FLAGS.  This will keep `recent' flags from being
 stored in file folders as an artefact of the IMAP.

---
 v7/src/imail/imail-core.scm  |  9 +++++++--
 v7/src/imail/imail-imap.scm  | 13 +++++++++----
 v7/src/imail/imail-rmail.scm |  4 ++--
 v7/src/imail/imail-umail.scm | 19 +++++++++++--------
 4 files changed, 29 insertions(+), 16 deletions(-)

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index b9d0cde71..9efeb97ab 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.173 2008/08/29 20:14:50 riastradh Exp $
+$Id: imail-core.scm,v 1.174 2008/08/31 23:02:17 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -659,7 +659,7 @@ USA.
     (if folder
 	(unmap-folder-index folder index)
 	index)))
-
+
 (define %set-message-flags!
   (let ((modifier (slot-modifier <message> 'FLAGS)))
     (lambda (message flags)
@@ -668,6 +668,11 @@ USA.
 	(if folder
 	    (object-modified! folder 'FLAGS message))))))
 
+(define-generic message-permanent-flags (message))
+
+(define-method message-permanent-flags ((message <message>))
+  (message-flags message))
+
 (define (message-attached? message #!optional folder)
   (let ((folder (if (default-object? folder) #f folder)))
     (if folder
diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index a2f1cd81c..1657be5b5 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.228 2008/08/29 20:14:50 riastradh Exp $
+$Id: imail-imap.scm,v 1.229 2008/08/31 23:02:17 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1074,6 +1074,13 @@ USA.
 		      (lambda (flag)
 			(flags-member? flag allowed-flags)))))))))))
 
+(define-method message-permanent-flags ((message <imap-message>))
+  ;; Perhaps this should intersect the flags with the folder's list of
+  ;; permanent flags, if the folder does not allow permanent
+  ;; user-defined flags, in order to preserve only those flags that
+  ;; the IMAP folder would consider permanent.
+  (flags-delete "recent" (message-flags message)))
+
 (define (imap-flag->imail-flag flag)
   (let ((entry (assq flag standard-imap-flags)))
     (if entry
@@ -2041,9 +2048,7 @@ USA.
 		(imap:command:append connection
 				     (imap-url-server-mailbox url)
 				     (map imail-flag->imap-flag
-					  (flags-delete
-					   "recent"
-					   (message-flags message)))
+					  (message-permanent-flags message))
 				     (message-internal-time message)
 				     (message->string message)))))))))
 
diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index c4ce22587..83b201a9d 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.78 2008/07/03 20:08:12 cph Exp $
+$Id: imail-rmail.scm,v 1.79 2008/08/31 23:02:17 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -98,7 +98,7 @@ USA.
   folder
   (make-rmail-message (message-header-fields message)
 		      (file-message-body message)
-		      (list-copy (message-flags message))
+		      (list-copy (message-permanent-flags message))
 		      (rmail-message-displayed-header-fields message)
 		      (message-internal-time message)))
 
diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 6c6f7ff00..b7894faf7 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.58 2008/07/03 20:08:15 cph Exp $
+$Id: imail-umail.scm,v 1.59 2008/08/31 23:02:17 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -74,7 +74,7 @@ USA.
   folder
   (make-umail-message (message-header-fields message)
 		      (file-message-body message)
-		      (list-copy (message-flags message))
+		      (list-copy (message-permanent-flags message))
 		      (umail-message-from-line message)))
 
 (define-method message-internal-time ((message <umail-message>))
@@ -160,12 +160,15 @@ USA.
 (define (write-umail-message message output-flags? port)
   (write-string (umail-message-from-line message) port)
   (newline port)
-  (write-header-fields (if output-flags?
-			   (append (message-header-fields message)
-				   (list (message-flags->header-field
-					  (message-flags message))))
-			   (message-header-fields message))
-		       port)
+  (write-header-fields
+   (if output-flags?
+       (append (message-header-fields message)
+	       (let ((flags (message-permanent-flags message)))
+		 (if (pair? flags)
+		     (list (message-flags->header-field flags))
+		     '())))
+       (message-header-fields message))
+   port)
   (for-each (lambda (line)
 	      (if (string-prefix-ci? "From " line)
 		  (write-string ">" port))
-- 
2.25.1