From 08d365ff6af35cc9e779b8467cb2444c0379f24b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Mon, 13 Mar 2023 22:42:03 +0100 Subject: [PATCH] Port original parse-command-line. --- brmsaptool.scm | 3 +++ command-line.scm | 24 +++++++++++++++++++++--- 2 files changed, 24 insertions(+), 3 deletions(-) diff --git a/brmsaptool.scm b/brmsaptool.scm index 8d6d7f3..88596d0 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -44,5 +44,8 @@ (command-line-tests!) (newline) +(command-line + (-h "This help" () (print "help"))) + (load-member-file "members/joe") (newline) diff --git a/command-line.scm b/command-line.scm index 90b7ffb..dc9ca19 100644 --- a/command-line.scm +++ b/command-line.scm @@ -26,6 +26,7 @@ (module command-line (command-line + parse-command-line command-line-tests!) (import scheme @@ -56,9 +57,24 @@ (cdr rargs) (cdr args)))) + ;; Performs the actual parsing based on specification. (define (parse-command-line specs) - #f) + (let loop ((args (get-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 (caddr 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)))))) + ;; Syntax for expanding various types of options. (define-syntax make-option (syntax-rules () ((_ opt help (args ...) body ...) @@ -68,11 +84,13 @@ ((_ opt help proc) (list (symbol->string 'opt) help proc)) ((_ opt help) - (list (symbol->string 'opt help 'help))))) + (list (symbol->string 'opt) help 'help)))) + ;; Simple syntax wrapper for command-line arguments specification and + ;; immediate parsing. (define-syntax command-line (syntax-rules () - ((_ ((exps ...) ...)) + ((_ (exps ...) ...) (parse-command-line (list (make-option exps ...) ...)))))