hg/stx-libtool: comparison Tools

equal deleted inserted replaced

-:a0654a5af9a1
+:6e40a20b361a
 selectionHolder := self selectedMethods.
 selection := selectionHolder value.
 changedObject == Smalltalk ifTrue:[
-	classes notNil ifTrue:[
+classes notNil ifTrue:[
-	    something == #methodCategory ifTrue:[
+something == #methodCategory ifTrue:[
-		"/ ignore here - methodCategoryList will tell me if required
+"/ ignore here - methodCategoryList will tell me if required
-		^ self
+^ self
-	    ].
+].
-	    something == #classOrganization ifTrue:[
+something == #classOrganization ifTrue:[
-		"/ ignore here - methodCategoryList will tell me if required
+"/ ignore here - methodCategoryList will tell me if required
-		^ self
+^ self
-	    ].
+].
-	    something == #methodInClass ifTrue:[
+something == #methodInClass ifTrue:[
-		"/ a method has been added/changed
+"/ a method has been added/changed
-		cls := aParameter at:1.
+cls := aParameter at:1.
-		(classes includesIdentical:cls) ifTrue:[
+(classes includesIdentical:cls) ifTrue:[
-		    sel := aParameter at:2.
+sel := aParameter at:2.
-		    oldMethod := aParameter at:3.
+oldMethod := aParameter at:3.
-		    newMethod := cls compiledMethodAt:sel.
+newMethod := cls compiledMethodAt:sel.
-		    (oldMethod notNil and:[newMethod notNil]) ifTrue:[
+(oldMethod notNil and:[newMethod notNil]) ifTrue:[
-			"a method was changed & acccepted;
+"a method was changed & acccepted;
-			 No need for a rescan of the methodDictionary;
+No need for a rescan of the methodDictionary;
-			 however, ensure that the refs to the old method are updated
+however, ensure that the refs to the old method are updated
-			"
+"
-			methods := selection.
+methods := selection.
-			methods size > 0 ifTrue:[
+methods size > 0 ifTrue:[
-			    (methods includesIdentical:oldMethod) ifTrue:[
+(methods includesIdentical:oldMethod) ifTrue:[
-				needSelectionChange := true.
+needSelectionChange := true.
-			    ]
+]
-			].
+].
-			methodList replaceAllIdentical:oldMethod with:newMethod.
+methodList replaceAllIdentical:oldMethod with:newMethod.
-			lastSelectedMethods notNil ifTrue:[
+lastSelectedMethods notNil ifTrue:[
-			    lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
-			].
+].
-			methods size > 0 ifTrue:[
+methods size > 0 ifTrue:[
-			    methods := methods asOrderedCollection.
+methods := methods asOrderedCollection.
-			    methods replaceAllIdentical:oldMethod with:newMethod.
+methods replaceAllIdentical:oldMethod with:newMethod.
-			].
+].
-			needSelectionChange == true ifTrue:[
+needSelectionChange == true ifTrue:[
-			    selectionHolder setValue:methods.
+selectionHolder setValue:methods.
-			    selectionHolder changed.
+selectionHolder changed.
-			].
+].
-			(variableFilter value size > 0
+(variableFilter value size > 0
-			or:[oldMethod package ~= newMethod package
+or:[oldMethod package ~= newMethod package
-			or:[oldMethod resources ~= newMethod resources]]) ifTrue:[
+or:[oldMethod resources ~= newMethod resources]]) ifTrue:[
-			    "/ only update that methods entry
+"/ only update that methods entry
-			    self updateListEntryFor:newMethod.
+self updateListEntryFor:newMethod.
-			    "/ sigh - must invalidate
+"/ sigh - must invalidate
-			    "/ self invalidateList.
+"/ self invalidateList.
-			].
+].
-			^ self.
+^ self.
-		    ].
+].
-		    "/ method was added - update the methodList
+"/ method was added - update the methodList
-		    "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+"/ Q: is this needed (methodCategoryList should send me a new inGenerator)
-		    self invalidateList.
+self invalidateList.
-		].
+].
-		^ self.
+^ self.
-	    ].
+].
-	    something == #methodInClassRemoved ifTrue:[
+something == #methodInClassRemoved ifTrue:[
-		cls := aParameter at:1.
+cls := aParameter at:1.
-		(classes includesIdentical:cls) ifTrue:[
+(classes includesIdentical:cls) ifTrue:[
-		    sel := aParameter at:2.
+sel := aParameter at:2.
-		    "/ method was removed - update the methodList
+"/ method was removed - update the methodList
-		    "/ Q: is this needed (methodCategoryList should send me a new inGenerator)
+"/ Q: is this needed (methodCategoryList should send me a new inGenerator)
-		    self invalidateList.
+self invalidateList.
-		].
+].
-		^ self.
+^ self.
-	    ].
+].
-	    something == #methodTrap ifTrue:[
+(something == #methodTrap
-		cls := aParameter at:1.
+or:[ something == #privacyOfMethod ]) ifTrue:[
-		sel := aParameter at:2.
+cls := aParameter at:1.
-		(classes includesIdentical:cls) ifTrue:[
+sel := aParameter at:2.
-		    newMethod := cls compiledMethodAt:sel.
+(classes includesIdentical:cls) ifFalse:[ ^ self].
-		    newMethod isNil ifTrue:[
+newMethod := cls compiledMethodAt:sel.
-			self invalidateList.
+newMethod isNil ifTrue:[
-			^ self
+self invalidateList.
-		    ].
+^ self
-		    newMethod isWrapped ifTrue:[
+].
-			oldMethod := newMethod originalMethod
-		    ] ifFalse:[
+(something == #privacyOfMethod) ifTrue:[
-			selection size > 0 ifTrue:[
+self updateListEntryFor:newMethod.
-			    oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
+].
-			]
-		    ].
+(something == #methodTrap) ifTrue:[
+newMethod isWrapped ifTrue:[
-		    selection size > 0 ifTrue:[
+oldMethod := newMethod originalMethod
-			(selection includesIdentical:oldMethod) ifTrue:[
+] ifFalse:[
-			    needSelectionChange := true.
+selection size > 0 ifTrue:[
-			]
+oldMethod := selection detect:[:each | each isWrapped and:[each originalMethod == newMethod]] ifNone:nil.
-		    ].
+]
-		    methodList replaceAllIdentical:oldMethod with:newMethod.
+].
-		    lastSelectedMethods notNil ifTrue:[
-			lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
+selection size > 0 ifTrue:[
-		    ].
+(selection includesIdentical:oldMethod) ifTrue:[
-		    selection size > 0 ifTrue:[
+needSelectionChange := true.
-			selection := selection asOrderedCollection.
+]
-			selection replaceAllIdentical:oldMethod with:newMethod.
+].
-		    ].
+methodList replaceAllIdentical:oldMethod with:newMethod.
-		    needSelectionChange == true ifTrue:[
+lastSelectedMethods notNil ifTrue:[
-			selectionHolder changed.
+lastSelectedMethods replaceAllIdentical:oldMethod with:newMethod
-		    ].
+].
+selection size > 0 ifTrue:[
-		    "/ actually, could just change that single item ...
+selection := selection asOrderedCollection.
-		    "/ ... might be cheaper, if list is huge.
+selection replaceAllIdentical:oldMethod with:newMethod.
-		    "/ only update that methods entry
+].
-		    self updateListEntryFor:newMethod.
+needSelectionChange == true ifTrue:[
-		    "/ self invalidateList.
+selectionHolder changed.
-		].
+].
-		^ self
-	    ].
+"/ actually, could just change that single item ...
+"/ ... might be cheaper, if list is huge.
-	    something == #projectOrganization ifTrue:[
+"/ only update that methods entry
-		aParameter notNil ifTrue:[
+self updateListEntryFor:newMethod.
-		    cls := aParameter at:1.
+"/ self invalidateList.
-		    cls notNil ifTrue:[
+].
-			((classes includesIdentical:cls theNonMetaclass)
+^ self
-			or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
+].
-			    self invalidateList.
-			].
+something == #projectOrganization ifTrue:[
-		    ].
+aParameter notNil ifTrue:[
-		] ifFalse:[
+cls := aParameter at:1.
-		    self invalidateList.
+cls notNil ifTrue:[
-		].
+((classes includesIdentical:cls theNonMetaclass)
-		^ self
+or:[(classes includesIdentical:cls theMetaclass)]) ifTrue:[
-	    ].
+self invalidateList.
-	    "/ everything else is ignored
+].
-	    "/ self halt.
+].
-	].
+] ifFalse:[
-	^ self
+self invalidateList.
+].
+^ self
+].
+"/ everything else is ignored
+"/ self halt.
+].
+^ self
 ].
 "/    something == #organization ifTrue:[
 "/self halt:'no longer'.
 "/^ self.
 "/        ].
 "/        ^ self
 "/    ].
 changedObject == sortBy ifTrue:[
-	listValid ~~ true ifTrue:[  "/ could be nil
+listValid ~~ true ifTrue:[  "/ could be nil
-	    inGeneratorHolder value isNil ifTrue:[
+inGeneratorHolder value isNil ifTrue:[
-		"/ ok, no need to react on that one
+"/ ok, no need to react on that one
-		"/ (will invalidate anyway, once I have more info at hand)
+"/ (will invalidate anyway, once I have more info at hand)
-		^ self
+^ self
-	    ].
+].
-	].
+].
-	self invalidateList.
+self invalidateList.
-	^ self
+^ self
 ].
 (changedObject == variableFilter
 or:[changedObject == filterClassVars
 or:[changedObject == showMethodInheritance]]) ifTrue:[
-	self invalidateList.
+self invalidateList.
-	^  self
+^  self
 ].
 changedObject == selectedMethodNameIndices ifTrue:[
-	newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
+newSelection := self selectedMethodNameIndices value collect:[:idx | methodList at:idx].
-	newSelection ~= selection ifTrue:[
+newSelection ~= selection ifTrue:[
-	    selectionHolder value:newSelection.
+selectionHolder value:newSelection.
-	    lastSelectedMethods := newSelection.
+lastSelectedMethods := newSelection.
-	    lastSelectedMethods notNil ifTrue:[
+lastSelectedMethods notNil ifTrue:[
-		lastSelectedMethods := lastSelectedMethods asOrderedCollection
+lastSelectedMethods := lastSelectedMethods asOrderedCollection
-	    ].
+].
-	] ifFalse:[
+] ifFalse:[
-	    "/ a reselect - force update
+"/ a reselect - force update
 "/            selection size == 1 ifTrue:[
-		selectionHolder setValue:newSelection.
+selectionHolder setValue:newSelection.
-		selectionHolder changed:#value.
+selectionHolder changed:#value.
 "/            ].
-	].
+].
-	^ self
+^ self
 ].
 changedObject == selectionHolder ifTrue:[
-	self selectedMethodsChanged.
+self selectedMethodsChanged.
-	lastSelectedMethods := selectionHolder value.
+lastSelectedMethods := selectionHolder value.
-	lastSelectedMethods notNil ifTrue:[
+lastSelectedMethods notNil ifTrue:[
-	    lastSelectedMethods := lastSelectedMethods asOrderedCollection
+lastSelectedMethods := lastSelectedMethods asOrderedCollection
-	].
+].
-	^ self
+^ self
 ].
 "/    something == #methodTrap ifTrue:[
 "/self halt:'no longer'.
 "/^ self.
 "/        (classes includesIdentical:changedObject) ifTrue:[
 ].
 something isNil ifTrue:[
 "/ self halt "/ huh - Smalltalk changed - so what ?
 ^ self.
 ].
 something == #classComment ifTrue:[
 ^ self.
 ].
 something == #classVariables ifTrue:[
 ^ self.
 ].
 something == #classOrganization ifTrue:[
 "/ 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
 ].
 ].
 classAndSelectorsRedefinedBySubclassesOfClass := nil.
 (classes includesIdentical:cls) ifFalse:[
 ^ self   "/ I dont care for that class
 ].
 ].
-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
 ! !
 !MethodList methodsFor:'private'!
 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,
+adding a little image to breakPointed methods,
-	inheritance indicators,
+inheritance indicators,
-	highlight accessors of variable"
+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.
+clsName := cls nameInBrowser.
-	s := clsName , ' ' , s allBold
+s := clsName , ' ' , s allBold
 ].
 "/
 "/ wrap icons (i.e. break- or trace points)
 "/ have higher prio ...
 "/
 aMethod isWrapped ifTrue:[
-	(s endsWith:' !!') ifTrue:[
+(s endsWith:' !!') ifTrue:[
-	    s := s copyWithoutLast:2
+s := s copyWithoutLast:2
-	].
+].
-	aMethod isBreakpointed ifTrue:[
+aMethod isBreakpointed ifTrue:[
-	    icn := self stopIcon
+icn := self stopIcon
-	] ifFalse:[
+] ifFalse:[
-	    aMethod isTimed ifTrue:[
+aMethod isTimed ifTrue:[
-		icn := self timeIcon
+icn := self timeIcon
-	    ] ifFalse:[
+] ifFalse:[
-		icn := self traceIcon
+icn := self traceIcon
-	    ]
+]
-	].
+].
 ].
 icn isNil ifTrue:[
-	icn := self resourceIconForMethod:aMethod.
+icn := self resourceIconForMethod:aMethod.
-	icn isNil ifTrue:[
+icn isNil ifTrue:[
-	    aMethod isProtected ifTrue:[
+aMethod isProtected ifTrue:[
-		icn := self protectedMethodIcon
+icn := self protectedMethodIcon
-	    ] ifFalse:[
+] ifFalse:[
-		aMethod isPrivate ifTrue:[
+aMethod isPrivate ifTrue:[
-		    icn := self privateMethodIcon
+icn := self privateMethodIcon
-		] ifFalse:[
+] ifFalse:[
-		    (aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
+(aMethod isIgnored) ifTrue:[
-			icn := self abstractMethodIcon
+icn := self ignoredMethodIcon
-		    ]
+] ifFalse:[
-		]
+(aMethod isJavaMethod and:[aMethod isAbstract]) ifTrue:[
-	    ].
+icn := self abstractMethodIcon
-	].
+]
+]
+]
+].
+].
 ].
 icn isNil ifTrue:[
-	(selector startsWith:'test') ifTrue:[
+(selector startsWith:'test') ifTrue:[
-	    ((cls isSubclassOf:TestCase)
+((cls isSubclassOf:TestCase)
-	    and:[cls isAbstract not]) ifTrue:[
+and:[cls isAbstract not]) ifTrue:[
-		cls lastTestRunResultOrNil == false ifTrue:[
+cls lastTestRunResultOrNil == false ifTrue:[
-		    (cls testSelectorFailed:selector) ifTrue:[
+(cls testSelectorFailed:selector) ifTrue:[
-			icn := SystemBrowser testCaseFailedIcon
+icn := SystemBrowser testCaseFailedIcon
-		    ] ifFalse:[
+] ifFalse:[
-			"/ icn := SystemBrowser testCasePassedIcon
+"/ icn := SystemBrowser testCasePassedIcon
-		    ].
+].
-		]
+]
-	    ].
+].
-	]
+]
 ].
 showClass ifTrue:[
-	showClassFirst ifFalse:[
+showClassFirst ifFalse:[
-	    s := s , ' [' , cls name allBold , ']'.
+s := s , ' [' , cls name allBold , ']'.
-	]
+]
 ].
 showCategory ifTrue:[
-	cat := aMethod category.
+cat := aMethod category.
-	cat notNil ifTrue:[
+cat notNil ifTrue:[
-	    s := s , ' {' , cat "asText allItalic" , '}'
+s := s , ' {' , cat "asText allItalic" , '}'
-	]
+]
 ].
 variablesToHighlight := variableFilter value.
 variablesToHighlight size > 0 ifTrue:[
-	classVarsToHighLight := filterClassVars value.
+classVarsToHighLight := filterClassVars value.
-	classVarsToHighLight ifTrue:[
+classVarsToHighLight ifTrue:[
-	    doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
+doHighLight := self method:aMethod includesRefsToClassVariable:variablesToHighlight.
-	    doHighLight ifTrue:[
+doHighLight ifTrue:[
-		doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
+doHighLightRed := self method:aMethod includesModsOfClassVariable:variablesToHighlight.
-	    ].
+].
-	] ifFalse:[
+] ifFalse:[
-	    doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
+doHighLight := self method:aMethod includesRefsToInstanceVariable:variablesToHighlight.
-	    doHighLight ifTrue:[
+doHighLight ifTrue:[
-		doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
+doHighLightRed := self method:aMethod includesModsOfInstanceVariable:variablesToHighlight
-	    ]
+]
-	].
+].
-	doHighLight ifTrue:[
+doHighLight ifTrue:[
-	    s := s allBold.
+s := s allBold.
-	    doHighLightRed ifTrue:[
+doHighLightRed ifTrue:[
-		emp := (UserPreferences current emphasisForWrittenVariable)
+emp := (UserPreferences current emphasisForWrittenVariable)
-	    ] ifFalse:[
+] ifFalse:[
-		emp := (UserPreferences current emphasisForReadVariable)
+emp := (UserPreferences current emphasisForReadVariable)
-	    ].
+].
-	    s := s emphasisAllAdd:emp
+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 := LabelAndIcon icon:redefIcon string:s.
-	l image:icn.
+l image:icn.
-	l gap:2.
+l gap:2.
-	^ l
+^ l
 ].
 ^ s
 "Created: / 22.10.1996 / 19:51:00 / cg"
 "Modified: / 31.10.2001 / 10:46:50 / cg"
 ! !
 !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 $'
 ! !

changeset 5998	6e40a20b361a
parent 5885	26dee2c80ea9
child 6259	e440c14b02aa