--- scheme/env/build.scm	Sun Nov 21 12:12:50 2004
+++ scheme/env/build.scm	Thu Jul  1 17:08:43 2004
@@ -1,4 +1,4 @@
-; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
+; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
 
 
 ; Commands for writing images.
@@ -11,22 +11,27 @@
 
 ; dump <filename>
 
-(define-command-syntax 'dump "<filename>"
+(define-command-syntax 'dump "<filename> [<message> [<startup-file>]]"
   "write the current heap to an image file"
-  '(filename &opt form))
+  '(filename &opt form filename))
 
-(define (dump filename . maybe-info)
-  (let ((info (if (null? maybe-info) "(suspended image)" (car maybe-info)))
+(define (dump filename . args)
+  (let ((info (if (null? args) "(suspended image)" (car args)))
+        (startup-file (if (or (null? args)
+                              (null? (cdr args))
+                              (eq? (cadr args) #t))
+                          (fluid $startup-file)
+                          (cadr args)))
 	(context (user-context))
 	(env (environment-for-commands)))
     (build-image (lambda (arg)
 		   (with-interaction-environment env
 		     (lambda ()
-		       (restart-command-processor arg
-						  context
-						  (lambda ()
-						    (greet-user info))
-						  values))))
+		       (restart-command-processor arg context
+                         (lambda ()
+                           (greet-user info)
+                           (let-fluid $startup-file startup-file
+                             load-startup-file))))))
 		 filename)))
 
 ; build <exp> <filename>
@@ -73,3 +78,29 @@
 	   (punt)))))
 
 ;(define interrupt/keyboard (enum interrupt keyboard))
+
+(define $startup-file (make-fluid #f))
+
+(define (load-startup-file)
+  ((call-with-current-continuation
+     (lambda (abort)
+       (with-handler (lambda (c punt)
+                       (abort (lambda ()
+                                (display-condition c (command-output))
+                                (newline             (command-output)))))
+         (lambda ()
+           (cond ((not (string? (fluid $startup-file)))
+                  (abort values))
+                 ((call-with-current-continuation
+                    (lambda (k)
+                      (with-handler (lambda (c punt) (k #f))
+                        (lambda ()      ; Lame approximation of FILE-EXISTS?.
+                          (close-input-port
+                           (open-input-file (fluid $startup-file)))
+                          #t))))
+                  (display "Loading startup file from " (command-output))
+                  (display (fluid $startup-file)        (command-output))
+                  (display "..."                        (command-output))
+                  (newline                              (command-output))
+                  (load (fluid $startup-file) (user-command-environment))
+                  (abort values)))))))))