Use load-port to implement -sfd switch.
This commit is contained in:
parent
855cffa3c7
commit
96ab618b28
24
scsh/top.scm
24
scsh/top.scm
|
@ -42,6 +42,10 @@
|
|||
(let-fluid $current-noise-port (make-null-output-port)
|
||||
(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)
|
||||
(let-fluid $current-noise-port (make-null-output-port)
|
||||
(lambda ()
|
||||
|
@ -122,7 +126,7 @@
|
|||
(let* ((fd (string->number (car args)))
|
||||
(p (fdes->inport fd)))
|
||||
(release-port-handle p) ; Unreveal the port.
|
||||
(values (reverse switches) 's p
|
||||
(values (reverse switches) 'sfd p
|
||||
top-entry (cdr args)))))
|
||||
|
||||
((string=? arg "--")
|
||||
|
@ -351,17 +355,19 @@
|
|||
;; 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>
|
||||
(car all-args))
|
||||
term-val ; Script file.
|
||||
(if (eq? term-val 'sfd)
|
||||
"file-descriptor-script" ; -sfd <num>
|
||||
(car all-args)))
|
||||
args))
|
||||
|
||||
(let* ((script-loaded? (do-switches switches term-val)))
|
||||
(if (and (not script-loaded?) ; There wasn't a -ds, -dm, or -de,
|
||||
(eq? term-switch 's)) ; but there is a script,
|
||||
(load-quietly term-val ; so load it now.
|
||||
(interaction-environment)))
|
||||
(if (not script-loaded?) ; There wasn't a -ds, -dm, or -de,
|
||||
(if (eq? term-switch 's) ; but there is a script,
|
||||
(load-quietly term-val; so load it now.
|
||||
(interaction-environment))
|
||||
(if (eq? term-switch 'sfd)
|
||||
(load-port-quietly term-val (interaction-environment)))))
|
||||
|
||||
(cond ((not term-switch) ; -- interactive
|
||||
(scsh-exit-now ;; TODO: ,exit will bypass this
|
||||
|
|
Loading…
Reference in New Issue