#BUGFIX by cg
class: AbstractFileBrowser
changed: #currentFileNameHolder
endless loop if file not present.
"
COPYRIGHT (c) 2000 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
BrowserList subclass:#MethodList
instanceVariableNames:'classes selectedMethodNameIndices methodList lastSelectedMethods
browserNameList variableFilter filterClassVars updateProcess
lastShowClass lastShowCategory lastShowClassFirst
showMethodInheritance lastMethodClass lastMethodClassesSubclasses
classAndSelectorsRedefinedBySubclassesOfClass showClass
showMethodComplexity showMethodTypeIcon
showImageResourceMethodsImages showSyntheticMethods'
classVariableNames:'ShowComplexityValue'
poolDictionaries:''
category:'Interface-Browsers-New'
!
!MethodList class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
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'!
singleMethodWindowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:MethodList andSelector:#singleMethodWindowSpec
MethodList new openInterface:#singleMethodWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #singleMethodWindowSpec
#window:
#(#WindowSpec
#label: 'SingleSelectorList'
#name: 'SingleSelectorList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'MethodName'
#name: 'MethodLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #methodLabelHolder
#menu: #menuHolder
)
)
)
)
"Modified: / 1.3.2000 / 20:50:15 / cg"
!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::MethodList andSelector:#windowSpec
Tools::MethodList new openInterface:#windowSpec
Tools::MethodList open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'SelectorList'
name: 'SelectorList'
min: (Point 0 0)
bounds: (Rectangle 0 0 300 300)
)
component:
(SpecCollection
collection: (
(SequenceViewSpec
name: 'List'
layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
tabable: true
model: selectedMethodNameIndices
menu: menuHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
miniScrollerHorizontal: true
isMultiSelect: true
valueChangeSelector: selectionChangedByClick
useIndex: true
sequenceList: browserNameList
doubleClickChannel: doubleClickChannel
properties:
(PropertyListDictionary
canDropSelector: canDropContext:
dragArgument: nil
dropArgument: nil
dropSelector: doDropContext:
)
)
)
)
)
! !
!MethodList class methodsFor:'plugIn spec'!
aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
environmentHolder
#(doubleClickChannel action)
#filterClassVars
#forceGeneratorTrigger
#immediateUpdate
#inGeneratorHolder
#menuHolder
#methodCategoryHolder
#packageFilter
#selectedMethods
#selectionChangeCondition
#showCoverageInformation
#showImageResourceMethodsImages
#showMethodComplexity
#showMethodInheritance
#showMethodTypeIcon
#sortBy
#updateTrigger
#variableFilter
#showSyntheticMethods
).
"Modified: / 24-02-2014 / 10:37:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MethodList methodsFor:'aspects'!
browserNameList
browserNameList isNil ifTrue:[
browserNameList := List new.
].
^ browserNameList.
"Modified: / 31.1.2000 / 00:42:44 / cg"
"Created: / 5.2.2000 / 22:38:32 / cg"
!
defaultSlaveModeValue
^ false.
!
filterClassVars
filterClassVars isNil ifTrue:[
filterClassVars := false asValue.
filterClassVars addDependent:self
].
^ filterClassVars
!
filterClassVars:aValueHolder
filterClassVars notNil ifTrue:[
filterClassVars removeDependent:self
].
filterClassVars := aValueHolder.
filterClassVars notNil ifTrue:[
filterClassVars addDependent:self
].
!
methodLabelHolder
^ self pseudoListLabelHolder
"Created: / 1.3.2000 / 20:50:07 / cg"
!
methodList
^ methodList
!
selectedMethodNameIndices
selectedMethodNameIndices isNil ifTrue:[
selectedMethodNameIndices := ValueHolder new.
selectedMethodNameIndices addDependent:self
].
^ selectedMethodNameIndices.
"Modified: / 5.2.2000 / 00:31:48 / cg"
"Created: / 5.2.2000 / 22:59:31 / cg"
!
selectedMethods
^ self selectionHolder
!
selectedMethods:aValueHolder
^ self selectionHolder:aValueHolder
!
showImageResourceMethodsImages
showImageResourceMethodsImages isNil ifTrue:[
showImageResourceMethodsImages := false asValue.
showImageResourceMethodsImages addDependent:self
].
^ showImageResourceMethodsImages
!
showImageResourceMethodsImages:aValueHolder
showImageResourceMethodsImages notNil ifTrue:[
showImageResourceMethodsImages removeDependent:self
].
showImageResourceMethodsImages := aValueHolder.
showImageResourceMethodsImages notNil ifTrue:[
showImageResourceMethodsImages addDependent:self
].
!
showMethodComplexity
showMethodComplexity isNil ifTrue:[
showMethodComplexity := false asValue.
showMethodComplexity addDependent:self
].
^ showMethodComplexity
!
showMethodComplexity:aValueHolder
showMethodComplexity notNil ifTrue:[
showMethodComplexity removeDependent:self
].
showMethodComplexity := aValueHolder.
showMethodComplexity notNil ifTrue:[
showMethodComplexity addDependent:self
].
!
showMethodInheritance
showMethodInheritance isNil ifTrue:[
showMethodInheritance := false asValue.
showMethodInheritance addDependent:self
].
^ showMethodInheritance
!
showMethodInheritance:aValueHolder
showMethodInheritance notNil ifTrue:[
showMethodInheritance removeDependent:self
].
showMethodInheritance := aValueHolder.
showMethodInheritance notNil ifTrue:[
showMethodInheritance addDependent:self
].
!
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
].
!
showSyntheticMethods
showSyntheticMethods isNil ifTrue:[
showSyntheticMethods := false asValue.
showSyntheticMethods addDependent:self
].
^ showSyntheticMethods
"Created: / 13-04-2012 / 16:03:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
showSyntheticMethods:aValueHolder
showSyntheticMethods notNil ifTrue:[
showSyntheticMethods removeDependent:self
].
showSyntheticMethods := aValueHolder.
showSyntheticMethods notNil ifTrue:[
showSyntheticMethods addDependent:self
].
"Created: / 13-04-2012 / 16:03:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
variableFilter
variableFilter isNil ifTrue:[
variableFilter := nil asValue.
variableFilter addDependent:self
].
^ variableFilter
!
variableFilter:aValueHolder
variableFilter notNil ifTrue:[
variableFilter removeDependent:self
].
variableFilter := aValueHolder.
variableFilter notNil ifTrue:[
variableFilter addDependent:self
].
! !
!MethodList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|cls clsName sel oldMethod newMethod methods newSelection
selectionHolder selection needSelectionChange|
selectionHolder := self selectedMethods.
selection := selectionHolder value.
changedObject == environment ifTrue:[
classes notNil ifTrue:[
something == #classDefinition ifTrue:[
cls := aParameter.
clsName := cls name.
(classes contains:[:aClass | aClass name = clsName]) ifFalse:[
^ self "/ I don't care for that class
].
classes := classes collect:[:eachClass | (environment classNamed:eachClass name) ].
self invalidateList.
"/ self updateList.
^ 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
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.
"/ (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.
].
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.
"/ self enqueueDelayedUpdateList.
"/ listValid == true ifTrue:[
"/ self invalidateList.
"/ ].
^ 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
].
((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.
]
].
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
].
(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
].
"/ something == #organization ifTrue:[
"/self halt:'no longer'.
"/^ self.
"/ "/ a methods cateory has changed
"/ (classes includesIdentical:changedObject) ifTrue:[
"/ aParameter isSymbol ifTrue:[
"/ "/ a method with a new category
"/ (self methodList includesIdentical:(changedObject compiledMethodAt:aParameter)) ifTrue:[
"/ self invalidateList.
"/ ].
"/ ^ self.
"/ ].
"/ "/ a new category (no method yet)
"/ self invalidateList
"/ ].
"/ ^ self
"/ ].
"/ something == #methodDictionary ifTrue:[
"/self halt:'no longer'.
"/^ self.
"/ "/ a method has been added/removed
"/ (classes includesIdentical:changedObject) ifTrue:[
"/ aParameter isArray ifTrue:[
"/ sel := aParameter at:1.
"/ oldMethod := aParameter at:2.
"/ newMethod := changedObject compiledMethodAt:sel.
"/ oldMethod 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.
"/ selectionHolder changed.
"/ ].
"/ ^ self.
"/ ]
"/ ].
"/ "/ class has changed must update the methodList
"/ self invalidateList.
"/ ].
"/ ^ self.
"/ ].
"/ something == #projectOrganization ifTrue:[
"/ ((classes includesIdentical:changedObject theNonMetaclass)
"/ or:[(classes includesIdentical:changedObject theMetaclass)]) ifTrue:[
"/ self invalidateList.
"/ ].
"/ ^ self
"/ ].
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
].
(changedObject == variableFilter
or:[changedObject == filterClassVars
or:[changedObject == showMethodInheritance
or:[changedObject == showMethodComplexity
or:[changedObject == showSyntheticMethods
]]]]) 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
"/ selection size == 1 ifTrue:[
selectionHolder setValue:newSelection.
selectionHolder changed:#value.
"/ ].
].
^ self
].
changedObject == selectionHolder ifTrue:[
self selectedMethodsChanged.
lastSelectedMethods := selectionHolder value.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods := lastSelectedMethods asOrderedCollection
].
^ self
].
"/ something == #methodTrap ifTrue:[
"/self halt:'no longer'.
"/^ self.
"/ (classes includesIdentical:changedObject) ifTrue:[
"/ newMethod := changedObject compiledMethodAt:aParameter.
"/ newMethod isNil ifTrue:[
"/ self invalidateList.
"/ ^ self
"/ ].
"/ 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.
"/ ].
"/ self invalidateList.
"/ ^ self
"/ ].
"/ ^ self
"/ ].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 05-02-2000 / 13:42:14 / cg"
"Modified: / 05-06-2012 / 23:47:15 / cg"
"Modified: / 24-08-2013 / 00:41:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectedMethodsChanged
"the set of selected methods has changed;
update the selection-index collection (for the selectionInListView)"
|indices methods reverseMap
selectedMethodsHolder selectedMethods selectedMethodNameIndicesHolder|
methods := methodList ? #().
methods size == 0 ifTrue:[
"/ this may happen during early startup,
"/ when invoked with a preset methodSelection,
"/ and the methodGenerator has not yet been setup
"/ to not clobber the selection, defer the update
"/ until the methodList arrives ...
^ self
].
selectedMethodsHolder := self selectedMethods.
selectedMethods := selectedMethodsHolder value.
"/ check if all is selected (likely)
((selectedMethods size == methodList size)
and:[selectedMethods = methodList]) ifTrue:[
indices := (1 to:selectedMethods size)
] ifFalse:[
selectedMethods size > 100 ifTrue:[
"/ check if all is selected (likely)
((selectedMethods size == methodList size)
and:[selectedMethods = methodList]) ifTrue:[
indices := (1 to:selectedMethods size)
] ifFalse:[
"/ for big collections, generate a reverse map
reverseMap := IdentityDictionary new.
methods keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
indices := selectedMethods collect:[:eachSelectedMethod |
reverseMap at:eachSelectedMethod ifAbsent:0
]
]
] ifFalse:[
indices := (selectedMethods ? #()) collect:[:eachSelectedMethod |
methods identityIndexOf:eachSelectedMethod.
]
].
indices := indices select:[:idx | idx ~= 0].
].
selectedMethodNameIndicesHolder := self selectedMethodNameIndices.
selectedMethodNameIndicesHolder value ~= indices ifTrue:[
selectedMethodNameIndicesHolder value:indices.
]
!
selectionChanged
|methods|
methods := ((self selectedMethodNameIndices value) ? #()) collect:[:idx | methodList at:idx].
methods notEmpty ifTrue:[
lastSelectedMethods := methods asOrderedCollection.
].
"/ to allow reselect, change my valueHolder, even if the same collection
"/ self selectedMethods value ~= methods ifTrue:[
self selectedMethods value:methods asOrderedCollection
"/ ]
"Created: / 05-02-2000 / 13:42:14 / cg"
"Modified: / 05-02-2000 / 23:32:20 / cg"
"Modified: / 13-06-2013 / 12:19:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder "
!
update:something with:aParameter from:changedObject
|cls clsName sel mthd mustFlushInheritanceInfo|
mustFlushInheritanceInfo := true.
"/ some can be ignored immediately
changedObject == environment ifTrue:[
classes isNil ifTrue:[
^ self.
].
something isNil ifTrue:[
"/ self halt "/ huh - environment 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 == #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 == #methodTrap
or:[ something == #methodPrivacy
or:[ something == #lastTestRunResult] ]) ifTrue:[
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
].
cls := aParameter at:1.
sel := aParameter at:2.
mthd := cls compiledMethodAt:sel.
(mthd notNil and:[mthd isWrapped or:[mthd isMethodWithBreakpoints]]) ifTrue:[
(methodList includes:mthd originalMethod) ifTrue:[
methodList replaceAll:mthd originalMethod with:mthd.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods replaceAll:mthd originalMethod with:mthd.
].
]
].
mustFlushInheritanceInfo := false.
].
something == #newClass ifTrue:[
^ self.
].
(something == #methodInClass
or:[ something == #methodInClassRemoved ]) ifTrue:[
cls := aParameter first.
clsName := cls name.
(classes contains:[:aClass | aClass name = clsName]) ifFalse:[
^ self "/ I dont care for that class
].
sel := aParameter second.
(methodList contains:[:mthd | mthd getMclass notNil and:[mthd selector = sel]]) ifFalse:[
mustFlushInheritanceInfo := false.
self window topView hasFocus ifFalse:[
self enqueueDelayedUpdate:something with:aParameter from:changedObject.
^ self.
].
].
].
mustFlushInheritanceInfo ifTrue:[
"/ as the organisation changes, flush my remembered redefinition-cache-info
classAndSelectorsRedefinedBySubclassesOfClass := nil.
].
something == #classDefinition ifTrue:[
cls := aParameter.
clsName := cls name.
(classes contains:[:aClass | aClass name = clsName]) ifFalse:[
^ self "/ I don't 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
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
].
].
super update:something with:aParameter from:changedObject
"Modified: / 17-11-2011 / 19:22:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-06-2012 / 23:41:50 / cg"
! !
!MethodList methodsFor:'drag & drop'!
canDropContext:aDropContext
|methods|
aDropContext sourceWidget == aDropContext targetWidget ifTrue:[^ false].
methods := aDropContext dropObjects collect:[:obj | obj theObject].
(methods conform:[:aMethod | aMethod isMethod]) ifFalse:[^ false].
self masterApplication theSingleSelectedClass isNil ifTrue:[^ false].
^ true
"Modified: / 13-09-2006 / 11:43:54 / cg"
!
doDropContext:aDropContext
|methods browser|
methods := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(methods conform:[:something | something isMethod]) ifFalse:[^ self].
browser := self masterApplication.
aDropContext dragType == DropContext dragTypeCopy ifTrue:[
browser
copyMethods:methods
toClass:(browser theSingleSelectedClass).
] ifFalse:[
browser
moveMethods:methods
toClass:(browser theSingleSelectedClass).
].
"Modified: / 13-09-2006 / 11:43:44 / cg"
! !
!MethodList methodsFor:'private'!
isMethodToBeShown:aMethod
"invoked, when we get a change for aMethod which was previously not
in the list (for example, if I show a filtered list).
Check if that single method is to be shown now.
Used to speed up update for senders/string/implementors lists"
|generator|
generator := inGeneratorHolder value.
generator isNil ifTrue:[
^ false
].
"/ generator generates nil-selector entries
"/ to pass multiple-class and multiple-protocol info
generator do:[:cls :cat :sel :mthd |
mthd == aMethod ifTrue:[
mthd isSynthetic ifFalse:[
sel notNil ifTrue:[
"/ cg: no longer filter those...
"/ (packageFilter value isNil
"/ or:[ packageFilter value includes:mthd package ]) ifTrue:[
^ true
"/ ]
]
].
^ false
]
].
^ false
"Created: / 17-08-2011 / 15:03:34 / cg"
!
listOfMethodNames
|methods entries selectorBag newNameList allClasses newClasses
allCategories "allSelectors"
generator doShowClass doShowClassFirst doShowCategory enforceClassAndProtocolInList
theMethod sortByClass anyMethodToWatch mclass
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.
enforceClassAndProtocolInList := false.
anyMethodToWatch := false.
"/ no longer filter those
"/ JV@2013-09-17: Why on hell not? A little explanation please!!
"/ Enabled again, because when i select package in a browser I expect
"/ to see only methods belonging to that package!!
packageFilterValue := packageFilter value.
"/ 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 := (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:[showSyntheticMethods value == true])
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|
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 ].
doShowClassFirst := doShowClass.
doShowClassFirst := doShowClass and:[ sortBy value == #class ].
sortBy value == false ifTrue:[
"/ 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|
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|
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 ]
].
].
].
].
methods := OrderedCollection new:(entries size).
"/ first generate the new methodList, and see if it is different ...
entries do:[:entry |
|sel mthd|
mthd := entry at:3.
methods add:mthd.
].
false "methodList = methods" "does not care for changed icons" ifTrue:[
"/ same list
newNameList := self browserNameList.
] ifFalse:[
newNameList := OrderedCollection new:(entries size).
"/ multiple classes must add the className for some
entries do:[:entry |
|cls sel mthd s needClass|
cls := entry at:1.
sel := entry at:2.
mthd := entry at:3.
needClass := doShowClass.
"/ 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
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) ])
].
"/ 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: / 24-08-2010 / 20:34:09 / Jan Vrany <enter your email here>"
"Modified: / 20-07-2012 / 20:00:58 / cg"
"Modified (comment): / 17-09-2013 / 10:31:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
makeDependent
environment addDependent:self.
"/ ChangeSet addDependent:self.
"Modified: / 10-11-2006 / 17:57:01 / cg"
!
makeIndependent
environment removeDependent:self.
"/ ChangeSet removeDependent:self.
!
method:mthd includesModsOfClassVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#modifiedClassVars
!
method:mthd includesModsOfInstanceVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#modifiedInstVars
!
method:mthd includesRefsToClassVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#usedClassVars
!
method:mthd includesRefsToInstanceVariable:variablesToHighLight
^ self method:mthd includesRefsToVariable:variablesToHighLight askParserWith:#usedInstVars
!
method:mthd includesRefsToVariable:variablesToHighLight askParserWith:querySelector
|cls src parser usedVars anyVarNameAccessable|
cls := mthd mclass.
cls isNil ifTrue:[^ false].
anyVarNameAccessable := cls allInstVarNames includesAny:variablesToHighLight.
anyVarNameAccessable ifFalse:[
anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
].
anyVarNameAccessable ifFalse:[
"/ no need to parse
^ false
].
"/ JV Following code is just very bad. It assumes that method is a Smalltalk method.
"/ But it may not, it could be JavaScript method, Java method or whatever fancy language
"/ method. Should be actually delegated to the method itself, just as #messagesSend & co.
"/ I'm not going to refactor now to keep the differences between jv-branch and CVS
"/ ss small as possible. This interface is bad anyway as method is parsed several times
"/ to check different things. Once should be enough.
"/ Hack:
mthd programmingLanguage isSmalltalk ifFalse:[
^ [
usedVars := mthd perform:querySelector.
usedVars includesAny:variablesToHighLight
] on: Error do:[
false
]
].
src := mthd source.
src notNil ifTrue:[
"
before doing a slow parse, quickly scan the
methods source for the variables name ...
"
(variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
parser := Parser
parseMethod:src
in:cls
ignoreErrors:true
ignoreWarnings:true.
(parser notNil and:[parser ~~ #Error]) ifTrue:[
usedVars := parser perform:querySelector.
(usedVars includesAny:variablesToHighLight)
ifTrue:[
^ true
]
]
]
].
^ false
"Modified: / 30-08-2013 / 13:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methodIsInheritedFromAbove:aMethod
|mClass|
mClass := aMethod mclass.
(mClass notNil and:[mClass superclass notNil]) ifTrue:[
^ (mClass superclass whichClassIncludesSelector:aMethod selector) notNil.
].
^ false
!
methodIsRedefinedBelow:aMethod
|mclass subClasses setOfRedefinedSelectors|
mclass := aMethod mclass.
mclass isNil ifTrue:[^ false].
"/ if possible, make use of info prepared by listOfMethodNames
classAndSelectorsRedefinedBySubclassesOfClass notNil
ifTrue:[
setOfRedefinedSelectors := classAndSelectorsRedefinedBySubclassesOfClass at:mclass ifAbsent:nil.
setOfRedefinedSelectors notNil ifTrue:[
^ setOfRedefinedSelectors includes:aMethod selector
]
].
lastMethodClass == mclass ifTrue:[
subClasses := lastMethodClassesSubclasses
] ifFalse:[
subClasses := aMethod mclass allSubclasses.
lastMethodClassesSubclasses := subClasses.
lastMethodClass := mclass.
].
^ subClasses contains:[:cls | cls includesSelector:aMethod selector].
!
redefinedOrInheritedIconFor:aMethod
|inherited redefined subclassResponsibility|
inherited := self methodIsInheritedFromAbove:aMethod.
redefined := self methodIsRedefinedBelow:aMethod.
inherited ifTrue:[
redefined ifTrue:[
^ self methodInheritedFromAboveAndRedefinedBelowIcon.
].
^ self methodInheritedFromAboveIcon.
].
subclassResponsibility := aMethod sends:#subclassResponsibility.
redefined ifTrue:[
subclassResponsibility ifTrue:[
^ self methodIsSubclassResponsibilityAndRedefinedBelowIcon.
].
^ self methodRedefinedBelowIcon.
].
subclassResponsibility ifTrue:[
^ self methodIsSubclassResponsibilityIcon.
].
^ self methodEmptyInheritedIcon
!
release
super release.
filterClassVars removeDependent:self.
selectedMethodNameIndices removeDependent:self.
showMethodInheritance removeDependent:self.
variableFilter removeDependent:self.
!
resourceIconForMethod:aMethod
^ SystemBrowser resourceIconForMethod:aMethod
"Modified: / 17-08-2006 / 09:09:01 / cg"
!
setOfAllSelectorsImplementedBelow:aClass
|set|
set := IdentitySet new.
aClass allSubclassesDo:[:eachSubclass |
set addAll:(eachSubclass methodDictionary keys).
].
^ set
!
updateList
|prevSelection newList newSelection newSelIdx reverseMap sameContents newListSize oldListSize
prevClasses methodSet selectedMethodsHolder|
selectedMethodsHolder := self selectedMethods.
prevSelection := selectedMethodsHolder value ? #().
prevClasses := classes isNil ifTrue:[ #() ] ifFalse:[ classes copy ].
oldListSize := self browserNameList size.
self topApplication withWaitCursorDo:[
newList := self listOfMethodNames.
].
newListSize := newList size.
sameContents := self updateListFor:newList.
sameContents ifFalse:[
"/ self browserNameList value:newList.
(prevSelection size == 0
and:[selectedMethodsHolder value size ~~ 0]) ifTrue:[
"/ this happens during early startup time,
"/ when the selection is already (pre-)set,
"/ and the methodList is generated the first time
"/ (i.e. when opened with preset selection
"/ do not clobber the selection in this case.
prevSelection := selectedMethodsHolder value.
].
(methodList size == 0 or:[prevSelection size == 0]) ifTrue:[
newSelection := #()
] ifFalse:[
methodSet := methodList.
"/ intersect is much faster with sets, if the number of items is large
"/ however, only if its worth building the set ...
(methodSet size + prevSelection size) > 35 ifTrue:[
methodSet := methodSet asIdentitySet.
].
newSelection := methodSet intersect:prevSelection.
].
newSelection size > 0 ifTrue:[
newSelection size > 100 ifTrue:[
"/ need selection indices - might be expensive if done straight forward...
reverseMap := IdentityDictionary new.
methodList keysAndValuesDo:[:idx :mthd | reverseMap at:mthd put:idx].
newSelIdx := newSelection collect:[:mthd | reverseMap at:mthd].
] ifFalse:[
newSelIdx := newSelection collect:[:mthd | methodList identityIndexOf:mthd]
].
"/ self halt.
"/ force change (for dependents)
newSelIdx ~= selectedMethodNameIndices value ifTrue:[
self selectedMethodNameIndices value:newSelIdx.
].
] ifFalse:[
lastSelectedMethods := selectedMethodsHolder value.
lastSelectedMethods notNil ifTrue:[
lastSelectedMethods := lastSelectedMethods asOrderedCollection
].
selectedMethodNameIndices value size > 0 ifTrue:[
selectedMethodNameIndices value:#().
]
].
newSelection ~= prevSelection ifTrue:[
self selectionChanged.
]
] ifTrue:[
"/ same list - but classes might have changed
"/ that is the case, if the class selection has been changed,
"/ to another class which has the same categories.
(prevClasses ~= (classes ? IdentitySet new)) ifTrue:[
(newListSize > 0 or:[oldListSize > 0]) ifTrue:[
self selectionChanged.
]
]
]
"Modified: / 05-03-2007 / 16:07:24 / cg"
"Modified: / 24-02-2014 / 11:08:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateListEntryFor:aMethod
"update my list for a single method.
(used when a single methods package, code or whatever changes, and a full udpate
would be too slow)"
|s idx|
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.
].
]
].
idx == 0 ifTrue:[
"/ method was not previously shown; try to avoid a full update
(self isMethodToBeShown:aMethod) ifTrue:[
self invalidateList
].
] ifFalse:[
self browserNameList at:idx put:s.
]
"Modified: / 17-08-2011 / 15:05:02 / cg"
! !
!MethodList methodsFor:'private-presentation'!
colorForCoverageInformationOfMethod:aMethod
aMethod isInstrumented ifFalse:[^ nil].
aMethod category = 'documentation' ifTrue:[^ nil].
aMethod hasBeenCalled ifTrue:[
aMethod haveAllBlocksBeenExecuted ifTrue:[
^ UserPreferences current colorForInstrumentedFullyCoveredCode
].
^ UserPreferences current colorForInstrumentedPartiallyCoveredCode
].
^ UserPreferences current colorForInstrumentedNeverCalledCode
"Created: / 30-04-2010 / 11:53:38 / cg"
!
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"
^ 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.
].
showClassFirst ifTrue:[
s := aMethod printStringForBrowserWithSelector:selector allBold inClass:cls.
s := cls nameInBrowser , ' ' , s
] ifFalse:[
s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
].
"/
"/ wrap icons (i.e. break- or trace points on the method)
"/ have higher prio ...
"/
(aMethod notNil and:[aMethod isWrapped]) ifTrue:[
(s endsWith:' !!') ifTrue:[
s := s copyButLast:2
].
aMethod isBreakpointed ifTrue:[
icn := self stopIcon
] ifFalse:[
aMethod isTimed ifTrue:[
icn := self timeIcon
] ifFalse:[
icn := self traceIcon
]
].
].
"/
"/ breakpoint icons (i.e. break- or trace points inside)
"/
icn isNil ifTrue:[
(aMethod notNil and:[aMethod isMethodWithBreakpoints]) ifTrue:[
icn := self breakPointedIcon
].
].
icn isNil ifTrue:[
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
]
]
]
].
].
].
icn isNil ifTrue:[
(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:[
|state|
state := lastResultOrNil result.
(state == TestResult statePass) ifTrue:[
icn := ToolbarIconLibrary testCasePassedIcon
] ifFalse:[
(state == TestResult stateError) ifTrue:[
icn := ToolbarIconLibrary testCaseErrorIcon
] ifFalse:[
(state == TestResult stateFail) ifTrue:[
icn := ToolbarIconLibrary testCaseFailedIcon
] ifFalse:[
icn := ToolbarIconLibrary testCaseSkippedIcon
]
]
]
].
].
]
].
showClass ifTrue:[
showClassFirst ifFalse:[
s := s , ' [' , cls name allBold , ']'.
]
].
(showCategory and:[aMethod mclass supportsMethodCategories]) ifTrue:[
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
"/ ].
].
] 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.
].
(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
]
].
(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.
ShowComplexityValue == true ifTrue:[
complexityString := '{' , complexity printString , '}'.
s := complexityString , ' ' , s.
].
"/ icn := icn ? complexityIcon.
s := LabelAndIcon icon:complexityIcon string:s.
].
].
(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
].
^ s
"Created: / 22-10-1996 / 19:51:00 / cg"
"Modified: / 15-08-2009 / 13:13:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 07-03-2012 / 19:06:09 / cg"
"Modified: / 16-10-2013 / 01:10:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MethodList methodsFor:'private-watching'!
startWatchProcess
updateProcess notNil ifTrue:[
^ self
].
updateProcess := [
[true] whileTrue:[
Delay waitForSeconds:1.
self enqueueDelayedUpdateList
]
] fork.
!
stopWatchProcess
|p|
(p := updateProcess) notNil ifTrue:[
updateProcess := nil.
p terminate
].
! !
!MethodList methodsFor:'setup'!
postBuildWith:aBuilder
|methodListView|
super postBuildWith:aBuilder.
methodListView := aBuilder componentAt:'List'.
methodListView notNil ifTrue:[
methodListView allowDrag:true.
methodListView dragObjectConverter:[:obj |
|nm method idx|
nm := obj theObject asString string string.
idx := browserNameList value findFirst:[:item | item string string = nm].
method := methodList value at:idx.
DropObject newMethod:method.
].
]
! !
!MethodList class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.96 2014-02-25 10:41:22 vrany Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.96 2014-02-25 10:41:22 vrany Exp $'
! !