Remove old command-line parsing.

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
+(command-line
- (("-h" print-help)
+ print-help
-  ("-M" (lambda (dn) (*members-directory* dn)))
+ (-h "Help" print-help)
-  ("-mi" (lambda (id)
+ (-M (dn) "Members dir" (*members-directory* dn))
-	   (action 'member-by-id)
+ (-mi (id) "Id" 
-	   (member-parm (string->number id))))
+  (action 'member-by-id)
-  ("-mn" (lambda (nick)
+  (member-parm (string->number id)))
-	   (action 'member-by-nick)
+ (-mn (nick) "Nick"
-	   (member-parm nick)))
+  (action 'member-by-nick)
-  ))
+  (member-parm nick))
+ )
 
 ;; Run tests
 (print "Running self-tests:")