"{ Encoding: utf8 }"

"{ Package: 'stx:goodies/monticello' }"

"{ NameSpace: Smalltalk }"

MCSnapshotReader subclass:#MCStReader
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-Chunk Format'
!

!MCStReader class methodsFor:'documentation'!

documentation
"
    I read Category/Classes/Methodes/.... definitions from Monticello source.st file format.

    See also MCStWriter.

    Example:

    |source|
    source := String streamContents: [:aStream| |writer|
        writer := MCStWriter on: aStream.
        writer writeDefinitions: {True asClassDefinition. False asClassDefinition}.
    ].

    (MCStReader on: source readStream) definitions explore.
"
! !

!MCStReader class methodsFor:'as yet unclassified'!

extension
	^ 'st'
! !

!MCStReader methodsFor:'as yet unclassified'!

addDefinitionsFromDoit: aString
	| parser |
	(parser := MCDoItParser forDoit: aString) ifNotNil:
		[
		parser addDefinitionsTo: definitions]
!

categoryFromDoIt: aString
	| tokens  |
	tokens := Scanner new scanTokens: aString.
	tokens size = 3 ifFalse: [self error: 'Unrecognized category definition'].
	^ tokens at: 3
!

classDefinitionFrom: aPseudoClass
	| tokens traitCompositionString lastIndex classTraitCompositionString |
	tokens := Scanner new scanTokens: aPseudoClass definition.
	traitCompositionString := ((ReadStream on: aPseudoClass definition)
		match: 'uses:';
		upToAll: 'instanceVariableNames:') withBlanksTrimmed.
	classTraitCompositionString := ((ReadStream on: aPseudoClass metaClass definition asString)
		match: 'uses:';
		upToAll: 'instanceVariableNames:') withBlanksTrimmed.
	traitCompositionString isEmpty ifTrue: [traitCompositionString := '{}'].
	classTraitCompositionString isEmpty ifTrue: [classTraitCompositionString := '{}'].
	lastIndex := tokens size.
	^ MCClassDefinition
		name: (tokens at: 3)
		superclassName: (tokens at: 1)
		traitComposition: traitCompositionString
		classTraitComposition: classTraitCompositionString
		category: (tokens at: lastIndex)
		instVarNames: ((tokens at: lastIndex - 6) findTokens: ' ')
		classVarNames: ((tokens at: lastIndex - 4) findTokens: ' ')
		poolDictionaryNames: ((tokens at: lastIndex - 2) findTokens: ' ')
		classInstVarNames: (self classInstVarNamesFor: aPseudoClass)
		type: (self typeOfSubclass: (tokens at: 2))
		comment: (self commentFor: aPseudoClass)
		commentStamp: (self commentStampFor: aPseudoClass)
!

classInstVarNamesFor: aPseudoClass
	| tokens |
	
	self flag: #traits.
	aPseudoClass metaClass hasDefinition ifFalse: [^ #()].
	tokens := Scanner new scanTokens: aPseudoClass metaClass definition.
	"tokens size = 4 ifFalse: [self error: 'Unrecognized metaclass definition']."
	^ tokens last findTokens: ' '
!

commentFor: aPseudoClass
	| comment |
	comment := aPseudoClass organization classComment.
	^ comment asString = ''
		ifTrue: [comment]
		ifFalse: [comment string]
!

commentStampFor: aPseudoClass
	| comment |
	comment := aPseudoClass organization classComment.
	^  [comment stamp] on: MessageNotUnderstood do: [nil]
!

methodDefinitionsFor: aPseudoClass
        ^ aPseudoClass selectors collect: 
                [:ea |
                 MCMethodDefinition
                        className: aPseudoClass name
                        classIsMeta: aPseudoClass isMeta
                        selector: ea
                        category: (aPseudoClass organization categoryOfElement: ea)
                        timeStamp: (aPseudoClass stampAt: ea)
                        source: (aPseudoClass sourceCodeAt: ea) string]
!

systemOrganizationFromRecords: changeRecords
	| categories |
	categories := changeRecords
					select: [:ea | 'SystemOrganization*' match: ea string]
					thenCollect: [:ea | (self categoryFromDoIt: ea string)].
	^ categories isEmpty ifFalse: [MCOrganizationDefinition categories: categories asArray]
!

typeOfSubclass: aSymbol
	#(
		(subclass: normal)
		(variableSubclass: variable)
		(variableByteSubclass: bytes)
		(variableWordSubclass: words)
		(weakSubclass: weak)
		) do: [:ea | ea first = aSymbol ifTrue: [^ ea second]].
	self error: 'Unrecognized class definition'
! !

!MCStReader methodsFor:'evaluating'!

loadDefinitions
    |changeList|

    definitions := OrderedCollection new.

    Smalltalk isSmalltalkX ifTrue:[
        changeList := ChangeSet fromStream:self readStream.
        changeList do:[:eachChange |
            |dfn|

            self addDefinitionFromChange:eachChange.
        ].
    ] ifFalse:[
        | filePackage |
        filePackage :=
                FilePackage new
                        fullName: 'ReadStream';
                        fileInFrom: self readStream.
        filePackage classes do:
                [:pseudoClass |
                pseudoClass hasDefinition
                        ifTrue: [definitions add:
                                        (self classDefinitionFrom: pseudoClass)].
                definitions addAll: (self methodDefinitionsFor: pseudoClass).
                definitions addAll: (self methodDefinitionsFor: pseudoClass metaClass)].
        filePackage doIts do:
                [:ea |
                self addDefinitionsFromDoit: ea string].
    ]

    "Modified: / 25-11-2011 / 17:23:48 / cg"
!

readStream
	^ ('!!!!

', stream contents) readStream
! !

!MCStReader methodsFor:'stx change conversion'!

addDefinitionFromChange:aChange
    aChange acceptChangeVisitor:self.

    "Created: / 25-11-2011 / 17:24:08 / cg"
!

visitClassCommentChange:aChange
    definitions add:(MCClassComment new
                        className: aChange className
                        comment: aChange comment
                        source: aChange source string
                    )
!

visitClassDefinitionChange:aChange
        | tokens traitCompositionString lastIndex classTraitCompositionString |

        tokens := Scanner new scanTokens: aChange source.

"/        traitCompositionString := ((ReadStream on: aChange source)
"/                match: 'uses:';
"/                upToAll: 'instanceVariableNames:') withBlanksTrimmed.
"/        classTraitCompositionString := ((ReadStream on: aPseudoClass metaClass definition asString)
"/                match: 'uses:';
"/                upToAll: 'instanceVariableNames:') withBlanksTrimmed.
        traitCompositionString isEmptyOrNil ifTrue: [traitCompositionString := '{}'].
        classTraitCompositionString isEmptyOrNil ifTrue: [classTraitCompositionString := '{}'].
        lastIndex := tokens size.
        definitions add:( MCClassDefinition
                name: aChange className "/ (tokens at: 3)
                superclassName: aChange superClassName "/ (tokens at: 1)
                traitComposition: traitCompositionString
                classTraitComposition: classTraitCompositionString
                category: aChange category "/ (tokens at: lastIndex)
                instVarNames: aChange instanceVariableNames "asCollectionOfWords" "/ ((tokens at: lastIndex - 6) findTokens: ' ')
                classVarNames: aChange classVariableNames "asCollectionOfWords" "/ ((tokens at: lastIndex - 4) findTokens: ' ')
                poolDictionaryNames: aChange poolDictionaries asCollectionOfWords "/ ((tokens at: lastIndex - 2) findTokens: ' ')
                classInstVarNames: (aChange classInstanceVariableNames ? #()) "asCollectionOfWords" "/ (self classInstVarNamesFor: aPseudoClass)
                type: (self typeOfSubclass: (tokens at: 2))
                comment: nil "/ (self commentFor: aPseudoClass)
                commentStamp: nil "/ (self commentStampFor: aPseudoClass)
            )

    "Created: / 25-11-2011 / 17:20:41 / cg"
!

visitClassInstVarDefinitionChange:aChange
    "there must be already a definition change for that class"

    |nonMetaName defn|

    self assert:(aChange className endsWith:' class').
    nonMetaName := aChange className copyButLast:' class' size.

    defn := definitions detectLast:[:def | def isClassDefinition and:[def className = nonMetaName]].
    defn classInstVarNames: (aChange classInstVarNames).

    "Created: / 25-11-2011 / 17:32:12 / cg"
!

visitDoItChange:aChange
    self addDefinitionsFromDoit: aChange source

    "Created: / 25-11-2011 / 17:15:21 / cg"
!

visitMethodChange:aChange
    definitions add:(MCMethodDefinition
                        className: aChange className
                        classIsMeta: aChange isForMeta
                        selector: aChange changeSelector
                        category: aChange category "/ (aPseudoClass organization categoryOfElement: ea)
                        timeStamp: nil "aChange timeStamp" "/ (aPseudoClass stampAt: ea)
                        source: aChange source string"/ (aPseudoClass sourceCodeAt: ea)
                    )

    "Created: / 25-11-2011 / 17:15:36 / cg"
! !

!MCStReader class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_SVN
    ^ '$Id$'
! !