"

 COPYRIGHT (c) 2003 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic3' }"

"{ NameSpace: Packages }"

AbstractPackageManager subclass:#PackageManager

	instanceVariableNames:'workingPackage defaultPackage'

	classVariableNames:''

	poolDictionaries:''

	category:'Package-Managers'

!

PackageManager class instanceVariableNames:'currentPackage currentManager imageChanges'

"

 No other class instance variables are inherited by this class.

"

!

!PackageManager class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2003 by eXept Software AG

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    PackageManager smalltalkPackageManager

    [author:]

	 (james@miraculix)

    [instance variables:]

    [class variables:]

    [see also:]

"

!

documentation_exceptions

"

    ClassDescription fileOutErrorSignal

	    can occur when a class within a package is autoloaded. Handle in application

    [author:]

	 (james@miraculix)

"

!

examples

"

  more examples to be added:

								[exBegin]

    ... add code fragment for

    ... executable example here ...

								[exEnd]

"

!

history

    "Created: / 27.1.2003 / 13:57:50 / james"

! !

!PackageManager class methodsFor:'instance creation'!

initialize

    "Uninitialize Singleton"

    currentManager ifNotNil:[

	currentManager uninitialize.

	currentManager := nil.

	currentPackage := nil.

    ]

"

    self initialize

"

!

newManagerOfCurrentImage

    | anInstance |

    anInstance := self new.

    self basicPackagesInImage do:[:aPackage |

	package isInstalled:true.

	anInstance addPackage:aPackage

    ].

    ^ anInstance

"

currentManager := self newManagerOfCurrentImage.

"

! !

!PackageManager class methodsFor:'* As yet uncategorized *'!

basePackageNames

    ^ (Array with:(Project noProjectID)) ,

	#(

	    #'stx:clients/AddrBook'

	    #'stx:clients/Animation'

	    #'stx:clients/Clock'

	    #'stx:clients/Demos'

	    #'stx:clients/DirView'

	    #'stx:clients/DocTool'

	    #'stx:clients/DrawTool'

	    #'stx:clients/GLdemos'

	    #'stx:clients/GuessingGame'

	    #'stx:clients/LogicTool'

	    #'stx:clients/MailTool'

	    #'stx:clients/NewsTool'

	    #'stx:clients/PingPong'

	    #'stx:clients/Tetris'

	    #'stx:clients/TicTacToe'

	    #'stx:clients/TicTacToe3D'

	    #'stx:clients/Tools'

	    #'stx:goodies'

	    #'stx:goodies/benchmarks'

	    #'stx:goodies/benchmarks/deltaBlue'

	    #'stx:goodies/benchmarks/dhrystones'

	    #'stx:goodies/benchmarks/misc'

	    #'stx:goodies/benchmarks/richards'

	    #'stx:goodies/benchmarks/self'

	    #'stx:goodies/communication'

	    #'stx:goodies/dhbNumeric'

	    #'stx:goodies/distributions'

	    #'stx:goodies/glorp'

	    #'stx:goodies/lisp'

	    #'stx:goodies/math/fibonacci'

	    #'stx:goodies/measurement'

	    #'stx:goodies/minneStore'

	    #'stx:goodies/obsolete'

	    #'stx:goodies/persistency'

	    #'stx:goodies/postscript'

	    #'stx:goodies/prolog'

	    #'stx:goodies/rdoit'

	    #'stx:goodies/refactoryBrowser'

	    #'stx:goodies/regex'

	    #'stx:goodies/remoteObjects'

	    #'stx:goodies/screenSavers'

	    #'stx:goodies/sif'

	    #'stx:goodies/smaCC'

	    #'stx:goodies/soap'

	    #'stx:goodies/soap/examples'

	    #'stx:goodies/soap/opera'

	    #'stx:goodies/soap/splash'

	    #'stx:goodies/soap/spray'

	    #'stx:goodies/soap/wsdl'

	    #'stx:goodies/soap/xe'

	    #'stx:goodies/soap/xmlsig'

	    #'stx:goodies/sound'

	    #'stx:goodies/stmath'

	    #'stx:goodies/stxInExternalWindow'

	    #'stx:goodies/sunit'

	    #'stx:goodies/swazoo'

	    #'stx:goodies/tgen'

	    #'stx:goodies/webServer'

	    #'stx:goodies/webServer/pwsSwiki'

	    #'stx:goodies/xml-indelv'

	    #'stx:goodies/xml-vw'

	    #'stx:goodies/xml-yaxo'

	    #'stx:libbasic'

	    #'stx:libbasic2'

	    #'stx:libbasic3'

	    #'stx:libboss'

	    #'stx:libcomp'

	    #'stx:libcompat'

	    #'stx:libhtml'

	    #'stx:libjava'

	    #'stx:libjava/examples'

	    #'stx:libjavascript'

	    #'stx:libodbc'

	    #'stx:libopengl'

	    #'stx:libsnmp'

	    #'stx:libtable'

	    #'stx:libtool'

	    #'stx:libtool2'

	    #'stx:libui'

	    #'stx:libview'

	    #'stx:libview2'

	    #'stx:libwidg'

	    #'stx:libwidg2'

	    #'stx:libwidg3'

    )

! !

!PackageManager class methodsFor:'accessing'!

changes

    imageChanges ifNil:[

	imageChanges := OrderedCollection new.

    ].

    ^ imageChanges

!

smalltalkPackageManager

    "/ to clear the singleton for the moment

     | workingPackage packagesInImage|

    "/    self initialize.

    currentManager

	ifNil:[

	    currentManager := self new.

	    packagesInImage := self basicPackagesInImage.

	    workingPackage := packagesInImage removeKey:(Project noProjectID).

	    currentManager addPackages:(packagesInImage).

	    currentManager defaultPackage:workingPackage.

	].

    ^ currentManager

! !

!PackageManager class methodsFor:'defaults'!

defaultPackages

    ^ DictionaryStack new.

! !

!PackageManager class methodsFor:'factory'!

defaultPackage

    ^ (Packages::Package named:#'__NoProject__')

!

packageClass

    ^ Package

! !

!PackageManager class methodsFor:'temporary'!

basicPackagesInImage

    "builds up dictionary of the packages in the system taking the information of the classes and

    methods so we have a complete picture but without the prerequisite information.

    returns the dictionary"

    | packagesInImage extentions clsPkg |

    packagesInImage := Dictionary new.

    extentions := Dictionary new.

    "collect the classes and mark where the extentions are"

    Smalltalk allClasses do:[:aClass |

	    aClass isNameSpace ifFalse:[

		clsPkg := aClass package.

		((packagesInImage at: clsPkg

				 ifAbsentPut:[clsPkg == #'__NoProject__' ifTrue:[

				    (Package named:clsPkg)

				 ] ifFalse:[(Package named:clsPkg)

				 ].         ])

		    addedClass:aClass).

"/                aClass hasExtensions ifTrue:[

		    aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |

			|mthdPkg|

			mthdPkg := mthd package.

			mthdPkg ~= clsPkg ifTrue:[| methodPackage |

			    "this is found out when you add a class!!"

"/                            (packagesInImage at: clsPkg) removeMethod:mthd. "does not belong to the package"

			    methodPackage :=

				    (packagesInImage at: mthdPkg ifAbsentPut:[

					mthdPkg == #'__NoProject__' ifTrue:[

					    (Package named:mthdPkg)

					 ] ifFalse:[(Package named:mthdPkg)

					 ].

				     ]).

			     methodPackage  addedMethod:mthd

			].

"/                    ].

		]

	    ]

    ].

"/    packagesInImage removeKey:#''.    "remove namespaces"

    packagesInImage do:[:aPackage |

	aPackage initializeInstalled.

    ].

    "the following is needed in a fresh image!!"

    packagesInImage at:#'__NoProject__' ifAbsentPut:[(Package named:#'__NoProject__')].

    ^ packagesInImage

! !

!PackageManager methodsFor:'accessing'!

allClassCategories

    | allClassCategories |

    allClassCategories := SortedCollection new.

    self packagesDo:[:aPackage |

	allClassCategories addAll:aPackage classCategories

    ].

    ^ allClassCategories

!

allPackageCategories

    ^ (self packages collect:[:aPackage | aPackage category]) asSet.

!

changes

    ^ self class changes

!

defaultPackage

    "return the value of the instance variable 'defaultPackage' (automatically generated)"

    ^ defaultPackage

!

defaultPackage:something

    "set the value of the instance variable 'defaultPackage' if the current default package

    is also the working package. Change the working package "

    workingPackage == defaultPackage ifTrue:[

	workingPackage := something.

    ].

    defaultPackage := something.

!

packageNamed:anIdentifier

    ^ self packageNamed:anIdentifier ifAbsent:[nil]

!

packageNamed:anIdentifier ifAbsent:aBlock

    anIdentifier ifNil:[

	^ aBlock value

    ].

    defaultPackage name == anIdentifier ifTrue:[

	^ defaultPackage

    ].

    ^ packages atKey:anIdentifier ifAbsent:aBlock

!

packagesAtCategoryName:aCategoryName

    ^ self packages select:[:aPackage |

	(aPackage isInCategoryNamed:aCategoryName)

    ].

!

packagesNamed:aCollectionOfPackageNames

    ^ (aCollectionOfPackageNames collect:[:aName |

	self packageNamed:aName

    ]).

!

smalltalkChanges

    ^ self class changes

!

workingPackage

    "return the value of the instance variable 'workingPackage' (automatically generated)"

    ^ workingPackage

!

workingPackage:aPackage

    ((aPackage == defaultPackage) or:[self includesPackage:aPackage]) ifFalse:[

	self error:'Trying to make a package that i do not know about the workingPackage!!'

    ].

    workingPackage removeDependent:self.

    workingPackage:= aPackage.

    workingPackage addDependent:self.

! !

!PackageManager methodsFor:'adding & removing'!

addChange:aChange

    ^ self class changes add:aChange.

!

addPackage:aPackage

    "the reciever needs to be dependent on the packages just in case they change"

    aPackage addDependent:self.

    self basicAddPackage:aPackage.

    self changed:#addPackage: with:aPackage

!

addPackages:aPackages

    "the reciever needs to be dependent on the packages just in case they change"

    aPackages do:[:aPackage |

	self basicAddPackage:aPackage.

    ].

    self changed:#addPackages: with:aPackages

!

basicAddPackage:aPackage

    "the reciever needs to be dependent on the packages just in case they change"

    packages push:aPackage.

!

basicRemovePackage:aPackage

    ^ packages removeKey:aPackage name

!

removeChange:aChange

    ^ self class changes remove:aChange.

!

removePackage:aPackage

    "the reciever needs to be dependent on the packages just in case they change"

    aPackage removeDependent:self.

    self basicRemovePackage:aPackage.

    self changed:#removePackage: with:aPackage

!

removePackageNamed:aPackageName

    | aPackage |

    aPackage := (packages removeKey:aPackageName).

    aPackage removeDependent:self.

    self changed:#removePackage: with:aPackage

! !

!PackageManager methodsFor:'api'!

addClass:aClass toPackage:newPackage

    "A manager type of the method which should not be called from Smalltalk changes"

    | oldPackageName oldPackage |

    (self includesPackage:newPackage) ifFalse:[

	self error:'The package manager does not know of the package ', newPackage name.

    ].

    oldPackageName := aClass package.

    oldPackage := self packageNamed:oldPackageName.

    (oldPackageName == newPackage name) ifTrue:["error??"

	newPackage addedClass:aClass.

	^ self

    ].

    self setClass:aClass toPackage:newPackage.

    PackageError handle:[:ex |

	self setClass:aClass toPackage:oldPackage.

	ex raise.

    ] do:[

	newPackage addedClass:aClass.

	oldPackage overrideClassNamed:aClass name byPackageNamed:newPackage name.

    ].

!

addMethod:aMethod toPackage:newPackage

    | oldPackageName oldPackage|

    (self includesPackage:newPackage) ifFalse:[

	self error:'The package manager does not know of the package ', newPackage name.

    ].

"/    self moveClass:aClass toPackage:newPackage.

    oldPackageName := aMethod package.

    oldPackage := self packageNamed:oldPackageName.

    (oldPackageName == newPackage name) ifTrue:[

	newPackage addedMethod:aMethod.

	^ self  "error??"

    ].

    aMethod setPackage:newPackage name.

    newPackage addedMethod:aMethod.

    oldPackage overrideMethod:aMethod byPackageNamed:newPackage name.

!

installPackage:aPackage

    "installs a package that the receiver is aware of into the image if not raise an error

    for the sender to catch so it is able to handle it"

    (self includesPackage:aPackage) ifFalse:[

	self error:'The package manager does not know of the package ', aPackage name,' so it cannot be installed!!'

    ].

    ^ (self getPackageHandlerForPackage:aPackage) installPackageIn:self

!

loadPackageFromFile:aFilename

    "install a starter package which comes from a file. This is the

    a state where the package has not yet entered the image but it

    is a package that the receiver is aware of and has some initial

    information about. Return the installed Package"

    ^ (self getPackageReaderForFile:aFilename) loadPackageIn:self .

!

moveClass:aClass toPackage:newOwnerPackage

    "i have the responsibilty to set aClasses new variable (newOwnerPackage name) and

    all the methods in aClass with the same package name!!

    "

    | oldOwnerPackage|

    oldOwnerPackage := self packageNamed:aClass package.

    oldOwnerPackage ifNil:[

	"error handling - if a package has accidentially been removed

	and i do not know about it. Fake it and put it in the default package"

       oldOwnerPackage := defaultPackage.

       self setClass:aClass toPackage:defaultPackage.

       (defaultPackage includesPackagedClassNamed:aClass name) ifTrue:[

	   defaultPackage removedClassNamed:aClass name.

       ].

       defaultPackage addedClass:aClass.

    ].

    oldOwnerPackage == newOwnerPackage ifTrue:[

	(oldOwnerPackage includesPackagedClassNamed:aClass name) ifFalse:[

	    self setClass:aClass toPackage:newOwnerPackage.

	    oldOwnerPackage addedClass:aClass.