Remove old command-line parsing.
This commit is contained in:
parent
84c5aac95e
commit
bd098dfc12
1 changed files with 13 additions and 72 deletions
|
@ -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:")
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue