metrics display
authorClaus Gittinger <cg@exept.de>
Wed, 20 Apr 2005 18:26:25 +0200
changeset 6268 df63cb5277cc
parent 6267 ebcb6b917498
child 6269 c9bfca4d93dc
metrics display
Tools_MethodList.st
--- a/Tools_MethodList.st	Wed Apr 20 12:00:37 2005 +0200
+++ b/Tools_MethodList.st	Wed Apr 20 18:26:25 2005 +0200
@@ -20,7 +20,7 @@
 		lastShowClass lastShowCategory lastShowClassFirst
 		showMethodInheritance lastMethodClass lastMethodClassesSubclasses
 		classAndSelectorsRedefinedBySubclassesOfClass showClass
-		showMethodComplexity'
+		showMethodComplexity showMethodTypeIcon'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Interface-Browsers-New'
@@ -167,6 +167,7 @@
         #filterClassVars
         #showMethodInheritance
         #showMethodComplexity
+        #showMethodTypeIcon
         #sortBy
       ).
 ! !
@@ -270,6 +271,24 @@
     ].
 !
 
+showMethodTypeIcon
+    showMethodTypeIcon isNil ifTrue:[
+        showMethodTypeIcon := true asValue.
+        showMethodTypeIcon addDependent:self
+    ].
+    ^  showMethodTypeIcon
+!
+
+showMethodTypeIcon:aValueHolder
+    showMethodTypeIcon notNil ifTrue:[
+        showMethodTypeIcon removeDependent:self
+    ].
+    showMethodTypeIcon := aValueHolder.
+    showMethodTypeIcon notNil ifTrue:[
+        showMethodTypeIcon addDependent:self
+    ].
+!
+
 variableFilter
     variableFilter isNil ifTrue:[
 	variableFilter := nil asValue.
@@ -771,7 +790,7 @@
 
     |clsName s icn variablesToHighlight classVarsToHighLight 
      doHighLight doHighLightRed emp cat l redefIcon metrics complexity
-     lBr complexityString rBr|
+     lBr complexityString rBr complexityIcon|
 
     aMethod isAssociation ifTrue:[
         self halt:'should not happen'.
@@ -803,7 +822,9 @@
     ].
 
     icn isNil ifTrue:[
-        icn := self resourceIconForMethod:aMethod.
+        showMethodTypeIcon value ~~ false ifTrue:[
+            icn := self resourceIconForMethod:aMethod.
+        ].
         icn isNil ifTrue:[
             aMethod isProtected ifTrue:[
                 icn := self protectedMethodIcon
@@ -878,25 +899,17 @@
     and:[ OOM::MethodMetrics notNil ]) ifTrue:[
         metrics := OOM::MethodMetrics forMethod:aMethod.
         complexity := metrics complexity ? 0.
+        complexityIcon := OOM::MethodMetrics iconForComplexity:complexity.
+
         complexityString := complexity printString asText.
         lBr := '{'.
         rBr := '}'.
-        complexity > OOM::MethodMetrics yellowLimit ifTrue:[
-            complexity > OOM::MethodMetrics redLimit ifTrue:[
-                complexityString backgroundColorizeAllWith:Color red.
-                "/ lBr := (lBr asText) colorizeAllWith:Color red.
-                "/ rBr := (rBr asText) colorizeAllWith:Color red.
-            ] ifFalse:[
-                complexityString backgroundColorizeAllWith:Color yellow
-                "/ lBr := (lBr asText) backgroundColorizeAllWith:Color yellow.
-                "/ rBr := (rBr asText) backgroundColorizeAllWith:Color yellow.
-            ].
-        ] ifFalse:[
-            complexityString backgroundColorizeAllWith:Color green.
-            "/ lBr := (lBr asText) colorizeAllWith:Color green.
-            "/ rBr := (rBr asText) colorizeAllWith:Color green.
-        ].
+
+        "/ icon := OOM::MethodMetrics iconForComplexity:complexity.
+        complexityString backgroundColorizeAllWith:(OOM::MethodMetrics colorForComplexity:complexity).
         s := lBr , complexityString , rBr , ' ' , s.
+        icn := icn ? complexityIcon.
+        "/ s := LabelAndIcon icon:complexityIcon string:s.
     ].
 
     showMethodInheritance value ~~ false ifTrue:[
@@ -1398,24 +1411,23 @@
     |s idx|
 
     s := self 
-	    listEntryForMethod:aMethod 
-	    selector:aMethod selector 
-	    class:aMethod mclass 
-	    showClass:lastShowClass 
-	    showCategory:lastShowCategory
-	    classFirst:lastShowClassFirst.
+            listEntryForMethod:aMethod 
+            selector:aMethod selector 
+            class:aMethod mclass 
+            showClass:lastShowClass 
+            showCategory:lastShowCategory
+            classFirst:lastShowClassFirst.
 
     idx := methodList identityIndexOf:aMethod.
     idx == 0 ifTrue:[
-	aMethod isWrapped ifTrue:[
-	    idx := methodList identityIndexOf:aMethod originalMethod.
-	] ifFalse:[
-	]
+        aMethod isWrapped ifTrue:[
+            idx := methodList identityIndexOf:aMethod originalMethod.
+        ]
     ].
     idx == 0 ifTrue:[
-	self invalidateList
+        self invalidateList
     ] ifFalse:[
-	self browserNameList at:idx put:s.
+        self browserNameList at:idx put:s.
     ]
 ! !
 
@@ -1466,5 +1478,5 @@
 !MethodList class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.7 2005-04-20 07:41:40 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.8 2005-04-20 16:26:25 cg Exp $'
 ! !