brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

New command-line syntax.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-14 09:22:29 +01:00
parent 08d365ff6a
commit 70e5079239
3 changed files with 21 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

4
brmsaptool-orig.scm
View file

@ -198,8 +198,8 @@
;; Gets command-line arguments after the "--" of csi (not useful when ;; Gets command-line arguments after the "--" of csi (not useful when
;; compiled) ;; compiled)
(define (get-command-line-arguments) (define (get-command-line-arguments . explicit-argv)
(let* ((args (argv)) (let* ((args (if (null? explicit-argv) (argv) explicit-argv))
(rargs (member "--" args))) (rargs (member "--" args)))
(if rargs (if rargs
(cdr rargs) (cdr rargs)

9
brmsaptool.scm
View file

@ -45,7 +45,8 @@
(newline) (newline)
(command-line (command-line
(-h "This help" () (print "help"))) print-help
(-h "This help" () (print "help") (print-help) (print "done") (exit 0))
(load-member-file "members/joe") (-a "One-argument" (x) (print "Argument x " x))
(newline) (-b "Two arguments" (x y) (print "Arguments " x y))
(-c "Argument lambda" (lambda (x) (print "Lambda x " x))))

21
command-line.scm
View file

@ -26,7 +26,8 @@
(module (module
command-line command-line
(command-line (command-line
parse-command-line command-line:parse-command-line
command-line:print-options
command-line-tests!) command-line-tests!)
(import scheme (import scheme
@ -58,7 +59,7 @@
(cdr args)))) (cdr args))))
;; Performs the actual parsing based on specification. ;; Performs the actual parsing based on specification.
(define (parse-command-line specs) (define (command-line:parse-command-line specs)
(let loop ((args (get-command-line-arguments))) (let loop ((args (get-command-line-arguments)))
(when (not (null? args)) (when (not (null? args))
(let* ((arg (car args)) (let* ((arg (car args))
@ -74,15 +75,19 @@
(apply proc aargs) (apply proc aargs)
(loop args)))))) (loop args))))))
;; Prints options descriptions.
(define (command-line:print-options specs)
(print "options"))
;; Syntax for expanding various types of options. ;; Syntax for expanding various types of options.
(define-syntax make-option (define-syntax make-option
(syntax-rules () (syntax-rules ()
((_ opt help proc)
(list (symbol->string 'opt) help proc))
((_ opt help (args ...) body ...) ((_ opt help (args ...) body ...)
(list (symbol->string 'opt) (list (symbol->string 'opt)
help help
(lambda (args ...) body ...))) (lambda (args ...) body ...)))
((_ opt help proc)
(list (symbol->string 'opt) help proc))
((_ opt help) ((_ opt help)
(list (symbol->string 'opt) help 'help)))) (list (symbol->string 'opt) help 'help))))
@ -90,9 +95,11 @@
;; immediate parsing. ;; immediate parsing.
(define-syntax command-line (define-syntax command-line
(syntax-rules () (syntax-rules ()
((_ (exps ...) ...) ((_ print-help (exps ...) ...)
(parse-command-line (letrec ((specs (list (make-option exps ...) ...))
(list (make-option exps ...) ...))))) (print-help (lambda ()
(command-line:print-options specs))))
(command-line:parse-command-line specs)))))
;; Performs self-tests of the command-line module ;; Performs self-tests of the command-line module
(define (command-line-tests!) (define (command-line-tests!)