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