--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/packages/Package.st Wed Apr 09 13:23:18 2003 +0200
@@ -0,0 +1,1929 @@
+"{ Package: 'stx:libbasic3' }"
+
+"{ NameSpace: Packages }"
+
+AbstractPackage subclass:#Package
+ instanceVariableNames:'packageHandler packagedClasses packagedMethods packageComment
+ prerequisites scripts isDirty isInstalled packageVersion
+ overriddenChanges blockedMethods'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Package'
+!
+
+Package class instanceVariableNames:'CurrentPackage'
+
+"
+ No other class instance variables are inherited by this class.
+"
+!
+
+Object subclass:#PackagedClass
+ instanceVariableNames:'name package instanceDefinition classDefinition
+ instanceVariableNames classVariableNames
+ classInstanceVariableNames poolDictionaries category'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Package
+!
+
+Object subclass:#PackagedMethod
+ instanceVariableNames:'name package source ownedClassName'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Package
+!
+
+Object subclass:#PackagedScript
+ instanceVariableNames:'string receiver'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Package
+!
+
+!Package class methodsFor:'documentation'!
+
+documentation
+"
+ documentation to be added.
+
+ [author:]
+ (james@miraculix)
+
+ [instance variables:]
+
+ blockedMethods <Dictionary>
+ A reference of methods that the receiver is NOT responsible for
+ but the receiver is responsible for the method's class. It usage is
+ the same as a filter would be.
+
+ overriddenChanges <Dictionary1><Dictionary2><Dictionary3>
+ This variable helps the receiver keep its original state. When a
+ method changes it is held here so we can get the original. So the package
+ is still responsible for the overridden changes.
+
+ There are two way items can become added to overriddenChanges:
+ 1) through loading packages - too many of these may not be desirable.
+ 2) through editing a package - default package 'overrides it!!'
+
+ DESIGN: it is designed with dictionaries containing dictionaries as - for the
+ time being - to cope with different types of change. At the moment being
+ methodChanges (and soon classChanges). It is easier to search for changes
+ by using this hierarchy of dictionaries, and - i think - it is quite
+ extendable.
+ The only problem i can see with it is lingering dictionaries which are not deleted
+ when they contain nothing.
+
+
+
+
+
+ [class variables:]
+
+ [see also:]
+
+"
+!
+
+examples
+"
+
+ more examples to be added:
+ [exBegin]
+ ... add code fragment for
+ ... executable example here ...
+ [exEnd]
+"
+!
+
+history
+ "Created: / 31.3.2003 / 16:45:04 / james"
+! !
+
+!Package class methodsFor:'instance creation'!
+
+named:aString
+ "create a new package named aString "
+ ^ self named:aString addToManager:nil. "or 'self defaultPackageManager'"
+!
+
+named:aString addToManager:aManager
+ ^ self named:aString withClasses:nil withMethods:nil addToManager:aManager
+!
+
+named:aString withClasses:classes
+ ^ self named:aString withClasses:classes withMethods:nil addToManager:nil
+!
+
+named:aString withClasses:classes withMethods:methods addToManager:aManager
+ "create a new package named aString "
+ |anInstance |
+ anInstance := self new name:aString.
+ classes ifNotNil:[
+ anInstance addedClasses:classes.
+ ].
+ methods ifNotNil:[
+ anInstance addedMethods:methods.
+ ].
+
+ aManager ifNotNil:[
+ aManager addPackage:anInstance.
+ ].
+ ^ anInstance
+!
+
+named:aString withMethods:methods
+ ^ self named:aString withClasses:nil withMethods:methods addToManager:nil
+! !
+
+!Package class methodsFor:'constant'!
+
+classChangeNamespace
+ "just returns a constant."
+ ^ #ClassChange
+!
+
+emptyDictionaryConstant
+ "could eventually be a variable in class... but i doubt it would buy is
+ much time savings..."
+ ^ Dictionary new
+!
+
+methodChangeNamespace
+ "just returns a constant."
+ ^ #MethodChange
+! !
+
+!Package class methodsFor:'defaults'!
+
+defaultBlockedMethodsCollection
+ ^ Dictionary new
+!
+
+defaultOverriddenChangesCollection
+ "a dictionary of sets. The keys are the classes and
+ the sets are a collection of selectors!!"
+ ^ Dictionary new
+!
+
+defaultPackagedClassesCollection
+ ^ Dictionary new
+!
+
+defaultPackagedMethodsCollection
+ ^ Dictionary new
+!
+
+defaultPrerequisiteCollection
+ ^ PrerequisiteCollection new
+!
+
+defaultScriptsCollection
+ ^ IdentityDictionary new
+!
+
+newDefaultPackage
+ ^ self named:#'__NoProject__'.
+!
+
+packageHandlerClass
+ ^ StxPackageHandler
+!
+
+packageManager
+ ^ self packageManagerClass smalltalkPackageManager.
+!
+
+packageManagerClass
+ ^ PackageManager.
+! !
+
+!Package class methodsFor:'private - instance creation'!
+
+new
+ "creates a new package and initialize's"
+ | anInstance |
+ anInstance := self basicNew initialize.
+ ^ anInstance
+! !
+
+!Package methodsFor:'accessing'!
+
+blockedMethods
+ "return the value of the instance variable 'blockedMethods' (automatically generated)"
+
+ ^ blockedMethods
+!
+
+blockedMethods:something
+ "set the value of the instance variable 'blockedMethods' (automatically generated)"
+
+ blockedMethods := something.
+!
+
+classNamed:aSymbol
+ "return the class named aSymbol if it exists in the receiver. Otherwise
+ return nil"
+ (self includesClassNamed:aSymbol) ifTrue:[
+ ^ Smalltalk classNamed:aSymbol
+ ].
+
+ ^ nil
+!
+
+classNames
+ ^ self packagedClasses values collect:[:aPackagedClass |
+ aPackagedClass name
+ ].
+!
+
+classPrerequisites
+ ^ prerequisites select:[:aPre |
+ aPre isClassPrerequisite
+ ].
+
+!
+
+filename
+ "return the value of the instance variable 'filename' (automatically generated)"
+
+ ^ packageHandler filename
+!
+
+isDirty
+ "has the receiver been changed by adding scripts or added classes since the
+ time it is loaded. This instance variable is NOT affected by changes in the image!!"
+
+ ^ isDirty "? true" "not needed because set by initialize"
+!
+
+isDirty:aBoolean
+ isDirty := aBoolean
+!
+
+isInstalled
+ "return the value of the instance variable 'isInstalled' (automatically generated)"
+
+ ^ isInstalled
+!
+
+isInstalled:something
+ "set the value of the instance variable 'isInstalled' (automatically generated)"
+
+ isInstalled := something.
+!
+
+isOverridden
+ ^ overriddenChanges notEmpty
+!
+
+looseMethodAtClass:aClassName atMethodName:aMethodName
+ self looseMethods do:[:aLooseMethod |
+ ((aLooseMethod name == aMethodName) and:[
+ aLooseMethod className == aClassName]) ifTrue:[
+ ^ aLooseMethod
+ ].
+
+ ].
+ ^ nil
+!
+
+looseMethods
+ | col mthdInImage |
+ col := OrderedCollection new.
+ self packagedMethods keysAndValuesDo:[:key :aDic | | looseMethodsInKey|
+
+ looseMethodsInKey := aDic keysAndValuesDo:[:selector :aPackagedMethod | |collectValue|
+ aPackagedMethod isLoose ifTrue:[
+ mthdInImage := aPackagedMethod methodInImage.
+ mthdInImage ifNil:[
+ col add:aPackagedMethod.
+ ] ifNotNil:[
+ col add:mthdInImage.
+ ].
+ ].
+ ].
+
+ ].
+
+ ^ col.
+!
+
+packageComment
+ "return the value of the instance variable 'packageComment' (automatically generated)"
+
+ ^ packageComment
+!
+
+packageComment:something
+ "set the value of the instance variable 'packageComment' (automatically generated)"
+
+ packageComment := something.
+!
+
+packageHandler
+ "return the value of the instance variable 'packageHandler' (automatically generated)"
+
+ packageHandler isNil ifTrue:[
+ packageHandler := PackageHandler forPackage:self.
+ ].
+ ^ packageHandler
+!
+
+packageHandler:something
+ "set the value of the instance variable 'packageHandler' (automatically generated)"
+
+ packageHandler := something.
+!
+
+packageType
+ ^ 'STX Package' copy.
+!
+
+packageVersion
+ "return the value of the instance variable 'packageVersion' (automatically generated)"
+
+ ^ packageVersion
+!
+
+packageVersion:something
+ "set the value of the instance variable 'packageVersion' (automatically generated)"
+
+ packageVersion := something.
+!
+
+packagedClasses
+ "return the value of the instance variable 'packagedClasses' (automatically generated)"
+
+ ^ packagedClasses
+!
+
+packagedMethods
+ "return the value of the instance variable 'packagedMethods' (automatically generated)"
+
+ ^ packagedMethods
+!
+
+prerequisites
+ "return the value of the instance variable 'prerequisites' (automatically generated)"
+
+ ^ prerequisites
+!
+
+scripts
+ "return the value of the instance variable 'scripts' (automatically generated)"
+
+ ^ scripts
+! !
+
+!Package methodsFor:'adding & removing'!
+
+addBlockedMethodNamed:aMethodName forClassNamed:aClassName
+ ^ (self blockedMethodsAt:aClassName ifAbsentPut:[Set new]) add:aMethodName.
+!
+
+addOverriddenClassChange:aPackagedClass
+ "add an overridden method. under #methodClassName -> #methodChangeNamespace -> #methodChange"
+ self
+ addOverriddenClassChange:aPackagedClass
+ byPackageNamed:(self class packageManager workingPackage) "the only way???"
+!
+
+addOverriddenClassChange:aPackagedClass byPackageNamed:byPackageName
+ "add an overridden method. under #package -> #className -> #classChangeNamespace -> aPackagedClass"
+ | className classChangeNamespace |
+ className := aPackagedClass name.
+ classChangeNamespace := self class classChangeNamespace.
+
+ (((overriddenChanges at:byPackageName ifAbsentPut:[Dictionary new])
+ at:className ifAbsentPut:[Dictionary new])
+ at:classChangeNamespace
+ ifAbsentPut:[Set new]) add:aPackagedClass
+!
+
+addOverriddenMethodChange:aPackagedMethod
+ "add an overridden method. under #methodClassName -> #methodChangeNamespace -> #methodChange"
+ self
+ addOverriddenMethodChange:aPackagedMethod
+ byPackageNamed:(self class packageManager workingPackage) "the only way???"
+!
+
+addOverriddenMethodChange:aPackagedMethod byPackageNamed:byPackageNamed
+ "add an overridden method. under #package -> #methodClassName -> #methodChangeNamespace -> #methodChange"
+ | methodClassName methodChangeNamespace |
+ methodClassName := aPackagedMethod ownedClassName.
+ methodChangeNamespace := self class methodChangeNamespace.
+
+ (((overriddenChanges at:byPackageNamed ifAbsentPut:[Dictionary new])
+ at:methodClassName ifAbsentPut:[Dictionary new])
+ at:methodChangeNamespace
+ ifAbsentPut:[Dictionary new]) at:aPackagedMethod name put:aPackagedMethod
+!
+
+addPackagedClass:aPackagedClass
+ "add or replace aPackagedClass"
+ packagedClasses at:aPackagedClass put:aPackagedClass
+!
+
+addPackagedClasses:somePackagedClasses
+ somePackagedClasses do:[:each |
+ self addPackagedClass:each
+ ].
+ ^ somePackagedClasses
+!
+
+addPackagedMethod:aPackagedMethod
+ "add or replace aPackagedMethod from the receiver"
+ ^ (self packagedMethodsAt:aPackagedMethod mclass name ifAbsentPut:[Dictionary new])
+ at:aPackagedMethod name put:aPackagedMethod.
+!
+
+addPackagedMethods:somePackageMethods
+
+ somePackageMethods do:[:aPackageMethod |
+ self addPackagedMethod:aPackageMethod copy.
+ ].
+ ^ somePackageMethods
+!
+
+blockedMethodsAt:arg
+ ^ (blockedMethods at:arg ifAbsent:[nil])
+!
+
+blockedMethodsAt:aClassName ifAbsentPut:anObject
+ ^ blockedMethods at:aClassName ifAbsentPut:anObject
+!
+
+blockedMethodsRemoveKey:aKey
+ ^ (self blockedMethodsRemoveKey:aKey ifAbsent:[nil"Q: be quiet or show error???"])
+!
+
+blockedMethodsRemoveKey:arg ifAbsent:aBlock
+ ^ (blockedMethods removeKey:arg ifAbsent:aBlock)
+!
+
+packagedClassAt:arg
+ ^ (packagedClasses at:arg ifAbsent:[nil])
+!
+
+packagedClassesRemoveKey:aKey ifAbsent:aBlock
+ ^ self packagedClasses removeKey:aKey ifAbsent:aBlock
+!
+
+packagedMethodsAt:arg
+ ^ (packagedMethods at:arg ifAbsent:[nil])
+!
+
+packagedMethodsAt:arg ifAbsent:aBlock
+ ^ (packagedMethods at:arg ifAbsent:aBlock)
+!
+
+packagedMethodsAt:arg ifAbsentPut:aBlock
+ ^ (packagedMethods at:arg ifAbsentPut:aBlock)
+!
+
+removeBlockedMethodNamed:aMethodName forClassNamed:aClassName
+ ^ (self blockedMethodsAt:aClassName) remove:aMethodName.
+!
+
+removeOverriddenMethodNamed:aMethodName forClassNamed:aClassName
+ | classOverridenChanges methodOverridenChanges|
+
+ classOverridenChanges := (overriddenChanges
+ at:self class methodChangeNamespace
+ ifAbsent:[ ^ self"jump out of method here!!"]).
+ methodOverridenChanges := (classOverridenChanges
+ at:aClassName
+ ifAbsent:[ ^ self"jump out of method here!!"]).
+
+ (methodOverridenChanges
+ removeKey:aMethodName
+ ifAbsent:[self error:'trying to remove a method that does not exist!!'"should i keep this?"]).
+!
+
+scriptAt:aSymbol
+ ^ scripts at:aSymbol ifAbsent:[PackagedScript string:(String new) receiver:self]
+!
+
+scriptAt:aSymbol put:aString
+ scripts at:aSymbol put:aString
+! !
+
+!Package methodsFor:'adding & removing - basic'!
+
+basicAddMethodNamed:aMethodName forClassNamed:aClassName
+ "add a method to the responsibility to the receiver."
+ | aPackagedMethod aClass doesNotOwnClass|
+
+ (self blockedMethodsIncludeMethodName:aMethodName forClassNamed:aClassName) ifTrue:[
+ self removeBlockedMethodNamed:aMethodName forClassNamed:aClassName.
+ ^ aPackagedMethod.
+ ].
+
+ aClass := (Smalltalk classNamed:aClassName).
+
+ aClass ifNil:[self error
+ ].
+
+ doesNotOwnClass := (self classNamed:aClassName) isNil.
+
+ doesNotOwnClass ifTrue:[| aMethod |
+ aMethod := aClass compiledMethodAt:aMethodName.
+ aPackagedMethod := (self newPackagedMethodWithMethod:aMethod).
+
+ (self packagedMethodsAt:aClassName ifAbsentPut:[Dictionary new])
+ at:aMethodName put:aPackagedMethod.
+ ].
+
+ (self overriddenChangesIncludesMethodName:aMethodName forClass:aClassName) ifTrue:[
+ "it should not be consider overriden anymore has the method has just been
+ added to the receiver!!"
+ self removeOverriddenMethodNamed:aMethodName forClassNamed:aClassName
+ ].
+ ^ aPackagedMethod "if nil, the method is still to be installed. Could use a dummy here instead??"
+!
+
+basicAddPackagedClass:aPackageClass
+ "adds a class to the receiver.
+ NOTE: Does not mark the receiver as dirty.
+ That is the responsibility of the called of this method!!"
+ aPackageClass isClass ifTrue:[
+ self halt.
+ ].
+ self packagedClasses at:aPackageClass name put:(aPackageClass).
+ ^ aPackageClass
+!
+
+basicAddPrerequisite:aPrerequisite
+ prerequisites add:aPrerequisite
+!
+
+basicAddedClass:aClass
+ "add a representation of a class (PackagedClass) to the receiver.
+ Look in aClass to see if we need to add any blocked methods - this could
+ be done by the manager but is done locally to avoid too many message sends"
+ | methodDic|
+ self basicAddPackagedClass:(self newPackagedClass:aClass).
+ methodDic := aClass methodDictionary copy.
+ methodDic keysAndValuesDo:[:aMethodName :aMethod |
+ (aMethod package == self name) ifFalse:[
+ self addBlockedMethodNamed:aMethodName forClassNamed:aClass name
+ ].
+ ].
+ ^ aClass
+!
+
+basicAddedMethod:aMethod
+
+ | aPackagedMethod aClass doesNotOwnClass aMethodName aClassName|
+ aMethodName := aMethod name.
+ (aClass := aMethod mclass) ifNil:[self error
+ ].
+ aClassName := aClass name.
+
+ (self blockedMethodsIncludeMethodName:aMethodName forClassNamed:aClassName) ifTrue:[
+ self removeBlockedMethodNamed:aMethodName forClassNamed:aClassName.
+ ^ aMethod.
+ ].
+
+ doesNotOwnClass := (self classNamed:aClassName) isNil.
+ doesNotOwnClass ifTrue:[
+ aPackagedMethod := (self newPackagedMethodWithMethod:aMethod).
+ (self packagedMethodsAt:aClassName ifAbsentPut:[Dictionary new])
+ at:aMethodName put:aPackagedMethod.
+ ].
+
+ (self overriddenChangesIncludesMethodName:aMethodName forClass:aClassName) ifTrue:[
+ "it should not be consider overriden anymore has the method has just been
+ added to the receiver!!"
+ self removeOverriddenMethodNamed:aMethodName forClassNamed:aClassName
+ ].
+ ^ aMethod "if nil, the method is still to be installed. Could use a dummy here instead??"
+!
+
+basicRemoveClassNamed:aSymbol
+
+ self packagedClassesRemoveKey:aSymbol ifAbsent:[
+ "how much information do i need to recover from this error?"
+ self raisePackageError:'Cannot remove packagedClass ', aSymbol asString,
+ ' from package: ', name string.
+ ].
+ self blockedMethodsRemoveKey:aSymbol ifAbsent:[nil "this is not always there!!"].
+ ^ aSymbol
+
+
+
+
+
+!
+
+basicRemoveMethodNamed:aMethodName forClassNamed:aClassName
+ "note: could also create a loose method object which could be more useful"
+ ^ self basicRemoveMethodNamed:aMethodName forClassNamed:aClassName ifAbsent:[self error.]
+!
+
+basicRemoveMethodNamed:aMethodName forClassNamed:aClassName ifAbsent:aBlock
+ "remove method named aMethodName from the receiver. If it is in loose methods, remove it,
+ if the receiver just owns the class, add it to the blockedMethods if teh blockedMethods already have it,
+ evaluate aBlock"
+ | aPackagedMethod |
+ aPackagedMethod :=
+ (self packagedMethodsAt:aClassName ifAbsent:[self class emptyDictionaryConstant "is absent now"])
+ removeKey:aMethodName
+ ifAbsent:[
+ (self blockedMethodsIncludeMethodName:aMethodName forClassNamed:aClassName) ifTrue:[
+ ^ aBlock value. "the receiver does not know this method!!"
+ ].
+ "i own the class of the method"
+ self addBlockedMethodNamed:aMethodName forClassNamed:aClassName
+ ].
+
+ (self overriddenChangesIncludesMethodName:aMethodName forClass:aClassName) ifTrue:[
+ self halt:'I need to remove the overriden change here as once the method
+ is removed from me i dont want to know about it any more!!'.
+ ].
+
+ ^ aPackagedMethod
+! !
+
+!Package methodsFor:'api - accessing'!
+
+changeSet
+ | changeSet |
+ changeSet := ChangeSet new.
+ packagedClasses do:[:aPackagedClass |
+ changeSet addAll:aPackagedClass changeSet
+ ].
+ self looseMethods do:[:aPackageMethod | | aMethod aClass |
+ changeSet addMethodChange:aPackageMethod method in:aPackageMethod ownedClass
+ ].
+
+ ^ changeSet
+!
+
+classCategories
+ | return |
+ return := Set new.
+ self packagedClassesDo:[:aPackagedClass |
+ return add:aPackagedClass category.
+ ].
+ ^ return asOrderedCollection sort:[:x :y | x > y].
+!
+
+classesInCategory:aCategory
+ | collectingClasses |
+ collectingClasses := OrderedCollection new.
+
+ self packagedClassesDo:[:aPackagedClass |
+ aPackagedClass category == aCategory ifTrue:[
+ collectingClasses add: aPackagedClass classInImage.
+ ].
+ ].
+ ^ collectingClasses
+!
+
+getSourceForClass:aClass
+ "get the source of a class in the context of the receiver"
+ | currentSourceStream |
+ currentSourceStream := aClass currentSourceStream.
+ self halt.
+!
+
+looseMethodNames
+ ^ self looseMethods collect:[:aMethod | aMethod name].
+! !
+
+!Package methodsFor:'api - adding & removing'!
+
+addClassNamed:aClass
+ "called when adding a class on startup. So far this is a kludge. To be replaced by a
+ loaded package class - this is soley an installed class"
+ ^ self basicAddPackagedClass:(PackagedClass name:aClass package:self)
+!
+
+addMethodNamed:aMethodName forClassNamed:aClassName
+
+ | aPackagedMethod doesNotOwnClass |
+
+ aPackagedMethod := (self newPackagedMethodSelector:aMethodName className:aClassName).
+
+ (self blockedMethodsIncludeMethodName:aMethodName forClassNamed:aClassName) ifTrue:[
+ self removeBlockedMethodNamed:aMethodName forClassNamed:aClassName.
+ ^ aPackagedMethod.
+ ].
+
+ doesNotOwnClass := (self classNamed:aClassName) isNil.
+ doesNotOwnClass ifTrue:[
+ (self packagedMethodsAt:aClassName ifAbsentPut:[Dictionary new])
+ at:aMethodName put:aPackagedMethod.
+ ].
+
+ (self overriddenChangesIncludesMethodName:aMethodName forClass:aClassName) ifTrue:[
+ "it should not be consider overriden anymore has the method has just been
+ added to the receiver!!"
+ self removeOverriddenMethodNamed:aMethodName forClassNamed:aClassName
+ ].
+ ^ aPackagedMethod "if nil, the method is still to be installed. Could use a dummy here instead??"
+!
+
+addedClass:aClass
+ "Add a class to a package. Return the aClass.
+ This only works when 'aClass package == name' if not and error will occur.
+ This method is called only AFTER the class package has changed!! This class
+ is NOT responsible for changing values in classes!!
+ "
+ (aClass package == self name) ifFalse:[
+ self error:'Cannot add ', aClass name, ' to package ''', name,
+ ''' as the class ', aClass name, Character cr asString,
+ ' belongs in the package''', aClass package asString,''''.
+ ].
+ self basicAddedClass:aClass.
+ self markDirty.
+ self changed:#addedClass: with:aClass.
+ ^ aClass
+!
+
+addedClasses:aClasses
+ "Add a class to a package. Return the aClass"
+ aClasses do:[:aClass |
+ self basicAddedClass:aClass.
+ ].
+
+ self markDirty.
+ self changed:#addClasses: with:aClasses.
+ ^ aClasses
+!
+
+addedMethod:aMethod
+ "Add a method to a package. Return the aMethod"
+ self basicAddedMethod:aMethod.
+ self markDirty.
+ self changed:#addedMethod: with:aMethod.
+ ^ aMethod
+!
+
+addedMethods:someMethods
+ "Add someMethods to a package. Return the someMethods"
+ someMethods do:[:aMethod |
+ self basicAddedMethod:aMethod.
+ ].
+ self markDirty.
+ self changed:#addedMethods: with:someMethods.
+ ^ someMethods
+!
+
+addedPackage:aPackage
+ "this is a little like inherits from but with packages. It could also be
+ considered to be a prerequisit that aPackageClass must be in the image before this
+ is installed!!"
+ self shouldImplement."soon"
+!
+
+removePackage:aPackage
+ "this is a little like inherits from but with packages. It could also be
+ considered to be a prerequisit that aPackageClass must be in the image before this
+ is installed!!"
+ self shouldImplement."soon"
+!
+
+removedClass:aClass
+ "Add a class to a package. Return the aClass"
+ ^ self removedClassNamed:aClass name.
+!
+
+removedClassNamed:aSymbol
+ self basicRemoveClassNamed:aSymbol.
+ self markDirty.
+ self changed:#removedClassNamed: with:aSymbol.
+ ^ aSymbol
+!
+
+removedMethod:aMethod
+ ^ self
+ removedMethodNamed:aMethod name
+ forClassNamed:aMethod mclass name.
+!
+
+removedMethodNamed:aMethodName forClassNamed:aClassName
+ "note: could also create a loose method object which could be more useful"
+ ^ self removedMethodNamed:aMethodName forClassNamed:aClassName ifAbsent:[]
+!
+
+removedMethodNamed:aMethodName forClassNamed:aClassName ifAbsent:aBlock
+ "note: could also create a loose method object which could be more useful"
+ | aPackagedMethod |
+ aPackagedMethod := self basicRemoveMethodNamed:aMethodName forClassNamed:aClassName ifAbsent:aBlock.
+ self markDirty.
+ self changed:#removedMethodNamed:forClassNamed: with:(Array with:(aMethodName)with:(aClassName)).
+ ^ aPackagedMethod
+! !
+
+!Package methodsFor:'api - prerequisites'!
+
+addClassNamePrerequisite:aClassName
+ "changed sent in the following call"
+ ^ self addClassNamePrerequisite:aClassName ifFailString:''.
+!
+
+addClassNamePrerequisite:aName ifFailString:aString
+ | returnValue |
+ returnValue := self basicAddPrerequisite:(self newClassPrerequisiteNamed:aName ifFailString:aString).
+ self changed:#addClassNamePrerequisite: with:aName.
+ ^ returnValue.
+!
+
+addPackageNamePrerequisite:aName
+ "changed sent in the following call"
+ ^ self addPackageNamePrerequisite:aName ifFailString:''.
+!
+
+addPackageNamePrerequisite:aName ifFailString:aString
+ | returnValue |
+ returnValue := self basicAddPrerequisite:(self newPackagePrerequisiteNamed:aName
+ ifFailString:aString).
+
+ self changed:#addPackageNamePrerequisite: with:aName.
+ ^ returnValue.
+! !
+
+!Package methodsFor:'api - scripts'!
+
+postInstallScript
+ ^ self scriptAt:#postInstall
+!
+
+postInstallScriptString:aString
+ self scriptAt:#postInstall put:(self newPackageScriptWithString:aString).
+ self changed:#postInstallScriptString: with:aString.
+!
+
+postUninstallScript
+ ^ self scriptAt:#postUninstall
+!
+
+postUninstallScriptString:aString
+ self scriptAt:#postUninstall put:(self newPackageScriptWithString:aString).
+ self changed:#postUninstallScriptString: with:aString.
+!
+
+preInstallScript
+ ^ (self scriptAt:#preInstall)
+!
+
+preInstallScriptString:aString
+ self scriptAt:#preInstall put:(self newPackageScriptWithString:aString).
+ self changed:#preInstallScriptString: with:aString.
+!
+
+preUninstallScript
+ ^ self scriptAt:#preUninstall
+!
+
+preUninstallScriptString:aString
+ self scriptAt:#preUninstall put:(self newPackageScriptWithString:aString).
+ self changed:#preUninstallScriptString: with:aString.
+! !
+
+!Package methodsFor:'api - temporary'!
+
+basicPackagesInImage
+ ^ PackageManager basicPackagesInImage
+!
+
+mergeFromImage
+ "get everything related to my package name in the image and add it to self."
+ | myGhost |
+
+ myGhost := self basicPackagesInImage at:name.
+ self addPackagedClasses:(myGhost packagedClasses values asSet - self packagedClasses values asSet).
+ self addPackagedMethods:(myGhost looseMethods asSet - self looseMethods asSet).
+"
+ (self named:#'__NoProject__') mergeFromImage
+"
+! !
+
+!Package methodsFor:'api - uninstall'!
+
+uninstall
+ self checkOkToUninstall.
+ self basicUninstall.
+! !
+
+!Package methodsFor:'api-moving'!
+
+movedClass:aClass toPackage:newOwnerPackage
+ "Note: all the methods of the class have also been moved to newOwnerPackage BUT
+ we do not have to do anything about that here!! We also do not get any change messages
+ and we - in effect - get this change for free :-) as now newOwnerPackage owns the class!!"
+ self removedClass:aClass.
+ newOwnerPackage addedClass:aClass.
+!
+
+movedMethod:aMethod toPackage:newOwnerPackage
+ self removedMethod:aMethod.
+ newOwnerPackage addedMethod:aMethod.
+! !
+
+!Package methodsFor:'changes'!
+
+classChange:classChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ "
+
+ self changed:#classChange: with:classChange
+!
+
+classDefinitionChange:aClassDefinitionChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ At present a classDefinitionChange does not result in a class changing packages!!
+ If it does then this method needs to change and put this change type in overridden changes!!
+ "
+ self markDirty.
+ self changed:#classDefinitionChange: with:aClassDefinitionChange
+!
+
+classInstVarDefinitionChange:aClassInstVarDefinitionChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ At present a classInstVarDefinitionChange does not result in a class changing packages!!
+ If it does then this method needs to change and put this change type in overridden changes!!
+ "
+ self markDirty.
+ self changed:#classInstVarDefinitionChange: with:aClassInstVarDefinitionChange
+!
+
+classRemoveChange:aClassRemoveChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ At the moment i store the original package information in the instance variable
+ packagedClasses, and this is where i get the original class definition from!! It might be
+ an idea to get this info from aClassRemoveChange like it is done in methodRemoveChange.
+ Then we would not need the packageClasses themselves and just storing symbolic links
+ to the classesand create the packageClasses on the fly when needed.
+ "
+ |classBeingRemoved originalClassDefinition |
+
+ classBeingRemoved := ClassRemoveChange::ClassBeingRemovedQuery query.
+ originalClassDefinition := (self packagedClassAt: classBeingRemoved name).
+ self addOverriddenClassChange:originalClassDefinition.
+ self changed:#classRemoveChange:aClassRemoveChange
+!
+
+classRenameChange:aClassRenameChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ This action requires the receiver to change all references to the old class name to the
+ new name.
+ "
+ | newClass |
+ newClass := (Smalltalk classNamed:aClassRenameChange className).
+ newClass ifNil:[
+ self error:'The class named ', newClass name,
+ 'does not exist!! It is expected to exist from a rename action!!'
+ ].
+ self removedClassNamed:aClassRenameChange oldName.
+ self addedClass:newClass "not expected to be nil".
+
+ self changed:#classRenameChange: with:aClassRenameChange
+!
+
+markClean
+ self isDirty:false.
+!
+
+markDirty
+ self isDirty:true
+!
+
+methodCategoryChange:aChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ This is not considered a 'major change'. Therefore do nothing to the receiver to indicate that
+ this method (specified by aChange) has been overriden or change. Just mark the receiver as
+ dirty
+ "
+ self markDirty.
+ self changed:#methodCategoryRenameChange: with:aChange
+!
+
+methodCategoryRenameChange:aChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ This is not considered a 'major change'. Therefore do nothing to the receiver to indicate that
+ this method (specified by aChange) has been overriden or change. Just mark the receiver as
+ dirty
+ "
+ self markDirty.
+ self changed:#methodCategoryRenameChange: with:aChange
+!
+
+methodChanged:aMethodChange
+ "assumes that checks to see if the receiver is affected by the change have been made
+ a method as changed.
+
+ There are really two types of change that come in here. A 'new method change' and a
+ 'method redefinition'.
+
+ If the receiver is dependent on the change there are two things that
+ can happen depending on the change:
+
+ 1) if the receiver owns the class but not the method
+ - to keep the package consistant - we add a blocked method to the receiver
+
+ 2) if the receiver has a loose method defining the method
+ add an overriddenMethod change - to store the original.
+
+ Context note:
+ at present a change to a methods results ALWAYS in the default package owning the method.
+ so here we assume that the current version package is NEVER the receiver!! This could be
+ added functionality option later on (i have no way of testing this now).
+ "
+ | previousVersion aMethodName aClassName aPackagedMethod byPackageName |
+
+ aMethodName := aMethodChange selector.
+ aClassName := aMethodChange className.
+ previousVersion := aMethodChange previousVersion.
+ aPackagedMethod := self
+ newPackagedMethodSelector:aMethodName
+ className:aClassName
+ source:previousVersion.
+ byPackageName := aPackagedMethod currentPackageOwner.
+
+ (self includesClassNamed:aClassName) ifTrue:[
+ previousVersion ifNil:[
+ "should only really happen in Default class - at least for the time being.
+ This is because as is noted in - 'Context note' - above"
+ ^ self newMethodChanged:aMethodChange
+ ].
+ previousVersion package asSymbol == self name ifTrue:[
+ ^ self addOverriddenMethodChange:aPackagedMethod byPackageNamed:byPackageName.
+ ].
+ self error:'i should NEVER be here.... either isDependentOnMethodChange does not
+ work correctly OR i have just gone a bit bonkers!!'
+ ].
+
+ "when i am here aMethodChange is in with my packageMethods (loose method)
+ the following should be true(but is it needed???):
+ previousVersion package asSymbol == self name
+ "
+
+ self addOverriddenMethodChange:aPackagedMethod byPackageNamed:byPackageName.
+
+ self changed:#methodChanged: with:aMethodChange
+!
+
+methodRemoveChange:aMethodRemoveChange
+ "assumes that checks to see if the receiver is affected by the change have been made.
+ A method that i am dependant on has been removed. I could be dependent on it's class
+ or the method itself (then it would be a loose method).
+
+ There is one special case where i would be dependent on the class but not the method.
+ In this case i just remove the blocked method from my blocked method list!!
+ Otherwise adds changes to overriddenChanges.
+ "
+ | previousVersion aMethodName aClassName aPackagedMethod|
+ aMethodName := aMethodRemoveChange selector.
+ aClassName := aMethodRemoveChange className.
+ previousVersion := aMethodRemoveChange previousVersion.
+ aPackagedMethod := self
+ newPackagedMethodSelector:aMethodName
+ className:aClassName
+ source:previousVersion source.
+
+ (self blockedMethodsIncludeMethodName:aMethodName forClassNamed:aClassName) ifTrue:[
+ self removeBlockedMethodNamed:aMethodName forClassNamed:aClassName.
+ ^ self.
+ ].
+
+ (self includesClassNamed:aMethodRemoveChange className asSymbol) ifTrue:[
+
+ previousVersion package asSymbol == self name ifTrue:[
+ ^ self addOverriddenMethodChange:aPackagedMethod."never be nil"
+ ].
+ self error:'i should NEVER be here.... either isDependentOnMethodChange does not
+ work correctly OR i have just gone a bit bonkers!!'
+ ].
+
+ "when i am here aMethodChange is in with my packageMethods"
+ self addOverriddenMethodChange:aPackagedMethod.
+
+ self changed:#methodChanged: with:aMethodRemoveChange
+!
+
+newMethodChanged:aMethodChange
+ "a new method has been created. In this case i must be dependent on the method's class
+ so i need to block this method from my 'view of the world'."
+ | aMethodName aClassName |
+ aMethodName := aMethodChange selector.
+ aClassName := aMethodChange className.
+ ^ self addBlockedMethodNamed:aMethodName forClassNamed:aClassName
+! !
+
+!Package methodsFor:'checks'!
+
+readyForInstall
+ #ToDo.
+!
+
+readyForUninstall
+ #ToDo.
+! !
+
+!Package methodsFor:'enumerating'!
+
+classNamesDo:aOneArgBlock
+ self classNames do:[:aClassName|
+ aOneArgBlock value:aClassName
+ ].
+!
+
+classesDo:aBlock
+ self packagedClassesDo:[:aPackage | | aClass |
+ (aClass"orNil" := aPackage classInImage) ifNotNil:[
+ aBlock value:aClass
+ ].
+ ].
+!
+
+looseMethodNamesAndClassNamesDo:aTwoArgBlock
+ self looseMethods do:[:aMethod |
+ aTwoArgBlock value:aMethod name value:aMethod mclass name
+ ].
+!
+
+looseMethodsDo:aBlock
+ self looseMethods do:aBlock.
+!
+
+packagePrerequisites
+ ^ prerequisites select:[:aPre |
+ aPre isPackagePrerequisite
+ ].
+
+!
+
+packagedClassesCollect:aBlock
+ ^ self packagedClasses collect:aBlock
+!
+
+packagedClassesDo:aOneArgBlock
+ ^ packagedClasses do:aOneArgBlock
+! !
+
+!Package methodsFor:'exceptions'!
+
+packageError:aString
+ PackageError
+ raiseFromPackage:self
+ withString:aString.
+!
+
+packageNotification:arg
+ self halt:'please define packageNotification: here'.
+!
+
+raisePackageError:aString
+ PackageError raiseErrorString:aString.
+! !
+
+!Package methodsFor:'factory'!
+
+newClassPrerequisiteNamed:aName ifFailString:aString
+ ^ ClassPrerequisite named:aName ifFailString:aString.
+!
+
+newOverriddenChangeWithChange:aChange
+ ^ OverriddenChange newChange:aChange package:self.
+!
+
+newPackagePrerequisiteNamed:aName ifFailString:aString
+ ^ PackagePrerequisite named:aName ifFailString:aString.
+!
+
+newPackageScriptWithString:aString
+ ^ PackagedScript string:aString receiver:self
+!
+
+newPackagedClass:aClass
+ ^ (PackagedClass class:aClass package:self)
+!
+
+newPackagedMethodSelector:aMethodSelector className:aClassName
+ ^ PackagedMethod new
+ name:aMethodSelector;
+ ownedClassName: aClassName;
+ package:self.
+!
+
+newPackagedMethodSelector:aMethodSelector className:aClassName source:aSourceString
+ ^ PackagedMethod
+ name:aMethodSelector
+ ownedClassName: aClassName
+ package:self
+ source:aSourceString
+!
+
+newPackagedMethodWithMethod:aMethod
+ ^ PackagedMethod
+ name:aMethod selector
+ ownedClassName: aMethod mclass name
+ package:self
+ source:aMethod source
+! !
+
+!Package methodsFor:'initialization'!
+
+initialize
+
+ packagedClasses := self class defaultPackagedClassesCollection.
+ packagedMethods := self class defaultPackagedMethodsCollection.
+ blockedMethods := self class defaultBlockedMethodsCollection.
+ overriddenChanges := self class defaultOverriddenChangesCollection.
+ prerequisites := self class defaultPrerequisiteCollection.
+ scripts := self class defaultScriptsCollection.
+
+ isDirty := false.
+ isInstalled := false. "not sure about this..."
+ super initialize.
+!
+
+initializeClasses
+ self classesDo:[:aClass |
+ aClass initialize.
+ ].
+!
+
+initializeInstalled
+ "initialize as if the receiver as if it has just been loaded"
+ | myName packagedClass |
+ myName := self name.
+ self isDirty:false.
+ self isInstalled:true.
+ self classesDo:[:aClass |
+ aClass setPackage:myName.
+ "get initial information"
+ packagedClass := (self packagedClassAt:aClass name).
+ packagedClass instanceDefinition: aClass definition.
+ packagedClass classDefinition: aClass class definition.
+ ].
+
+ self looseMethodsDo:[:aMethod |
+ aMethod setPackage:myName
+ ].
+!
+
+initializeLoaded
+ "initialize as if the receiver as just been loaded"
+ self isDirty:false.
+ self isInstalled:false.
+! !
+
+!Package methodsFor:'printing'!
+
+printOn:aStream
+
+ 'named:', self name.
+ aStream nextPutAll:self class printString.
+ aStream nextPutAll:' named:'.
+ aStream nextPut:$'.
+ aStream nextPutAll:self name.
+ aStream nextPut:$'.
+! !
+
+!Package methodsFor:'queries'!
+
+blockedMethodsIncludeMethodName:aMethodName forClassNamed:aClassName
+ | blockedMethods |
+ blockedMethods := (self blockedMethodsAt:aClassName).
+ blockedMethods ifNil:[
+ ^ false.
+ ].
+
+ ^ blockedMethods includes:aMethodName
+!
+
+definesSelector:aSymbol forClass:aClass
+ | dictionaryOfPackagedMethods |
+ dictionaryOfPackagedMethods := self packagedMethods at:aClass name ifAbsent:[^ false].
+ dictionaryOfPackagedMethods at:aSymbol ifAbsent:[^ false].
+ ^ true
+!
+
+includesClassNamed:aSymbol
+ | classWithoutClassEnding |
+ classWithoutClassEnding := (aSymbol asString copyUpTo:Character space) asSymbol.
+ self packagedClasses at:classWithoutClassEnding ifAbsent:[^ false].
+ ^ true
+!
+
+includesSelector:aMethodSymbol forClass:aClassSymbol
+ "checks to see if the receiver is dependent on a method selector associated
+ with a class symbol. if the current method package name is not the same as the receiver's
+ i am not responsible for this method any more."
+
+ | theClass |
+ (theClass := self classNamed:aClassSymbol) ifNil:[
+ ^ false.
+ ].
+
+ (theClass compiledMethodAt:aMethodSymbol) package == name ifFalse:[
+ ^ false.
+ ].
+
+ ^ true.
+!
+
+isDependentOnClassChange:classChange
+ "checks to see if the receiver is affected by the change. returns a boolean
+ "
+ ^ (self includesClassNamed:(classChange className))
+!
+
+isDependentOnClassDefinitionChange:aClassDefinitionChange
+ ^ (self includesClassNamed:(aClassDefinitionChange className))
+!
+
+isDependentOnClassInstVarDefinitionChange:aClassInstVarDefinitionChange
+ ^ (self includesClassNamed:(aClassInstVarDefinitionChange className))
+!
+
+isDependentOnClassRemoveChange:aClassRemoveChange
+ ^ (self includesClassNamed:(aClassRemoveChange className))
+!
+
+isDependentOnClassRenameChange:classChange
+ "checks to see if the receiver is affected by the change. returns a boolean
+ "
+ ^ (self includesClassNamed:(classChange oldName))
+!
+
+isDependentOnMethodCategoryChange:aMethodCategoryChange
+ "if you want to later to be dependent on this MethodCategoryChange needs to probably store the
+ previous version in its already available instance variable. Implement this method also in DefaultPackage.
+ Also do we really need a MethodCategoryChange as well as a MethodCategoryRenameChange??"
+ ^ false
+!
+
+isDependentOnMethodCategoryRenameChange:aMethodChange
+ "if you want to later to be dependent on this MethodCategoryChange needs to probably store the
+ previous version in its already available instance variable. Implement this method also in DefaultPackage.
+ Also do we really need a MethodCategoryChange as well as a MethodCategoryRenameChange??"
+ ^ false
+!
+
+isDependentOnMethodChange:aMethodChange
+ "a method as changed. If the receiver is responsible for the change return true
+ or false."
+ | previousVersion aMethodChangeSelector aMethodChangeClassName |
+ aMethodChangeSelector := aMethodChange selector.
+ aMethodChangeClassName := aMethodChange className.
+
+ (previousVersion := aMethodChange previousVersion) ifNotNil:[
+ previousVersion package == self name ifTrue:[
+ ^ true
+ ].
+ ].
+ (self includesClassNamed:aMethodChange className asSymbol) ifTrue:[
+ (self blockedMethodsIncludeMethodName:aMethodChangeSelector forClassNamed:aMethodChangeClassName) ifTrue:[
+ ^ false.
+ ].
+
+ (self overriddenChangesIncludesMethodChange:aMethodChange) ifTrue:[
+ ^ false.
+ ].
+ previousVersion ifNil:[
+ ^ true
+ ].
+
+ ].
+
+ aMethodChange package == self name ifTrue:[
+ ^ true
+ ].
+ ^ false
+!
+
+isDependentOnMethodRemoveChange:aMethodRemoveChange
+ "a method as been removed. If the receiver is responsible for the change return true
+ or false."
+ | previousVersion aMethodChangeSelector aMethodChangeClassName |
+ aMethodChangeSelector := aMethodRemoveChange selector.
+ aMethodChangeClassName := aMethodRemoveChange className.
+
+ (previousVersion := aMethodRemoveChange previousVersion) ifNotNil:[
+ previousVersion package == self name ifTrue:[
+ ^ true
+ ].
+ ].
+ (self includesClassNamed:aMethodRemoveChange className asSymbol) ifTrue:[
+ (self blockedMethodsIncludeMethodName:aMethodChangeSelector forClassNamed:aMethodChangeClassName) ifTrue:[
+ ^ true.
+ ].
+
+ (self overriddenChangesIncludesMethodChange:aMethodRemoveChange) ifTrue:[
+ ^ true.
+ ].
+
+ ].
+
+ aMethodRemoveChange package == self name ifTrue:[
+ ^ true
+ ].
+ ^ false
+!
+
+isLooseMethod:aMethod
+ ^ (self includesClassNamed:aMethod mclass) not
+!
+
+isPackage
+ ^ true
+!
+
+overriddenChangesIncludesMethodChange:aMethodChange
+ ^ self
+ overriddenChangesIncludesMethodName:aMethodChange selector
+ forClass:aMethodChange changeClass name
+!
+
+overriddenChangesIncludesMethodName:aMethodName forClass:aClassName
+ | classOverridenChanges methodOverridenChanges|
+ classOverridenChanges := (overriddenChanges
+ at:self class methodChangeNamespace
+ ifAbsent:[ ^ false"jump out of method here!!"]).
+ methodOverridenChanges := (classOverridenChanges
+ at:aClassName
+ ifAbsent:[ ^ false"jump out of method here!!"]).
+
+ (methodOverridenChanges
+ at:aMethodName
+ ifAbsent:[ ^ false"jump out of method here!!"]).
+
+ ^ true
+! !
+
+!Package methodsFor:'uninstall'!
+
+basicUninstall
+
+ self preUninstallScript evaluate.
+ self uninstallDependentPackages.
+ self uninstallClasses.
+ self uninstallLooseMethods.
+ self initializeLoaded.
+ self postUninstallScript evaluate.
+!
+
+checkOkToUninstall
+ #toDo.
+!
+
+uninstallClasses
+ self classesDo:[:aClass |
+ aClass removeFromSystem.
+ ]
+!
+
+uninstallDependentPackages
+ #toDo
+!
+
+uninstallLooseMethods
+ self looseMethodNamesAndClassNamesDo:[:aMethodName :aClassName |
+ (Smalltalk at:aClassName) removeSelector:aMethodName.
+ ].
+!
+
+uninstallLooseMethodsFromPackage:aPackage in:aPackageManager
+ aPackage looseMethodNamesAndClassNamesDo:[:aMethodName :aClassName |
+ (Smalltalk at:aClassName) removeSelector:aMethodName.
+ ].
+ #ToLookAt.
+! !
+
+!Package::PackagedClass class methodsFor:'instance creation'!
+
+class:aClass package:aPackage
+ | anInstance|
+ anInstance := (self basicNew name:aClass name package:aPackage).
+ (aClass isLoaded) ifFalse:[
+ "could also be dependant on Smalltalk!!"
+ aClass addDependent:anInstance. "get the definition when the class is autoloaded"
+ ^ anInstance.
+ ].
+ anInstance instanceDefinition: aClass definition.
+ anInstance classDefinition: aClass class definition.
+
+ ^ anInstance
+!
+
+name:aClassName package:aPackage
+ ^ (self basicNew name:aClassName package:aPackage).
+! !
+
+!Package::PackagedClass methodsFor:'accessing'!
+
+category
+ ^ self classInImage category
+!
+
+category:something
+ "set the value of the instance variable 'category' (automatically generated)"
+
+ category := something.
+!
+
+classDefinition
+ "return the value of the instance variable 'classDefinition' (automatically generated)"
+
+ ^ classDefinition
+!
+
+classDefinition:something
+ "set the value of the instance variable 'classDefinition' (automatically generated)"
+
+ classDefinition := something.
+!
+
+classInstanceVariableNames
+ "return the value of the instance variable 'classInstanceVariableNames' (automatically generated)"
+
+ ^ classInstanceVariableNames
+!
+
+classInstanceVariableNames:something
+ "set the value of the instance variable 'classInstanceVariableNames' (automatically generated)"
+
+ classInstanceVariableNames := something.
+!
+
+classVariableNames
+ "return the value of the instance variable 'classVariableNames' (automatically generated)"
+
+ ^ classVariableNames
+!
+
+classVariableNames:something
+ "set the value of the instance variable 'classVariableNames' (automatically generated)"
+
+ classVariableNames := something.
+!
+
+instanceDefinition
+ "return the value of the instance variable 'instanceDefinition' (automatically generated)"
+
+ ^ instanceDefinition
+!
+
+instanceDefinition:something
+ "set the value of the instance variable 'instanceDefinition' (automatically generated)"
+
+ instanceDefinition := something.
+!
+
+instanceVariableNames
+ "return the value of the instance variable 'instanceVariableNames' (automatically generated)"
+
+ ^ instanceVariableNames
+!
+
+instanceVariableNames:something
+ "set the value of the instance variable 'instanceVariableNames' (automatically generated)"
+
+ instanceVariableNames := something.
+!
+
+name
+ "return the value of the instance variable 'name' (automatically generated)"
+
+ ^ name
+!
+
+name:something
+ "set the value of the instance variable 'name' (automatically generated)"
+
+ name := something.
+!
+
+name:nameArg package:packageArg
+ "set instance variables (automatically generated)"
+
+ name := nameArg.
+ package := packageArg.
+!
+
+package
+ "return the value of the instance variable 'package' (automatically generated)"
+
+ ^ package
+!
+
+package:something
+ "set the value of the instance variable 'package' (automatically generated)"
+
+ package := something.
+!
+
+poolDictionaries
+ "return the value of the instance variable 'poolDictionaries' (automatically generated)"
+
+ ^ poolDictionaries
+!
+
+poolDictionaries:something
+ "set the value of the instance variable 'poolDictionaries' (automatically generated)"
+
+ poolDictionaries := something.
+! !
+
+!Package::PackagedClass methodsFor:'api'!
+
+changeSet
+ | theClass |
+ (theClass := self classInImage) ifNil:[
+ ^ ChangeSet new
+ ].
+
+ theClass autoload.
+
+ ^ ChangeSet forExistingClass:theClass
+!
+
+classInImage
+ ^ Smalltalk at:name
+!
+
+isInImage
+ "just looks for the class with the same name"
+ ^ self classInImage notNil
+! !
+
+!Package::PackagedClass methodsFor:'change & update'!
+
+update:something with:aParameter from:changedObject
+
+ (changedObject == self classInImage) ifTrue:[
+ changedObject isLoaded ifTrue:[
+ changedObject removeDependent:self. "dont need you any more"
+ definition := changedObject definition.
+ ].
+ ].
+! !
+
+!Package::PackagedClass methodsFor:'printing'!
+
+printOn:aStream
+ aStream nextPutAll:'(PackagedClass named:#', name, ')'.
+! !
+
+!Package::PackagedClass methodsFor:'queries'!
+
+isLoaded
+ ^ self classInImage isLoaded.
+! !
+
+!Package::PackagedMethod class methodsFor:'instance creation'!
+
+name:aMethodName ownedClassName: aClassName package:aPackageName source:source
+ ^ self basicNew name:aMethodName ownedClassName: aClassName package:aPackageName source:source
+! !
+
+!Package::PackagedMethod methodsFor:'* uncategorized *'!
+
+currentPackageOwner
+ | class method |
+ class := (Smalltalk classNamed:ownedClassName).
+ class ifNil:[
+ ^ nil.
+ ].
+ method := class compiledMethodAt:self name.
+
+ method ifNil:[
+ ^ nil
+ ].
+
+ ^ method package
+! !
+
+!Package::PackagedMethod methodsFor:'accessing'!
+
+category
+ (self isInImage) ifTrue:[
+ ^ self method category.
+ ].
+ ^ nil.
+!
+
+methodInImage
+ | myClass |
+ myClass := Smalltalk classNamed:ownedClassName.
+ myClass ifNil:[^ nil].
+
+ ^ myClass compiledMethodAt:self name.
+!
+
+name
+ "return the value of the instance variable 'name' (automatically generated)"
+
+ ^ name
+!
+
+name:something
+ "set the value of the instance variable 'name' (automatically generated)"
+
+ name := something.
+!
+
+name:nameArg ownedClassName:classNameArg package:packageArg
+ "set instance variables (automatically generated)"
+
+ name := nameArg.
+ ownedClassName := classNameArg.
+ package := packageArg.
+!
+
+name:nameArg ownedClassName:classNameArg package:packageArg source:sourceArg
+ "set instance variables (automatically generated)"
+
+ name := nameArg.
+ ownedClassName := classNameArg.
+ package := packageArg.
+ source := sourceArg.
+!
+
+ownedClass
+ ^ Compiler evaluate:ownedClassName
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:[nil]
+ compile:false
+
+
+
+"
+ (self new ownedClassName:'asdfasdf') ownedClass
+"
+!
+
+ownedClassName
+ "return the value of the instance variable 'className' (automatically generated)"
+
+ ^ ownedClassName
+!
+
+ownedClassName:something
+ "set the value of the instance variable 'className' (automatically generated)"
+
+ ownedClassName := something.
+!
+
+package
+ "return the value of the instance variable 'package' (automatically generated)"
+
+ ^ package
+!
+
+package:something
+ "set the value of the instance variable 'package' (automatically generated)"
+
+ package := something.
+!
+
+source
+ source isNil ifTrue:[
+ self isInImage ifFalse:[
+ ^ '** no method - no source **' copy.
+ ].
+ source := self method source.
+ ].
+
+ ^ source.
+!
+
+source:something
+ "set the value of the instance variable 'source' (automatically generated)"
+
+ source := something.
+! !
+
+!Package::PackagedMethod methodsFor:'fileIn/Out'!
+
+fileOutOn:aWriteStream
+
+ aWriteStream nextPut:$!!.
+ aWriteStream nextPutAll:ownedClassName asString.
+ aWriteStream nextPutAll:' methodsFor:'.
+ aWriteStream nextPut:$'.
+ aWriteStream nextPutAll:(self category).
+ aWriteStream nextPut:$'.
+ aWriteStream nextPut:$!!.
+ aWriteStream cr.
+
+ aWriteStream nextPutAll:self source.
+ aWriteStream nextPut:$!!.
+ aWriteStream cr.
+! !
+
+!Package::PackagedMethod methodsFor:'method - api'!
+
+mclass
+ ^ (Smalltalk classNamed:ownedClassName)
+!
+
+selector
+ ^ name
+! !
+
+!Package::PackagedMethod methodsFor:'printing'!
+
+printOn:aStream
+ self isLoose ifTrue:[
+ aStream nextPutAll:'LooseMethod:'.
+ ] ifFalse:[
+ aStream nextPutAll:'Method:'.
+ ].
+
+ aStream nextPutAll:self ownedClassName.
+ aStream nextPutAll:'->', name printString.
+ aStream cr.
+! !
+
+!Package::PackagedMethod methodsFor:'queries'!
+
+isInImage
+ | myClass|
+ (myClass := self ownedClass) ifNotNil:[
+ ^ (myClass methodDictionary at:name ifAbsent:[nil])~~ nil.
+ ].
+
+ ^ false.
+!
+
+isLoose
+ ^ (package includesClassNamed:ownedClassName) not
+!
+
+isTheSameAsInImage
+ | myClass method|
+ self halt.
+ (myClass := (Smalltalk at:ownedClassName)) ifNotNil:[
+ (method :=(myClass methodDictionary at:name ifAbsent:[nil])) ifNotNil:[
+ ^ method source = source. "there is a more efficient way but i have forgotten"
+ ].
+
+ ].
+ ^ false.
+!
+
+method
+ | myClass|
+ (myClass := self ownedClass) ifNotNil:[
+ ^ (myClass methodDictionary at:name ifAbsent:[nil]).
+ ].
+ self halt.
+ ^ nil.
+! !
+
+!Package::PackagedScript class methodsFor:'instance creation'!
+
+string:aString receiver:aPackage
+ ^ self basicNew string:aString receiver:aPackage
+! !
+
+!Package::PackagedScript methodsFor:'accessing'!
+
+getString
+ ^ string
+!
+
+string:stringArg receiver:receiverArg
+ "set instance variables (automatically generated)"
+
+ string := stringArg.
+ receiver := receiverArg.
+! !
+
+!Package::PackagedScript methodsFor:'evaluation'!
+
+evaluate
+ ^ Compiler evaluate:string receiver:receiver.
+! !
+
+!Package::PackagedScript methodsFor:'printing'!
+
+printOn:aStream
+ aStream nextPutAll:'Compiler evaluate:'.
+ aStream nextPut:$'.
+ aStream nextPutAll:string.
+ aStream nextPut:$'.
+ aStream nextPutAll:' receiver:('.
+ aStream nextPutAll:(receiver printString).
+ aStream nextPut:$).
+
+"
+ self string:'1 + 1' receiver:nil
+"
+! !
+
+!Package class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/packages/Package.st,v 1.1 2003-04-09 11:22:18 james Exp $'
+! !