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

Flush all ports before exit.

This commit is contained in:
mainzelm 2001-11-27 17:10:07 +00:00
parent abf7c53cc5
commit 0602e0707f
1 changed files with 16 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
scsh/top.scm
View File

@ -269,24 +269,30 @@
args args
context context
(lambda () (lambda ()
(display "welcome to scsh-0.6 alpha " (display "Welcome to scsh 0.6 (Chinese Democracy) [alpha version]"
(current-output-port))
(newline (current-output-port))
(display "Type ,? for help and ,debug to enter the debugger"
(current-output-port)) (current-output-port))
(newline (current-output-port)) (newline (current-output-port))
(in-package (user-environment) '()))))) (in-package (user-environment) '())))))
((eq? term-switch 'c) ((eq? term-switch 'c)
(scheme-exit-now (let ((result (eval (read-exactly-one-sexp-from-string term-val)
(eval (read-exactly-one-sexp-from-string term-val) (interaction-environment))))
(interaction-environment)))) ) (call-exit-hooks)
(scheme-exit-now result)))
(top-entry ; There was a -e <entry>. (top-entry ; There was a -e <entry>.
(scheme-exit-now ((eval top-entry (interaction-environment)) (let ((result ((eval top-entry (interaction-environment))
(command-line)))) (command-line))))
(call-exit-hooks)
(scheme-exit-now result)))
;; Otherwise, the script executed as it loaded, ;; Otherwise, the script executed as it loaded,
;; so we're done. ;; so we're done.
(else (scheme-exit-now 0)))))))))))) (else (call-exit-hooks)
(scheme-exit-now 0)))))))))))))
(define (read-exactly-one-sexp-from-string s) (define (read-exactly-one-sexp-from-string s)
@ -295,6 +301,9 @@
(if (eof-object? (read)) val (if (eof-object? (read)) val
(error "More than one value read from string" s))))) (error "More than one value read from string" s)))))
;;; placeholder for an extensible mechanism in the future
(define (call-exit-hooks)
(flush-all-ports))
(define (bad-arg . msg) (define (bad-arg . msg)
(with-current-output-port (current-error-port) (with-current-output-port (current-error-port)