From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Sat, 27 Mar 2010 21:46:20 +0000 (-0700)
Subject: Add simple restart to sf/internal.
X-Git-Tag: 20100708-Gtk~71^2~18
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3d35db12904aac0c25b607e5c844d0e8d9e65840;p=mit-scheme.git

Add simple restart to sf/internal.
---

diff --git a/src/sf/toplev.scm b/src/sf/toplev.scm
index 9378d8d08..e666827f5 100644
--- a/src/sf/toplev.scm
+++ b/src/sf/toplev.scm
@@ -121,32 +121,35 @@ USA.
 (define (sf/internal input-pathname bin-pathname spec-pathname
 		     environment declarations)
   spec-pathname				;ignored
-  (let ((do-it
-	 (let ((start-date (get-decoded-time)))
-	   (lambda ()
-	     (fasdump (make-comment
-		       `((SOURCE-FILE . ,(->namestring input-pathname))
-			 (DATE ,(decoded-time/year start-date)
-			       ,(decoded-time/month start-date)
-			       ,(decoded-time/day start-date))
-			 (TIME ,(decoded-time/hour start-date)
-			       ,(decoded-time/minute start-date)
-			       ,(decoded-time/second start-date)))
-		       (sf/file->scode input-pathname bin-pathname
-				       environment declarations))
-		      bin-pathname
-		      #t)))))
-    (if sf:noisy?
-	(let ((message
-	       (lambda (port)
-		 (write-string "Generating SCode for file: " port)
-		 (write (enough-namestring input-pathname) port)
-		 (write-string " => " port)
-		 (write (enough-namestring bin-pathname) port))))
-	  (if (eq? sf:noisy? 'old-style)
-	      (timed message do-it)
-	      (with-notification message do-it)))
-	(do-it))))
+  (with-simple-restart
+   'CONTINUE (string-append "Skip processing file " (->namestring input-pathname))
+   (lambda ()
+     (let ((do-it
+	    (let ((start-date (get-decoded-time)))
+	      (lambda ()
+		(fasdump (make-comment
+			  `((SOURCE-FILE . ,(->namestring input-pathname))
+			    (DATE ,(decoded-time/year start-date)
+				  ,(decoded-time/month start-date)
+				  ,(decoded-time/day start-date))
+			    (TIME ,(decoded-time/hour start-date)
+				  ,(decoded-time/minute start-date)
+				  ,(decoded-time/second start-date)))
+			  (sf/file->scode input-pathname bin-pathname
+					  environment declarations))
+			 bin-pathname
+			 #t)))))
+       (if sf:noisy?
+	   (let ((message
+		  (lambda (port)
+		    (write-string "Generating SCode for file: " port)
+		    (write (enough-namestring input-pathname) port)
+		    (write-string " => " port)
+		    (write (enough-namestring bin-pathname) port))))
+	     (if (eq? sf:noisy? 'old-style)
+		 (timed message do-it)
+		 (with-notification message do-it)))
+	   (do-it))))))
 
 (define (sf/file->scode input-pathname output-pathname
 			environment declarations)