Basic command-line parsing.
This commit is contained in:
parent
30c0a9838d
commit
90abcaa03c
1 changed files with 54 additions and 1 deletions
|
@ -30,7 +30,6 @@
|
||||||
(chicken sort)
|
(chicken sort)
|
||||||
(chicken time)
|
(chicken time)
|
||||||
(chicken time posix)
|
(chicken time posix)
|
||||||
|
|
||||||
(chicken process-context))
|
(chicken process-context))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -484,6 +483,56 @@
|
||||||
(define (list-members-nicks mdb)
|
(define (list-members-nicks mdb)
|
||||||
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mdb))
|
(map (lambda (mr) (dict-ref (dict-ref mr 'info) 'nick)) mdb))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Command-line parsing
|
||||||
|
|
||||||
|
;; Prints simple help
|
||||||
|
(define (print-help)
|
||||||
|
(print "Command-line arguments:
|
||||||
|
|
||||||
|
-h prints this help
|
||||||
|
-M dir specifies the members database directory
|
||||||
|
")
|
||||||
|
(exit 0))
|
||||||
|
|
||||||
|
;; Consumes given number of arguments from the list and returns the
|
||||||
|
;; remainder of the list and a list of arguments consumed.
|
||||||
|
(define (consume-args args num)
|
||||||
|
(let loop ((args args)
|
||||||
|
(res '())
|
||||||
|
(num num))
|
||||||
|
(if (= num 0)
|
||||||
|
(list args (reverse res))
|
||||||
|
(if (null? args)
|
||||||
|
(error 'consume-args "Not enough arguments" num)
|
||||||
|
(loop (cdr args)
|
||||||
|
(cons (car args) res)
|
||||||
|
(- num 1))))))
|
||||||
|
|
||||||
|
;; Performs the actual parsing based on specification.
|
||||||
|
(define (do-parse-command-line specs)
|
||||||
|
(let loop ((args (command-line-arguments)))
|
||||||
|
(when (not (null? args))
|
||||||
|
(let* ((arg (car args))
|
||||||
|
(specp (assoc arg specs)))
|
||||||
|
(when (not specp)
|
||||||
|
(error 'parse-command-line "Unknown argument" arg))
|
||||||
|
(let* ((proc (cadr specp))
|
||||||
|
(info (procedure-information proc))
|
||||||
|
(nargs (- (length info) 1))
|
||||||
|
(aargsl (consume-args (cdr args) nargs))
|
||||||
|
(args (car aargsl))
|
||||||
|
(aargs (cadr aargsl)))
|
||||||
|
(apply proc aargs)
|
||||||
|
(loop args))))))
|
||||||
|
|
||||||
|
;; Simple syntax wrapper for command-line arguments specification
|
||||||
|
(define-syntax parse-command-line
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ ((arg proc) ...))
|
||||||
|
(do-parse-command-line
|
||||||
|
`((arg ,proc) ...)))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Run everything
|
;; Run everything
|
||||||
|
|
||||||
|
@ -491,6 +540,10 @@
|
||||||
(print "brmsaptool 0.1 (c) 2023 Brmlab, z.s.")
|
(print "brmsaptool 0.1 (c) 2023 Brmlab, z.s.")
|
||||||
(newline)
|
(newline)
|
||||||
|
|
||||||
|
(parse-command-line
|
||||||
|
(("-h" print-help)
|
||||||
|
("-M" (lambda (dn) (*members-directory* dn)))))
|
||||||
|
|
||||||
;; Run tests
|
;; Run tests
|
||||||
(print "Running self-tests:")
|
(print "Running self-tests:")
|
||||||
(dict-tests!)
|
(dict-tests!)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue