From bd098dfc12815f59bff0471c09c57e2b9214abf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dominik=20Pant=C5=AF=C4=8Dek?= Date: Tue, 14 Mar 2023 21:12:39 +0100 Subject: [PATCH] Remove old command-line parsing. --- brmsaptool-orig.scm | 85 +++++++-------------------------------------- 1 file changed, 13 insertions(+), 72 deletions(-) diff --git a/brmsaptool-orig.scm b/brmsaptool-orig.scm index b9c7fad..03b1228 100644 --- a/brmsaptool-orig.scm +++ b/brmsaptool-orig.scm @@ -34,7 +34,8 @@ dictionary month period - member-file) + member-file + command-line) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Static default configuration @@ -168,67 +169,6 @@ (not (or (member-suspended? mr) (member-destroyed? mr)))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Command-line parsing - -;; Prints simple help -(define (print-help) - (print "Command-line arguments: - - -h prints this help - -M dir specifies the members database directory - -mi id member id - -mn nick member nick -") - (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)))))) - -;; Gets command-line arguments after the "--" of csi (not useful when -;; compiled) -(define (get-command-line-arguments . explicit-argv) - (let* ((args (if (null? explicit-argv) (argv) explicit-argv)) - (rargs (member "--" args))) - (if rargs - (cdr rargs) - (cdr args)))) - -;; Performs the actual parsing based on specification. -(define (do-parse-command-line specs) - (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 (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 @@ -240,16 +180,17 @@ (newline) ;; Handle options -(parse-command-line - (("-h" print-help) - ("-M" (lambda (dn) (*members-directory* dn))) - ("-mi" (lambda (id) - (action 'member-by-id) - (member-parm (string->number id)))) - ("-mn" (lambda (nick) - (action 'member-by-nick) - (member-parm nick))) - )) +(command-line + print-help + (-h "Help" print-help) + (-M (dn) "Members dir" (*members-directory* dn)) + (-mi (id) "Id" + (action 'member-by-id) + (member-parm (string->number id))) + (-mn (nick) "Nick" + (action 'member-by-nick) + (member-parm nick)) + ) ;; Run tests (print "Running self-tests:")