--- a/Tools_MethodList.st Wed Nov 07 15:36:23 2012 +0100
+++ b/Tools_MethodList.st Wed Nov 07 17:27:02 2012 +0100
@@ -763,7 +763,9 @@
!
update:something with:aParameter from:changedObject
- |cls mthd|
+ |cls mthd mustFlushInheritanceInfo|
+
+ mustFlushInheritanceInfo := true.
"/ some can be ignored immediately
changedObject == Smalltalk ifTrue:[
@@ -802,6 +804,7 @@
(classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[
^ self "/ I don't care for that class
].
+ mustFlushInheritanceInfo := false.
].
(something == #methodTrap
@@ -820,29 +823,36 @@
self invalidateList.
^ self
].
+ mustFlushInheritanceInfo := false.
+ ].
+ something == #newClass ifTrue:[
+ ^ self.
].
- "/ as the organisation changes, flush my remembered redefinition-cache-info
- classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ (something == #methodInClass
+ or:[ something == #methodInClassRemoved ]) ifTrue:[
+ |sel|
+
+ sel := aParameter second.
+ (methodList contains:[:mthd | mthd selector = sel]) ifFalse:[
+ mustFlushInheritanceInfo := false.
+ ].
+ ].
+
+ mustFlushInheritanceInfo ifTrue:[
+ "/ as the organisation changes, flush my remembered redefinition-cache-info
+self halt.
+ classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ ].
something == #classDefinition ifTrue:[
cls := aParameter.
(classes contains:[:aClass | aClass name == cls name]) ifFalse:[
^ self "/ I dont care for that class
].
-"/ classes := classes collect:[:eachClass | eachClass isMeta ifTrue:[
-"/ (Smalltalk at:eachClass theNonMetaclass name) class
-"/ ] ifFalse:[
-"/ Smalltalk at:eachClass name
-"/ ]
-"/ ].
-"/ self updateList.
self enqueueDelayedUpdate:something with:aParameter from:changedObject.
^ self.
].
- something == #newClass ifTrue:[
- ^ self.
- ].
something == #classRemove ifTrue:[
^ self.
].
@@ -964,7 +974,11 @@
allCategories "allSelectors"
generator doShowClass doShowClassFirst doShowCategory enforceClassAndProtocolInList
theMethod sortByClass anyMethodToWatch mclass
- packageFilterValue nameListEntryForExtensions|
+ packageFilterValue nameListEntryForExtensions
+ suppressInheritanceInfoNow startTime|
+
+ suppressInheritanceInfoNow := (showMethodInheritance value ? true) not.
+ startTime := Timestamp now.
generator := inGeneratorHolder value.
generator isNil ifTrue:[
@@ -1167,14 +1181,19 @@
"/ needClass ifFalse:[
"/ needClass := (selectorBag occurrencesOf:sel) > 1
"/ ].
-
+ (suppressInheritanceInfoNow not
+ and:[ (Timestamp now deltaFrom:startTime) > 3 seconds ]) ifTrue:[
+ suppressInheritanceInfoNow := true.
+ ].
+
s := self
- listEntryForMethod:mthd
- selector:sel
- class:cls
- showClass:needClass
- showCategory:doShowCategory
- classFirst:doShowClassFirst.
+ listEntryForMethod:mthd
+ selector:sel
+ class:cls
+ showClass:needClass
+ showCategory:doShowCategory
+ classFirst:doShowClassFirst
+ suppressInheritanceInfo:suppressInheritanceInfoNow.
newNameList add:s.
].
@@ -1196,11 +1215,11 @@
ifTrue:[ ('???' , ' ' , '???') ]
ifFalse:[ (mclass name , ' ' , theMethod selector) ])
].
- anyMethodToWatch ifTrue:[
- self startWatchProcess.
- ] ifFalse:[
- self stopWatchProcess.
- ].
+"/ anyMethodToWatch ifTrue:[
+"/ self startWatchProcess.
+"/ ] ifFalse:[
+"/ self stopWatchProcess.
+"/ ].
"/ remember these, in case of an incremental (single method only)
"/ update in the future.
@@ -1472,7 +1491,8 @@
class:aMethod mclass
showClass:lastShowClass
showCategory:lastShowCategory
- classFirst:lastShowClassFirst.
+ classFirst:lastShowClassFirst
+ suppressInheritanceInfo:false.
idx := methodList identityIndexOf:aMethod.
idx == 0 ifTrue:[
@@ -1520,6 +1540,22 @@
inheritance indicators,
highlight accessors of variable"
+ ^ self
+ listEntryForMethod:aMethod
+ selector:selector
+ class:cls
+ showClass:showClass showCategory:showCategory
+ classFirst:showClassFirst
+ suppressInheritanceInfo:false
+!
+
+listEntryForMethod:aMethod selector:selector class:cls showClass:showClass showCategory:showCategory classFirst:showClassFirst suppressInheritanceInfo:suppressInheritanceInfo
+ "answer a method list entry
+ gimmics:
+ adding a little image to breakPointed methods,
+ inheritance indicators,
+ highlight accessors of variable"
+
|s icn variablesToHighlight classVarsToHighLight
doHighLight doHighLightRed clr emp cat l redefIcon
metrics complexity complexityString complexityIcon mark|
@@ -1680,8 +1716,12 @@
].
].
- showMethodInheritance value ~~ false ifTrue:[
- redefIcon := self redefinedOrInheritedIconFor:aMethod.
+ (showMethodInheritance value ? true) ifTrue:[
+ suppressInheritanceInfo ifTrue:[
+ redefIcon := self methodEmptyInheritedIcon.
+ ] ifFalse:[
+ redefIcon := self redefinedOrInheritedIconFor:aMethod.
+ ].
].
(icn notNil or:[redefIcon notNil]) ifTrue:[
@@ -1750,9 +1790,9 @@
!MethodList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.71 2012-11-06 01:42:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.72 2012-11-07 16:27:02 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.71 2012-11-06 01:42:31 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.72 2012-11-07 16:27:02 cg Exp $'
! !