diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index 4366497..e320448 100644 --- a/scsh/scsh-package.scm +++ b/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 diff --git a/scsh/startup.scm b/scsh/startup.scm index 0bf6a41..fb95f43 100644 --- a/scsh/startup.scm +++ b/scsh/startup.scm @@ -44,27 +44,12 @@ (define (dump-scsh-program start filename) (let ((context (user-context))) - (really-dump-scsh-program (lambda (args) - (with-scsh-sighandlers - #f - (lambda () - (with-autoreaping - (lambda () - (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))) - + (really-dump-scsh-program (lambda (args) + (with-scsh-initialized + #f context args + (lambda () + (start args)))) + filename))) (define (scsh-stand-alone-resumer start) (usual-resumer ; sets up exceptions, interrupts, diff --git a/scsh/top.scm b/scsh/top.scm index 88f1ef9..a3e5135 100644 --- a/scsh/top.scm +++ b/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) - (parse-scsh-args (cdr all-args)) - (begin - ;;; restart-command-processor will provide one, but we need - ;;; one already in do-switches - (start-new-session context - (current-input-port) - (current-output-port) - (current-error-port) - args - term-switch) - (with-interaction-environment - (user-environment) + (receive (switches term-switch term-val top-entry args) + (parse-scsh-args (cdr all-args)) + (begin + (with-scsh-initialized + (not term-switch) context args (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. - "file-descriptor-script"); -sfd + term-val ; Script file. + "file-descriptor-script") ; -sfd (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, - (eq? term-switch 's)) ; but there is a script, + (if (and (not script-loaded?) ; There wasn't a -ds or -dm, + (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 . (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)