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

MCStXSnapshotTransformation subclass:#MCStXSnapshotPreWriteTransformation

	instanceVariableNames:'extensionMethodCategoryMap projectDefinition'

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

!

isSmalltalkXPackage

    ^ projectDefinition notNil

    "Created: / 12-06-2013 / 09:22:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MCStXSnapshotPreWriteTransformation methodsFor:'transforming'!

transform: anMCSnapshot

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

    extensionMethodCategoryMap := OrderedCollection new.

    original := anMCSnapshot.

    projectDefinition := self projectDefinition.

    projectDefinition isNil ifTrue:[

        "/ Not a Smalltalk/X package - no transformation

        transformed := original.

        ^transformed

    ].

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

    "Modified (format): / 12-06-2013 / 09:23:47 / 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: / 20-09-2013 / 00:14:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitMethodDefinition: definition

    | source |

    source := definition source asStringWithNativeLineEndings asStringCollection withTabs asStringWithSqueakLineEndings.

    definition source: source.

    (self isExtensionMethodDefinition: definition) ifTrue:[

        | prefix |

        prefix := '*' , self monticelloName asLowercase.

        (definition category asLowercase startsWith: prefix) ifFalse:[

            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: / 06-11-2014 / 03:11:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

visitOrganizationDefinition: defintion

    "Add a category in which project definition class is..."

    | categories |

    categories := defintion categories.

    (categories includes: projectDefinition monticelloName) ifFalse:[

        categories := categories copyWith: projectDefinition monticelloName asSymbol.

        defintion categories: categories.

    ].

    "Created: / 05-10-2014 / 00:59:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MCStXSnapshotPreWriteTransformation class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXSnapshotPreWriteTransformation.st,v 1.10 2014-11-06 09:08:04 vrany Exp $'

!

version_CVS

    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXSnapshotPreWriteTransformation.st,v 1.10 2014-11-06 09:08:04 vrany Exp $'

! !