--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MCPackageManager.st Wed Nov 22 14:15:51 2006 +0100
@@ -0,0 +1,243 @@
+"{ Package: 'stx:goodies/monticello' }"
+
+Object subclass:#MCPackageManager
+ instanceVariableNames:'package modified'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Monticello-Versioning'
+!
+
+MCPackageManager class instanceVariableNames:'registry'
+
+"
+ No other class instance variables are inherited by this class.
+"
+!
+
+
+!MCPackageManager class methodsFor:'as yet unclassified'!
+
+allManagers
+ ^ self registry values
+!
+
+forPackage: aPackage
+ ^ self registry at: aPackage ifAbsent:
+ [|mgr|
+ mgr _ self new initializeWithPackage: aPackage.
+ self registry at: aPackage put: mgr.
+ self changed: #allManagers.
+ mgr]
+!
+
+initialize
+ "Remove this later"
+ Smalltalk at: #SystemChangeNotifier ifPresent:[:cls|
+ (cls uniqueInstance) noMoreNotificationsFor: self.
+ ].
+!
+
+registry
+ ^ registry ifNil: [registry _ Dictionary new]
+! !
+
+!MCPackageManager class methodsFor:'system changes'!
+
+classModified: anEvent
+ self managersForClass: anEvent item do:[:mgr| mgr modified: true].
+!
+
+classMoved: anEvent
+ self classModified: anEvent.
+ self managersForCategory: anEvent oldCategory do:[:mgr| mgr modified: true].
+!
+
+classRemoved: anEvent
+ self classModified: anEvent
+!
+
+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 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 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 upTo: $-) capitalized)).
+ ].
+!
+
+managersForClass: aClass category: methodCategory do: aBlock
+ (methodCategory isEmptyOrNil or:[methodCategory first ~= $*]) ifTrue:[
+ "Not an extension method"
+ ^self managersForClass: aClass do: aBlock.
+ ].
+ self managersForCategory: methodCategory allButFirst do: aBlock.
+!
+
+managersForClass: aClass do: aBlock
+
+ self registry do: [:mgr |
+ (mgr packageInfo includesClass: aClass)
+ ifTrue: [aBlock value: mgr]]
+!
+
+managersForClass: aClass selector: aSelector do: aBlock
+ ^self managersForClass: aClass category: (aClass organization categoryOfElement: aSelector) do: aBlock
+!
+
+methodModified: anEvent
+ ^self managersForClass: anEvent itemClass selector: anEvent itemSelector do:[:mgr| mgr modified: true].
+!
+
+methodMoved: anEvent
+ self managersForClass: anEvent itemClass category: anEvent oldCategory do:[:mgr| mgr modified: true].
+ self methodModified: anEvent.
+!
+
+methodRemoved: anEvent
+ self managersForClass: anEvent itemClass category: anEvent itemProtocol do:[:mgr| mgr modified: true].
+!
+
+registerForNotifications
+ Smalltalk at: #SystemChangeNotifier ifPresent:[:cls|
+ (cls uniqueInstance)
+ noMoreNotificationsFor: self;
+ notify: self ofSystemChangesOfItem: #class change: #Added using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Modified using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Renamed using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Commented using: #classModified:;
+ notify: self ofSystemChangesOfItem: #class change: #Recategorized using: #classMoved:;
+ notify: self ofSystemChangesOfItem: #class change: #Removed using: #classRemoved:;
+ notify: self ofSystemChangesOfItem: #method change: #Added using: #methodModified:;
+ notify: self ofSystemChangesOfItem: #method change: #Modified using: #methodModified:;
+ notify: self ofSystemChangesOfItem: #method change: #Recategorized using: #methodMoved:;
+ notify: self ofSystemChangesOfItem: #method change: #Removed using: #methodRemoved:
+ ].
+! !
+
+!MCPackageManager methodsFor:'accessing'!
+
+modified
+ ^ modified
+!
+
+modified: aBoolean
+ modified = aBoolean ifTrue: [^ self].
+ modified _ aBoolean.
+ self changed: #modified.
+
+ modified ifFalse:
+ [(((Smalltalk classNamed: 'SmalltalkImage') ifNotNilDo: [:si | si current]) ifNil: [Smalltalk])
+ logChange: '"', self packageName, '"'].
+!
+
+package
+ ^ package
+!
+
+packageInfo
+ ^ package packageInfo
+!
+
+packageName
+ ^ package name
+!
+
+packageNameWithStar
+ ^ modified
+ ifTrue: ['* ', self packageName]
+ ifFalse: [self packageName]
+! !
+
+!MCPackageManager methodsFor:'initialize-release'!
+
+initialize
+ modified _ false.
+ self registerForNotifications.
+!
+
+initializeWithPackage: aPackage
+ package _ aPackage.
+ self initialize.
+! !
+
+!MCPackageManager methodsFor:'operations'!
+
+unregister
+ self class registry removeKey: package.
+ self class changed: #allManagers
+! !
+
+!MCPackageManager methodsFor:'system changes'!
+
+classModified: anEvent
+ "obsolete - remove this later"
+!
+
+classMoved: anEvent
+ "obsolete - remove this later"
+!
+
+classRemoved: anEvent
+ "obsolete - remove this later"
+!
+
+methodModified: anEvent
+ "obsolete - remove this later"
+!
+
+methodMoved: anEvent
+ "obsolete - remove this later"
+!
+
+methodRemoved: anEvent
+ "obsolete - remove this later"
+!
+
+registerForNotifications
+ "obsolete - remove this later"
+!
+
+registerForNotificationsFrom: aNotifier
+ "obsolete - remove this later"
+!
+
+systemChange: anEvent
+ "obsolete - remove this later"
+!
+
+update: aSymbol
+ InMidstOfFileinNotification signal ifFalse: [
+ [((aSymbol = #recentMethodSubmissions)
+ and: [self packageInfo
+ includesMethodReference: Utilities recentMethodSubmissions last])
+ ifTrue: [self modified: true]]
+ on: Error do: []]
+! !
+
+!MCPackageManager class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/goodies/monticello/MCPackageManager.st,v 1.1 2006-11-22 13:15:51 cg Exp $'
+! !
+
+MCPackageManager initialize!