12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(declare (unit margs))
;; (declare (uses common))
(define args:arg-hash (make-hash-table))
(define (args:get-arg arg . default)
(if (null? default)
(hash-table-ref/default args:arg-hash arg #f)
(hash-table-ref/default args:arg-hash arg (car default))))
(define (args:any? . args)
(not (null? (filter (lambda (x) x)
(map args:get-arg args)))))
(define (args:get-arg-from ht arg . default)
(if (null? default)
(hash-table-ref/default ht arg #f)
(hash-table-ref/default ht arg (car default))))
(define (args:usage . args)
(if (> (length args) 0)
(apply print "ERROR: " args))
(if (string? help)
(print help)
(print "Usage: " (car (argv)) " ... "))
(exit 0))
;; one-of args defined
(define (args:any-defined? . param)
(let ((res #f))
(for-each
|
|
|
>
|
>
>
>
>
>
>
>
>
>
|
|
|
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
(declare (unit margsmod))
(module margsmod
*
(import scheme chicken data-structures extras)
(import srfi-69 srfi-1)
(define args:help #f)
(define (args:set-help help)
(set! args:help help))
(define args:arg-hash (make-hash-table))
(define (args:get-arg arg . default)
(if (null? default)
(hash-table-ref/default args:arg-hash arg #f)
(hash-table-ref/default args:arg-hash arg (car default))))
(define (args:any? . args)
(not (null? (filter (lambda (x) x)
(map args:get-arg args)))))
(define (args:get-arg-from ht arg . default)
(if (null? default)
(hash-table-ref/default ht arg #f)
(hash-table-ref/default ht arg (car default))))
(define (args:usage . args)
(if (> (length args) 0)
(apply print "ERROR: " args))
(if (string? args:help)
(print args:help)
(print "Usage: " (car (argv)) " ... "))
(exit 0))
;; one-of args defined
(define (args:any-defined? . param)
(let ((res #f))
(for-each
|
82
83
84
85
86
87
88
|
))
(define (args:print-args remargs arg-hash)
(print "ARGS: " remargs)
(for-each (lambda (arg)
(print " " arg " " (hash-table-ref/default arg-hash arg #f)))
(hash-table-keys arg-hash)))
|
>
|
92
93
94
95
96
97
98
99
|
))
(define (args:print-args remargs arg-hash)
(print "ARGS: " remargs)
(for-each (lambda (arg)
(print " " arg " " (hash-table-ref/default arg-hash arg #f)))
(hash-table-keys arg-hash)))
)
|