Tools_MethodCategoryList.st
changeset 8860 d8ce6a00a43f
parent 8848 1bc3db6d2e50
child 8867 c926be235b4b
--- a/Tools_MethodCategoryList.st	Sat Oct 03 12:42:02 2009 +0200
+++ b/Tools_MethodCategoryList.st	Sat Oct 03 13:00:13 2009 +0200
@@ -18,15 +18,17 @@
 		leafClasses protocolList rawProtocolList selectedProtocolIndices
 		lastGeneratedProtocols packageFilterOnInput
 		methodVisibilityHolder noAllItem noPseudoItems
-		showPseudoProtocols cachedMethodInfo'
-	classVariableNames:'AdditionalEmptyCategoriesPerClassName'
+		showPseudoProtocols'
+	classVariableNames:'AdditionalEmptyCategoriesPerClassName MethodInfoCache
+		MethodInfoCacheAccessLock'
 	poolDictionaries:''
 	category:'Interface-Browsers-New'
 !
 
 Object subclass:#CachedMethodInfo
-	instanceVariableNames:'isObsolete sendsSuper isUncommented isDocumentationMethod'
-	classVariableNames:''
+	instanceVariableNames:'flags'
+	classVariableNames:'FlagObsolete FlagSendsSuper FlagIsUncommented
+		FlagIsDocumentationMethod'
 	poolDictionaries:''
 	privateIn:MethodCategoryList
 !
@@ -47,6 +49,17 @@
 "
 ! !
 
+!MethodCategoryList class methodsFor:'initialization'!
+
+flushMethodInfo
+    MethodInfoCache := Dictionary new.
+!
+
+initialize
+    MethodInfoCache := Dictionary new.
+    MethodInfoCacheAccessLock := RecursionLock new.
+! !
+
 !MethodCategoryList class methodsFor:'interface specs'!
 
 singleProtocolWindowSpec
@@ -968,11 +981,11 @@
 !
 
 flushMethodInfoForClassNamed:className selector:selector
-    cachedMethodInfo isNil ifTrue:[ ^ self ].
-
-    ^ cachedMethodInfo 
-        removeKey:(className,'>>',selector)
-        ifAbsent:[]
+    MethodInfoCacheAccessLock critical:[
+        MethodInfoCache 
+            removeKey:(className,'>>',selector)
+            ifAbsent:[]
+    ]
 !
 
 listOfMethodCategories
@@ -1237,22 +1250,25 @@
 !
 
 methodInfoFor:aMethod
-    cachedMethodInfo isNil ifTrue:[ cachedMethodInfo := Dictionary new ].
+    |info|
 
-    ^ cachedMethodInfo 
-        at:(aMethod mclass name,'>>',aMethod selector)
-        ifAbsentPut:[
-            |info|
+    MethodInfoCacheAccessLock critical:[
+        info := MethodInfoCache 
+            at:(aMethod mclass name,'>>',aMethod selector)
+            ifAbsentPut:[
+                |info|
 
-            true "aMethod mclass language isSmalltalk" ifTrue:[
-                info := CachedMethodInfo new.
-                info isObsolete:(aMethod isObsolete).
-                info sendsSuper:(aMethod superMessages notEmptyOrNil).
-                info isUncommented:(aMethod comment isEmptyOrNil and:[aMethod isVersionMethod not]).
-                info isDocumentationMethod:( aMethod isDocumentationMethod).
-            ].
-            info
-        ]
+                true "aMethod mclass language isSmalltalk" ifTrue:[
+                    info := CachedMethodInfo new.
+                    info isObsolete:(aMethod isObsolete).
+                    info sendsSuper:(aMethod superMessages notEmptyOrNil).
+                    info isUncommented:(aMethod comment isEmptyOrNil and:[aMethod isVersionMethod not]).
+                    info isDocumentationMethod:( aMethod isDocumentationMethod).
+                ].
+                info
+            ]
+    ].
+    ^ info
 !
 
 release
@@ -1412,46 +1428,76 @@
     Smalltalk changed:#methodCategoryRenamed with:(Array with:aClass with:oldName with:newName).     "/ not really ... to force update
 ! !
 
+!MethodCategoryList::CachedMethodInfo class methodsFor:'initialization'!
+
+initialize
+    FlagObsolete := 1.
+    FlagSendsSuper := 2.
+    FlagIsUncommented := 4.
+    FlagIsDocumentationMethod := 8.
+! !
+
+!MethodCategoryList::CachedMethodInfo class methodsFor:'instance creation'!
+
+new
+    ^ self basicNew flags:0.
+! !
+
 !MethodCategoryList::CachedMethodInfo methodsFor:'accessing'!
 
+flags:something
+    flags := something.
+!
+
 isDocumentationMethod
-    ^ isDocumentationMethod
+    ^ (flags ? 0) bitTest: FlagIsDocumentationMethod
 !
 
 isDocumentationMethod:aBoolean
-    isDocumentationMethod := aBoolean.
+    flags := aBoolean
+                ifTrue:[ flags bitOr: FlagIsDocumentationMethod ]
+                ifFalse:[ flags bitClear: FlagIsDocumentationMethod]
 !
 
 isObsolete
-    ^ isObsolete
+    ^ (flags ? 0) bitTest: FlagObsolete
 !
 
 isObsolete:aBoolean
-    isObsolete := aBoolean.
+    flags := aBoolean
+                ifTrue:[ flags bitOr: FlagObsolete ]
+                ifFalse:[ flags bitClear: FlagObsolete]
 !
 
 isUncommented
-    ^ isUncommented
+    ^ (flags ? 0) bitTest: FlagIsUncommented
 !
 
 isUncommented:aBoolean 
-    isUncommented := aBoolean.
+    flags := aBoolean
+                ifTrue:[ flags bitOr: FlagIsUncommented ]
+                ifFalse:[ flags bitClear: FlagIsUncommented]
 !
 
 sendsSuper
-    ^ sendsSuper
+    ^ (flags ? 0) bitTest: FlagSendsSuper
 !
 
 sendsSuper:aBoolean
-    sendsSuper := aBoolean.
+    flags := aBoolean
+                ifTrue:[ flags bitOr: FlagSendsSuper ]
+                ifFalse:[ flags bitClear: FlagSendsSuper]
 ! !
 
 !MethodCategoryList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.32 2009-10-02 09:19:21 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.33 2009-10-03 11:00:13 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.32 2009-10-02 09:19:21 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.33 2009-10-03 11:00:13 cg Exp $'
 ! !
+
+MethodCategoryList initialize!
+MethodCategoryList::CachedMethodInfo initialize!