"{ Encoding: utf8 }"

"
 COPYRIGHT (c) 2018 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libbasic3' }"

"{ NameSpace: Smalltalk }"

Object subclass:#GSTFileReader
	instanceVariableNames:'changeSet source parser nameSpace inStream className
		fullClassName'
	classVariableNames:''
	poolDictionaries:''
	category:'Kernel-Classes-Support'
!

!GSTFileReader class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2018 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    I know how to read GST-smalltalk source files as a change set.
"
! !

!GSTFileReader methodsFor:'reading - API'!

changeSetFromStream:aStream
    changeSet := ChangeSet new.
    
    source := aStream contentsAsString.
    inStream := source readStream.
    self readDefinitions.
    ^ changeSet
    
    "
     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/auth.st' 
                        asFilename readStream).
     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/hacks.st' 
                        asFilename readStream).

     '/Users/cg/Downloads/smalltalk/shampoo/shampoo' asFilename directoryContentsAsFilenamesDo:[:fn |                    
        fn suffix = 'st' ifTrue:[
           (self new changeSetFromStream:(fn readStream)) inspect
        ]
      ]    
    "

    "Created: / 22-09-2018 / 19:09:29 / Claus Gittinger"
    "Modified (comment): / 23-09-2018 / 00:08:51 / Claus Gittinger"
! !

!GSTFileReader methodsFor:'reading - private'!

readClass:expr
    "already read 'name subclass:name'"

    |superClassName superClass 
     category comment instVarNameString definitionSelector change
     readingClassAttributes|

    (expr receiver isConstant and:[expr receiver value isNil]) ifTrue:[
        superClass := nil.
    ] ifFalse:[    
        superClassName := expr receiver name.
        superClass := nameSpace classNamed:superClassName.
        superClass isNil ifTrue:[
            superClass := Smalltalk classNamed:superClassName.
        ].    
    ].
    className := expr arg1 name.

    self assert:(parser tokenType == $[ ).
    parser nextToken.

    instVarNameString := ''.

    readingClassAttributes := true.
    [readingClassAttributes] whileTrue:[
        parser tokenType == $| ifTrue:[
            parser nextToken.
            [ parser tokenType == $| ] whileFalse:[
                |var|

                var := parser variable.
                instVarNameString := instVarNameString , ' ' , var name.
                parser nextToken.
            ].
            parser nextToken.
        ] ifFalse:[
            (parser token = '<') ifTrue:[
                parser nextToken.
                parser token = 'category:' ifTrue:[
                    parser nextToken.
                    self assert:(parser tokenType == #String).
                    category := parser tokenValue.
                    parser nextToken.
                ] ifFalse:[
                    parser token = 'comment:' ifTrue:[
                        parser nextToken.
                        self assert:(parser tokenType == #String).
                        comment := parser tokenValue.
                        parser nextToken.
                    ] ifFalse:[
                        self halt.
                    ].
                ].
                self assert:(parser token = '>').
                parser nextToken.
            ] ifFalse:[
                readingClassAttributes := false
            ]    
        ].    
    ].
    
    definitionSelector := #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'.

    fullClassName :=     
        ((nameSpace ? Smalltalk) ~~ Smalltalk) 
            ifTrue:[ nameSpace name,'::',className ]
            ifFalse:[ className ].
        
    change := ClassDefinitionChange new.
    change className:fullClassName.
    change definitionSelector:definitionSelector.
    superClassName notNil ifTrue:[ change superClassName:superClassName ].
    change instanceVariableString:instVarNameString.
    "/ change classVariableString:arg evaluate.
    "/ change poolDictionaries:arg evaluate.
    change category:category.
    changeSet add:change.
    comment notNil ifTrue:[
        change := ClassCommentChange className:fullClassName.
        change comment:comment.
        changeSet add:change.
    ].                

    self readMethods.

    "
     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/auth.st' 
                        asFilename readStream).
    "

    "Created: / 22-09-2018 / 22:50:24 / Claus Gittinger"
    "Modified: / 23-09-2018 / 02:12:04 / Claus Gittinger"
!

readDefinitions
    |expr|

    parser := Parser for:inStream in:nil.
    parser parserFlags allowQualifiedNames:true.
    
    parser nextToken.
    [inStream atEnd] whileFalse:[
        expr := parser expression.

        (expr isMessage 
          and:[ (expr selector = 'current:')
          and:[ (expr receiver isGlobalVariableNamed:'Namespace') ]]
        ) ifTrue:[
            self assert:(parser tokenType == $[ ).
            parser nextToken.
            nameSpace := NameSpace name:(expr arg1 name).
            self readNamespace.
            self assert:(parser tokenType == $] ).
            parser nextToken.
        ] ifFalse:[
            (expr isMessage 
              and:[ (expr selector = 'extend')
              and:[ (expr receiver isGlobalVariable) ]]
            ) ifTrue:[
                self assert:(parser tokenType == $[ ).
                parser nextToken.
                className := fullClassName := (expr receiver name).
                self readMethods.
            ] ifFalse:[
                (expr isMessage 
                  and:[ (expr selector = 'extend')
                  and:[ expr receiver isMessage
                        and:[ (expr receiver selector = 'class')
                        and:[ (expr receiver receiver isGlobalVariable) ]]]]
                ) ifTrue:[
                    self assert:(parser tokenType == $[ ).
                    parser nextToken.
                    className := fullClassName := (expr receiver receiver name),' class'.
                    self readMethods.
                ] ifFalse:[ 
                    (expr isVariable and:[expr name = 'Eval']) ifTrue:[
                        self assert:(parser tokenType == $[ ).
                        parser nextToken.

                        parser parseMethodBodyOrEmpty.

                        self assert:(parser tokenType == $] ).
                        parser nextToken.
                    ] ifFalse:[    
                        self halt.
                    ].    
                ].    
            ].    
        ].    
    ].
    
    "
     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/auth.st' 
                        asFilename readStream).

     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/hacks.st' 
                        asFilename readStream).

     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/responses.st' 
                        asFilename readStream).
                        
     '/Users/cg/Downloads/smalltalk/shampoo/shampoo' asFilename directoryContentsAsFilenamesDo:[:fn |                    
        fn suffix = 'st' ifTrue:[
           (self new changeSetFromStream:(fn readStream)) inspect
        ]
      ]    
    "

    "Created: / 22-09-2018 / 22:48:24 / Claus Gittinger"
    "Modified: / 23-09-2018 / 01:59:24 / Claus Gittinger"
!

readMethods
    "already read 'name subclass:name'"

    |methodSelector methodArgNames
     startPos endPos methodSource change
     specStartPos specEndPos specSource|

    [ parser token == $] ] whileFalse:[
        |expr methodClassName isClassMethod statements methodCategory|

        methodClassName := fullClassName.
        isClassMethod := false.
        ((parser tokenType == #Identifier)
        and:[ (parser token = className)]) ifTrue:[
            parser nextToken.
            parser token = 'class' ifTrue:[
                isClassMethod := true.
                parser nextToken.
                methodClassName := methodClassName,' class'.
            ].    
            self assert:(parser token = '>>').
            parser nextToken.
        ].
        
        specStartPos := parser tokenPosition.

        parser release.            
        parser parseMethodSpec.
        methodSelector := parser selector.
        methodArgNames := parser methodArgs.

        specEndPos := parser tokenPosition - 1.
        specSource := (source copyFrom:specStartPos to:specEndPos) withoutSeparators.

        self assert:(parser tokenType == $[ ).
        parser nextToken.
        startPos := parser tokenPosition.

        statements := parser parseMethodBodyOrEmpty.

        endPos := parser tokenPosition-1.
        self assert:(parser tokenType == $] ).
        parser nextToken.

        methodSource := source copyFrom:startPos to:endPos.

        change := MethodDefinitionChange 
                    className:methodClassName
                    selector:methodSelector
                    source:(specSource,Character cr,methodSource)
                    category:methodCategory.
        changeSet add:change.
    ].
    
    parser nextToken.

    "
     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/responses.st' 
                        asFilename readStream).
    "

    "Created: / 22-09-2018 / 22:54:29 / Claus Gittinger"
    "Modified (comment): / 23-09-2018 / 01:01:50 / Claus Gittinger"
!

readNamespace
    "already read 'Namespace'"
    "Namespace current: <name> [ <code for namespace> ]"

    |expr|

    [
        inStream atEnd not
        and:[ parser tokenType ~~ $] ]
    ] whileTrue:[
        expr := parser expression.

        (expr isMessage 
          and:[ (expr selector == #'subclass:')
          and:[ ((expr receiver isConstant and:[expr receiver value isNil])
                or:[ expr receiver isGlobalVariable ])
          and:[ (expr arg1 isGlobalVariable) ]]]
        ) ifTrue:[
            self readClass:expr.
        ] ifFalse:[
            (expr isMessage 
              and:[ (expr selector = 'extend')
              and:[ (expr receiver isGlobalVariable) ]]
            ) ifTrue:[
                self assert:(parser tokenType == $[ ).
                parser nextToken.
                className := (expr receiver name).
                fullClassName := nameSpace name,'::',className.
                self readMethods.
            ] ifFalse:[
                (expr isMessage 
                  and:[ (expr selector = 'extend')
                  and:[ expr receiver isMessage
                        and:[ (expr receiver selector = 'class')
                        and:[ (expr receiver receiver isGlobalVariable) ]]]]
                ) ifTrue:[
                    self assert:(parser tokenType == $[ ).
                    parser nextToken.
                    className := (expr receiver receiver name),' class'.
                    fullClassName := nameSpace name,'::',className.
                    self readMethods.
                ] ifFalse:[    
                     self halt.
                ].    
            ].    
        ].    
    ].

    "
     self new 
        changeSetFromStream:('/Users/cg/Downloads/smalltalk/shampoo/shampoo/auth.st' 
                        asFilename readStream).
    "

    "Created: / 22-09-2018 / 22:49:59 / Claus Gittinger"
    "Modified: / 23-09-2018 / 02:09:14 / Claus Gittinger"
! !

!GSTFileReader class methodsFor:'documentation'!

version_CVS
    ^ '$Header$'
! !