initial checkin
authorClaus Gittinger <cg@exept.de>
Fri, 10 Mar 2006 10:45:16 +0100
changeset 6660 9510b89eed9d
parent 6659 b5a99443ef97
child 6661 2ed2ba9f5a7c
initial checkin
Tools__MethodCategoryCache.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__MethodCategoryCache.st	Fri Mar 10 10:45:16 2006 +0100
@@ -0,0 +1,98 @@
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+Object subclass:#MethodCategoryCache
+	instanceVariableNames:'cachedMethodCategories lock'
+	classVariableNames:'TheOneAndOnlyCache'
+	poolDictionaries:''
+	category:'Interface-Browsers-New'
+!
+
+
+!MethodCategoryCache class methodsFor:'instance creation'!
+
+new
+    TheOneAndOnlyCache isNil ifTrue:[
+        TheOneAndOnlyCache := self basicNew initialize.
+    ].
+    ^ TheOneAndOnlyCache
+! !
+
+!MethodCategoryCache methodsFor:'accessing'!
+
+allMethodCategories
+    cachedMethodCategories isNil ifTrue:[
+        self updateCachedMethodCategories
+    ].
+    ^ cachedMethodCategories
+!
+
+updateCachedMethodCategories
+    lock critical:[
+        cachedMethodCategories := Set new.
+        Smalltalk allBehaviorsDo:[:eachClass |
+            cachedMethodCategories addAll:eachClass categories 
+        ].
+    ].
+! !
+
+!MethodCategoryCache methodsFor:'change & update'!
+
+update:something with:aParameter from:changedObject
+    |removed|
+
+    changedObject == Smalltalk ifTrue:[
+        something == #methodInClassRemoved ifTrue:[
+            cachedMethodCategories := nil.
+            ^ self.
+        ].
+        (something == #classOrganization) ifTrue:[
+            cachedMethodCategories := nil.
+            ^ self.
+        ].
+        (something == #methodCategoryAdded) ifTrue:[
+            cachedMethodCategories add:(aParameter second).
+            ^ self.
+        ].
+        (something == #methodCategoryRemoved) ifTrue:[
+            cachedMethodCategories := nil.
+            ^ self.
+        ].
+        (something == #methodCategoriesRemoved) ifTrue:[
+            removed := aParameter second asSet.
+            Smalltalk allMethodsDo:[:m |
+                |mCat|
+                mCat := m category.
+                (removed includes:mCat) ifTrue:[
+                    removed remove:mCat.
+                    removed isEmpty ifTrue:[^ self ].
+                ].
+            ].
+            cachedMethodCategories removeAll:removed.
+            ^ self.
+        ].
+        (something == #methodCategoryRenamed) ifTrue:[
+            cachedMethodCategories := nil.
+            ^ self.
+        ].
+        something == #methodInClass ifTrue:[
+            ^ self.
+        ].
+        ^ self.
+    ].
+    super update:something with:aParameter from:changedObject
+! !
+
+!MethodCategoryCache methodsFor:'initialization'!
+
+initialize
+    lock := Semaphore forMutualExclusion.
+    Smalltalk addDependent:self.
+! !
+
+!MethodCategoryCache class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__MethodCategoryCache.st,v 1.1 2006-03-10 09:45:16 cg Exp $'
+! !