From: Taylor R. Campbell <net/mumble/campbell>
Date: Sat, 9 Feb 2008 10:29:03 +0000 (+0000)
Subject: Make SAVE-RESOURCE on file folders gracefully handle failure to write
X-Git-Tag: 20090517-FFI~345
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fba2a33b05d8df2ea1f77f887f14451dbdaf937d;p=mit-scheme.git

Make SAVE-RESOURCE on file folders gracefully handle failure to write
the file.  Previously killing an IMAIL file folder buffer for a
read-only file would create an *error* buffer and fail to kill the
IMAIL buffer!

(Perhaps it would be better to add a new value to FOLDER-SYNC-STATUS,
to indicate that the persistant storage is immutable.  But putting an
error handler here is useful anyway, because the state of the world
may change between the call to FOLDER-SYNC-STATUS and the actual write
to the disk.)
---

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 3a4976c0c..d11f5b773 100644
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: imail-file.scm,v 1.93 2008/01/30 20:02:09 cph Exp $
+$Id: imail-file.scm,v 1.94 2008/02/09 10:29:03 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -404,9 +404,21 @@ USA.
 	     (and (eq? status 'BOTH-MODIFIED)
 		  (imail-ui:prompt-for-yes-or-no?
 		   "Disk file has changed since last read.  Save anyway"))))
-       (begin
-	 (synchronize-file-folder-write folder write-file-folder)
-	 #t)))
+       (call-with-current-continuation
+	 (lambda (k)
+	   (bind-condition-handler (list condition-type:error)
+	       (lambda (condition)
+		 ;; Can this be done in a pop-up buffer?  It doesn't
+		 ;; work just to use IMAIL-UI:PRESENT-USER-ALERT
+		 ;; because that futzes with the kill-buffer hooks.
+		 (imail-ui:message
+		  (call-with-output-string
+		    (lambda (output-port)
+		      (write-condition-report condition output-port))))
+		 (k #f))
+	     (lambda ()
+	       (synchronize-file-folder-write folder write-file-folder)
+	       #t))))))
 
 (define-generic write-file-folder (folder pathname))