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

Revert last check-in. Reading again through the manual, I now think that it's maybe better to complain if -e was specified without -sfd or -s.

This commit is contained in:
mainzelm 2004-02-20 15:27:29 +00:00
parent 388d2f7b2b
commit 90ba284584
1 changed files with 78 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
scsh/top.scm
View File

@ -107,7 +107,7 @@
(define (parse-scsh-args args) (define (parse-scsh-args args)
(let lp ((args (meta-arg-process-arglist args)) (let lp ((args (meta-arg-process-arglist args))
(switches '()) ; A list of handler thunks (switches '()) ; A list of handler thunks
(top-entry #f) ; -e <entry> (top-entry #f) ; -t <entry>
(need-script? #f)) ; Found a -ds, -dm, or -de? (need-script? #f)) ; Found a -ds, -dm, or -de?
; (display args (current-output-port)) ; (display args (current-output-port))
(if (pair? args) (if (pair? args)
@ -115,47 +115,31 @@
(args (cdr args))) (args (cdr args)))
(cond ((string=? arg "-c") (cond ((string=? arg "-c")
(cond ((not (pair? args)) (if (or need-script? top-entry (not (pair? args)))
(bad-arg "-c switch requires argument")) (bad-arg)
(top-entry
(bad-arg "-c switch used with -e switch"))
(need-script?
(bad-arg "-ds, -dm, or -de switch requires -s <script>"))
(else
(values (reverse switches) 'c (car args) (values (reverse switches) 'c (car args)
top-entry (cdr args))))) top-entry (cdr args))))
((string=? arg "-s") ((string=? arg "-s")
(cond ((not (pair? args)) (if (not (pair? args))
(bad-arg "-s switch requires argument")) (bad-arg "-s switch requires argument")
(top-entry
(bad-arg "-s switch used with -e switch"))
(need-script?
(bad-arg "-ds, -dm, or -de switch requires -s <script>"))
(else
(values (reverse switches) 's (car args) (values (reverse switches) 's (car args)
top-entry (cdr args))))) top-entry (cdr args))))
;; -sfd <num> ;; -sfd <num>
((string=? arg "-sfd") ((string=? arg "-sfd")
(cond ((not (pair? args)) (if (not (pair? args))
(bad-arg "-sfd switch requires argument")) (bad-arg "-sfd switch requires argument")
(top-entry
(bad-arg "-sdf switch used with -e switch"))
(else
(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) 'sfd p (values (reverse switches) 'sfd p
top-entry (cdr args)))))) top-entry (cdr args)))))
((string=? arg "--") ((string=? arg "--")
(cond (need-script? (if need-script?
(bad-arg "-ds, -dm, or -de switch requires -s <script>")) (bad-arg "-ds, -dm, or -de switch requires -s <script>")
(top-entry (values (reverse switches) #f #f top-entry args)))
(bad-arg "-- switch used with -e switch"))
(else
(values (reverse switches) #f #f top-entry args))))
((or (string=? arg "-ds") ((or (string=? arg "-ds")
(string=? arg "-dm") (string=? arg "-dm")
@ -202,10 +186,8 @@
(string->symbol (car args)) need-script?)) (string->symbol (car args)) need-script?))
(else (bad-arg "Unknown switch" arg)))) (else (bad-arg "Unknown switch" arg))))
(cond (need-script?
(bad-arg "-ds, -dm, or -de switch requires -s <script>")) (values (reverse switches) #f #f top-entry '()))))
(else
(values (reverse switches) #f #f top-entry '()))))))
;;; Do each -ds, -dm, -de, -o, -n, -m, -l/lm/ll, +lp/+lpe/lp+/lpe+, or ;;; Do each -ds, -dm, -de, -o, -n, -m, -l/lm/ll, +lp/+lpe/lp+/lpe+, or
;;; -lp-clear/lp-default switch, and return the final result package and a ;;; -lp-clear/lp-default switch, and return the final result package and a
@ -359,7 +341,6 @@
(define (parse-switches-and-execute all-args context) (define (parse-switches-and-execute all-args context)
(receive (switches term-switch term-val top-entry args) (receive (switches term-switch term-val top-entry args)
(parse-scsh-args (cdr all-args)) (parse-scsh-args (cdr all-args))
(let ((interactive? (not (or term-switch top-entry))))
(with-handler (with-handler
(lambda (cond more) (lambda (cond more)
(if (warning? cond) (if (warning? cond)
@ -372,7 +353,7 @@
(more))))) (more)))))
(lambda () (lambda ()
(with-scsh-initialized (with-scsh-initialized
interactive? context args (not term-switch) context args
(lambda () (lambda ()
;; Have to do these before calling DO-SWITCHES, because actions ;; Have to do these before calling DO-SWITCHES, because actions
;; performed while processing the switches may use these guys. ;; performed while processing the switches may use these guys.
@ -387,12 +368,12 @@
(let* ((script-loaded? (do-switches switches term-val))) (let* ((script-loaded? (do-switches switches term-val)))
(if (not script-loaded?) ; There wasn't a -ds, -dm, or -de, (if (not script-loaded?) ; There wasn't a -ds, -dm, or -de,
(if (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) (if (eq? term-switch 'sfd)
(load-port-quietly term-val (interaction-environment))))) (load-port-quietly term-val (interaction-environment)))))
(cond (interactive? (cond ((not term-switch) ; -- interactive
(scsh-exit-now ;; TODO: ,exit will bypass this (scsh-exit-now ;; TODO: ,exit will bypass this
(restart-command-processor (restart-command-processor
args args
@ -421,7 +402,7 @@
;; Otherwise, the script executed as it loaded, ;; Otherwise, the script executed as it loaded,
;; so we're done. ;; so we're done.
(else (scsh-exit-now 0))))))))))) (else (scsh-exit-now 0))))))))))
(define (read-exactly-one-sexp-from-string s) (define (read-exactly-one-sexp-from-string s)