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

"{ NameSpace: Smalltalk }"

MCStXSnapshotTransformation subclass:#MCStXSnapshotPreWriteTransformation
	instanceVariableNames:'extensionMethodCategoryMap projectDefinition includeExtrasForSTX'
	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"

    includeExtrasForSTX := anMCSnapshot includeExtrasForSTX.
    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: / 24-04-2015 / 12:39:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MCStXSnapshotPreWriteTransformation methodsFor:'visiting'!

visitClassDefinition: definition
    "
     save ProjectDefinition classes with Object as superclass   
     (because ProjectDefinition is not present in Pharo/Squeak).
     When reading back into ST/X, the PostReadTransformation undoes this
    "
    | class |

    class := definition actualClass.
    class isProjectDefinition ifTrue:[
        transformed definitions remove: definition.
        includeExtrasForSTX 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: / 23-04-2015 / 23:26:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

visitMethodDefinition: definition
    | class source |

    includeExtrasForSTX ifFalse:[  
        "/ If St/X extras should not be included, then remove all methods
        "/ that belong to project definition class.
        class := definition actualClass theNonMetaclass.
        class == projectDefinition ifTrue:[ 
            transformed definitions remove: definition.
            ^ self.
        ].
        "/ Also, remove all version_XX methods
        (AbstractSourceCodeManager isVersionMethodSelector: definition selector) ifTrue:[
            transformed definitions remove: definition.
        ]
    ].

    source := definition source asStringWithNativeLineEndings.  "/ Make sure source has native line endings
    source := self class reindentUsingTabsOnly: source.         "/ Make sure there are only tabs (norm on Squeak / Pharo)
    source := source asStringWithSqueakLineEndings.             "/ Make sure source has Squeak line endings
    source := source asSingleByteStringIfPossible.              "/ Convert to single byte string

    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: / 10-05-2015 / 15:08:26 / 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.11 2015-03-30 19:54:21 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXSnapshotPreWriteTransformation.st,v 1.11 2015-03-30 19:54:21 cg Exp $'
!

version_HG

    ^ '$Changeset: <not expanded> $'
! !