1
2
3
4
5
6
7
8
9
10
11
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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
;; @module getopts.lsp
;; @description Parse short and long command line options according to POSIX rules
;; @version 1.0 initial release
;; @author Ted Walther, July 2011
;;
;; POSIX options come in 4 types; long and short, with or without an extra argument.
;;
;; Short options are just a single letter with a <tt>-</tt> in front. '-a -v -h' are single options. Short options can be collapsed together. '-a -v -h' is the same thing as '-avh'
;;
;; A short option that takes an argument can take the following two forms: '-fmyletter.txt' is the same as '-f myletter.txt'
;;
;; Long options start with '--'. '--quiet' and '--help' are good examples.
;;
;; A long option that takes an argument can be in the following two forms: '--file=myletter.txt' is the same as '--file myletter.txt'
;;
;; Here is an example of how to use this module. It includes a bunch of standard options that every GNU program should support.
;;
;; @example
;;
;; (module "getopts.lsp")
;;
;; (setq version-string "Version: 1.0 (2011)")
;;
;; (shortopt "V" (getopts:die version-string) nil "Print version string")
;; (shortopt "v" (++ verbosity) nil "Increase verbosity")
;; (shortopt "q" (setq verbosity 0) nil "Quiet")
;; (shortopt "?" (getopts:usage) nil "Print this help message")
;; (shortopt "h" (getopts:usage) nil "Print this help message")
;; (shortopt "o" (setq output-file getopts:arg) "file" "Output file")
;; (longopt "help" (getopts:usage) nil "Print this help message")
;; (longopt "quiet" (setq verbosity 0) nil "Quiet")
;; (longopt "verbose" (++ verbosity) nil)
;; (longopt "version" (getopts:die version-string) nil "Print version string")
;; (longopt "output" (setq output-file getopts:arg) "file" "Output file")
;;
;; (println (main-args))
;; (println (getopts (2 (main-args))))
;; (println "Verbosity: " verbosity)
;; (println "Output To: " output-file)
;; (exit)
;; @syntax (shortopt <opt> <action> <arg?> <desc>)
;; @param <opt> The single letter option
;; @param <action> The code to execute when the option is found
;; @param <arg?> 'nil' if the option doesn't take an argument, otherwise a string that describes the type of argument the option takes.
;; @param <desc> A string that describes the option. This is used by the 'usage' function.
;; @example
;; (shortopt "o" (setq output-file getopts:arg) "file" "Output file")
;; ...
;; $ ./myscript.lsp -ofoo.txt -q
;; $ ./myscript.lsp -qofoo.txt
;; $ ./myscript.lsp -o foo.txt -q
;; $ ./myscript.lsp -qo foo.txt
(define-macro (shortopt opt action arg? desc)
(if (assoc opt getopts:short)
(setf (assoc opt getopts:short) (list opt (list action arg? (or desc ""))))
(push (list opt (list action arg? (or desc ""))) getopts:short)))
;; @syntax (longopt <opt> <action> <arg?> <desc>)
;; @param <opt> The long option
;; @param <action> The code to execute when the option is found
;; @param <arg?> 'nil' if the option doesn't take an argument, otherwise a string that describes the type of argument the option takes.
;; @param <desc> A string that describes the option. This is used by the 'usage' function.
;; @example
;; (longopt "output" (setq output-file getopts:arg) "file" "Output file")
;; ...
;; $ ./myscript.lsp --output=foo.txt --quiet
;; $ ./myscript.lsp --verbose --output foo.txt
(define-macro (longopt opt action arg? desc)
(if (assoc opt getopts:long)
(setf (assoc opt getopts:long) (list opt (list action arg? (or desc ""))))
(push (list opt (list action arg? (or desc ""))) getopts:long)))
;; @syntax getopts:arg
;;
;; The variable <getopts:arg> holds the argument to the option, for those options
;; which take an argument. This is useful inside the <action> code, so you can make
;; use of the argument. For instance, '--prefix=/usr/bin' on the command line, would
;; leave the value '/usr/bin' in <getopts:arg>, and your <action> code could store the
;; value or act on it in some other way.
(context 'getopts)
(define short (list))
(define long (list))
;; @syntax (getopts:usage)
;; @return Exits script with a value of 0
;; Prints out every command line option that has been registered with the getopts module.
;;
;; @example
;; (shortopt "?" (getopts:usage) nil "Print this help message")
;; ...
;; $ ./myscript.lsp -?
;; ==>
;; Usage: ./myscript.lsp [options]
;; -o file Output file
;; -h Print this help message
;; -? Print this help message
;; -q Quiet
;; -v Increase verbosity
;; --output file Output file
;; --verbose
;; --quiet Quiet
;; --help Print this help message
;;
(define (usage)
(println "Usage: " (main-args 1) " [options]")
(dolist (o short) (println (format "\t -%s %-15s\t%s" (o 0) (or (o 1 1) "") (o 1 2))))
(dolist (o long) (println (format "\t--%s %-15s\t%s" (o 0) (or (o 1 1) "") (o 1 2))))
(exit 0))
;; @syntax (getopts:die <format-string> [<format options...>])
;; @return Exits script with a value of 1
;; Prints an error message, then exits. Syntax is exactly the same as the 'format' function.
(define-macro (die)
(println (eval (append (list 'format) (args)))) (exit 1))
(define (getopts:getopts arglst)
(let (unoption-args (list))
(while arglst
(let (a (pop arglst))
(cond
((regex "^--$" a)
(setq unoption-args (append unoption-args arglst) arglst nil))
((regex "^--([^=]+)=(.*)$" a)
(let (opt $1 arg $2)
(unless (lookup opt long)
(die {Unrecognized option "%s" {%s}} opt a))
(unless ((lookup opt long) 1)
(die {Option "%s" doesn't take an argument! {%s}} opt a))
(when (empty? arg)
(die {No argument supplied for option "%s" {%s}} opt a))
(eval (first (lookup opt long)))))
((regex "^--([^=]+)$" a)
(let (opt $1 arg nil)
(unless (lookup opt long)
(die {Unrecognized option "%s" {%s}} opt a))
(when ((lookup opt long) 1)
(unless arglst
(die {No argument supplied for option "%s" {%s}} opt a))
(setq arg (pop arglst)))
(eval (first (lookup opt long)))))
((regex "^-([^-]+)$" a)
(let (options $1)
(while (not (empty? options))
(let (opt (pop options) arg nil)
(unless (lookup opt short)
(die {Unrecognized option "%s" {%s}} opt a))
(when ((lookup opt short) 1)
(if (not (empty? options))
(setq arg options options "")
(if arglst
(setq arg (pop arglst))
(die {No argument supplied for option "%s" {%s}} opt a))))
(eval (first (lookup opt short)))))))
(true (push a unoption-args -1))
)
)
)
unoption-args
)
)
(context MAIN)
;; @syntax (getopts <arglist>)
;; @param <arglist> A list of strings, typically a subset of (main-args)
;; @return The list of all command line arguments that were NOT options.
;; After you have set up all the options using 'shortopt' and 'longopt', call 'getopts' to parse the commandline.
|
