--- 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!