np/embddr-scheme-library
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Change ontions definition. Able to define only long or short option

Browse Source
This commit is contained in:
Nikolay Puzanov 2022-11-30 14:16:54 +03:00
parent 1156b31463
commit 877efd7f95
1 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
embddr/optargs.scm
View File

@ -11,51 +11,50 @@
;;; TODO: Write docs
;;;
(define (option-get opts name)
(let ((opt (assq name opts)))
(let ((opt (assoc name opts)))
(if opt
(cdr opt)
#f)))
(define (option-set opts name value)
(if (assq name opts)
(if (assoc name opts)
(map (lambda (opt)
(if (eq? (car opt) name)
(if (equal? (car opt) name)
(cons name value)
opt))
opts)
(alist-cons name value opts)))
(define (option-add opts name value)
(if (assq name opts)
(if (assoc name opts)
(option-set opts name
(cons value
(option-get opts name)))
(alist-cons name `(,value) opts)))
;;; opt-spec - '(#\o "option" [none | required | optional | multiple])
;;; opt-spec - '(("option" #\o) [none | required | optional | multiple])
(define (parse-opts args . opt-spec)
(args-fold
;; args
args
;; options
(map (lambda (spec)
(let ((char (list-ref spec 0))
(name (list-ref spec 1))
(type (list-ref spec 2)))
(let ((name-str (symbol->string name))
(req? (eq? type 'required))
(opt? (eq? type 'optional))
(many? (eq? type 'multiple)))
(option (list char name-str) (or many? req?) opt?
(if many?
(lambda (opt nm arg opts rest error)
(values (if arg
(option-add opts name arg)
opts)
rest
error))
(lambda (opt nm arg opts rest error)
(values (option-set opts name (if arg arg #t)) rest error)))))))
(let* ((names (list-ref spec 0))
(type (list-ref spec 1))
(name (car names))
(req? (eq? type 'required))
(opt? (eq? type 'optional))
(many? (eq? type 'multiple)))
(option names (or many? req?) opt?
(if many?
(lambda (opt nm arg opts rest error)
(values (if arg
(option-add opts name arg)
opts)
rest
error))
(lambda (opt nm arg opts rest error)
(values (option-set opts name (if arg arg #t)) rest error))))))
opt-spec)
;; unrecognized options
(lambda (opt name arg opts rest error)