Fix in MCStXSnapshotPreWriteTransformation.
Make sure that MCOrganizationDefinition contains class category for project
definition class. Otherwise package won't load cleanly on Squeak/Pharo.
"{ 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
(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>"
!
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.8 2014-10-05 00:24:12 vrany Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/monticello/MCStXSnapshotPreWriteTransformation.st,v 1.8 2014-10-05 00:24:12 vrany Exp $'
! !