diff --git a/brmsaptool.scm b/brmsaptool.scm index 7b199a8..ee6d2f6 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -30,7 +30,6 @@ (chicken sort) (chicken time) (chicken time posix) - (chicken process-context)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -484,6 +483,56 @@ (define (list-members-nicks 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 @@ -491,6 +540,10 @@ (print "brmsaptool 0.1 (c) 2023 Brmlab, z.s.") (newline) +(parse-command-line + (("-h" print-help) + ("-M" (lambda (dn) (*members-directory* dn))))) + ;; Run tests (print "Running self-tests:") (dict-tests!)