--- a/Tools_MethodList.st Fri Sep 10 12:14:34 2004 +0200
+++ b/Tools_MethodList.st Fri Sep 10 12:15:34 2004 +0200
@@ -278,136 +278,143 @@
selection := selectionHolder value.
changedObject == Smalltalk ifTrue:[
- classes notNil ifTrue:[
- something == #methodCategory ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
- something == #classOrganization ifTrue:[
- "/ ignore here - methodCategoryList will tell me if required
- ^ self
- ].
+ classes notNil ifTrue:[
+ something == #methodCategory ifTrue:[
+ "/ ignore here - methodCategoryList will tell me if required
+ ^ self
+ ].
+ something == #classOrganization 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 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.
- selectionHolder changed.
- ].
- (variableFilter value size > 0
- or:[oldMethod package ~= newMethod package
- or:[oldMethod resources ~= newMethod resources]]) ifTrue:[
- "/ only update that methods 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.
- ].
+ needSelectionChange == true ifTrue:[
+ selectionHolder setValue:methods.
+ selectionHolder changed.
+ ].
+ (variableFilter value size > 0
+ or:[oldMethod package ~= newMethod package
+ or:[oldMethod resources ~= newMethod resources]]) ifTrue:[
+ "/ only update that methods 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 == #methodTrap
+ 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 == #methodTrap ifTrue:[
- cls := aParameter at:1.
- sel := aParameter at:2.
- (classes includesIdentical:cls) ifTrue:[
- newMethod := cls compiledMethodAt:sel.
- 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.
- ]
- ].
+ (something == #privacyOfMethod) 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.
- ].
+ 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 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 == #projectOrganization 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:[
@@ -478,48 +485,48 @@
"/ ].
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]]) ifTrue:[
- self invalidateList.
- ^ self
+ 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'.
@@ -651,6 +658,7 @@
"/ self halt "/ huh - Smalltalk changed - so what ?
^ self.
].
+
something == #classComment ifTrue:[
^ self.
].
@@ -668,10 +676,15 @@
"/ ignore here - methodCategoryList will tell me if required
^ self
].
- something == #methodTrap ifTrue:[
+ (something == #methodTrap
+ or:[ something == #methodPrivacy ]) ifTrue:[
+ self window shown ifFalse:[
+ changedObject removeDependent:self. "/ ?????
+ ^ self
+ ].
cls := aParameter at:1.
(classes includesIdentical:cls) ifFalse:[
- ^ self
+ ^ self "/ I dont care for that class
].
].
@@ -722,17 +735,6 @@
].
].
- something == #methodTrap ifTrue:[
- self window shown ifFalse:[
- changedObject removeDependent:self. "/ ?????
- ^ self
- ].
- cls := aParameter at:1.
- (classes includesIdentical:cls) ifFalse:[
- ^ self "/ I dont care for that class
- ].
- ].
-
super update:something with:aParameter from:changedObject
! !
@@ -741,21 +743,21 @@
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"
+ adding a little image to breakPointed methods,
+ inheritance indicators,
+ highlight accessors of variable"
|clsName s icn variablesToHighlight classVarsToHighLight
doHighLight doHighLightRed emp cat l redefIcon|
aMethod isAssociation ifTrue:[
- self halt:'should not happen'.
+ self halt:'should not happen'.
].
s := aMethod printStringForBrowserWithSelector:selector inClass:cls.
showClassFirst ifTrue:[
- clsName := cls nameInBrowser.
- s := clsName , ' ' , s allBold
+ clsName := cls nameInBrowser.
+ s := clsName , ' ' , s allBold
].
"/
@@ -763,97 +765,101 @@
"/ have higher prio ...
"/
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:[
- icn := self resourceIconForMethod:aMethod.
- icn isNil ifTrue:[
- aMethod isProtected ifTrue:[
- icn := self protectedMethodIcon
- ] ifFalse:[
- aMethod isPrivate ifTrue:[
- icn := self privateMethodIcon
- ] ifFalse:[
- (aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
- icn := self abstractMethodIcon
- ]
- ]
- ].
- ].
+ 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:[
- cls lastTestRunResultOrNil == false ifTrue:[
- (cls testSelectorFailed:selector) ifTrue:[
- icn := SystemBrowser testCaseFailedIcon
- ] ifFalse:[
- "/ icn := SystemBrowser testCasePassedIcon
- ].
- ]
- ].
- ]
+ (selector startsWith:'test') ifTrue:[
+ ((cls isSubclassOf:TestCase)
+ and:[cls isAbstract not]) ifTrue:[
+ cls lastTestRunResultOrNil == false ifTrue:[
+ (cls testSelectorFailed:selector) ifTrue:[
+ icn := SystemBrowser testCaseFailedIcon
+ ] ifFalse:[
+ "/ icn := SystemBrowser testCasePassedIcon
+ ].
+ ]
+ ].
+ ]
].
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" , '}'
+ ]
].
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
+ ]
].
showMethodInheritance value ~~ false ifTrue:[
- redefIcon := self redefinedOrInheritedIconFor:aMethod.
+ redefIcon := self redefinedOrInheritedIconFor:aMethod.
].
(icn notNil or:[redefIcon notNil]) ifTrue:[
- l := LabelAndIcon icon:redefIcon string:s.
- l image:icn.
- l gap:2.
- ^ l
+ l := LabelAndIcon icon:redefIcon string:s.
+ l image:icn.
+ l gap:2.
+ ^ l
].
^ s
@@ -1412,5 +1418,5 @@
!MethodList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.3 2004-05-27 14:29:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodList.st,v 1.4 2004-09-10 10:15:34 cg Exp $'
! !