author | Claus Gittinger <cg@exept.de> |
Wed, 26 Jun 2019 22:06:12 +0200 | |
changeset 24369 | e796791ea838 |
parent 23385 | f93e38f2fe07 |
child 24765 | e91461190d47 |
permissions | -rw-r--r-- |
23385 | 1 |
"{ Encoding: utf8 }" |
2 |
||
10888 | 3 |
" |
4 |
Copyright (c) 2005 Ian Piumarta |
|
5 |
All rights reserved. |
|
6 |
||
7 |
Permission is hereby granted, free of charge, to any person obtaining a |
|
8 |
copy of this software and associated documentation files (the 'Software'), |
|
9 |
to deal in the Software without restriction, including without limitation |
|
10 |
the rights to use, copy, modify, merge, publish, distribute, and/or sell |
|
11 |
copies of the Software, and to permit persons to whom the Software is |
|
12 |
furnished to do so, provided that the above copyright notice(s) and this |
|
13 |
permission notice appear in all copies of the Software and that both the |
|
14 |
above copyright notice(s) and this permission notice appear in supporting |
|
15 |
documentation. |
|
16 |
||
17 |
THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. |
|
18 |
||
19 |
Last edited: 2006-02-03 11:13:33 by piumarta on margaux.local |
|
20 |
" |
|
21 |
"{ Package: 'stx:libbasic' }" |
|
22 |
||
23385 | 23 |
"{ NameSpace: Smalltalk }" |
24 |
||
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
25 |
Dictionary subclass:#GetOpt |
16690 | 26 |
instanceVariableNames:'defaultBlock onErrorBlock' |
10888 | 27 |
classVariableNames:'' |
28 |
poolDictionaries:'' |
|
29 |
category:'System-Support' |
|
30 |
! |
|
31 |
||
32 |
!GetOpt class methodsFor:'documentation'! |
|
33 |
||
34 |
copyright |
|
35 |
" |
|
36 |
Copyright (c) 2005 Ian Piumarta |
|
37 |
All rights reserved. |
|
38 |
||
39 |
Permission is hereby granted, free of charge, to any person obtaining a |
|
40 |
copy of this software and associated documentation files (the 'Software'), |
|
41 |
to deal in the Software without restriction, including without limitation |
|
42 |
the rights to use, copy, modify, merge, publish, distribute, and/or sell |
|
43 |
copies of the Software, and to permit persons to whom the Software is |
|
44 |
furnished to do so, provided that the above copyright notice(s) and this |
|
45 |
permission notice appear in all copies of the Software and that both the |
|
46 |
above copyright notice(s) and this permission notice appear in supporting |
|
47 |
documentation. |
|
48 |
||
49 |
THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. |
|
50 |
||
51 |
Last edited: 2006-02-03 11:13:33 by piumarta on margaux.local |
|
52 |
" |
|
53 |
! |
|
54 |
||
55 |
documentation |
|
56 |
" |
|
57 |
GetOpt -- command line parser |
|
58 |
||
59 |
Smalltalk version of Unix getopt(3)-like command line parser. |
|
60 |
Crash course: |
|
61 |
||
62 |
1) Create a GetOpt with 'GetOpt new'. |
|
63 |
2) Tell it what options to expect with 'getOpt at: optChar put: optBlock' |
|
64 |
where optChar is a character (the option, duh) and optBlock is a |
|
65 |
unary block (for options without arguments) or a binary block for |
|
66 |
options with arguments. (The first block parameter is always the |
|
67 |
option letter that was matched; the second, if present, is the |
|
68 |
argument to the option.) |
|
69 |
3) Tell it what to do with option $? if you want to intercept unrecognised |
|
70 |
options. |
|
71 |
4) Send it 'default: unaryBlock' to tell it what to do with non-option |
|
72 |
arguments. |
|
73 |
5) Send it 'parse: aCollection' to parse the arguments in aCollection. |
|
74 |
||
75 |
Note that '-x foo' and '-xfoo' are handled correctly for an option |
|
76 |
'x' that expects an argument (in both cases the argument is 'foo'). |
|
77 |
||
78 |
For anyone who didn't understand the crash course, the following: |
|
79 |
||
80 |
| files searchPath outputPath verbose | |
|
81 |
files := OrderedCollection new. |
|
82 |
searchPath := OrderedCollection new. |
|
83 |
outputPath := nil. |
|
84 |
verbose := false. |
|
85 |
GetOpt new |
|
86 |
at: $I put: [ :opt :arg | searchPath add: arg ]; |
|
87 |
at: $o put: [ :opt :arg | outputPath := arg ]; |
|
88 |
at: $v put: [ :opt | verbose := true ]; |
|
89 |
at: $? put: [ :opt | self error: 'illegal option: -' , opt asString ]; |
|
90 |
default: [ :arg | files add: arg ]; |
|
91 |
parse: Smalltalk arguments startingAt: 1. |
|
92 |
||
93 |
will parse a compiler command line for include directories ('-I dir' |
|
94 |
option, argument appended to 'searchPath'), an output filename |
|
95 |
('-o filename' option, argument left in 'outputPath'), a verbosity |
|
96 |
flag ('-v' option, setting 'verbose' to true), and zero or more input |
|
97 |
filenames (anything else, appended to 'files'). |
|
98 |
If you still don't understand then you shouldn't be here. |
|
99 |
||
100 |
[author:] |
|
101 |
Ian Piumarta |
|
102 |
||
103 |
[see also:] |
|
104 |
StandaloneStartup |
|
105 |
Smalltalk |
|
106 |
ReadEvalPrintLoop |
|
107 |
" |
|
108 |
! |
|
109 |
||
110 |
example |
|
111 |
" |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
112 |
| commandLine commandLineArguments files searchPath outputPath verbose foo level | |
10888 | 113 |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
114 |
commandLine := '-I /foo/bar -level 1 --foo -o bla.x -v file1 file2 file3'. |
10888 | 115 |
commandLineArguments := commandLine asCollectionOfWords. |
116 |
||
117 |
files := OrderedCollection new. |
|
118 |
searchPath := OrderedCollection new. |
|
119 |
outputPath := nil. |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
120 |
verbose := foo := false. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
121 |
level := nil. |
10888 | 122 |
GetOpt new |
123 |
at: $I put: [ :opt :arg | searchPath add: arg ]; |
|
124 |
at: $o put: [ :opt :arg | outputPath := arg ]; |
|
125 |
at: $v put: [ :opt | verbose := true ]; |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
126 |
at: '-foo' put: [ :opt | foo := true ]; |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
127 |
at: 'level' put: [ :opt :arg | level := arg ]; |
10888 | 128 |
at: $? put: [ :opt | self error: 'illegal option: -' , opt asString ]; |
129 |
default: [ :arg | files add: arg ]; |
|
130 |
parse: commandLineArguments startingAt: 1. |
|
131 |
||
132 |
Transcript show:'files: '; showCR:files. |
|
133 |
Transcript show:'searchPath: '; showCR:searchPath. |
|
134 |
Transcript show:'outputPath: '; showCR:outputPath. |
|
135 |
Transcript show:'verbose: '; showCR:verbose. |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
136 |
Transcript show:'foo: '; showCR:foo. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
137 |
Transcript show:'level: '; showCR:level. |
23385 | 138 |
|
139 |
||
140 |
| commandLine commandLineArguments debugOption helpOption | |
|
141 |
||
142 |
commandLine := '-h --debugPort 1234'. |
|
143 |
commandLineArguments := commandLine asCollectionOfWords. |
|
144 |
||
145 |
(GetOpt new) |
|
146 |
at:$d |
|
147 |
put:[:opt | debugOption := true]; |
|
148 |
at:$h |
|
149 |
put:[:opt | helpOption := true]; |
|
150 |
at:'-debugPort' |
|
151 |
put:[:opt :arg | debugOption := true]; |
|
152 |
at:$? |
|
153 |
put:[:arg | self halt]; |
|
154 |
default:[:arg | self halt]; |
|
155 |
onError:[:msg | self halt]; |
|
156 |
parse:commandLineArguments. |
|
157 |
||
158 |
||
10888 | 159 |
" |
160 |
! ! |
|
161 |
||
162 |
!GetOpt class methodsFor:'instance creation'! |
|
163 |
||
164 |
new |
|
165 |
^ super new initializeDefaultBlock |
|
166 |
! ! |
|
167 |
||
168 |
!GetOpt methodsFor:'accessing'! |
|
169 |
||
170 |
default: unaryBlock |
|
171 |
defaultBlock := unaryBlock |
|
16690 | 172 |
! |
173 |
||
174 |
onError: unaryBlock |
|
175 |
onErrorBlock := unaryBlock |
|
176 |
! ! |
|
177 |
||
178 |
!GetOpt methodsFor:'error reporting'! |
|
179 |
||
180 |
error:aMessage |
|
181 |
onErrorBlock notNil ifTrue:[ |
|
182 |
onErrorBlock value:aMessage |
|
183 |
]. |
|
184 |
super error:aMessage |
|
10888 | 185 |
! ! |
186 |
||
187 |
!GetOpt methodsFor:'initialization'! |
|
188 |
||
189 |
initializeDefaultBlock |
|
190 |
defaultBlock := [:arg | ]. |
|
191 |
! ! |
|
192 |
||
193 |
!GetOpt methodsFor:'parsing'! |
|
194 |
||
195 |
parse: argumentCollection |
|
196 |
^ self parse: argumentCollection startingAt: 1 |
|
197 |
! |
|
198 |
||
199 |
parse: argumentCollection startingAt: offset |
|
200 |
| args | |
|
201 |
||
202 |
args := argumentCollection readStream skip: (offset - 1). |
|
203 |
[args atEnd] |
|
204 |
whileFalse:[ |
|
205 |
| arg | |
|
206 |
arg := args next. |
|
207 |
self parseArgument: arg with: args ] |
|
208 |
! ! |
|
209 |
||
210 |
!GetOpt methodsFor:'parsing - private'! |
|
211 |
||
212 |
parseArgument: arg with: rest |
|
14133 | 213 |
(arg size > 1 and:[arg first = $-]) |
10888 | 214 |
ifTrue: [self parseOption: arg with: rest] |
215 |
ifFalse: [defaultBlock value: arg] |
|
216 |
! |
|
217 |
||
218 |
parseOption: option with: rest |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
219 |
| block longOption | |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
220 |
|
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
221 |
"/ cg: changed to support non-single-character args (--foo) |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
222 |
block := self at: option second ifAbsent:nil. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
223 |
block isNil ifTrue:[ |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
224 |
option size > 2 ifTrue:[ |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
225 |
longOption := option copyFrom:2. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
226 |
block := self at: longOption ifAbsent:nil. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
227 |
block notNil ifTrue:[ |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
228 |
"/ a long option; never take rest of option as argument |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
229 |
block arity = 1 |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
230 |
ifTrue: [ ^ block value: longOption ] |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
231 |
ifFalse: [ |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
232 |
rest atEnd |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
233 |
ifTrue: [self error: 'argument missing to option ' , longOption]. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
234 |
^ block value: longOption value: rest next |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
235 |
] |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
236 |
] |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
237 |
]. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
238 |
block isNil ifTrue:[ |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
239 |
block := self at: $? ifAbsent: nil. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
240 |
block isNil ifTrue:[ |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
241 |
^ defaultBlock value: option |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
242 |
] |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
243 |
] |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
244 |
]. |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
245 |
^ block arity = 1 |
10888 | 246 |
ifTrue: [self applyOption: option to: block] |
247 |
ifFalse: [self applyOption: option to: block with: rest] |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
248 |
|
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
249 |
"Modified: / 19-09-2011 / 10:07:57 / cg" |
10888 | 250 |
! ! |
251 |
||
252 |
!GetOpt methodsFor:'private'! |
|
253 |
||
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
254 |
applyOption: anOption to: unaryBlock |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
255 |
^anOption size == 2 |
10888 | 256 |
ifTrue: [unaryBlock value: anOption second] |
257 |
ifFalse: [self error: 'option ' , anOption , ' should not have an argument'] |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
258 |
|
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
259 |
"Modified: / 19-09-2011 / 10:03:31 / cg" |
10888 | 260 |
! |
261 |
||
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
262 |
applyOption: anOption to: binaryBlock with: rest |
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
263 |
^anOption size == 2 |
10888 | 264 |
ifTrue: [rest atEnd |
265 |
ifTrue: [self error: 'argument missing to option ' , anOption] |
|
266 |
ifFalse: [binaryBlock value: anOption second value: rest next]] |
|
267 |
ifFalse: [binaryBlock value: anOption second value: (anOption copyFrom: 3)] |
|
13712
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
268 |
|
9b34eae96ce6
cg: support long options, such as \"--foo\", \"-foo\", \"--bar x\" or
Claus Gittinger <cg@exept.de>
parents:
10888
diff
changeset
|
269 |
"Modified: / 19-09-2011 / 10:06:05 / cg" |
10888 | 270 |
! ! |
271 |
||
272 |
!GetOpt class methodsFor:'documentation'! |
|
273 |
||
274 |
version |
|
23385 | 275 |
^ '$Header$' |
10888 | 276 |
! ! |
16690 | 277 |