From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 14 Jul 2009 20:06:31 +0000 (-0400)
Subject: Fix appending to open file folders so that it signals an
X-Git-Tag: 20100708-Gtk~370^2~3
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c235189fb28be0d1a4cfbe30398af4e2eb46b1c2;p=mit-scheme.git

Fix appending to open file folders so that it signals an
INCREASE-LENGTH modification event.
---

diff --git a/src/imail/imail-file.scm b/src/imail/imail-file.scm
index 14001c2c7..2b07470e1 100644
--- a/src/imail/imail-file.scm
+++ b/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: imail-file.scm,v 1.97 2008/09/25 14:58:06 riastradh Exp $
+$Id$
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -309,14 +309,14 @@ USA.
 	  (let ((message (make-message-copy message folder)))
 	    (without-interrupts
 	     (lambda ()
-	       (set-file-folder-messages!
-		folder
-		(let ((messages (file-folder-messages folder)))
-		  (let ((n (vector-length messages)))
-		    (let ((messages (vector-grow messages (fix:+ n 1))))
-		      (attach-message! message folder n)
-		      (vector-set! messages n message)
-		      messages)))))))
+	       (let* ((messages (file-folder-messages folder))
+		      (n (vector-length messages))
+		      (n* (fix:+ n 1))
+		      (messages* (vector-grow messages n*)))
+		 (attach-message! message folder n)
+		 (vector-set! messages* n message)
+		 (set-file-folder-messages! folder messages*)
+		 (object-modified! folder 'INCREASE-LENGTH n n*)))))
 	  (let ((type
 		 (if exists?
 		     (url-file-folder-type url)