Unify initialization of scsh-specific stuff.

scsh/scsh-package.scm

@@ -294,7 +294,8 @@
   (access threads-internal)
   (files startup))
 
-(define-structure scsh-top-package (export parse-switches-and-execute 
+(define-structure scsh-top-package (export parse-switches-and-execute
+					   with-scsh-initialized
 					   repl )
   (open command-processor
 	command-levels          ; with-new-session

scsh/startup.scm

@@ -44,27 +44,12 @@
 
 (define (dump-scsh-program start filename)
   (let ((context (user-context)))
-  (really-dump-scsh-program (lambda (args)
+    (really-dump-scsh-program (lambda (args)
-			      (with-scsh-sighandlers 
+				(with-scsh-initialized
-			       #f
+				 #f context args 
-			       (lambda ()
+				 (lambda ()
-				 (with-autoreaping
+				   (start args))))
-				  (lambda ()
+			      filename)))
-				    (install-env)
-				    (initialize-cwd)
-				    (init-scsh-vars #f)	; Do it quietly.
-				    (start-new-session context    
-						       (current-input-port)
-						       (current-output-port)
-						       (current-error-port)
-						       args
-						       #f)
-				    (with-interaction-environment     
-				     (user-environment)
-				     (lambda ()
-				       (start args))))))))
-				  filename)))
-
 
 (define (scsh-stand-alone-resumer start)
   (usual-resumer			; sets up exceptions, interrupts,

scsh/top.scm

@@ -295,50 +295,51 @@
 (define (new-empty-package name)
   (make-simple-package '() #t
 		       (get-reflective-tower (user-environment)) ; ???
-		       name)) 
+		       name))
+
+(define (with-scsh-initialized interactive? context args thunk)
+  (with-scsh-sighandlers 
+   interactive?
+   (lambda ()
+     (with-autoreaping
+      (lambda ()
+	(install-env)
+	(initialize-cwd)
+	(init-scsh-vars interactive?)
+	(start-new-session context    
+			   (current-input-port)
+			   (current-output-port)
+			   (current-error-port)
+			   args
+			   (not interactive?))
+	(with-interaction-environment     
+	 (user-environment)
+	 thunk))))))
 
 (define (parse-switches-and-execute all-args context)
-   (receive (switches term-switch term-val top-entry args)
+  (receive (switches term-switch term-val top-entry args)
-	    (parse-scsh-args (cdr all-args))
+      (parse-scsh-args (cdr all-args))
-   (begin 
+    (begin
-     ;;; restart-command-processor will provide one, but we need 
+      (with-scsh-initialized
-     ;;; one already in do-switches
+       (not term-switch) context args
-    (start-new-session context    
- 			(current-input-port)
- 			(current-output-port)
- 			(current-error-port)
- 			args
- 			term-switch)
-     (with-interaction-environment     
-      (user-environment)
        (lambda ()
-	 (with-scsh-sighandlers 
-	  (not term-switch)
-	  (lambda ()
-	    (with-autoreaping
-	     (lambda ()
-	       (install-env)
-	       (initialize-cwd)
 	 ;; Have to do these before calling DO-SWITCHES, because actions
 	 ;; performed while processing the switches may use these guys.
 	 (set-command-line-args!
 	  (cons (if (eq? term-switch 's)
 		    (if (string? term-val)
-			term-val			; Script file.
+			term-val	; Script file.
-			"file-descriptor-script"); -sfd <num>
+			"file-descriptor-script") ; -sfd <num>
 		    (car all-args))
 		args))
-	     ;; Set HOME-DIRECTORY and EXEC-PATH-LIST,
-	 ;; quietly if not running an interactive script.
-	 (init-scsh-vars term-switch)
 	 
 	 (let* ((script-loaded?  (do-switches switches term-val)))
-	   (if (and (not script-loaded?)	; There wasn't a -ds or -dm,
+	   (if (and (not script-loaded?) ; There wasn't a -ds or -dm,
-		    (eq? term-switch 's))	; but there is a script,
+		    (eq? term-switch 's)) ; but there is a script,
 	       (load-quietly term-val	; so load it now.
-				 (interaction-environment)))
+			     (interaction-environment)))
 	   
-	   (cond ((not term-switch) ; -- interactive
+	   (cond ((not term-switch)	; -- interactive
 		  (exit 
 		   (restart-command-processor 
 		    args 
@@ -363,14 +364,14 @@
 		 
 		 (top-entry		; There was a -e <entry>.
 		  (let ((result ((eval top-entry (interaction-environment))
-				    (command-line))))
+				 (command-line))))
 		    (call-exit-hooks)
 		    (scheme-exit-now 0)))
 		 
-		     ;; Otherwise, the script executed as it loaded,
+		 ;; Otherwise, the script executed as it loaded,
 		 ;; so we're done.
 		 (else (call-exit-hooks)
-		       (scheme-exit-now 0)))))))))))))
+		       (scheme-exit-now 0)))))))))
 
 
 (define (read-exactly-one-sexp-from-string s)