scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Unify initialization of scsh-specific stuff.

This commit is contained in:
mainzelm 2002-05-16 14:34:58 +00:00
parent 021cd1efc1
commit dcebc64e8b
3 changed files with 42 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
scsh/scsh-package.scm
View File

@ -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

27
scsh/startup.scm
View File

@ -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,

67
scsh/top.scm
View File

@ -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 <num>
term-val ; Script file.
"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,
(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 <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)