Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 06:39:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing error messages for unknown options.

Browse source
This commit is contained in:
Alex Shinn 2015-04-03 14:11:33 +09:00
parent 443dd1bc3f
commit 59a4e56df5
1 changed files with 12 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
lib/chibi/app.scm
View file

@ -72,7 +72,8 @@
`(not ,x))
(else (lp (cdr ls))))))))
(define (parse-long-option str args fail)
(let* ((str+val (string-split str #\= 2))
(let* ((fail-args (cons (string-append "--" str) args))
(str+val (string-split str #\= 2))
(str (car str+val))
(args (if (pair? (cdr str+val)) (cons (cadr str+val) args) args))
(strs (string-split str #\.))
@ -82,11 +83,11 @@
((not spec)
;; check for 'no' prefix on boolean
(if (not (string-prefix? "no" str))
(fail prefix conf-spec (car args) args "unknown option")
(fail prefix conf-spec (car fail-args) fail-args "unknown option")
(let ((res (parse-long-option (substring str 2) args (lambda args #f))))
(cond
((not res)
(fail prefix conf-spec (car args) args "unknown option"))
(fail prefix conf-spec (car fail-args) fail-args "unknown option"))
((not (boolean? (cdar res)))
(error "'no' prefix only valid on boolean options"))
(else
@ -96,19 +97,20 @@
((and (eq? 'boolean (cadr spec)) (null? (cdr str+val)))
(cons (cons (append prefix (list (car spec))) #t) args))
((null? args)
(fail prefix conf-spec (car args) args "missing argument to option"))
(fail prefix conf-spec (car fail-args) fail-args "missing argument to option"))
(else
(let ((val+err (parse-value (cadr spec) (car args))))
(if (cadr val+err)
(fail prefix conf-spec (car args) args (cadr val+err))
(fail prefix conf-spec (car fail-args) fail-args (cadr val+err))
(cons (cons (append prefix syms) (car val+err))
(cdr args))))))))
(define (parse-short-option str args fail)
(let* ((ch (string-ref str 0))
(x (lookup-short-option ch conf-spec)))
(x (lookup-short-option ch conf-spec))
(fail-args (cons (string-append "-" str) args)))
(cond
((not x)
(fail prefix conf-spec (car args) args "unknown option"))
(fail prefix conf-spec (car fail-args) fail-args "unknown option"))
((and (pair? x) (eq? 'not (car x)))
(cons (cons (append prefix (list (car (cadr x)))) #f)
(if (= 1 (string-length str))
@ -126,7 +128,7 @@
(cons (cons (append prefix (list (car x))) (car val+err))
args))))
((null? args)
(fail prefix conf-spec (car args) args "missing argument to option"))
(fail prefix conf-spec (car fail-args) fail-args "missing argument to option"))
(else
(cons (cons (append prefix (list (car x))) (car args)) (cdr args))))))
(if (eqv? #\- (string-ref (car args) 1))
@ -167,8 +169,8 @@
((@)
(let* ((new-opt-spec (cadr (car spec)))
(new-fail
(lambda (new-prefix new-spec opt args reason)
(parse-option (prev-prefix prefix) opt-spec args fail)))
(lambda (new-prefix new-spec new-opt new-args reason)
(parse-options (prev-prefix prefix) opt-spec new-args fail)))
(cfg+args (parse-options prefix new-opt-spec args new-fail))
(config (conf-append (car cfg+args) config))
(args (cdr cfg+args)))