--- a/Tools__MethodList.st Fri Nov 30 14:25:59 2012 +0000
+++ b/Tools__MethodList.st Fri Nov 30 17:23:39 2012 +0000
@@ -40,6 +40,12 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+!
+
+documentation
+"
+ I implement the method list in the new system browser
+"
! !
!MethodList class methodsFor:'interface specs'!
@@ -319,8 +325,8 @@
showSyntheticMethods
showSyntheticMethods isNil ifTrue:[
- showSyntheticMethods := false asValue.
- showSyntheticMethods addDependent:self
+ showSyntheticMethods := false asValue.
+ showSyntheticMethods addDependent:self
].
^ showSyntheticMethods
@@ -329,11 +335,11 @@
showSyntheticMethods:aValueHolder
showSyntheticMethods notNil ifTrue:[
- showSyntheticMethods removeDependent:self
+ showSyntheticMethods removeDependent:self
].
showSyntheticMethods := aValueHolder.
showSyntheticMethods notNil ifTrue:[
- showSyntheticMethods addDependent:self
+ showSyntheticMethods addDependent:self
].
"Created: / 13-04-2012 / 16:03:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -367,185 +373,186 @@
selection := selectionHolder value.
changedObject == Smalltalk ifTrue:[
- classes notNil ifTrue:[
- 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 invalidateList.
+ classes notNil ifTrue:[
+ 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 invalidateList.
"/ self updateList.
- ^ self.
- ].
+ ^ self.
+ ].
- something == #methodCategory ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
- (something == #classOrganization
- or:[ something == #methodCategoryAdded
- or:[ something == #methodCategoryRemoved
- or:[ something == #methodCategoriesRemoved
- or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
+ something == #methodCategory ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+ (something == #classOrganization
+ or:[ something == #methodCategoryAdded
+ or:[ something == #methodCategoryRemoved
+ or:[ something == #methodCategoriesRemoved
+ or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
- something == #methodInClass ifTrue:[
- "/ a method has been added/changed
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifTrue:[
- sel := aParameter at:2.
- oldMethod := aParameter at:3.
- newMethod := cls compiledMethodAt:sel.
- (oldMethod notNil and:[newMethod notNil]) ifTrue:[
- "a method was changed & acccepted;
- No need for a rescan of the methodDictionary;
- however, ensure that the refs to the old method are updated
- "
- methods := selection.
- methods size > 0 ifTrue:[
- (methods includesIdentical:oldMethod) ifTrue:[
- needSelectionChange := true.
- ]
- ].
- methodList replaceAllIdentical:oldMethod with:newMethod.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
- ].
- methods size > 0 ifTrue:[
- methods := methods asOrderedCollection.
- methods replaceAllIdentical:oldMethod with:newMethod.
- ].
+ (something == #methodInClass
+ or:[something == #methodCoverageInfo]) ifTrue:[
+ "/ a method has been added/changed
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ oldMethod := aParameter at:3.
+ newMethod := cls compiledMethodAt:sel.
+ (oldMethod notNil and:[newMethod notNil]) ifTrue:[
+ "a method was changed & acccepted;
+ No need for a rescan of the methodDictionary;
+ however, ensure that the refs to the old method are updated
+ "
+ methods := selection.
+ methods size > 0 ifTrue:[
+ (methods includesIdentical:oldMethod) ifTrue:[
+ needSelectionChange := true.
+ ]
+ ].
+ methodList replaceAllIdentical:oldMethod with:newMethod.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+ ].
+ methods size > 0 ifTrue:[
+ methods := methods asOrderedCollection.
+ methods replaceAllIdentical:oldMethod with:newMethod.
+ ].
- needSelectionChange == true ifTrue:[
- selectionHolder setValue:methods.
- "/ self enqueueDelayedMethodsSelectionChanged.
- "/ need this to inform my browser that method was changed
- "/ by someone else.
- selectionHolder changed.
- ].
- "/JV@2011-07-22: Update always - I need to see immediately that
- "/the method has changed. Also, add/remove breakpoint etc.
+ needSelectionChange == true ifTrue:[
+ selectionHolder setValue:methods.
+ "/ self enqueueDelayedMethodsSelectionChanged.
+ "/ need this to inform my browser that method was changed
+ "/ by someone else.
+ selectionHolder changed.
+ ].
+ "/JV@2011-07-22: Update always - I need to see immediately that
+ "/the method has changed. Also, add/remove breakpoint etc.
"/ (variableFilter value size > 0
"/ or:[oldMethod package ~= newMethod package
"/ or:[oldMethod resources ~= newMethod resources
"/ or:[showMethodComplexity value == true]]])
- self autoUpdateOnChange ifTrue:[
- "/ only update that method's entry
- self updateListEntryFor:newMethod.
- "/ sigh - must invalidate
- "/ self invalidateList.
- ].
- ^ self.
- ].
- "/ method was added - update the methodList
- "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
- self invalidateList.
- ].
- ^ self.
- ].
+ self autoUpdateOnChange ifTrue:[
+ "/ only update that method's entry
+ self updateListEntryFor:newMethod.
+ "/ sigh - must invalidate
+ "/ self invalidateList.
+ ].
+ ^ self.
+ ].
+ "/ method was added - update the methodList
+ "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+ self invalidateList.
+ ].
+ ^ self.
+ ].
- something == #methodInClassRemoved ifTrue:[
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifTrue:[
- sel := aParameter at:2.
- "/ method was removed - update the methodList
- "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
- self invalidateList.
- ].
- ^ self.
- ].
+ something == #methodInClassRemoved ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifTrue:[
+ sel := aParameter at:2.
+ "/ method was removed - update the methodList
+ "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+ self invalidateList.
+ ].
+ ^ self.
+ ].
- something == #methodCoverageInfo ifTrue:[
- "/ already checked if it is one of my classes
- self updateListEntryFor:aParameter.
+ something == #methodCoverageInfo ifTrue:[
+ "/ already checked if it is one of my classes
+ self updateListEntryFor:aParameter.
"/ self enqueueDelayedUpdateList.
"/ listValid == true ifTrue:[
"/ self invalidateList.
"/ ].
- ^ self.
- ].
+ ^ self.
+ ].
- (something == #methodTrap
- or:[ something == #lastTestRunResult
- or:[ something == #privacyOfMethod ]]) ifTrue:[
- cls := aParameter at:1.
- sel := aParameter at:2.
- (classes includesIdentical:cls) ifFalse:[ ^ self].
+ (something == #methodTrap
+ or:[ something == #lastTestRunResult
+ or:[ something == #privacyOfMethod ]]) ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ (classes includesIdentical:cls) ifFalse:[ ^ self].
- newMethod := cls compiledMethodAt:sel.
- newMethod isNil ifTrue:[
- self invalidateList.
- ^ self
- ].
+ newMethod := cls compiledMethodAt:sel.
+ newMethod isNil ifTrue:[
+ self invalidateList.
+ ^ self
+ ].
- ((something == #privacyOfMethod) or:[something == #lastTestRunResult]) ifTrue:[
- self updateListEntryFor:newMethod.
- ].
+ ((something == #privacyOfMethod) or:[something == #lastTestRunResult]) ifTrue:[
+ self updateListEntryFor:newMethod.
+ ].
- (something == #methodTrap) ifTrue:[
- newMethod isWrapped ifTrue:[
- oldMethod := newMethod originalMethod
- ] ifFalse:[
- selection size > 0 ifTrue:[
- oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
- ]
- ].
+ (something == #methodTrap) ifTrue:[
+ newMethod isWrapped ifTrue:[
+ oldMethod := newMethod originalMethod
+ ] ifFalse:[
+ selection size > 0 ifTrue:[
+ oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
+ ]
+ ].
- selection size > 0 ifTrue:[
- (selection includesIdentical:oldMethod) ifTrue:[
- needSelectionChange := true.
- ]
- ].
- methodList replaceAllIdentical:oldMethod with:newMethod.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
- ].
- selection size > 0 ifTrue:[
- selection := selection asOrderedCollection.
- selection replaceAllIdentical:oldMethod with:newMethod.
- ].
- needSelectionChange == true ifTrue:[
- selectionHolder changed.
- ].
+ selection size > 0 ifTrue:[
+ (selection includesIdentical:oldMethod) ifTrue:[
+ needSelectionChange := true.
+ ]
+ ].
+ methodList replaceAllIdentical:oldMethod with:newMethod.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+ ].
+ selection size > 0 ifTrue:[
+ selection := selection asOrderedCollection.
+ selection replaceAllIdentical:oldMethod with:newMethod.
+ ].
+ needSelectionChange == true ifTrue:[
+ selectionHolder changed.
+ ].
- "/ actually, could just change that single item ...
- "/ ... might be cheaper, if list is huge.
- "/ only update that methods entry
- self updateListEntryFor:newMethod.
- "/ self invalidateList.
- ].
- ^ self
- ].
+ "/ actually, could just change that single item ...
+ "/ ... might be cheaper, if list is huge.
+ "/ only update that methods entry
+ self updateListEntryFor:newMethod.
+ "/ self invalidateList.
+ ].
+ ^ self
+ ].
- (something == #projectOrganization
- or:[something == #lastTestRunResult]) ifTrue:[
- aParameter notNil ifTrue:[
- cls := aParameter at:1.
- cls notNil ifTrue:[
- ((classes includesIdentical:cls theNonMetaclass)
- or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
- self invalidateList.
- ].
- ].
- ] ifFalse:[
- self invalidateList.
- ].
- ^ self
- ].
+ (something == #projectOrganization
+ or:[something == #lastTestRunResult]) ifTrue:[
+ aParameter notNil ifTrue:[
+ cls := aParameter at:1.
+ cls notNil ifTrue:[
+ ((classes includesIdentical:cls theNonMetaclass)
+ or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
+ self invalidateList.
+ ].
+ ].
+ ] ifFalse:[
+ self invalidateList.
+ ].
+ ^ self
+ ].
- "/ everything else is ignored
- "/ self halt.
- ].
- ^ self
+ "/ everything else is ignored
+ "/ self halt.
+ ].
+ ^ self
].
"/ something == #organization ifTrue:[
@@ -616,50 +623,49 @@
"/ ].
changedObject == sortBy ifTrue:[
- listValid ~~ true ifTrue:[ "/ could be nil
- inGeneratorHolder value isNil ifTrue:[
- "/ ok, no need to react on that one
- "/ (will invalidate anyway, once I have more info at hand)
- ^ self
- ].
- ].
- self invalidateList.
- ^ self
+ listValid ~~ true ifTrue:[ "/ could be nil
+ inGeneratorHolder value isNil ifTrue:[
+ "/ ok, no need to react on that one
+ "/ (will invalidate anyway, once I have more info at hand)
+ ^ self
+ ].
+ ].
+ self invalidateList.
+ ^ self
].
(changedObject == variableFilter
or:[changedObject == filterClassVars
or:[changedObject == showMethodInheritance
- or:[changedObject == showMethodComplexity
- or:[changedObject == showSyntheticMethods]]]]) ifTrue:[
- self invalidateList.
- ^ self
+ or:[changedObject == showMethodComplexity]]]) ifTrue:[
+ self invalidateList.
+ ^ self
].
changedObject == selectedMethodNameIndices ifTrue:[
- newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
- newSelection ~= selection ifTrue:[
- selectionHolder value:newSelection.
- lastSelectedMethods := newSelection.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods := lastSelectedMethods asOrderedCollection
- ].
- ] ifFalse:[
- "/ a reselect - force update
+ newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
+ newSelection ~= selection ifTrue:[
+ selectionHolder value:newSelection.
+ lastSelectedMethods := newSelection.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ ] ifFalse:[
+ "/ a reselect - force update
"/ selection size == 1 ifTrue:[
- selectionHolder setValue:newSelection.
- selectionHolder changed:#value.
+ selectionHolder setValue:newSelection.
+ selectionHolder changed:#value.
"/ ].
- ].
- ^ self
+ ].
+ ^ self
].
changedObject == selectionHolder ifTrue:[
- self selectedMethodsChanged.
- lastSelectedMethods := selectionHolder value.
- lastSelectedMethods notNil ifTrue:[
- lastSelectedMethods := lastSelectedMethods asOrderedCollection
- ].
- ^ self
+ self selectedMethodsChanged.
+ lastSelectedMethods := selectionHolder value.
+ lastSelectedMethods notNil ifTrue:[
+ lastSelectedMethods := lastSelectedMethods asOrderedCollection
+ ].
+ ^ self
].
"/ something == #methodTrap ifTrue:[
"/self halt:'no longer'.
@@ -702,7 +708,7 @@
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 05-02-2000 / 13:42:14 / cg"
- "Modified: / 13-04-2012 / 16:04:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-07-2011 / 18:12:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-06-2012 / 23:47:15 / cg"
!
@@ -781,132 +787,135 @@
!
update:something with:aParameter from:changedObject
- |cls mthd ts|
+ |cls mthd mustFlushInheritanceInfo|
+
+ mustFlushInheritanceInfo := true.
"/ some can be ignored immediately
changedObject == Smalltalk ifTrue:[
-"/ JV@2012-10-03: Rubbish
-"/
-"/ "JV2012-02-17: Suppress updates if they're comming too fast
-"/ (such as when booting Java or so)"
-"/ ts := OperatingSystem getMillisecondTime.
-"/ (ts - (lastUpdateFromSmalltalkTimestamp ? 0)) < 200"half a second, maybe too high" ifTrue:[
-"/ lastUpdateFromSmalltalkTimestamp := ts.
-"/ numUpdatesFromSmalltalkInLast200Msecs := numUpdatesFromSmalltalkInLast200Msecs + 1.
-"/ numUpdatesFromSmalltalkInLast200Msecs > 15 ifTrue:[ ^ self ].
-"/ ].
-"/ numUpdatesFromSmalltalkInLast200Msecs := 0.
-"/ lastUpdateFromSmalltalkTimestamp := ts.
-
- classes isNil ifTrue:[
- ^ self.
- ].
- something isNil ifTrue:[
- "/ self halt "/ huh - Smalltalk changed - so what ?
- ^ self.
- ].
+ classes isNil ifTrue:[
+ ^ self.
+ ].
+ something isNil ifTrue:[
+ "/ self halt "/ huh - Smalltalk changed - so what ?
+ ^ self.
+ ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #classVariables ifTrue:[
+ ^ self.
+ ].
+ something == #organization ifTrue:[
+ ^ self.
+ ].
+ something == #methodCategory ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+ (something == #classOrganization
+ or:[ something == #methodCategoryAdded
+ or:[ something == #methodCategoryRemoved
+ or:[ something == #methodCategoriesRemoved
+ or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
- something == #classComment ifTrue:[
- ^ self.
- ].
- something == #classVariables ifTrue:[
- ^ self.
- ].
- something == #organization ifTrue:[
- ^ self.
- ].
- something == #methodCategory ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
- (something == #classOrganization
- or:[ something == #methodCategoryAdded
- or:[ something == #methodCategoryRemoved
- or:[ something == #methodCategoriesRemoved
- or:[ something == #methodCategoryRenamed ]]]]) ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
+ something == #methodCoverageInfo ifTrue:[
+ self showCoverageInformation value ifFalse:[^ self].
+ mthd := aParameter.
+ (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[
+ ^ self "/ I don't care for that class
+ ].
+ mustFlushInheritanceInfo := false.
+ ].
- something == #methodCoverageInfo ifTrue:[
- self showCoverageInformation value ifFalse:[^ self].
- mthd := aParameter.
- (classes notNil and:[classes includesIdentical:mthd mclass]) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- ].
+ (something == #methodTrap
+ or:[ something == #methodPrivacy
+ or:[ something == #lastTestRunResult] ]) ifTrue:[
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self window shown ifFalse:[
+ "JV@2011-11-17: Do not break the dependency here,
+ because then the window won't get updates once
+ deiconified -> leads to confusing behavior (browser
+ shows obsolete info)"
+ "/changedObject removeDependent:self. "/ ?????
+ self invalidateList.
+ ^ self
+ ].
+ mustFlushInheritanceInfo := false.
+ ].
+ something == #newClass ifTrue:[
+ ^ self.
+ ].
- (something == #methodTrap
- or:[ something == #methodPrivacy
- or:[ something == #lastTestRunResult] ]) ifTrue:[
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- self window shown ifFalse:[
- "JV@2011-11-17: Do not break the dependency here,
- because then the window won't get updates once
- deiconified -> leads to confusing behavior (browser
- shows obsolete info)"
- "/changedObject removeDependent:self. "/ ?????
- self invalidateList.
- ^ self
- ].
- ].
+ (something == #methodInClass
+ or:[ something == #methodInClassRemoved ]) ifTrue:[
+ |sel|
- "/ as the organisation changes, flush my remembered redefinition-cache-info
- classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ sel := aParameter second.
+ (methodList contains:[:mthd | mthd selector = sel]) ifFalse:[
+ mustFlushInheritanceInfo := false.
+ ].
+ ].
+
+ mustFlushInheritanceInfo ifTrue:[
+ "/ as the organisation changes, flush my remembered redefinition-cache-info
+ 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.
- ].
- something == #classRename ifTrue:[
- ^ self.
- ].
+ something == #classDefinition ifTrue:[
+ cls := aParameter.
+ (classes contains:[:aClass | aClass name == cls name]) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+ ^ self.
+ ].
+ something == #classRemove ifTrue:[
+ ^ self.
+ ].
+ something == #classRename ifTrue:[
+ ^ self.
+ ].
].
"/ these must lead to immediate update of the selectedMethods collection
"/ (otherwise, that collection might be updated too late, leading to
"/ an obsolete methods code being shown by the codeView.
- something == #methodInClass ifTrue:[
- "/ as the organisation changes, flush my remembered redefinition-cache-info
- classAndSelectorsRedefinedBySubclassesOfClass := nil.
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- self enqueueDelayedUpdate:something with:aParameter from:changedObject.
- ^ self
+ (something == #methodInClass
+ or:[ something == #methodCoverageInfo ]) ifTrue:[
+ "/ as the organisation changes, flush my remembered redefinition-cache-info
+ classAndSelectorsRedefinedBySubclassesOfClass := nil.
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+ ^ self
+ ].
+
+ something == #coverageInfo ifTrue:[
+ listValid == true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ ^ self.
].
something == #methodInClassRemoved ifTrue:[
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifFalse:[
- ^ self "/ I dont care for that class
- ].
+ cls := aParameter at:1.
+ (classes includesIdentical:cls) ifFalse:[
+ ^ self "/ I dont care for that class
+ ].
].
super update:something with:aParameter from:changedObject
- "Modified: / 18-02-2012 / 21:58:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 17-11-2011 / 19:22:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-06-2012 / 23:41:50 / cg"
! !
@@ -985,21 +994,25 @@
!
listOfMethodNames
- |methods entries selectorBag newNameList allClasses newClasses
+ |methods entries selectorBag newNameList allClasses newClasses
allCategories "allSelectors"
- generator doShowClass doShowClassFirst doShowCategory enforceClassAndProtocolInList
+ generator doShowClass doShowClassFirst doShowCategory enforceClassAndProtocolInList
theMethod sortByClass anyMethodToWatch mclass
- packageFilterValue|
+ packageFilterValue nameListEntryForExtensions
+ suppressInheritanceInfoNow startTime|
+
+ suppressInheritanceInfoNow := (showMethodInheritance value ? true) not.
+ startTime := Timestamp now.
generator := inGeneratorHolder value.
generator isNil ifTrue:[
- ^ #()
+ ^ #()
].
allClasses := IdentitySet new.
allCategories := IdentitySet new.
-
+
"/ allSelectors := Set new.
-
+
newClasses := IdentitySet new.
selectorBag := Bag new.
entries := OrderedCollection new.
@@ -1010,240 +1023,238 @@
"/ generator generates nil-selector entries
"/ to pass multiple-class and multiple-protocol info
+ nameListEntryForExtensions := self class nameListEntryForExtensions.
generator do:[:cls :cat :sel :mthd |
- |categoryIsExtensionsPseudoCategory|
+ |categoryIsExtensionsPseudoCategory|
- categoryIsExtensionsPseudoCategory := (cat = self class nameListEntryForExtensions).
+ categoryIsExtensionsPseudoCategory := (cat = nameListEntryForExtensions).
- (cls isNil and:[ cat isNil and:[ sel isNil ] ]) ifTrue:[
- enforceClassAndProtocolInList := true
- ] ifFalse:[
- cls notNil ifTrue:[
- allClasses add:cls.
- ].
- cat notNil ifTrue:[
- allCategories add:cat.
- ].
- "/ JV: Filter method through package filter
- "/ but not, if it is an extension method and we are showing extensions
- (mthd notNil
- and:[ (mthd isSynthetic not or:[
- self showSyntheticMethods value
- ])
- and:[ sel notNil ]]
- ) ifTrue:[
- (packageFilterValue isNil
- or:[ (packageFilterValue includes:mthd package)
- or:[ categoryIsExtensionsPseudoCategory and:[ mthd isExtension ] ]]
- ) ifTrue:[
- entries add:(Array with:cls with:sel with:mthd).
- selectorBag add:sel.
- newClasses add:cls.
-
- "/ allSelectors add:sel.
- ]
- ]
- ].
- (mthd notNil and:[ mthd isWrapped ]) ifTrue:[
- (mthd isTiming or:[ mthd isCounting or:[ mthd isCountingMemoryUsage ] ]) ifTrue:[
- anyMethodToWatch := true
- ]
- ].
+ (cls isNil and:[ cat isNil and:[ sel isNil ] ]) ifTrue:[
+ enforceClassAndProtocolInList := true
+ ] ifFalse:[
+ cls notNil ifTrue:[
+ allClasses add:cls.
+ ].
+"/ cat notNil ifTrue:[
+"/ allCategories add:cat.
+"/ ].
+ "/ JV: Filter method through package filter
+ "/ but not, if it is an extension method and we are showing extensions
+ (mthd notNil
+ and:[ mthd isSynthetic not
+ and:[ sel notNil ]]
+ ) ifTrue:[
+ (packageFilterValue isNil
+ or:[ (packageFilterValue includes:mthd package)
+ or:[ categoryIsExtensionsPseudoCategory and:[ mthd isExtension] ]]
+ ) ifTrue:[
+ entries add:(Array with:cls with:sel with:mthd).
+ selectorBag add:sel.
+ newClasses add:cls.
+
+ allCategories add:mthd category.
+ "/ allSelectors add:sel.
+ ]
+ ]
+ ].
+ (mthd notNil and:[ mthd isWrapped ]) ifTrue:[
+ (mthd isTiming or:[ mthd isCounting or:[ mthd isCountingMemoryUsage ] ]) ifTrue:[
+ anyMethodToWatch := true
+ ]
+ ].
].
showMethodInheritance value ~~ false ifTrue:[
- "/ collect redefinition information once (big speedup for #methodIsRedefinedbelow)
- classAndSelectorsRedefinedBySubclassesOfClass isNil ifTrue:[
- classAndSelectorsRedefinedBySubclassesOfClass := IdentityDictionary new.
- ].
- allClasses do:[:cls |
- |d|
+ "/ collect redefinition information once (big speedup for #methodIsRedefinedbelow)
+ classAndSelectorsRedefinedBySubclassesOfClass isNil ifTrue:[
+ classAndSelectorsRedefinedBySubclassesOfClass := IdentityDictionary new.
+ ].
+ allClasses do:[:cls |
+ |d|
- d := classAndSelectorsRedefinedBySubclassesOfClass.
- (d notNil and:[ (d includesKey:cls) not ]) ifTrue:[
- cls isLoaded ifTrue:[
- d at:cls put:(self setOfAllSelectorsImplementedBelow:cls)
- ]
- ]
- ].
+ d := classAndSelectorsRedefinedBySubclassesOfClass.
+ (d notNil and:[ (d includesKey:cls) not ]) ifTrue:[
+ cls isLoaded ifTrue:[
+ d at:cls put:(self setOfAllSelectorsImplementedBelow:cls)
+ ]
+ ]
+ ].
].
+
+ "/ multiple classes must: add the className for some
+
+ doShowClass := enforceClassAndProtocolInList or:[ allClasses size > 1 ].
+
+ "/ multiple categories: must add the categorie for some
+
+ doShowCategory := enforceClassAndProtocolInList or:[ allCategories size > 1 ].
- "/ multiple classes must: add the className for some
-
- doShowClass := enforceClassAndProtocolInList or:[ allClasses size > 1 ].
-
- "/ multiple categories: must add the categorie for some
-
- doShowCategory := enforceClassAndProtocolInList
- or:[ allCategories size > 1 ].
doShowClassFirst := doShowClass.
doShowClassFirst := doShowClass and:[ sortBy value == #class ].
sortBy value == false ifTrue:[
- "/ do not sort
+ "/ do not sort
] ifFalse:[
- (doShowClass not and:[ sortBy value == #class ]) ifTrue:[
- "/ multiple classes must add the className for some
- "/ check, if doShowClass must be enforced
- entries do:[:entry |
- |cls sel mthd s needClass|
+ (doShowClass not and:[ sortBy value == #class ]) ifTrue:[
+ "/ multiple classes must add the className for some
+ "/ check, if doShowClass must be enforced
+ entries do:[:entry |
+ |cls sel mthd s needClass|
- cls := entry at:1.
- sel := entry at:2.
- mthd := entry at:3.
- doShowClass ifFalse:[
- doShowClass := (selectorBag occurrencesOf:sel) > 1
- ].
- ].
- ].
- sortByClass := doShowClass and:[ sortBy value == #class ].
- sortByClass ifTrue:[
- entries
- sort:[:a :b |
- |nmA nmB clsNmA clsNmB nsNmA nsNmB|
+ cls := entry at:1.
+ sel := entry at:2.
+ mthd := entry at:3.
+ doShowClass ifFalse:[
+ doShowClass := (selectorBag occurrencesOf:sel) > 1
+ ].
+ ].
+ ].
+ sortByClass := doShowClass and:[ sortBy value == #class ].
+ sortByClass ifTrue:[
+ entries
+ sort:[:a :b |
+ |nmA nmB clsNmA clsNmB nsNmA nsNmB|
- clsNmA := (a at:1) name.
- clsNmB := (b at:1) name.
- clsNmA = clsNmB ifTrue:[
- nmA := (a at:2) asSymbol selector.
- nmB := (b at:2) asSymbol selector.
- nmA = nmB ifTrue:[
- nsNmA := (a at:3) nameSpaceName.
- nsNmB := (b at:3) nameSpaceName.
- nsNmA < nsNmB
- ] ifFalse:[ nmA < nmB ]
- ] ifFalse:[
- clsNmA < clsNmB
- ]
- ].
- ] ifFalse:[
- sortBy value == #category ifTrue:[
- entries
- sort:[:a :b |
- |nmA nmB catA catB clsNmA clsNmB nsNmA nsNmB|
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[ nmA < nmB ]
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ].
+ ] ifFalse:[
+ sortBy value == #category ifTrue:[
+ entries
+ sort:[:a :b |
+ |nmA nmB catA catB clsNmA clsNmB nsNmA nsNmB|
- catA := (a at:3) category.
- catB := (b at:3) category.
- catA = catB ifTrue:[
- nmA := (a at:2) asSymbol selector.
- nmB := (b at:2) asSymbol selector.
- nmA = nmB ifTrue:[
- clsNmA := (a at:1) name.
- clsNmB := (b at:1) name.
- clsNmA = clsNmB ifTrue:[
- nsNmA := (a at:3) nameSpaceName.
- nsNmB := (b at:3) nameSpaceName.
- nsNmA < nsNmB
- ] ifFalse:[
- clsNmA < clsNmB
- ]
- ] ifFalse:[ nmA < nmB ]
- ] ifFalse:[
- catA < catB
- ]
- ].
- ] ifFalse:[
- entries
- sort:[:a :b |
- |nmA nmB clsNmA clsNmB nsNmA nsNmB|
+ catA := (a at:3) category.
+ catB := (b at:3) category.
+ catA = catB ifTrue:[
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ] ifFalse:[ nmA < nmB ]
+ ] ifFalse:[
+ catA < catB
+ ]
+ ].
+ ] ifFalse:[
+ entries
+ sort:[:a :b |
+ |nmA nmB clsNmA clsNmB nsNmA nsNmB|
- nmA := (a at:2) asSymbol selector.
- nmB := (b at:2) asSymbol selector.
- nmA = nmB ifTrue:[
- clsNmA := (a at:1) name.
- clsNmB := (b at:1) name.
- clsNmA = clsNmB ifTrue:[
- nsNmA := (a at:3) nameSpaceName.
- nsNmB := (b at:3) nameSpaceName.
- nsNmA < nsNmB
- ] ifFalse:[
- clsNmA < clsNmB
- ]
- ] ifFalse:[ nmA < nmB ]
- ].
- ].
- ].
+ nmA := (a at:2) asSymbol selector.
+ nmB := (b at:2) asSymbol selector.
+ nmA = nmB ifTrue:[
+ clsNmA := (a at:1) name.
+ clsNmB := (b at:1) name.
+ clsNmA = clsNmB ifTrue:[
+ nsNmA := (a at:3) nameSpaceName.
+ nsNmB := (b at:3) nameSpaceName.
+ nsNmA < nsNmB
+ ] ifFalse:[
+ clsNmA < clsNmB
+ ]
+ ] ifFalse:[ nmA < nmB ]
+ ].
+ ].
+ ].
].
methods := OrderedCollection new:(entries size).
-
+
"/ first generate the new methodList, and see if it is different ...
+
+ entries do:[:entry |
+ |sel mthd|
- entries do:[:entry |
- |sel mthd|
-
- mthd := entry at:3.
- methods add:mthd.
+ mthd := entry at:3.
+ methods add:mthd.
].
false "methodList = methods" "does not care for changed icons" ifTrue:[
- "/ same list
- newNameList := self browserNameList.
+ "/ same list
+ newNameList := self browserNameList.
] ifFalse:[
- newNameList := OrderedCollection new:(entries size).
-
- "/ multiple classes must add the className for some
+ newNameList := OrderedCollection new:(entries size).
+
+ "/ multiple classes must add the className for some
+
+ entries do:[:entry |
+ |cls sel mthd s needClass|
- entries do:[:entry |
- |cls sel mthd s needClass|
-
- cls := entry at:1.
- sel := entry at:2.
- mthd := entry at:3.
- needClass := doShowClass.
-
+ cls := entry at:1.
+ sel := entry at:2.
+ mthd := entry at:3.
+ needClass := doShowClass.
+
"/ needClass ifFalse:[
"/ needClass := (selectorBag occurrencesOf:sel) > 1
"/ ].
-
- s := self
- listEntryForMethod:mthd
- selector:sel
- class:cls
- showClass:needClass
- showCategory:doShowCategory
- classFirst:doShowClassFirst.
+ (suppressInheritanceInfoNow not
+ and:[ (Timestamp now deltaFrom:startTime) > 3 seconds ]) ifTrue:[
+ suppressInheritanceInfoNow := true.
+ ].
-"/ s := mthd printStringForBrowserWithSelector:sel inClass:cls.
-"/ needClass ifTrue:[
-"/ s := s , ' [' , cls name , ']'.
-"/ ].
-"/ doShowCategory ifTrue:[
-"/ s := s , ' {' , mthd category "asText allItalic" , '}'
-"/ ].
-
- newNameList add:s.
- ].
+ s := self
+ listEntryForMethod:mthd
+ selector:sel
+ class:cls
+ showClass:needClass
+ showCategory:doShowCategory
+ classFirst:doShowClassFirst
+ suppressInheritanceInfo:suppressInheritanceInfoNow.
+
+ newNameList add:s.
+ ].
].
self makeIndependent.
classes := newClasses.
self makeDependent.
methodList := methods.
methods size == 1 ifTrue:[
- theMethod := methods first.
- mclass := theMethod mclass.
- mclass isNil ifTrue:[
- theMethod isWrapped ifTrue:[
- theMethod := theMethod originalMethod.
- mclass := theMethod mclass.
- ].
- ].
- self methodLabelHolder value:(mclass isNil
- ifTrue:[ ('???' , ' ' , '???') ]
- ifFalse:[ (mclass name , ' ' , theMethod selector) ])
+ theMethod := methods first.
+ mclass := theMethod mclass.
+ mclass isNil ifTrue:[
+ theMethod isWrapped ifTrue:[
+ theMethod := theMethod originalMethod.
+ mclass := theMethod mclass.
+ ].
+ ].
+ self methodLabelHolder value:(mclass isNil
+ 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.
-
+
lastShowClass := doShowClass.
lastShowClassFirst := doShowClassFirst.
lastShowCategory := doShowCategory.
^ newNameList.
"Created: / 05-02-2000 / 22:43:40 / cg"
+ "Modified: / 20-07-2010 / 11:21:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-08-2010 / 20:34:09 / Jan Vrany <enter your email here>"
"Modified: / 20-07-2012 / 20:00:58 / cg"
!
@@ -1498,31 +1509,32 @@
|s idx|
- s := self
- listEntryForMethod:aMethod
- selector:aMethod selector
- class:aMethod mclass
- showClass:lastShowClass
- showCategory:lastShowCategory
- classFirst:lastShowClassFirst.
+ s := self
+ listEntryForMethod:aMethod
+ selector:aMethod selector
+ class:aMethod mclass
+ showClass:lastShowClass
+ showCategory:lastShowCategory
+ classFirst:lastShowClassFirst
+ suppressInheritanceInfo:false.
idx := methodList identityIndexOf:aMethod.
idx == 0 ifTrue:[
- aMethod isWrapped ifTrue:[
- idx := methodList identityIndexOf:aMethod originalMethod.
- idx == 0 ifTrue:[
- "/ aMethod (wrapped) has changed its status, but is not in the list.
- ^ self.
- ].
- ]
+ aMethod isWrapped ifTrue:[
+ idx := methodList identityIndexOf:aMethod originalMethod.
+ idx == 0 ifTrue:[
+ "/ aMethod (wrapped) has changed its status, but is not in the list.
+ ^ self.
+ ].
+ ]
].
idx == 0 ifTrue:[
- "/ method was not previously shown; try to avoid a full update
- (self isMethodToBeShown:aMethod) ifTrue:[
- self invalidateList
- ].
+ "/ method was not previously shown; try to avoid a full update
+ (self isMethodToBeShown:aMethod) ifTrue:[
+ self invalidateList
+ ].
] ifFalse:[
- self browserNameList at:idx put:s.
+ self browserNameList at:idx put:s.
]
"Modified: / 17-08-2011 / 15:05:02 / cg"
@@ -1546,33 +1558,42 @@
!
listEntryForMethod:aMethod selector:selector class:cls showClass:showClass showCategory:showCategory classFirst:showClassFirst
- "answer a method list entry
- gimmics:
- adding a little image to breakPointed methods,
- inheritance indicators,
- highlight accessors of variable"
+ "answer a method list entry
+ gimmics:
+ adding a little image to breakPointed methods,
+ inheritance indicators,
+ highlight accessors of variable"
- |clsName s icn variablesToHighlight classVarsToHighLight
- doHighLight doHighLightRed clr emp cat l redefIcon
- metrics complexity complexityString complexityIcon mark|
+ ^ 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 lastResultOrNil|
aMethod isNil ifTrue:[
- "/ a non-existing (pseudo) method (such as required protocol)
- ^ selector colorizeAllWith:Color red.
- ].
-
- aMethod isAssociation ifTrue:[
- self halt:'should not happen'.
+ "/ a non-existing (pseudo) method (such as required protocol)
+ ^ selector colorizeAllWith:Color red.
].
- selector isNil ifTrue:[
- s := '???'
+ showClassFirst ifTrue:[
+ s := aMethod printStringForBrowserWithSelector:selector allBold inClass:cls.
+ s := cls nameInBrowser , ' ' , s
] ifFalse:[
- s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
- ].
- showClassFirst ifTrue:[
- clsName := cls nameInBrowser.
- s := clsName , ' ' , s allBold
+ s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
].
"/
@@ -1580,175 +1601,174 @@
"/ have higher prio ...
"/
(aMethod notNil and:[aMethod isWrapped]) ifTrue:[
- (s endsWith:' !!') ifTrue:[
- s := s copyWithoutLast:2
- ].
- aMethod isBreakpointed ifTrue:[
- icn := self stopIcon
- ] ifFalse:[
- aMethod isTimed ifTrue:[
- icn := self timeIcon
- ] ifFalse:[
- icn := self traceIcon
- ]
- ].
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ aMethod isBreakpointed ifTrue:[
+ icn := self stopIcon
+ ] ifFalse:[
+ aMethod isTimed ifTrue:[
+ icn := self timeIcon
+ ] ifFalse:[
+ icn := self traceIcon
+ ]
+ ].
].
icn isNil ifTrue:[
- self showImageResourceMethodsImages value ~~ false ifTrue:[
- (aMethod hasImageResource) ifTrue:[
- aMethod mclass isMeta ifTrue:[
- icn := aMethod valueWithReceiver:nil arguments:nil .
- ].
- ].
- ].
+ self showImageResourceMethodsImages value ~~ false ifTrue:[
+ (aMethod hasImageResource) ifTrue:[
+ aMethod mclass isMeta ifTrue:[
+ icn := aMethod valueWithReceiver:nil arguments:nil .
+ ].
+ ].
+ ].
].
icn isNil ifTrue:[
- showMethodTypeIcon value ~~ false ifTrue:[
- icn := self resourceIconForMethod:aMethod.
- ].
- icn isNil ifTrue:[
- aMethod isProtected ifTrue:[
- icn := self protectedMethodIcon
- ] ifFalse:[
- aMethod isPrivate ifTrue:[
- icn := self privateMethodIcon
- ] ifFalse:[
- (aMethod isIgnored) ifTrue:[
- icn := self ignoredMethodIcon
- ] ifFalse:[
- (aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
- icn := self abstractMethodIcon
- ]
- ]
- ]
- ].
- ].
+ showMethodTypeIcon value ~~ false ifTrue:[
+ icn := self resourceIconForMethod:aMethod.
+ ].
+ icn isNil ifTrue:[
+ aMethod isProtected ifTrue:[
+ icn := self protectedMethodIcon
+ ] ifFalse:[
+ aMethod isPrivate ifTrue:[
+ icn := self privateMethodIcon
+ ] ifFalse:[
+ (aMethod isIgnored) ifTrue:[
+ icn := self ignoredMethodIcon
+ ] ifFalse:[
+ (aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
+ icn := self abstractMethodIcon
+ ]
+ ]
+ ]
+ ].
+ ].
].
icn isNil ifTrue:[
- cls isTestCaseLike ifTrue:[
- ((cls isTestSelector: selector)
- and:[cls isAbstract not]) ifTrue:[
- "JV@2011-11-17: Show thumbs even if not all test were run"
- "/cls lastTestRunResultOrNil "== false" notNil ifTrue:[
- | realTestCaseCls |
- realTestCaseCls := cls isJavaClass
- ifTrue:[cls asTestCase]
- ifFalse:[cls].
- ((realTestCaseCls testSelectorFailed:selector) or:[(realTestCaseCls testSelectorError:selector)]) ifTrue:[
- icn := SystemBrowser testCaseFailedIcon
- ] ifFalse:[
- (realTestCaseCls testSelectorPassed: selector) ifTrue:
- [icn := SystemBrowser testCasePassedIcon]
- ].
- "/]
- ].
- ]
+ (selector startsWith:'test') ifTrue:[
+ ((cls isSubclassOf:TestCase)
+ and:[cls isAbstract not]) ifTrue:[
+ "JV@2011-11-17: Show thumbs even if not all test were run"
+
+ lastResultOrNil := cls rememberedOutcomeFor:selector.
+ lastResultOrNil notNil ifTrue:[
+ (lastResultOrNil result == TestResult statePass) ifTrue:[
+ icn := SystemBrowser testCasePassedIcon
+ ] ifFalse:[
+ ((lastResultOrNil result == TestResult stateError)
+ or:[ (lastResultOrNil result == TestResult stateFail) ]) ifTrue:[
+ icn := SystemBrowser testCaseFailedIcon
+ ]
+ ]
+ ].
+ ].
+ ]
].
showClass ifTrue:[
- showClassFirst ifFalse:[
- s := s , ' [' , cls name allBold , ']'.
- ]
+ showClassFirst ifFalse:[
+ s := s , ' [' , cls name allBold , ']'.
+ ]
].
showCategory ifTrue:[
- cat := aMethod category.
- cat notNil ifTrue:[
- s := s , ' {' , cat "asText allItalic" , '}'
- ]
+ cat := aMethod category.
+ cat notNil ifTrue:[
+ s := s , ' {' , (cat "asText allItalic" colorizeAllWith:Color grey), '}'
+ ]
].
self showCoverageInformation value ifTrue:[
- clr := self colorForCoverageInformationOfMethod:aMethod.
- clr notNil ifTrue:[
- s := self colorize:s with:(#color->clr).
- "/ aMethod isInstrumented ifTrue:[
- "/ icn := self instrumentationIcon
- "/ ].
- ].
+ clr := self colorForCoverageInformationOfMethod:aMethod.
+ clr notNil ifTrue:[
+ s := self colorize:s with:(#color->clr).
+ "/ aMethod isInstrumented ifTrue:[
+ "/ icn := self instrumentationIcon
+ "/ ].
+ ].
] ifFalse:[
- (ChangeSet current includesChangeForClass:cls selector:selector) ifTrue:[
- mark := self class markForBeingInChangeList.
- "/ mark := self colorizeForChangedCode:mark.
- s := s , mark.
- "/ cg: I dont know why this was disabled - it is req'd to
- "/ see changed methods in a method list (implementors...)
- s := self colorizeForChangedCode:s.
- ].
+ (ChangeSet current includesChangeForClass:cls selector:selector) ifTrue:[
+ mark := self class markForBeingInChangeList.
+ "/ mark := self colorizeForChangedCode:mark.
+ s := s , mark.
+ "/ cg: I dont know why this was disabled - it is req'd to
+ "/ see changed methods in a method list (implementors...)
+ s := self colorizeForChangedCode:s.
+ ].
- (SmallTeam notNil and:[SmallTeam includesChangeForClass:cls selector:selector]) ifTrue:[
- s := (self colorizeForChangedCodeInSmallTeam:'!! '),s
- ].
+ (SmallTeam notNil and:[SmallTeam includesChangeForClass:cls selector:selector]) ifTrue:[
+ s := (self colorizeForChangedCodeInSmallTeam:'!! '),s
+ ].
].
variablesToHighlight := variableFilter value.
variablesToHighlight size > 0 ifTrue:[
- classVarsToHighLight := filterClassVars value.
- classVarsToHighLight ifTrue:[
- doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
- ].
- ] ifFalse:[
- doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
- ]
- ].
- doHighLight ifTrue:[
- s := s allBold.
- doHighLightRed ifTrue:[
- emp := (UserPreferences current emphasisForWrittenVariable)
- ] ifFalse:[
- emp := (UserPreferences current emphasisForReadVariable)
- ].
- s := s emphasisAllAdd:emp
- ]
+ classVarsToHighLight := filterClassVars value.
+ classVarsToHighLight ifTrue:[
+ doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
+ ].
+ ] ifFalse:[
+ doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
+ ]
+ ].
+ doHighLight ifTrue:[
+ s := s allBold.
+ doHighLightRed ifTrue:[
+ emp := (UserPreferences current emphasisForWrittenVariable)
+ ] ifFalse:[
+ emp := (UserPreferences current emphasisForReadVariable)
+ ].
+ s := s emphasisAllAdd:emp
+ ]
].
- (showMethodComplexity value == true
+ (showMethodComplexity value == true
and:[ OOM::MethodMetrics notNil ]) ifTrue:[
- icn isNil ifTrue:[
- metrics := OOM::MethodMetrics forMethod:aMethod.
- complexity := metrics complexity ? 0.
- complexityIcon := OOM::MethodMetrics iconForComplexity:complexity.
+ icn isNil ifTrue:[
+ metrics := OOM::MethodMetrics forMethod:aMethod.
+ complexity := metrics complexity ? 0.
+ complexityIcon := OOM::MethodMetrics iconForComplexity:complexity.
- ShowComplexityValue == true ifTrue:[
- complexityString := '{' , complexity printString , '}'.
- s := complexityString , ' ' , s.
- ].
- "/ icn := icn ? complexityIcon.
- s := LabelAndIcon icon:complexityIcon string:s.
- ].
+ ShowComplexityValue == true ifTrue:[
+ complexityString := '{' , complexity printString , '}'.
+ s := complexityString , ' ' , s.
+ ].
+ "/ icn := icn ? complexityIcon.
+ s := LabelAndIcon icon:complexityIcon string:s.
+ ].
].
- showMethodInheritance value ~~ false ifTrue:[
- redefIcon := self redefinedOrInheritedIconFor:aMethod.
- ].
-
- "JV@2012-04-13: Show all synthetic methods in gray"
- aMethod isSynthetic ifTrue:[
- s := s colorizeAllWith: Color gray.
+ (showMethodInheritance value ? true) ifTrue:[
+ suppressInheritanceInfo ifTrue:[
+ redefIcon := self methodEmptyInheritedIcon.
+ ] ifFalse:[
+ redefIcon := self redefinedOrInheritedIconFor:aMethod.
+ ].
].
(icn notNil or:[redefIcon notNil]) ifTrue:[
- "/eXept version
- "/l := LabelAndIcon icon:redefIcon string:s.
- "/l image:icn.
- "/JV:
- l := LabelAndIcon icon:icn string:s.
- l image:redefIcon.
- icn isNil ifTrue:[l offset: 13].
- l gap:1.
- ^ l
+ "/eXept version
+ "/l := LabelAndIcon icon:redefIcon string:s.
+ "/l image:icn.
+ "/JV:
+ l := LabelAndIcon icon:icn string:s.
+ l image:redefIcon.
+ icn isNil ifTrue:[l offset: 13].
+ l gap:1.
+ ^ l
].
^ s
"Created: / 22-10-1996 / 19:51:00 / cg"
"Modified: / 15-08-2009 / 13:13:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 17-11-2011 / 20:51:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-03-2012 / 19:06:09 / cg"
- "Modified: / 17-04-2012 / 22:54:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MethodList methodsFor:'private-watching'!
@@ -1798,13 +1818,13 @@
!MethodList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.66 2012/07/20 18:11:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.74 2012/11/07 23:04:35 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.66 2012/07/20 18:11:57 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.74 2012/11/07 23:04:35 cg Exp §'
!
version_SVN
- ^ '$Id: Tools__MethodList.st 8061 2012-10-03 22:28:49Z vranyj1 $'
+ ^ '$Id: Tools__MethodList.st 8074 2012-11-30 17:23:39Z vranyj1 $'
! !