A new version of Monticello.impl was added to project Monticello Public: http://www.squeaksource.com/mc/Monticello.impl-kph.562.mcz
==================== Summary ====================
Name: Monticello.impl-kph.562 Author: kph Time: 3 August 2008, 4:52:05 am UUID: 0eb39f75-165b-498c-bb57-722e72d97100 Ancestors: Monticello.impl-mtf.561
Refactoring -
- PackageInfo now has a properties dictionary for general current status use, amongst other things. - Scripts preambles etc. use this dictionary. - PackageOrganizer now manages the single master package list - MCWorkingCopy register (now retired) - MC stores its package manager for each package as a property #mc in the PackageInfo instances in the master list.
(this may break things, the migration process may need some work as yet)
=============== Diff against Monticello.impl-mtf.561 ===============
Item was changed: ----- Method: MCWorkingCopyBrowser>>editScript: (in category 'morphic ui') ----- editScript: scriptSymbol
| script | + script := workingCopy packageInfo propertyOrDefaultAt: scriptSymbol. - script := workingCopy packageInfo perform: scriptSymbol. script openLabel: scriptSymbol asString, ' of the Package ', workingCopy package name.!
Item was changed: ----- Method: MCWorkingCopy class>>freeSomeSpace (in category 'as yet unclassified') ----- freeSomeSpace
+ " | wc | PackageOrganizer default in: [ :po | po packageNames do: [ :pName | wc := self registry at: (MCPackage named: pName) ifAbsent: nil. wc ifNotNil: [ wc ancestry size = 0 ifTrue: [ po unregisterPackageNamed: pName. wc unregister ] ] ifNil: [ po unregisterPackageNamed: pName ].
]. + ] + "! - ]!
Item was added: + ----- Method: PackageInfo>>manager: (in category '*monticello') ----- + manager: mcPackageManager + + ^ self propertyAt: #mc put: mcPackageManager!
Item was changed: ----- Method: MCWorkingCopy class>>initialize (in category 'as yet unclassified') ----- initialize Smalltalk at: #MczInstaller ifPresent: [:installer | self adoptVersionInfoFrom: installer].
registry ifNotNil:[registry rehash]. "changed #=" self allInstancesDo:[:each| "moved notifications" Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| cls uniqueInstance noMoreNotificationsFor: each. ]. ]. self registerForNotifications. + self registry. + ! - - !
Item was added: + ----- Method: MCPackageManager class>>packageInfos (in category 'as yet unclassified') ----- + packageInfos + ^ self organizer packageInfos!
Item was changed: ----- Method: MCPackage>>snapshot (in category 'as yet unclassified') ----- snapshot + | definitions categories packageInfo | - | packageInfo definitions categories |
packageInfo := self packageInfo. definitions := OrderedCollection new. categories := packageInfo systemCategories. definitions addAll: (self orphanage orphansFor: packageInfo). definitions removeAllFoundIn: self orphanage unlinkedClasses. categories isEmpty ifFalse: [ definitions add: (MCOrganizationDefinition categories: categories) ]. packageInfo methods do: [:ea | definitions add: ea asMethodDefinition] displayingProgress: 'Snapshotting methods... '. (packageInfo respondsTo: #overriddenMethods) ifTrue: [ packageInfo overriddenMethods do: [:ea | definitions add: (packageInfo changeRecordForOverriddenMethod: ea) asMethodDefinition] displayingProgress: 'Searching for overrides...'].
packageInfo classes do: [:ea | definitions addAll: ea classDefinitions] displayingProgress: 'Snapshotting classes...'. + MCScriptDefinition subclassesDo: [ :ea | ea from: packageInfo addTo: definitions ]. - (packageInfo respondsTo: #hasPreamble) ifTrue: [ - packageInfo hasPreamble ifTrue: [definitions add: (MCPreambleDefinition from: packageInfo)]. - packageInfo hasPostscript ifTrue: [definitions add: (MCPostscriptDefinition from: packageInfo)]. - packageInfo hasPreambleOfRemoval ifTrue: [definitions add: (MCRemovalPreambleDefinition from: packageInfo)]. - packageInfo hasPostscriptOfRemoval ifTrue: [definitions add: (MCRemovalPostscriptDefinition from: packageInfo)]].
^ MCSnapshot fromDefinitions: definitions !
Item was changed: ----- Method: MCPackage>>packageInfo (in category 'as yet unclassified') ----- packageInfo + ^ PackageInfo named: name ! - ^ PackageInfo named: name!
Item was changed: ----- Method: MCPackageManager class>>allManagers (in category 'as yet unclassified') ----- allManagers + ^ self packageInfos collect:[ :pi | pi manager ifNil: [ self forPackage: (MCPackage named: pi name) ] ]! - ^ self registry values!
Item was changed: ----- Method: MCPackageManager class>>registry (in category 'as yet unclassified') ----- registry + + "if we have a registry migrate to using PackageOrganizer" + + ^ registry ifNotNil: [ + registry values collect: [ :mgr | mgr package packageInfo manager: mgr ]. + ] + + ! - ^ registry ifNil: [registry := Dictionary new]!
Item was changed: ----- Method: MCPackageManager class>>forPackage: (in category 'as yet unclassified') ----- forPackage: aPackage + + ^ (PackageInfo named: aPackage name) in: [ :pi | + + pi manager ifNil: [ pi manager: (self new initializeWithPackage: aPackage). + self changed: #allManagers. + pi manager ] + + ] ! - ^ self registry at: aPackage ifAbsent: - [|mgr| - mgr := self new initializeWithPackage: aPackage. - self registry at: aPackage put: mgr. - self changed: #allManagers. - mgr]!
Item was added: + ----- Method: MCScriptDefinition class>>from:addTo: (in category 'as yet unclassified') ----- + from: aPackageInfo addTo: definitions + + (aPackageInfo respondsTo: #propertyAt:) ifFalse: [ ^ self ]. + + (aPackageInfo propertyAt: self scriptSelector) + ifNotNilDo: [ :v | definitions add: (self from: v) ]!
Item was added: + ----- Method: PackageInfo>>manager (in category '*monticello') ----- + manager + + ^ self propertyAt: #mc!
Item was added: + ----- Method: MCWorkingCopy class>>r (in category 'as yet unclassified') ----- + r + + ^ registry!
Item was changed: ----- Method: MCPackageManager>>unregister (in category 'operations') ----- unregister + self class organizer unregisterPackageNamed: self package name. - self class registry removeKey: package. self class changed: #allManagers!
Item was changed: ----- Method: MCPackage>>hasWorkingCopy (in category 'as yet unclassified') ----- hasWorkingCopy + MCWorkingCopy organizer packageNamed: self name ifAbsent: [ ^ false ]. + + ^ true! - ^ MCWorkingCopy registry includesKey: self!
Item was added: + ----- Method: MCPackageManager class>>organizer (in category 'as yet unclassified') ----- + organizer + ^ PackageOrganizer default !
Item was changed: ----- Method: MCPackageManager class>>managersForCategory:do: (in category 'system changes') ----- managersForCategory: aSystemCategory do: aBlock "Got to be careful here - we might get method categories where capitalization is problematic." | cat foundOne index | foundOne := false. cat := aSystemCategory ifNil:[^nil]. "yes this happens; for example in eToy projects" "first ask PackageInfos, their package name might not match the category" + self packageInfos do: [:pi | + (pi includesSystemCategory: aSystemCategory) ifTrue: [ + aBlock value: pi manager. - self registry do: [:mgr | - (mgr packageInfo includesSystemCategory: aSystemCategory) ifTrue: [ - aBlock value: mgr. foundOne := true. ] ]. foundOne ifTrue: [^self]. ["Loop over categories until we found a matching one" + + (self organization packageNamed: cat ifAbsent: nil) ifNotNilDo:[:pi | + aBlock value: pi manager. - self registry at: (MCPackage named: cat) ifPresent:[:mgr| - aBlock value: mgr. foundOne := true. ]. + index := cat lastIndexOf: $-. index > 0]whileTrue:[ "Step up to next level package" cat := cat copyFrom: 1 to: index-1. ]. foundOne ifFalse:[ "Create a new (but only top-level)" aBlock value: (MCWorkingCopy forPackage: (MCPackage named: (aSystemCategory copyUpTo: $-) capitalized)). ].!
Item was changed: ----- Method: MCScriptDefinition class>>from: (in category 'as yet unclassified') ----- from: aPackageInfo + ^ self script: (aPackageInfo propertyAt: self scriptSelector) contents asString packageName: aPackageInfo name! - ^ self script: (aPackageInfo perform: self scriptSelector) contents asString packageName: aPackageInfo name!
Item was changed: ----- Method: MCPackageManager class>>managersForClass:do: (in category 'system changes') ----- managersForClass: aClass do: aBlock
+ self packageInfos do: [:pi | + (pi includesClass: aClass) + ifTrue: [aBlock value: pi manager]]! - self registry do: [:mgr | - (mgr packageInfo includesClass: aClass) - ifTrue: [aBlock value: mgr]]!
Item was removed:
Item was removed:
Item was removed: - ----- Method: MCPackageManager class>>initialize (in category 'as yet unclassified') ----- - initialize - "Remove this later" - Smalltalk at: #SystemChangeNotifier ifPresent:[:cls| - (cls uniqueInstance) noMoreNotificationsFor: self. - ].!
packages@lists.squeakfoundation.org