"{ Package: 'stx:goodies/monticello' }"
Object subclass:#MCPackage
instanceVariableNames:'name'
classVariableNames:''
poolDictionaries:''
category:'Monticello-Base'
!
!MCPackage class methodsFor:'as yet unclassified'!
named: aString
^ self new name: aString
! !
!MCPackage methodsFor:'as yet unclassified'!
= other
^ other species = self species and: [other name sameAs: name]
!
hasWorkingCopy
^ MCWorkingCopy registry includesKey: self
!
hash
^ name asLowercase hash
!
name
^ name
!
name: aString
name _ aString
!
packageInfo
Smalltalk isSmalltalkX ifTrue:[
^ ProjectDefinition
definitionClassForMonticelloPackage:name createIfAbsent:true
] ifFalse:[
^ PackageInfo named: name
].
!
printOn: aStream
super printOn: aStream.
aStream
nextPut: $(;
nextPutAll: name;
nextPut: $)
!
snapshot
| packageInfo definitions categories |
packageInfo := self packageInfo.
definitions := OrderedCollection new.
Smalltalk isSmalltalkX ifTrue:[
packageInfo
extensionMethods do: [:each |
definitions add:(
MCMethodDefinition
className: (each mclass name)
classIsMeta: (each mclass isMeta)
selector: (each selector)
category: (each category)
timeStamp: nil
source: (each source))
].
packageInfo classes do: [:ea |
definitions addAll: ea classDefinitions.
].
packageInfo classes do: [:ea |
(ea class includesSelector:#initialize) ifTrue:[
definitions add:(MCPostscriptDefinition script:(ea name,' initialize') packageName:packageInfo name).
].
].
packageInfo hasPreLoadAction ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)].
packageInfo hasPostLoadAction ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)].
packageInfo hasPreUnloadAction ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)].
"/ in ST/X, there is no live after death
"/ packageInfo hasPostUnloadAction ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)].
] ifFalse:[
categories := packageInfo systemCategories.
categories isEmpty ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ].
packageInfo methods do: [:ea | definitions add: ea asMethodDefinition] displayingProgress: 'Snapshotting methods...'.
(packageInfo respondsTo: #overriddenMethods) ifTrue:
[packageInfo overriddenMethods
do: [:ea | definitions add:
(packageInfo changeRecordForOverriddenMethod: ea) asMethodDefinition]
displayingProgress: 'Searching for overrides...'].
packageInfo classes do: [:ea | definitions addAll: ea classDefinitions] displayingProgress: 'Snapshotting classes...'.
(packageInfo respondsTo: #hasPreamble) ifTrue: [
packageInfo hasPreamble ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)].
packageInfo hasPostscript ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)].
packageInfo hasPreambleOfRemoval ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)].
packageInfo hasPostscriptOfRemoval ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)]].
].
^ MCSnapshot fromDefinitions: definitions
!
storeOn: aStream
aStream
nextPutAll: 'MCPackage';
space; nextPutAll: 'named: '; store: name.
!
unload
^ self workingCopy unload
!
workingCopy
^ MCWorkingCopy forPackage: self.
! !
!MCPackage class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/monticello/MCPackage.st,v 1.5 2009-10-26 21:53:01 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/monticello/MCPackage.st,v 1.5 2009-10-26 21:53:01 cg Exp $'
! !