Re: [Help-smalltalk] Re: Starting with smalltalk

[Paolo Bonzini]

> I'll get a book on Smalltalk, take some time to read-up on the syntax
> and try Squeak to see the difference between GNU and Squeak.
You can try the tutorial that comes with GNU Smalltalk.

The differences are mostly conceptual.  Plus Squeak has a huge (and 
sometimes very poorly designed) class library for graphics and much more.
> Then, I'll get back to you all.
No need to wait.  We're here to help and to understand where you have 
problems.
> Nice looking commandline parser by the way. I don't understand it all
> yet, but I'll get there. In the end I'll try to make a commandline
> arguments parser and post it somewhere.
Heh... I wanted to see how far I was from my (purposedly exaggerate) 
30-minutes estimate of the time to make one.  So I did it.

Here it is.  220 lines in ~2 hours, slightly less actually, including 30 
minutes for testing (didn't have time to do SUnit tests, so they're just 
commands at the end of the file).  No comments for now, I will add them 
when I commit.  :-P

Paolo

"======================================================================
|
|   Smalltalk command-line parser
|
|
 ======================================================================"


"======================================================================
|
| Copyright 2006 Free Software Foundation, Inc.
| Written by Paolo Bonzini.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, USA.  
|
 ======================================================================"


Object subclass: #Getopt
                  instanceVariableNames: 'options longOptions prefixes args 
currentArg actionBlock errorBlock'
                  classVariableNames: ''
                  poolDictionaries: ''
                  category: 'Language-Data types'
!

Getopt comment: 
'My instances represent ASCII string data types.  Being a very common
case, they are particularly optimized.' !


!Getopt class methodsFor: 'instance creation'!

test: args with: pattern
    args do: [ :each |
        self
            parse: each subStrings 
            with: pattern
            do: [ :x :y | (x->y) printNl ]
            ifError: [ (each->'error') displayNl ].
        Transcript nl ]!
    
parse: args with: pattern do: actionBlock
    ^self new
        parsePattern: pattern;
        actionBlock: actionBlock;
        errorBlock: [ ^nil ];
        parse: args!

parse: args with: pattern do: actionBlock ifError: errorBlock
    ^self new
        parsePattern: pattern;
        actionBlock: actionBlock;
        errorBlock: [ ^errorBlock value ];
        parse: args!

!Getopt methodsFor: 'initializing'!

fullOptionName: aString
    (prefixes includes: aString) ifFalse: [ errorBlock value ].
    longOptions do: [ :k |
        (k startsWith: aString) ifTrue: [ ^k ] ].
    self halt!

optionKind: aString
    | kindOrString |
    kindOrString := options at: aString ifAbsent: [ errorBlock value ].
    ^kindOrString isSymbol
        ifTrue: [ kindOrString ]
        ifFalse: [ options at: kindOrString ]!

optionName: aString
    | kindOrString |
    kindOrString := options at: aString ifAbsent: [ errorBlock value ].
    ^kindOrString isSymbol
        ifTrue: [ aString ]
        ifFalse: [ kindOrString ]!

parseRemainingArguments
    [ args atEnd ] whileFalse: [
        actionBlock value: nil value: args next ]!

parseOption: name kind: kind with: arg
    | theArg |
    theArg := arg.
    (kind = #mandatoryArg and: [ arg isNil ])
        ifTrue: [
            args atEnd ifTrue: [ errorBlock value ].
            theArg := args next ].
    (kind = #noArg and: [ theArg notNil ])
        ifTrue: [ errorBlock value ].

    actionBlock value: name value: theArg!
    
parseLongOption: argStream
    | name kind haveArg arg |
    name := argStream upTo: $=.
    argStream skip: -1.

    name := self fullOptionName: name.
    name := self optionName: name.
    kind := self optionKind: name.
    haveArg := argStream nextMatchFor: $=.
    arg := haveArg ifTrue: [ argStream upToEnd ] ifFalse: [ nil ].
    self parseOption: name kind: kind with: arg!

parseShortOptions: argStream
    | name kind ch haveArg arg |
    [ argStream atEnd ] whileFalse: [
        ch := argStream next.
        name := self optionName: ch.
        kind := self optionKind: ch.
        haveArg := kind ~~ #noArg and: [ argStream atEnd not ].
        arg := haveArg ifTrue: [ argStream upToEnd ] ifFalse: [ nil ].
        self parseOption: name kind: kind with: arg ]!

parseOneArgument
    | arg argStream |
    arg := args next.
    arg = '--' ifTrue: [ ^self parseRemainingArguments ].

    (arg isEmpty or: [ arg first ~= $- ])
        ifTrue: [ ^actionBlock value: nil value: arg ].

    argStream := arg readStream.
    (arg at: 2) = $-
        ifTrue: [ argStream next: 2. self parseLongOption: argStream ]
        ifFalse: [ argStream next. self parseShortOptions: argStream ]!

parse
    [ args atEnd ] whileFalse: [ self parseOneArgument ]!
  
!Getopt methodsFor: 'initializing'!

addPrefixes: option
    longOptions add: option.
    1 to: option size do: [ :length |
        prefixes add: (option copyFrom: 1 to: length) ]!

rejectBadPrefixes
    longOptions := longOptions asSortedCollection: [ :a :b | a size <= b size ].

    prefixes := prefixes select: [ :each | (prefixes occurrencesOf: each) == 1 
].
    prefixes := prefixes asSet.
    prefixes addAll: longOptions!

initialize
    options := Dictionary new.
    longOptions := Set new.
    prefixes := Bag new!

checkSynonyms: synonyms
    (synonyms allSatisfy: [ :each | each startsWith: '-' ])
        ifFalse: [ ^self error: 'expected -' ].

    (synonyms anySatisfy: [ :each | each size < 2 or: [ each = '--' ] ])
        ifTrue: [ ^self error: 'expected option name' ].

    synonyms do: [ :each |
        ((each startsWith: '--') and: [ each includes: $= ])
            ifTrue: [ ^self error: 'unexpected = inside long option' ] ]!

colonsToKind: colons
    colons = 0 ifTrue: [ ^#noArg ].
    colons = 1 ifTrue: [ ^#mandatoryArg ].
    colons = 2 ifTrue: [ ^#optionalArg ].
    ^self error: 'too many colons, don''t know what to do with them...'!

atSynonym: synonym put: kindOrName
    | key |
    synonym size = 2
        ifTrue: [ key := synonym at: 2 ]
        ifFalse: [ key := synonym copyFrom: 3. self addPrefixes: key ].

    (options includes: key) ifTrue: [ self error: 'duplicate option' ].
    options at: key put: kindOrName.
    ^key!

parseSynonyms: synonyms kind: kind
    | last |
    last := self atSynonym: synonyms last put: kind.
    synonyms from: 1 to: synonyms size - 1 do: [ :each |
        self atSynonym: each put: last ]!

parseOption: opt
    | colons optNames synonyms kind |
    optNames := opt copyWithout: $:.
    colons := opt size - optNames size.
    opt from: optNames size + 1 to: opt size do: [ :ch |
        ch = $: ifFalse: [ ^self error: 'invalid pattern, colons are hosed' ] ].

    kind := self colonsToKind: colons.
    synonyms := optNames subStrings: $|.
    self checkSynonyms: synonyms.
    self parseSynonyms: synonyms kind: kind!

parsePattern: pattern
    self initialize.
    pattern subStrings do: [ :opt | self parseOption: opt ].
    self rejectBadPrefixes!

actionBlock: aBlock
    actionBlock := aBlock!
            
errorBlock: aBlock
    errorBlock := aBlock!
            
parse: argsArray
    args := argsArray readStream.
    self parse.
    ^args contents!

!SystemDictionary class methodsFor: 'command-line'!

arguments: pattern do: actionBlock
    ^Getopt
        parse: self arguments
        with: pattern
        do: actionBlock!

arguments: pattern do: actionBlock ifError: errorBlock
    ^Getopt
        parse: self arguments
        with: pattern
        do: actionBlock
        ifError: errorBlock! !

"Getopt new parsePattern: '-B'"
"Getopt new parsePattern: '--long'"
"Getopt new parsePattern: '--longish --longer'"
"Getopt new parsePattern: '--long --longer'"
"Getopt new parsePattern: '-B:'"
"Getopt new parsePattern: '-B::'"
"Getopt new parsePattern: '-a|-b'"
"Getopt new parsePattern: '-a|--long'"
"Getopt new parsePattern: '-a|--very-long|--long'"
"Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a -b'"
"Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a: -b'"
"Getopt test: #('-a' '-b' '-ab' '-a -b') with: '-a:: -b'"
"Getopt test: #('--longish' '--longer' '--longi' '--longe' '--lo' '-longer') 
with: '--longish --longer'"
"Getopt test: #('--lo' '--long' '--longe' '--longer') with: '--long --longer'"
"Getopt test: #('--noarg' '--mandatory' '--mandatory foo' '--mandatory=' 
'--mandatory=foo' '--optional' '--optional foo') with: '--noarg --mandatory: 
--optional::'"
"Getopt test: #('-a' '-b') with: '-a|-b'"
"Getopt test: #('--long' '-b') with: '-b|--long'"
"Getopt test: #('--long=x' '-bx') with: '-b|--long:'"
"Getopt test: #('-b' '--long' '--very-long') with: '-b|--very-long|--long'"
"Getopt test: #('--long=x' '--very-long x' '-bx') with: 
'-b|--very-long|--long:'"
"Getopt test: #('-b -- -b' '-- -b' '-- -b -b') with: '-b'"