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

Use load-port to implement -sfd switch.

This commit is contained in:
mainzelm 2003-03-13 07:53:34 +00:00
parent 855cffa3c7
commit 96ab618b28
1 changed files with 15 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
scsh/top.scm
View File

@ -42,6 +42,10 @@
(let-fluid $current-noise-port (make-null-output-port) (let-fluid $current-noise-port (make-null-output-port)
(lambda () (load-into filename p)))) (lambda () (load-into filename p))))
(define (load-port-quietly port p)
(let-fluid $current-noise-port (make-null-output-port)
(lambda () (load-port port p))))
(define (really-ensure-loaded noise . structs) (define (really-ensure-loaded noise . structs)
(let-fluid $current-noise-port (make-null-output-port) (let-fluid $current-noise-port (make-null-output-port)
(lambda () (lambda ()
@ -122,7 +126,7 @@
(let* ((fd (string->number (car args))) (let* ((fd (string->number (car args)))
(p (fdes->inport fd))) (p (fdes->inport fd)))
(release-port-handle p) ; Unreveal the port. (release-port-handle p) ; Unreveal the port.
(values (reverse switches) 's p (values (reverse switches) 'sfd p
top-entry (cdr args))))) top-entry (cdr args)))))
((string=? arg "--") ((string=? arg "--")
@ -351,17 +355,19 @@
;; performed while processing the switches may use these guys. ;; performed while processing the switches may use these guys.
(set-command-line-args! (set-command-line-args!
(cons (if (eq? term-switch 's) (cons (if (eq? term-switch 's)
(if (string? term-val) term-val ; Script file.
term-val ; Script file. (if (eq? term-val 'sfd)
"file-descriptor-script") ; -sfd <num> "file-descriptor-script" ; -sfd <num>
(car all-args)) (car all-args)))
args)) args))
(let* ((script-loaded? (do-switches switches term-val))) (let* ((script-loaded? (do-switches switches term-val)))
(if (and (not script-loaded?) ; There wasn't a -ds, -dm, or -de, (if (not script-loaded?) ; There wasn't a -ds, -dm, or -de,
(eq? term-switch 's)) ; but there is a script, (if (eq? term-switch 's) ; but there is a script,
(load-quietly term-val ; so load it now. (load-quietly term-val; so load it now.
(interaction-environment))) (interaction-environment))
(if (eq? term-switch 'sfd)
(load-port-quietly term-val (interaction-environment)))))
(cond ((not term-switch) ; -- interactive (cond ((not term-switch) ; -- interactive
(scsh-exit-now ;; TODO: ,exit will bypass this (scsh-exit-now ;; TODO: ,exit will bypass this