--- a/Tools_MethodCategoryList.st	Wed Sep 23 19:25:59 2009 +0200
+++ b/Tools_MethodCategoryList.st	Wed Sep 23 19:27:20 2009 +0200
@@ -18,12 +18,19 @@
 		leafClasses protocolList rawProtocolList selectedProtocolIndices
 		lastGeneratedProtocols packageFilterOnInput
 		methodVisibilityHolder noAllItem noPseudoItems
-		showPseudoProtocols'
+		showPseudoProtocols cachedMethodInfo'
 	classVariableNames:'AdditionalEmptyCategoriesPerClassName'
 	poolDictionaries:''
 	category:'Interface-Browsers-New'
 !
 
+Object subclass:#CachedMethodInfo
+	instanceVariableNames:'isObsolete sendsSuper isUncommented isDocumentationMethod'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:MethodCategoryList
+!
+
 !MethodCategoryList class methodsFor:'documentation'!
 
 copyright
@@ -424,6 +431,7 @@
                 cls := aParameter at:1.
                 (classes includesIdentical:cls) ifTrue:[
                     sel := aParameter at:2.
+                    self flushMethodInfoForClassNamed:cls name selector:sel.
                     oldMethod := aParameter at:3.
                     newMethod := cls compiledMethodAt:sel.
                     oldMethod notNil ifTrue:[
@@ -457,6 +465,7 @@
                 cls := aParameter at:1.
                 (classes includesIdentical:cls) ifTrue:[
                     sel := aParameter at:2.
+                    self flushMethodInfoForClassNamed:cls name selector:sel.
                     "/ method was removed - update the list and output generator
                     self invalidateList.
                     "/ self updateOutputGenerator.
@@ -658,7 +667,9 @@
             "/ a method has been added/removed/changed
             cls := aParameter at:1.
             (classes notNil and:[classes includesIdentical:cls]) ifFalse:[^ self].
+
             sel := aParameter at:2.
+            self flushMethodInfoForClassNamed:cls name selector:sel.
             oldMethod := aParameter at:3.
             newMethod := cls compiledMethodAt:sel.
             oldMethod notNil ifTrue:[
@@ -812,7 +823,7 @@
                             anyInThisClass := false.
 
                             aClass methodDictionary keysAndValuesDo:[:sel :mthd |
-                                |cat mPkg|
+                                |cat mPkg includeIt info|
 
                                 supportsMethodCategories ifTrue:[
                                     cat := mthd category.
@@ -823,15 +834,32 @@
                                         cat := noCat.
                                     ]
                                 ].
-                                (allProtocols 
-                                or:[ (protocols includes:cat)
-                                or:[ (superSendProtocols and:[ mthd superMessages notEmptyOrNil ]) 
-                                or:[ (uncommentedProtocols and:[ mthd comment isEmptyOrNil and:[ mthd isVersionMethod not]])
-                                or:[ (obsoleteProtocols and:[ mthd isObsolete ])
-                                or:[ (documentationProtocols and:[mthd isDocumentationMethod]) ]]]]]) ifTrue:[
-                                    mPkg := mthd package.
-                                    (packages isNil or:[mPkg = noPackage or:[packages includes:mPkg]])
-                                    ifTrue:[
+                                mPkg := mthd package.
+                                (packages isNil or:[mPkg = noPackage or:[packages includes:mPkg]])
+                                ifTrue:[
+                                    "/ used to be a more readable or, but to reuse info, I've splitted it.
+                                    "/ because we should use the parser only once, we reuse the same methodInfo.
+                                    "/ otherwise, the list update becomes too slow for long classes (NewSystemBrowser)
+                                    includeIt := allProtocols.
+                                    includeIt ifFalse:[ includeIt := protocols includes:cat ].
+                                    includeIt ifFalse:[
+                                        superSendProtocols ifTrue:[
+                                            info isNil ifTrue:[ info := self methodInfoFor:mthd ].
+                                            includeIt := info sendsSuper ]]. 
+                                    includeIt ifFalse:[
+                                        uncommentedProtocols ifTrue:[
+                                            info isNil ifTrue:[ info := self methodInfoFor:mthd ].
+                                            includeIt := info isUncommented ]]. 
+                                    includeIt ifFalse:[ 
+                                        obsoleteProtocols ifTrue:[
+                                            info isNil ifTrue:[ info := self methodInfoFor:mthd ].
+                                            includeIt := info isObsolete ]]. 
+                                    includeIt ifFalse:[ 
+                                        documentationProtocols ifTrue:[
+                                            info isNil ifTrue:[ info := self methodInfoFor:mthd ].
+                                            includeIt := info isDocumentationMethod ]].
+
+                                    includeIt ifTrue:[
                                         (methodVisibilityHolder value == #class) ifTrue:[
                                             whatToDo value:aClass value:cat value:sel value:mthd.
                                         ] ifFalse:[
@@ -840,7 +868,6 @@
                                                 whatToDo value:aClass value:cat value:sel value:mthd.
                                             ].
                                         ].
-
                                         anyInThisClass := true.
                                         remainingCategories remove:cat ifAbsent:nil.
                                     ]
@@ -940,6 +967,13 @@
     ^ self classesToProcessForClasses:classes withVisibility:methodVisibilityHolder value.
 !
 
+flushMethodInfoForClassNamed:className selector:selector
+    cachedMethodInfo isNil ifTrue:[ ^ self ].
+
+    ^ cachedMethodInfo 
+        removeKey:(className,'>>',selector)
+!
+
 listOfMethodCategories
     |categoryList plainCategories classesProcessed leafClassesProcessed
      generator nm variablesToHighlight classVarsToHighLight
@@ -1020,19 +1054,14 @@
                                         ].     
                                         self showPseudoProtocols value ifTrue:[
                                             cls selectorsAndMethodsDo:[:sel :mthd |
+                                                |info|
+
                                                 mthd category = cat ifTrue:[
-                                                    mthd isObsolete ifTrue:[ numObsolete := numObsolete + 1 ].
-                                                    mthd superMessages notEmptyOrNil ifTrue:[ numSuper := numSuper + 1 ].
-                                                    mthd comment isEmptyOrNil ifTrue:[
-                                                        "/ version method does not count !!
-                                                        mthd isVersionMethod ifFalse:[
-                                                            numUncommented := numUncommented + 1 
-                                                        ].
-                                                    ] ifFalse:[
-                                                        mthd isDocumentationMethod ifTrue:[
-                                                            numDocumentation := numDocumentation + 1 
-                                                        ].
-                                                    ].
+                                                    info := self methodInfoFor:mthd.
+                                                    info isObsolete ifTrue:[ numObsolete := numObsolete + 1 ].
+                                                    info sendsSuper ifTrue:[ numSuper := numSuper + 1 ].
+                                                    info isUncommented ifTrue:[ numUncommented := numUncommented + 1 ].
+                                                    info isDocumentationMethod ifTrue:[ numDocumentation := numDocumentation + 1 ].
                                                 ]
                                             ].
                                         ].
@@ -1206,6 +1235,23 @@
 "/    ChangeSet removeDependent:self.
 !
 
+methodInfoFor:aMethod
+    cachedMethodInfo isNil ifTrue:[ cachedMethodInfo := Dictionary new ].
+
+    ^ cachedMethodInfo 
+        at:(aMethod mclass name,'>>',aMethod selector)
+        ifAbsentPut:[
+            |info|
+
+            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
+        ]
+!
+
 release
     super release.
 
@@ -1363,8 +1409,42 @@
     Smalltalk changed:#methodCategoryRenamed with:(Array with:aClass with:oldName with:newName).     "/ not really ... to force update
 ! !
 
+!MethodCategoryList::CachedMethodInfo methodsFor:'accessing'!
+
+isDocumentationMethod
+    ^ isDocumentationMethod
+!
+
+isDocumentationMethod:aBoolean
+    isDocumentationMethod := aBoolean.
+!
+
+isObsolete
+    ^ isObsolete
+!
+
+isObsolete:aBoolean
+    isObsolete := aBoolean.
+!
+
+isUncommented
+    ^ isUncommented
+!
+
+isUncommented:aBoolean 
+    isUncommented := aBoolean.
+!
+
+sendsSuper
+    ^ sendsSuper
+!
+
+sendsSuper:aBoolean
+    sendsSuper := aBoolean.
+! !
+
 !MethodCategoryList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.29 2009-09-21 20:46:34 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.30 2009-09-23 17:27:20 cg Exp $'
 ! !