[Pkg] Monticello Public: Monticello.impl-kph.562.mcz
squeaksource-noreply at iam.unibe.ch
squeaksource-noreply at iam.unibe.ch
Sun Aug 3 03:52:41 UTC 2008
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.
- ].!
More information about the Packages
mailing list