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

View File

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