MCPackage.st
author Claus Gittinger <cg@exept.de>
Mon, 26 Oct 2009 22:53:01 +0100
changeset 159 890c82936065
parent 157 eed1900fd7a1
child 245 ba7317557a9c
permissions -rw-r--r--
changed: #snapshot

"{ 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 $'
! !