GetOpt.st
changeset 13712 9b34eae96ce6
parent 10888 a69f9b6e90a4
child 14133 5d8a617c96d5
--- a/GetOpt.st	Sun Sep 18 13:05:14 2011 +0200
+++ b/GetOpt.st	Mon Sep 19 10:14:26 2011 +0200
@@ -18,7 +18,7 @@
 "
 "{ Package: 'stx:libbasic' }"
 
-IdentityDictionary subclass:#GetOpt
+Dictionary subclass:#GetOpt
 	instanceVariableNames:'defaultBlock'
 	classVariableNames:''
 	poolDictionaries:''
@@ -105,19 +105,22 @@
 
 example
 "
-    | commandLine commandLineArguments files searchPath outputPath verbose |
+    | commandLine commandLineArguments files searchPath outputPath verbose foo level |
 
-    commandLine := '-I /foo/bar -o bla.x -v file1 file2 file3'.
+    commandLine := '-I /foo/bar -level 1 --foo -o bla.x -v file1 file2 file3'.
     commandLineArguments := commandLine asCollectionOfWords.
 
     files := OrderedCollection new.
     searchPath := OrderedCollection new.
     outputPath := nil.
-    verbose := false.
+    verbose := foo := false.
+    level := nil.
     GetOpt new
         at: $I put: [ :opt :arg | searchPath add: arg ];
         at: $o put: [ :opt :arg | outputPath := arg ];
         at: $v put: [ :opt | verbose := true ];
+        at: '-foo' put: [ :opt | foo := true ];
+        at: 'level' put: [ :opt :arg | level := arg ];
         at: $? put: [ :opt | self error: 'illegal option: -' , opt asString ];
         default: [ :arg | files add: arg ];
         parse: commandLineArguments startingAt: 1.
@@ -126,6 +129,8 @@
     Transcript show:'searchPath: '; showCR:searchPath.
     Transcript show:'outputPath: '; showCR:outputPath.
     Transcript show:'verbose: '; showCR:verbose.
+    Transcript show:'foo: '; showCR:foo.
+    Transcript show:'level: '; showCR:level.
 "
 ! !
 
@@ -173,31 +178,61 @@
 !
 
 parseOption: option with: rest
-    | block |
-    block := self at: option second ifAbsent: [self at: $? ifAbsent: [^defaultBlock value: option]].
-    ^block arity = 1
+    | block longOption |
+
+    "/ cg: changed to support non-single-character args (--foo)
+    block := self at: option second ifAbsent:nil.
+    block isNil ifTrue:[
+        option size > 2 ifTrue:[
+            longOption := option copyFrom:2.
+            block := self at: longOption ifAbsent:nil.
+            block notNil ifTrue:[
+                "/ a long option; never take rest of option as argument
+                block arity = 1
+                    ifTrue:  [ ^ block value: longOption ]
+                    ifFalse: [ 
+                        rest atEnd
+                            ifTrue:  [self error: 'argument missing to option ' , longOption].
+                        ^ block value: longOption value: rest next
+                    ]
+            ]
+        ].
+        block isNil ifTrue:[
+            block := self at: $? ifAbsent: nil.
+            block isNil ifTrue:[
+                ^ defaultBlock value: option
+            ] 
+        ]
+    ].
+    ^ block arity = 1
         ifTrue:  [self applyOption: option to: block]
         ifFalse: [self applyOption: option to: block with: rest]
+
+    "Modified: / 19-09-2011 / 10:07:57 / cg"
 ! !
 
 !GetOpt methodsFor:'private'!
 
-applyOption: anOption to: unaryBlock
-    ^anOption size = 2
+applyOption: anOption to: unaryBlock 
+    ^anOption size == 2
         ifTrue:  [unaryBlock value: anOption second]
         ifFalse: [self error: 'option ' , anOption , ' should not have an argument']
+
+    "Modified: / 19-09-2011 / 10:03:31 / cg"
 !
 
-applyOption: anOption to: binaryBlock with: rest
-    ^anOption size = 2
+applyOption: anOption to: binaryBlock with: rest 
+    ^anOption size == 2
         ifTrue:  [rest atEnd
                       ifTrue:  [self error: 'argument missing to option ' , anOption]
                       ifFalse: [binaryBlock value: anOption second value: rest next]]
         ifFalse: [binaryBlock value: anOption second value: (anOption copyFrom: 3)]
+
+    "Modified: / 19-09-2011 / 10:06:05 / cg"
 ! !
 
 !GetOpt class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/GetOpt.st,v 1.1 2008-02-29 10:14:01 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/GetOpt.st,v 1.2 2011-09-19 08:14:26 cg Exp $'
 ! !