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

MCStXSnapshotTransformation subclass:#MCStXSnapshotPreWriteTransformation
	instanceVariableNames:'extensionMethodCategoryMap'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-St/X Storing'
!

!MCStXSnapshotPreWriteTransformation class methodsFor:'documentation'!

documentation
"
    documentation to be added.

    [author:]
        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!MCStXSnapshotPreWriteTransformation methodsFor:'accessing'!

monticelloName  
    | def |

    def := self projectDefinition.
    ^def notNil ifTrue:[def monticelloName] ifFalse:[nil]

    "Created: / 31-05-2013 / 00:12:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

projectDefinition
    transformed definitions reverseDo:[:d|
        | c |    
        (d isClassDefinition 
            and:[(c := d actualClass) notNil
                and:[c isProjectDefinition]])
                    ifTrue:[ ^ c  ]
    ].
    ^nil

    "Created: / 31-05-2013 / 00:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MCStXSnapshotPreWriteTransformation methodsFor:'accessing - templates'!

monticelloSmalltalkXExtensionMethodCategories_Code
^
'monticelloSmalltalkXExtensionMethodCategor
    "Returns an array of triples (class name, selector , St/X category)
     This information is used by Smalltalk/X when reading back Monticello package
     to patch methods category as in Monticello extensions must have funny name
     to be recognized by Monticello as extensions."

    ^#(
%1
    )
'

    "Created: / 31-05-2013 / 00:20:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

monticelloSmalltalkXProjectType_Code
^
'monticelloSmalltalkXProjectType
    "Returns either #library or #application.
     This information is used by Smalltalk/X when reading back Monticello package
     to patch my superclass as neither LibraryDefinition nor ApplicationDefinition classes
     are present in Squeak/Pharo images."

    ^%1
'

    "Created: / 30-05-2013 / 12:42:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MCStXSnapshotPreWriteTransformation methodsFor:'testing'!

isExtensionMethodDefinition: definition
    ^transformed includesClassNamed: definition className

    "Created: / 30-05-2013 / 22:48:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-05-2013 / 00:04:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MCStXSnapshotPreWriteTransformation methodsFor:'transforming'!

transform: anMCSnapshot
    "Returns a transformed **copy** of the original snapshot"

    | projectDefinition |
    extensionMethodCategoryMap := OrderedCollection new.
    super transform: anMCSnapshot.
    projectDefinition := self projectDefinition.
    (projectDefinition notNil and:[extensionMethodCategoryMap notEmpty]) ifTrue:[
        | source |

        source := 
            self monticelloSmalltalkXExtensionMethodCategories_Code bindWith:
                (String streamContents:[:s|
                    extensionMethodCategoryMap do:[:entry|
                        s tab; tab; nextPutLine:  entry storeString
                    ].
                ]).

         transformed definitions addFirst:
            (MCMethodDefinition
                className:  projectDefinition name
                classIsMeta: true
                selector: 'monticelloSmalltalkXExtensionMethodCategories'
                category: 'accessing - monticello'
                timeStamp: 'Generated by ', self class name , ' at ' , Timestamp now printString
                source: source)
    ].
    ^transformed.

    "Created: / 31-05-2013 / 00:05:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MCStXSnapshotPreWriteTransformation methodsFor:'visiting'!

visitClassDefinition: definition
    | class |

    class := definition actualClass.
    class isProjectDefinition ifTrue:[
        definition
            superclassName: 'Object';
            category: class monticelloName.
        transformed definitions addFirst:
            (MCMethodDefinition
                className: definition className
                classIsMeta: true
                selector: 'monticelloProjectDefinitionTypeName'
                category: 'accessing - monticello'
                timeStamp: 'Generated by ', self class name , ' at ' , Timestamp now printString
                source: 
                    (self monticelloSmalltalkXProjectType_Code bindWith: (class isApplicationDefinition ifTrue:[#application] ifFalse:[#library]) storeString))
    ]

    "Created: / 29-05-2013 / 12:19:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-05-2013 / 00:56:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitMethodDefinition: definition
    (self isExtensionMethodDefinition: definition) ifTrue:[
        extensionMethodCategoryMap add:
            (Array 
                with: definition className , (definition classIsMeta ifTrue:[' class'] ifFalse:[''])
                with: definition selector
                with: definition category).
        definition category: '*' , self monticelloName.
    ].

    "Created: / 30-05-2013 / 22:48:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 31-05-2013 / 00:18:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MCStXSnapshotPreWriteTransformation class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXSnapshotPreWriteTransformation.st,v 1.3 2013-05-31 00:05:53 vrany Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXSnapshotPreWriteTransformation.st,v 1.3 2013-05-31 00:05:53 vrany Exp $'
! !