|
1 " |
|
2 Copyright (c) 2005 Ian Piumarta |
|
3 All rights reserved. |
|
4 |
|
5 Permission is hereby granted, free of charge, to any person obtaining a |
|
6 copy of this software and associated documentation files (the 'Software'), |
|
7 to deal in the Software without restriction, including without limitation |
|
8 the rights to use, copy, modify, merge, publish, distribute, and/or sell |
|
9 copies of the Software, and to permit persons to whom the Software is |
|
10 furnished to do so, provided that the above copyright notice(s) and this |
|
11 permission notice appear in all copies of the Software and that both the |
|
12 above copyright notice(s) and this permission notice appear in supporting |
|
13 documentation. |
|
14 |
|
15 THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. |
|
16 |
|
17 Last edited: 2006-02-03 11:13:33 by piumarta on margaux.local |
|
18 " |
|
19 "{ Package: 'stx:libbasic' }" |
|
20 |
|
21 IdentityDictionary subclass:#GetOpt |
|
22 instanceVariableNames:'defaultBlock' |
|
23 classVariableNames:'' |
|
24 poolDictionaries:'' |
|
25 category:'System-Support' |
|
26 ! |
|
27 |
|
28 !GetOpt class methodsFor:'documentation'! |
|
29 |
|
30 copyright |
|
31 " |
|
32 Copyright (c) 2005 Ian Piumarta |
|
33 All rights reserved. |
|
34 |
|
35 Permission is hereby granted, free of charge, to any person obtaining a |
|
36 copy of this software and associated documentation files (the 'Software'), |
|
37 to deal in the Software without restriction, including without limitation |
|
38 the rights to use, copy, modify, merge, publish, distribute, and/or sell |
|
39 copies of the Software, and to permit persons to whom the Software is |
|
40 furnished to do so, provided that the above copyright notice(s) and this |
|
41 permission notice appear in all copies of the Software and that both the |
|
42 above copyright notice(s) and this permission notice appear in supporting |
|
43 documentation. |
|
44 |
|
45 THE SOFTWARE IS PROVIDED 'AS IS'. USE ENTIRELY AT YOUR OWN RISK. |
|
46 |
|
47 Last edited: 2006-02-03 11:13:33 by piumarta on margaux.local |
|
48 " |
|
49 ! |
|
50 |
|
51 documentation |
|
52 " |
|
53 GetOpt -- command line parser |
|
54 |
|
55 Smalltalk version of Unix getopt(3)-like command line parser. |
|
56 Crash course: |
|
57 |
|
58 1) Create a GetOpt with 'GetOpt new'. |
|
59 2) Tell it what options to expect with 'getOpt at: optChar put: optBlock' |
|
60 where optChar is a character (the option, duh) and optBlock is a |
|
61 unary block (for options without arguments) or a binary block for |
|
62 options with arguments. (The first block parameter is always the |
|
63 option letter that was matched; the second, if present, is the |
|
64 argument to the option.) |
|
65 3) Tell it what to do with option $? if you want to intercept unrecognised |
|
66 options. |
|
67 4) Send it 'default: unaryBlock' to tell it what to do with non-option |
|
68 arguments. |
|
69 5) Send it 'parse: aCollection' to parse the arguments in aCollection. |
|
70 |
|
71 Note that '-x foo' and '-xfoo' are handled correctly for an option |
|
72 'x' that expects an argument (in both cases the argument is 'foo'). |
|
73 |
|
74 For anyone who didn't understand the crash course, the following: |
|
75 |
|
76 | files searchPath outputPath verbose | |
|
77 files := OrderedCollection new. |
|
78 searchPath := OrderedCollection new. |
|
79 outputPath := nil. |
|
80 verbose := false. |
|
81 GetOpt new |
|
82 at: $I put: [ :opt :arg | searchPath add: arg ]; |
|
83 at: $o put: [ :opt :arg | outputPath := arg ]; |
|
84 at: $v put: [ :opt | verbose := true ]; |
|
85 at: $? put: [ :opt | self error: 'illegal option: -' , opt asString ]; |
|
86 default: [ :arg | files add: arg ]; |
|
87 parse: Smalltalk arguments startingAt: 1. |
|
88 |
|
89 will parse a compiler command line for include directories ('-I dir' |
|
90 option, argument appended to 'searchPath'), an output filename |
|
91 ('-o filename' option, argument left in 'outputPath'), a verbosity |
|
92 flag ('-v' option, setting 'verbose' to true), and zero or more input |
|
93 filenames (anything else, appended to 'files'). |
|
94 If you still don't understand then you shouldn't be here. |
|
95 |
|
96 [author:] |
|
97 Ian Piumarta |
|
98 |
|
99 [see also:] |
|
100 StandaloneStartup |
|
101 Smalltalk |
|
102 ReadEvalPrintLoop |
|
103 " |
|
104 ! |
|
105 |
|
106 example |
|
107 " |
|
108 | commandLine commandLineArguments files searchPath outputPath verbose | |
|
109 |
|
110 commandLine := '-I /foo/bar -o bla.x -v file1 file2 file3'. |
|
111 commandLineArguments := commandLine asCollectionOfWords. |
|
112 |
|
113 files := OrderedCollection new. |
|
114 searchPath := OrderedCollection new. |
|
115 outputPath := nil. |
|
116 verbose := false. |
|
117 GetOpt new |
|
118 at: $I put: [ :opt :arg | searchPath add: arg ]; |
|
119 at: $o put: [ :opt :arg | outputPath := arg ]; |
|
120 at: $v put: [ :opt | verbose := true ]; |
|
121 at: $? put: [ :opt | self error: 'illegal option: -' , opt asString ]; |
|
122 default: [ :arg | files add: arg ]; |
|
123 parse: commandLineArguments startingAt: 1. |
|
124 |
|
125 Transcript show:'files: '; showCR:files. |
|
126 Transcript show:'searchPath: '; showCR:searchPath. |
|
127 Transcript show:'outputPath: '; showCR:outputPath. |
|
128 Transcript show:'verbose: '; showCR:verbose. |
|
129 " |
|
130 ! ! |
|
131 |
|
132 !GetOpt class methodsFor:'instance creation'! |
|
133 |
|
134 new |
|
135 ^ super new initializeDefaultBlock |
|
136 ! ! |
|
137 |
|
138 !GetOpt methodsFor:'accessing'! |
|
139 |
|
140 default: unaryBlock |
|
141 defaultBlock := unaryBlock |
|
142 ! ! |
|
143 |
|
144 !GetOpt methodsFor:'initialization'! |
|
145 |
|
146 initializeDefaultBlock |
|
147 defaultBlock := [:arg | ]. |
|
148 ! ! |
|
149 |
|
150 !GetOpt methodsFor:'parsing'! |
|
151 |
|
152 parse: argumentCollection |
|
153 ^ self parse: argumentCollection startingAt: 1 |
|
154 ! |
|
155 |
|
156 parse: argumentCollection startingAt: offset |
|
157 | args | |
|
158 |
|
159 args := argumentCollection readStream skip: (offset - 1). |
|
160 [args atEnd] |
|
161 whileFalse:[ |
|
162 | arg | |
|
163 arg := args next. |
|
164 self parseArgument: arg with: args ] |
|
165 ! ! |
|
166 |
|
167 !GetOpt methodsFor:'parsing - private'! |
|
168 |
|
169 parseArgument: arg with: rest |
|
170 (arg first = $- and: [arg size > 1]) |
|
171 ifTrue: [self parseOption: arg with: rest] |
|
172 ifFalse: [defaultBlock value: arg] |
|
173 ! |
|
174 |
|
175 parseOption: option with: rest |
|
176 | block | |
|
177 block := self at: option second ifAbsent: [self at: $? ifAbsent: [^defaultBlock value: option]]. |
|
178 ^block arity = 1 |
|
179 ifTrue: [self applyOption: option to: block] |
|
180 ifFalse: [self applyOption: option to: block with: rest] |
|
181 ! ! |
|
182 |
|
183 !GetOpt methodsFor:'private'! |
|
184 |
|
185 applyOption: anOption to: unaryBlock |
|
186 ^anOption size = 2 |
|
187 ifTrue: [unaryBlock value: anOption second] |
|
188 ifFalse: [self error: 'option ' , anOption , ' should not have an argument'] |
|
189 ! |
|
190 |
|
191 applyOption: anOption to: binaryBlock with: rest |
|
192 ^anOption size = 2 |
|
193 ifTrue: [rest atEnd |
|
194 ifTrue: [self error: 'argument missing to option ' , anOption] |
|
195 ifFalse: [binaryBlock value: anOption second value: rest next]] |
|
196 ifFalse: [binaryBlock value: anOption second value: (anOption copyFrom: 3)] |
|
197 ! ! |
|
198 |
|
199 !GetOpt class methodsFor:'documentation'! |
|
200 |
|
201 version |
|
202 ^ '$Header: /cvs/stx/stx/libbasic/GetOpt.st,v 1.1 2008-02-29 10:14:01 cg Exp $' |
|
203 ! ! |