Issue #4: giving TDCommandLine another chance

src/GsDevKit_stones-Tode.package/TDCommandLine.class/class/commandLine.redirectTarget..st

@@ -0,0 +1,6 @@
+instance creation
+commandLine: commandLine redirectTarget: redirectTarget
+  ^ self new
+    commandLine: commandLine;
+    redirectTarget: redirectTarget;
+    yourself

src/GsDevKit_stones-Tode.package/TDCommandLine.class/class/fromStream.forEachCommand..st

@@ -0,0 +1,5 @@
+parsing
+fromStream: aStream forEachCommand: aBlock
+  "multi-line input"
+
+  self fromStream: aStream selectLine: [:cmdLine | true] forEachCommand: aBlock

src/GsDevKit_stones-Tode.package/TDCommandLine.class/class/fromStream.selectLine.forEachCommand..st

@@ -0,0 +1,29 @@
+parsing
+fromStream: aStream selectLine: selectLineBlock forEachCommand: aBlock
+  "multi-line input"
+
+  | cmdLines line escaped lastLine |
+  cmdLines := OrderedCollection new.
+  escaped := false.
+  lastLine := ''.
+  [ aStream atEnd ]
+    whileFalse: [ 
+      line := aStream nextLine.
+      (line isNil or: [ line isEmpty ])
+        ifFalse: [ 
+          (line isEmpty not and: [ line last == $\ ])
+            ifTrue: [ 
+              escaped := true.
+              lastLine := lastLine , (line copyFrom: 1 to: line size - 1) ]
+            ifFalse: [ 
+              escaped
+                ifTrue: [ 
+                  cmdLines add: lastLine , line.
+                  escaped := false ]
+                ifFalse: [ cmdLines add: line ] ] ] ].
+  escaped
+    ifTrue: [ cmdLines add: lastLine ].
+  cmdLines
+    do: [ :cmdLine | 
+      (selectLineBlock value: cmdLine)
+        ifTrue: [ self line: cmdLine forEachCommand: aBlock ] ]

src/GsDevKit_stones-Tode.package/TDCommandLine.class/class/isolate..st

@@ -0,0 +1,30 @@
+private
+isolate: aString
+  | isolated command final escaped skipComment |
+  isolated := OrderedCollection new.
+  command := WriteStream on: String new.
+  skipComment := escaped := false.
+  aString
+    do: [ :char | 
+      skipComment
+        ifFalse: [ 
+          escaped
+            ifTrue: [ 
+              command nextPut: char.
+              char = $`
+                ifTrue: [ escaped := false ] ]
+            ifFalse: [ 
+              char == $;
+                ifTrue: [ 
+                  isolated add: command contents.
+                  command := WriteStream on: String new ]
+                ifFalse: [ 
+                  char == $#
+                    ifTrue: [ skipComment := true ]
+                    ifFalse: [ command nextPut: char ] ].
+              char = $`
+                ifTrue: [ escaped := true ] ] ] ].
+  final := command contents.
+  final isEmpty
+    ifFalse: [ isolated add: final ].
+  ^ isolated

src/GsDevKit_stones-Tode.package/TDCommandLine.class/class/line.forEachCommand..st

@@ -0,0 +1,13 @@
+parsing
+line: cmdLineString forEachCommand: aBlock
+  "single command line"
+
+  (self isolate: cmdLineString)
+    do: [ :isolated | 
+      | redirected commandLine redirectTarget command |
+      redirected := self scan: isolated delim: $>.
+      commandLine := redirected at: 1.
+      redirectTarget := redirected size > 1
+        ifTrue: [ (redirected at: 2) trimBoth ].
+      command := self commandLine: commandLine redirectTarget: redirectTarget.
+      aBlock value: command ]

src/GsDevKit_stones-Tode.package/TDCommandLine.class/class/scan.delim..st

@@ -0,0 +1,34 @@
+private
+scan: aString delim: delim
+  | scanned command stream final escaped |
+  scanned := OrderedCollection new.
+  command := WriteStream on: String new.
+  stream := ReadStream on: aString.
+  escaped := false.
+  [ stream atEnd ]
+    whileFalse: [ 
+      | char |
+      char := stream next.
+      escaped
+        ifTrue: [ 
+          char = $`
+            ifTrue: [ escaped := false ].
+          command nextPut: char ]
+        ifFalse: [ 
+          char == Character space
+            ifTrue: [ 
+              stream peek == delim
+                ifTrue: [ 
+                  scanned add: command contents.
+                  command := WriteStream on: String new.
+                  stream next.
+                  command nextPut: stream next ]
+                ifFalse: [ command nextPut: char ] ]
+            ifFalse: [ 
+              char = $`
+                ifTrue: [ escaped := true ].
+              command nextPut: char ] ] ].
+  final := command contents.
+  final isEmpty
+    ifFalse: [ scanned add: final ].
+  ^ scanned

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/argPtrs.st

@@ -0,0 +1,4 @@
+private
+argPtrs
+  self tokens.	"ensure argPtrs defined"
+  ^ argPtrs

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/command.st

@@ -0,0 +1,3 @@
+accessing
+command
+  ^ self rawTokens at: 1

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/commandArgPtr.st

@@ -0,0 +1,3 @@
+private
+commandArgPtr
+  ^ self argPtrs at: 1

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/commandLine..st

@@ -0,0 +1,3 @@
+private
+commandLine: aString
+  commandLine := aString trimBoth

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/commandLine.st

@@ -0,0 +1,3 @@
+accessing
+commandLine
+  ^ commandLine

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getCommandLongOpts.short.do.argsDo..st

@@ -0,0 +1,11 @@
+private
+getCommandLongOpts: optionSpec short: shortOptionAliases do: optionBlock argsDo: argBlock
+  | optionStream optionString |
+  optionString := commandLine copyFrom: self commandArgPtr to: commandLine size.
+  optionStream := ReadStream on: optionString.
+  TDCommandGetOpts
+    getOptsLongFor: optionStream
+    longOptionSpec: optionSpec
+    shortOptionAliases: shortOptionAliases
+    do: optionBlock
+    nonOptionsDo: argBlock

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getCommandOpts.do.argsDo..st

@@ -0,0 +1,10 @@
+private
+getCommandOpts: optionSpec do: optionBlock argsDo: argBlock
+  | optionStream optionString |
+  optionString := commandLine copyFrom: self commandArgPtr to: commandLine size.
+  optionStream := ReadStream on: optionString.
+  TDCommandGetOpts
+    getOptsFor: optionStream
+    spec: optionSpec
+    do: optionBlock
+    nonOptionsDo: argBlock

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getCommandOpts.optionsAndArguments..st

@@ -0,0 +1,10 @@
+private
+getCommandOpts: optionSpec optionsAndArguments: optsAndArgsBlock
+  | options args |
+  options := Dictionary new.
+  args := OrderedCollection new.
+  self
+    getCommandOpts: optionSpec
+    do: [ :option :optionArg | options at: option asString put: optionArg ]
+    argsDo: [ :arg | args add: arg ].
+  optsAndArgsBlock value: options value: args

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getOpts.optionsAndArguments..st

@@ -0,0 +1,17 @@
+parsing
+getOpts: optionSpec optionsAndArguments: optsAndArgsBlock
+  | options args |
+  options := Dictionary new.
+  args := OrderedCollection new.
+  self hasSubCommand
+    ifTrue: [ 
+      self
+        getSubCommandOpts: optionSpec
+        do: [ :option :optionArg | options at: option asString put: optionArg ]
+        argsDo: [ :arg | args add: arg ] ]
+    ifFalse: [ 
+      self
+        getCommandOpts: optionSpec
+        do: [ :option :optionArg | options at: option asString put: optionArg ]
+        argsDo: [ :arg | args add: arg ] ].
+  ^ optsAndArgsBlock value: options value: args

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getOpts.subOpts.optionsAndArguments..st

@@ -0,0 +1,27 @@
+parsing
+getOpts: optionSpecs subOpts: subOptionSpecs optionsAndArguments: optsAndArgsBlock
+  | options arguments subCommandArgPtrIndex subCommandLine subCommand subOptions subArguments |
+  self
+    getOptsMixedLongShort: optionSpecs
+    optionsAndArguments: [ :optionDictionary :argsIn | 
+      options := optionDictionary.
+      arguments := argsIn ].
+  subCommandArgPtrIndex := self rawTokens size - arguments size.
+  subCommandLine := self commandLine
+    copyFrom: (self argPtrs at: subCommandArgPtrIndex)
+    to: self commandLine size.
+  TDCommandLine
+    line: subCommandLine
+    forEachCommand: [ :aCommand | 
+      subCommand := aCommand.
+      subCommand
+        getOptsMixedLongShort: subOptionSpecs
+        optionsAndArguments: [ :optionDictionary :argsIn | 
+          subOptions := optionDictionary.
+          subArguments := argsIn ] ].
+  ^ optsAndArgsBlock
+    value: options
+    value: arguments
+    value: subCommand command
+    value: subOptions
+    value: subArguments

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getOptsLong.optionsAndArguments..st

@@ -0,0 +1,6 @@
+parsing
+getOptsLong: longOptionSpec optionsAndArguments: optsAndArgsBlock
+  ^ self
+    getOptsLong: longOptionSpec
+    short: Dictionary new
+    optionsAndArguments: optsAndArgsBlock

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getOptsLong.short.optionsAndArguments..st

@@ -0,0 +1,19 @@
+parsing
+getOptsLong: longOptionSpec short: shortOptionAliases optionsAndArguments: optsAndArgsBlock
+  | options args |
+  options := Dictionary new.
+  args := OrderedCollection new.
+  self hasSubCommand
+    ifTrue: [ 
+      self
+        getSubCommandLongOpts: longOptionSpec
+        short: shortOptionAliases
+        do: [ :option :optionArg | options at: option asString put: optionArg ]
+        argsDo: [ :arg | args add: arg ] ]
+    ifFalse: [ 
+      self
+        getCommandLongOpts: longOptionSpec
+        short: shortOptionAliases
+        do: [ :option :optionArg | options at: option asString put: optionArg ]
+        argsDo: [ :arg | args add: arg ] ].
+  ^ optsAndArgsBlock value: options value: args

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getOptsMixedLongShort.optionsAndArguments..st

@@ -0,0 +1,29 @@
+parsing
+getOptsMixedLongShort: mixedOptionSpecs optionsAndArguments: optsAndArgsBlock
+  "mixedOptionSpecs is an array of option specs, for example:
+
+    {#('directory' $d #'required').
+      #('class' nil #'none').
+      #('package' nil #'none').
+      #('category' nil #'required')}
+
+   each subarray consists of the long-option-name, short-option-character, 
+     [required|none|optional]
+"
+
+  | longOptionsSpec shortOptionAliases |
+  longOptionsSpec := Dictionary new.
+  shortOptionAliases := Dictionary new.
+  mixedOptionSpecs
+    do: [ :spec | 
+      | optionName shortOptionCharacter optionValueSpec |
+      optionName := spec at: 1.
+      shortOptionCharacter := spec at: 2.
+      optionValueSpec := spec at: 3.
+      longOptionsSpec at: optionName put: optionValueSpec.
+      shortOptionCharacter
+        ifNotNil: [ shortOptionAliases at: shortOptionCharacter put: optionName ] ].
+  ^ self
+    getOptsLong: longOptionsSpec
+    short: shortOptionAliases
+    optionsAndArguments: optsAndArgsBlock

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getSubCommandLongOpts.short.do.argsDo..st

@@ -0,0 +1,13 @@
+obsolete
+getSubCommandLongOpts: optionSpec short: shortOptionAliases do: optionBlock argsDo: argBlock
+  | optionStream optionString |
+  optionString := commandLine
+    copyFrom: self subCommandArgPtr
+    to: commandLine size.
+  optionStream := ReadStream on: optionString.
+  TDCommandGetOpts
+    getOptsLongFor: optionStream
+    longOptionSpec: optionSpec
+    shortOptionAliases: shortOptionAliases
+    do: optionBlock
+    nonOptionsDo: argBlock

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getSubCommandOpts.do.argsDo..st

@@ -0,0 +1,12 @@
+obsolete
+getSubCommandOpts: optionSpec do: optionBlock argsDo: argBlock
+  | optionStream optionString |
+  optionString := commandLine
+    copyFrom: self subCommandArgPtr
+    to: commandLine size.
+  optionStream := ReadStream on: optionString.
+  TDCommandGetOpts
+    getOptsFor: optionStream
+    spec: optionSpec
+    do: optionBlock
+    nonOptionsDo: argBlock

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/getSubCommandOpts.optionsAndArguments..st

@@ -0,0 +1,10 @@
+obsolete
+getSubCommandOpts: optionSpec optionsAndArguments: optsAndArgsBlock
+  | options args |
+  options := Dictionary new.
+  args := OrderedCollection new.
+  self
+    getSubCommandOpts: optionSpec
+    do: [ :option :optionArg | options at: option asString put: optionArg ]
+    argsDo: [ :arg | args add: arg ].
+  optsAndArgsBlock value: options value: args

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/hasSubCommand..st

@@ -0,0 +1,3 @@
+obsolete
+hasSubCommand: aBool
+  hasSubCommand := aBool

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/hasSubCommand.st

@@ -0,0 +1,4 @@
+obsolete
+hasSubCommand
+  hasSubCommand ifNil: [ hasSubCommand := false ].
+  ^ hasSubCommand

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/parseMixedLongShortOpts..st

@@ -0,0 +1,27 @@
+private
+parseMixedLongShortOpts: mixedOptionSpecs
+  "mixedOptionSpecs is an array of option specs, for example:
+
+    {#('directory' $d #'required').
+      #('class' nil #'none').
+      #('package' nil #'none').
+      #('category' nil #'required')}
+
+   each subarray consists of the long-option-name, short-option-character, 
+     [required|none|optional]
+"
+
+  | longOptionsSpec shortOptionAliases |
+  longOptionsSpec := Dictionary new.
+  shortOptionAliases := Dictionary new.
+  mixedOptionSpecs
+    do: [ :spec | 
+      | optionName shortOptionCharacter optionValueSpec |
+      optionName := spec at: 1.
+      shortOptionCharacter := spec at: 2.
+      optionValueSpec := spec at: 3.
+      longOptionsSpec at: optionName put: optionValueSpec.
+      shortOptionCharacter
+        ifNotNil: [ shortOptionAliases at: shortOptionCharacter put: optionName ] ].
+  ^ {longOptionsSpec.
+  shortOptionAliases}

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/printOn..st

@@ -0,0 +1,3 @@
+printing
+printOn: aStream
+	aStream nextPutAll: self class name asString , '(' , self commandLine printString , ')'

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/rawTokens.st

@@ -0,0 +1,4 @@
+private
+rawTokens
+  tokens ifNil: [ tokens := self tokenize: self commandLine ].
+  ^ tokens

src/GsDevKit_stones-Tode.package/TDCommandLine.class/instance/redirectTarget..st

@@ -0,0 +1,3 @@
+private
+redirectTarget: aString
+  redirectTarget := aString