--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/packages/PackageManager.st Wed Apr 09 13:38:42 2003 +0200
@@ -0,0 +1,797 @@
+"{ Package: 'stx:libbasic3' }"
+
+"{ NameSpace: Packages }"
+
+AbstractPackageManager subclass:#PackageManager
+ instanceVariableNames:'workingPackage'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Package-Managers'
+!
+
+PackageManager class instanceVariableNames:'currentPackage currentManager imageChanges'
+
+"
+ No other class instance variables are inherited by this class.
+"
+!
+
+!PackageManager class methodsFor:'documentation'!
+
+documentation
+"
+ PackageManager smalltalkPackageManager
+
+ [author:]
+ (james@miraculix)
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+!
+
+documentation_exceptions
+"
+
+ ClassDescription fileOutErrorSignal
+ can occur when a class within a package is autoloaded. Handle in application
+
+ [author:]
+ (james@miraculix)
+
+"
+!
+
+examples
+"
+
+ more examples to be added:
+ [exBegin]
+ ... add code fragment for
+ ... executable example here ...
+ [exEnd]
+"
+!
+
+history
+ "Created: / 27.1.2003 / 13:57:50 / james"
+! !
+
+!PackageManager class methodsFor:'instance creation'!
+
+initialize
+ "Uninitialize Singleton"
+ currentManager ifNotNil:[
+ currentManager uninitialize.
+ currentManager := nil.
+ currentPackage := nil.
+ ]
+
+"
+ self initialize
+"
+!
+
+newManagerOfCurrentImage
+ | anInstance |
+ anInstance := self new.
+
+ self basicPackagesInImage do:[:aPackage |
+ package isInstalled:true.
+ anInstance addPackage:aPackage
+ ].
+ ^ anInstance
+
+"
+currentManager := self newManagerOfCurrentImage.
+"
+! !
+
+!PackageManager class methodsFor:'accessing'!
+
+changes
+ imageChanges ifNil:[
+ imageChanges := OrderedCollection new.
+ ].
+ ^ imageChanges
+!
+
+smalltalkPackageManager
+ "/ to clear the singleton for the moment
+ | workingPackage packagesInImage|
+
+ "/ self initialize.
+ currentManager
+ ifNil:[
+ currentManager := self new.
+
+ packagesInImage := self basicPackagesInImage.
+ workingPackage := packagesInImage removeKey:#'__NoProject__'.
+
+ currentManager addPackages:(packagesInImage).
+ currentManager workingPackage:workingPackage.
+ ].
+ ^ currentManager
+! !
+
+!PackageManager class methodsFor:'defaults'!
+
+defaultPackages
+ ^ DictionaryStack new.
+! !
+
+!PackageManager class methodsFor:'factory'!
+
+packageClass
+ ^ Package
+! !
+
+!PackageManager class methodsFor:'temporary'!
+
+basicPackagesInImage
+ "builds up dictionary of the packages in the system taking the information of the classes and
+ methods so we have a complete picture but without the prerequisite information.
+ returns the dictionary"
+ | packagesInImage extentions clsPkg |
+
+ packagesInImage := Dictionary new.
+ extentions := Dictionary new.
+
+ "collect the classes and mark where the extentions are"
+ Smalltalk allClasses do:[:aClass |
+ clsPkg := aClass package.
+ (packagesInImage at: clsPkg
+ ifAbsentPut:[clsPkg == #'__NoProject__' ifTrue:[
+ (DefaultPackage named:clsPkg)
+ ] ifFalse:[(Package named:clsPkg)
+ ]. ])
+ addedClass:aClass.
+
+"/ aClass hasExtensions ifTrue:[
+ aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ |mthdPkg|
+ mthdPkg := mthd package.
+ mthdPkg ~= clsPkg ifTrue:[| methodPackage |
+ "this is found out when you add a class!!"
+"/ (packagesInImage at: clsPkg) removeMethod:mthd. "does not belong to the package"
+ methodPackage :=
+ (packagesInImage at: mthdPkg ifAbsentPut:[
+ mthdPkg == #'__NoProject__' ifTrue:[
+ (DefaultPackage named:mthdPkg)
+ ] ifFalse:[(Package named:mthdPkg)
+ ].
+ ]).
+ methodPackage addedMethod:mthd
+
+ ].
+"/ ].
+ ]
+ ].
+ packagesInImage removeKey:#''. "remove namespaces"
+ packagesInImage do:[:aPackage |
+ aPackage initializeInstalled.
+ ].
+ ^ packagesInImage
+! !
+
+!PackageManager methodsFor:'accessing'!
+
+changes
+ ^ self class changes
+!
+
+packageNamed:anIdentifier
+ anIdentifier ifNil:[
+ ^ nil
+ ].
+ workingPackage name == anIdentifier ifTrue:[
+ ^ workingPackage
+ ].
+ ^ packages atKey:anIdentifier ifAbsent:[nil]
+!
+
+packagesNamed:aCollectionOfPackageNames
+ | aCol |
+ aCol := OrderedCollection new.
+
+ (aCollectionOfPackageNames includes:workingPackage name) ifTrue:[
+ aCol add:workingPackage
+ ].
+
+ aCol addAll: (aCollectionOfPackageNames collect:[:aName |
+ self packageNamed:aName
+ ]).
+
+ ^ aCol
+!
+
+workingPackage
+ "return the value of the instance variable 'workingPackage' (automatically generated)"
+
+ ^ workingPackage
+!
+
+workingPackage:aPackage
+ workingPackage removeDependent:self.
+ workingPackage:= aPackage.
+ workingPackage addDependent:self.
+! !
+
+!PackageManager methodsFor:'adding & removing'!
+
+addChange:aChange
+ ^ self class changes add:aChange.
+!
+
+addPackage:aPackage
+ "the reciever needs to be dependent on the packages just in case they change"
+ aPackage addDependent:self.
+ self basicAddPackage:aPackage.
+ self changed:#addPackage: with:aPackage
+!
+
+addPackages:aPackages
+ "the reciever needs to be dependent on the packages just in case they change"
+ aPackages do:[:aPackage |
+ self basicAddPackage:aPackage.
+ ].
+ self changed:#addPackages: with:aPackages
+!
+
+basicAddPackage:aPackage
+ "the reciever needs to be dependent on the packages just in case they change"
+ packages push:aPackage.
+!
+
+basicRemovePackage:aPackage
+ ^ packages removeKey:aPackage name
+!
+
+removeChange:aChange
+ ^ self class changes remove:aChange.
+!
+
+removePackage:aPackage
+ "the reciever needs to be dependent on the packages just in case they change"
+ aPackage removeDependent:self.
+ self basicRemovePackage:aPackage.
+ self changed:#removePackage: with:aPackage
+!
+
+removePackageNamed:aPackageName
+ | aPackage |
+ aPackage := (packages removeKey:aPackageName).
+ aPackage removeDependent:self.
+ self changed:#removePackage: with:aPackage
+! !
+
+!PackageManager methodsFor:'api'!
+
+addClass:aClass toPackage:aPackage
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'The package manager does not know of the package ', aPackage name.
+ ].
+ self moveClass:aClass toPackage:aPackage.
+!
+
+addMethod:aMethod toPackage:aPackage
+ "add method to a package. At this point it is determined to be a loose method or not"
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'The package manager does not know of the package ', aPackage name.
+ ].
+ aPackage addedMethod:aMethod
+!
+
+installPackage:aPackage
+ "installs a package that the receiver is aware of into the image if not raise an error
+ for the sender to catch so it is able to handle it"
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'The package manager does not know of the package ', aPackage name,' so it cannot be installed!!'
+ ].
+ ^ (self getPackageHandlerForPackage:aPackage) installPackageIn:self
+!
+
+loadPackageFromFile:aFilename
+ "install a starter package which comes from a file. This is the
+ a state where the package has not yet entered the image but it
+ is a package that the receiver is aware of and has some initial
+ information about. Return the installed Package"
+
+ ^ (self getPackageReaderForFile:aFilename) loadPackageIn:self .
+!
+
+moveClass:aClass toPackage:newOwnerPackage
+ "i have the responsibilty to set aClasses new variable (newOwnerPackage name) and
+ all the methods in aClass with the same package name!!
+ "
+ | oldOwnerPackage oldOwnerPackageName newOwnerPackageName|
+
+ oldOwnerPackageName := aClass package.
+ oldOwnerPackage := self packageNamed:aClass package.
+ newOwnerPackageName := newOwnerPackage name.
+
+ aClass package:newOwnerPackageName.
+ aClass methodDictionary copy keysAndValuesDo:[:aMethodName :aMethod |
+ aMethod package == oldOwnerPackageName ifTrue:[
+ aMethod package:newOwnerPackageName
+ ].
+ ].
+
+ oldOwnerPackage ifNil:[
+ "error handling"
+ aClass setPackage:workingPackage name.
+ workingPackage addedClass:aClass.
+ oldOwnerPackage := workingPackage.
+ ].
+
+ self recoveryHandlerDo:[
+ oldOwnerPackage movedClass:aClass toPackage:newOwnerPackage
+ ] forException:PackageError.
+!
+
+moveMethod:aMethod to:newOwnerPackage
+ | oldOwnerPackage |
+
+ oldOwnerPackage := self packageNamed:aMethod package.
+ oldOwnerPackage movedMethod:aMethod toPackage:newOwnerPackage
+!
+
+removeClass:aClass fromPackage:aPackage
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'The package manager does not know of the package ', aPackage name.
+ ].
+ self moveClass:aClass toPackage:workingPackage.
+!
+
+removeMethod:aMethod fromPackage:aPackage
+ "add method to a package. At this point it is determined to be a loose method or not"
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'The package manager does not know of the package ', aPackage name.
+ ].
+ aPackage removedMethod:aMethod
+!
+
+savePackage:aPackage
+ self savePackage:aPackage as:aPackage filename.
+!
+
+savePackage:aPackage as:aFilename
+ "saves a package that the receiver is aware of if not raise an error
+ for the sender to catch so it is able to handle it"
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'This package manager is not responsible of the package ', aPackage name,' so it cannot be saved!!'
+ ].
+
+ (self getPackageHandlerForPackage:aPackage) savePackageAs:aFilename.
+ ^ aPackage.
+!
+
+uninstallPackage:aPackage
+ "need to include the restoration of packages aPackage has overridden!!!!!!!!"
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'The package manager does not know of the package ', aPackage name,' so it cannot be uninstalled!!'
+ ].
+
+ ^ aPackage uninstall.
+!
+
+unloadPackage:aPackage
+ "unloads the package from the receiver.Does not need to
+ make any checks here as it is not installed."
+
+ (self includesPackage:aPackage) ifFalse:[
+ self error:'The package manager does not know of the package ', aPackage name.
+ ].
+
+ aPackage isInstalled ifTrue:[
+ self uninstallPackage:aPackage.
+ ].
+ self removePackage:aPackage.
+ ^ aPackage.
+! !
+
+!PackageManager methodsFor:'change & update'!
+
+changeSetChanged:something with:aChange from:changedObject
+ "find out what type of change it is and send the packages the corresponding
+ message to is if they are affected. If they are they should (if they are behaving)
+ send me a change notification to inform me about it(see packageChanged:with:from:)!!
+ "
+ aChange isCollection ifTrue:[
+ "after checking in"
+ ^ self "do i need to do anything???"
+ ].
+ (aChange isClassChange) ifFalse:[
+ self halt:' What is this???'.
+ ].
+
+ (aChange isMethodCategoryChange) ifTrue:[
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnMethodCategoryChange:aChange) ifTrue:[
+ aPackage methodCategoryChange:aChange.
+ ].
+ ].
+ ^ self
+ ].
+
+ "the following is similar to the one above"
+ (aChange isMethodCategoryRenameChange) ifTrue:[
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnMethodCategoryRenameChange:aChange) ifTrue:[
+ aPackage methodCategoryRenameChange:aChange.
+ ].
+ ].
+ ^ self
+ ].
+
+ aChange isMethodRemoveChange ifTrue:[
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnMethodRemoveChange:aChange) ifTrue:[
+ aPackage methodRemoveChange:aChange.
+ ].
+ ].
+ ^ self
+ ].
+
+ aChange isMethodChange ifTrue:[
+ "A new created method or a modified method"
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnMethodChange:aChange) ifTrue:[
+ aPackage methodChanged:aChange.
+ ].
+ ].
+ ^ self
+ ].
+
+ aChange isClassChange ifTrue:[
+ (aChange isClassRemoveChange) ifTrue:[
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnClassRemoveChange:aChange) ifTrue:[
+ aPackage classRemoveChange:aChange.
+ ].
+ ].
+ ^ self
+ ].
+
+ aChange isClassDefinitionChange ifTrue:[
+ "changes to instance variables, classVariableNames, poolDictionaries, category"
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnClassDefinitionChange:aChange) ifTrue:[
+ aPackage classDefinitionChange:aChange.
+ ].
+ ].
+ ^ self
+
+ ].
+ (aChange isClassInstVarDefinitionChange) ifTrue:[
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnClassInstVarDefinitionChange:aChange) ifTrue:[
+ aPackage classInstVarDefinitionChange:aChange.
+ ].
+ ].
+ ^ self
+ ].
+ (aChange isClassRenameChange) ifTrue:[
+ self packagesDo:[:aPackage |
+ (aPackage isDependentOnClassRenameChange:aChange) ifTrue:[
+ aPackage classRenameChange:aChange.
+ ].
+ ].
+ ^ self
+ ].
+
+
+ self halt.
+ ].
+
+ self halt.
+!
+
+classPackageChange:classToMove oldPackageName:oldPackageName
+ "reacts to a class package change
+ Assertion:
+ aClass package ~= oldPackageName
+ "
+ | newPackageName oldOwnerPackage newOwnerPackage|
+
+ newPackageName := classToMove package.
+ newOwnerPackage := self packageNamed:newPackageName.
+ oldOwnerPackage := self packageNamed:oldPackageName.
+ oldOwnerPackage movedClass:classToMove toPackage:newOwnerPackage.
+!
+
+methodPackageChange:aMethod class:methodOwnedClass oldPackageName:oldPackageName
+ | newPackageName oldOwnerPackage newOwnerPackage|
+
+ newPackageName := aMethod package.
+ oldOwnerPackage :=(self packageNamed:oldPackageName).
+ newOwnerPackage := (self packageNamed:newPackageName).
+
+ newOwnerPackage ifNil:[
+ PackageError raiseErrorString:'The package ', newPackageName, ' is not known',
+ ' to this packageManager', ' and so cannot realise this methodPackageChange'
+
+ ].
+
+ oldOwnerPackage ifNil:[
+ PackageError raiseErrorString:'The package ', oldPackageName, ' is not known',
+ ' to this packageManager', ' and so cannot realise this methodPackageChange'
+ ].
+
+ oldOwnerPackage movedMethod:aMethod toPackage:newOwnerPackage
+!
+
+packageChanged:something with:aParameter from:changedObject
+ "maybe send a change notification for views here???"
+"/ self halt.
+ self addChange:aParameter
+!
+
+update:something with:aParameter from:changedObject
+ #mayChange.
+ (self packagesIncludes:changedObject) ifTrue:[
+ self packageChanged:something with:aParameter from:changedObject.
+ ^ self.
+ ].
+ (changedObject == ChangeSet current) ifTrue:[
+ self changeSetChanged:something with:aParameter from:changedObject.
+ ^ self.
+ ].
+
+ (something == #projectOrganization) ifTrue:[
+ aParameter ifNil:[
+ "no need to know about this. It has probably already been past here already!!"
+ ^ self
+ ].
+ aParameter size == 2 ifTrue:[| oldPackageName |
+ (oldPackageName := aParameter second).
+ (oldPackageName isSymbol) ifTrue:[
+ self
+ classPackageChange:aParameter first
+ oldPackageName:aParameter second.
+ ^ self.
+ ] ifFalse:[
+ "ignore"
+ ^ self.
+ ].
+ ].
+ aParameter size == 3 ifTrue:[
+ self
+ methodPackageChange:(aParameter second)
+ class:(aParameter first)
+ oldPackageName:(aParameter third).
+ ^ self.
+ ].
+ aParameter size == 1 ifTrue:[
+ Transcript
+ nextPutAll:'From PackageManager>>update:with:from:' ;
+ cr;
+ nextPutAll:'When does this happen' ;
+ cr.
+ "checking out changedObject = Smalltalk"
+
+ ^ self.
+ ].
+ self halt.
+ ].
+!
+
+xxxchangeSetChanged:something with:aChange from:changedObject
+ "find out what type of change it is and send the packages the corresponding
+ message to is if they are affected. If they are they should (if they are behaving)
+ send me a change notification to inform me about it(see packageChanged:with:from:)!!
+ "
+
+ |currentPackageID currentPackage previousPackageID previousPackage |
+
+ "will this still be ok when we change package names? is this the same as
+ currentPackage := workingPackage. ??"
+ currentPackageID := Class packageQuerySignal query.
+ currentPackage :=(self packageNamed:currentPackageID).
+
+"------------------------------- method changes -------------------------------"
+
+ (aChange isMethodCategoryChange) ifTrue:[
+ currentPackage methodCategoryChange:aChange.
+ ^ self
+ ].
+ "the following is similar to the one above"
+ (aChange isMethodCategoryRenameChange) ifTrue:[
+ self halt.
+ currentPackage methodCategoryRenameChange:aChange.
+
+ previousPackageID := aChange previousPackage.
+ previousPackage := (self packageNamed:previousPackageID).
+ previousPackage ~= currentPackage ifTrue:[
+ previousPackage methodCategoryRenameChange:aChange.
+ ].
+ ^ self
+ ].
+
+ aChange isMethodChange ifTrue:[| isInitialMethod |
+ "A new created method or a modified method"
+ currentPackage methodChanged:aChange.
+
+ previousPackageID := aChange previousPackage.
+ isInitialMethod := previousPackageID isNil.
+
+ isInitialMethod ifFalse:[
+ previousPackage := (self packageNamed:previousPackageID).
+ previousPackage methodChanged:aChange.
+ ].
+ ^ self
+ ].
+
+ aChange isMethodRemoveChange ifTrue:[
+ "there is no current version for this type of change!!"
+ previousPackageID := aChange previousPackage.
+ previousPackage := (self packageNamed:previousPackageID).
+ previousPackage methodRemoveChange:aChange.
+ ^ self
+ ].
+
+
+"------------------------------- class changes -------------------------------"
+
+ aChange isClassChange ifTrue:[
+ (aChange isClassRemoveChange) ifTrue:[
+ previousPackage := currentPackage.
+ previousPackage classRemoveChange:aChange.
+ ^ self
+ ].
+
+ aChange isClassDefinitionChange ifTrue:[
+ "changes to instance variables class variables"
+ currentPackage classDefinitionChange:aChange.
+ ClassDefinitionChange::ClassBeingChangedQuery query ifNotNil:[
+ self halt.
+ ].
+ previousPackageID := aChange previousPackage. "does not work"
+ previousPackage := (self packageNamed:previousPackageID).
+ previousPackage ~= currentPackage ifTrue:[
+ previousPackage classDefinitionChange:aChange.
+ ].
+ ^ self
+ ].
+ (aChange isClassInstVarDefinitionChange) ifTrue:[
+ previousPackage classInstVarDefinitionChange:aChange.
+ previousPackage ~= currentPackage ifTrue:[
+ currentPackage classInstVarDefinitionChange:aChange.
+ ].
+ ^ self
+ ].
+
+ (aChange isClassRenameChange) ifTrue:[
+ previousPackage classRenameChange:aChange.
+ previousPackage ~= currentPackage ifTrue:[
+ currentPackage classRenameChange:aChange.
+ ].
+ ^ self
+ ].
+ (aChange isClassCommentChange) ifTrue:[
+ previousPackage classRenameChange:aChange.
+ previousPackage ~= currentPackage ifTrue:[
+ currentPackage classRenameChange:aChange.
+ ].
+ ^ self
+ ].
+
+ self halt.
+ ].
+
+ (aChange isClassChange) ifFalse:[
+ self halt:' What is this???'.
+ ].
+
+ self halt.
+! !
+
+!PackageManager methodsFor:'checks'!
+
+canLoadPackage:aPackage
+ ""
+ (self includesPackage:aPackage) ifTrue:[
+ Notification raise.
+ ].
+! !
+
+!PackageManager methodsFor:'enumarating'!
+
+packagesDo:aOneArgBlock
+ aOneArgBlock value:workingPackage.
+ super packagesDo:aOneArgBlock.
+! !
+
+!PackageManager methodsFor:'errors'!
+
+recoveryHandlerDo:aBlock forException:packageErrorClass
+ "an atomic action is about to happen. This should succeed or
+ fail and return to the previous state."
+
+ "to do - this could be done by an extra class.
+ could save the state of the receiver before this action is done
+ along with a 'transaction number' held in the receivers class to make
+ sure we are consistant. The hard copy could then be the backup. This
+ all depends on how long it takes to make the backup and how often
+ we are going to do this.
+ "
+ packageErrorClass handle:[:ex |
+ Transcript show:ex errorString.
+ ] do:[
+ aBlock value
+ ]
+! !
+
+!PackageManager methodsFor:'factory'!
+
+getPackageSaverForPackage:aPackage
+ ^ StxPackageFileWriter forPackage:aPackage
+!
+
+newPackageNamed:aString
+ | newPackage |
+
+ (self includesPackageNamed:aString) ifTrue:[
+ self breakPoint:''. "put some sort of error here"
+ ].
+
+ newPackage := self packageClass named:aString addToManager:self.
+ newPackage initializeInstalled.
+ ^ newPackage
+!
+
+packageClass
+ ^ Package
+! !
+
+!PackageManager methodsFor:'initialization'!
+
+initialize
+ super initialize.
+!
+
+uninitialize
+
+ self packagesDo:[:aPackage |
+ self removeDependent:aPackage.
+ ].
+ workingPackage removeDependent:self.
+
+ packages := nil.
+ super uninitialize.
+! !
+
+!PackageManager methodsFor:'private-opening'!
+
+getPackageHandlerForPackage:aPackage
+
+ | aPackageHandler |
+
+ (aPackageHandler := aPackage packageHandler) ifNil:[
+ aPackageHandler := PackageHandler forPackage:aPackage.
+ ].
+
+ ^ aPackageHandler
+!
+
+getPackageReaderForFile:aFilename
+ ^ StxPackageFileReader forFilename:aFilename
+! !
+
+!PackageManager methodsFor:'queries'!
+
+packagesIncludes:anObject
+ ^ ((packages includes:anObject)or:[workingPackage == anObject])
+! !
+
+!PackageManager class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/packages/PackageManager.st,v 1.1 2003-04-09 11:36:31 james Exp $'
+! !
+
+PackageManager initialize!