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

MCStXSnapshotTransformation subclass:#MCStXSnapshotPreWriteTransformation

	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

    original 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>"

    "Modified: / 31-05-2013 / 10:45:08 / 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) not

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

    "Modified: / 31-05-2013 / 01:16:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MCStXSnapshotPreWriteTransformation methodsFor:'transforming'!

transform: anMCSnapshot

    "Returns a transformed **copy** of the original snapshot"

    extensionMethodCategoryMap := OrderedCollection new.

    super transform: anMCSnapshot.

    (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

"/            className:(definition className capitalized);

            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 / 10:48:54 / 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

!

version_CVS

! !