packages/Package.st
author james
Fri, 11 Apr 2003 14:58:48 +0200
changeset 1244 93e70ae3c90f
parent 1239 4804c8cac426
child 1268 9dc8d1b8ce9b
permissions -rw-r--r--
*** empty log message ***

"{ 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 error:'I am expected a PackagedClass not a Class'.
    ].
    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 error:'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 error:'not used at the mo'.
!

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 breakPoint:''
!

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 name. 
!

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:'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'!

currentPackageOwner
    "get the name of the owner of this package"
    | class method |
    class := (Smalltalk classNamed:ownedClassName).
    class ifNil:[
        ^ nil.
    ].
    method := class compiledMethodAt:self name.

    method ifNil:[
        ^ nil
    ].

    ^ method package
!

isInImage
    | myClass|
    (myClass := self ownedClass) ifNotNil:[
        ^ (myClass methodDictionary at:name ifAbsent:[nil])~~ nil.
    ].
        
    ^ false.
!

isLoose
    ^ (package includesClassNamed:ownedClassName) not
!

isTheSameAsInImage
    | myClass method|
    (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.3 2003-04-11 12:58:16 james Exp $'
! !