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