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

21
embddr/optargs.scm
View File

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