diff -r d76ed66a63ed -r f6fb9ac10ac5 ResourceSelectionBrowser.st --- a/ResourceSelectionBrowser.st Wed Jul 16 15:32:40 2003 +0200 +++ b/ResourceSelectionBrowser.st Thu Jul 24 20:12:26 2003 +0200 @@ -112,14 +112,14 @@ Smalltalk allClassesDo:[:cls | |owner superclass info| - (owner := cls owningClass) notNil ifTrue:[ - info := subclassesAndPrivateClassesPerClass at:owner ifAbsent:nil. - info isNil ifTrue:[ - subclassesAndPrivateClassesPerClass at:owner put:(info := Array with:IdentitySet new - with:IdentitySet new). - ]. - (info at:2) add:cls - ] ifFalse:[ +"/ (owner := cls owningClass) notNil ifTrue:[ +"/ info := subclassesAndPrivateClassesPerClass at:owner ifAbsent:nil. +"/ info isNil ifTrue:[ +"/ subclassesAndPrivateClassesPerClass at:owner put:(info := Array with:IdentitySet new +"/ with:IdentitySet new). +"/ ]. +"/ (info at:2) add:cls +"/ ] ifFalse:[ superclass := cls superclass. superclass notNil ifTrue:[ info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil. @@ -129,7 +129,7 @@ ]. (info at:1) add:cls ] - ] +"/ ] ]. ^ [:aTreeItem| @@ -180,13 +180,11 @@ itemContents := aTreeItem contents. label := itemContents name. - (itemContents isPrivate - and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)]) - ifTrue: [label := label, ' (', superCls name, ')']. +"/ (itemContents isPrivate +"/ and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)]) +"/ ifTrue: [label := label, ' (', superCls name, ')']. label ] - - ! ! !ResourceSelectionBrowser class methodsFor:'image specs'! @@ -668,7 +666,8 @@ (cont := aTreeItem contents) isBehavior ifTrue:[ children := privateClasses select:[:cls | cls owningClass == aTreeItem contents]. children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name]. - children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child] + "/ children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child] + children := children collect: [:child| TreeItem name:(child name) contents: child] ] ifFalse:[ cont size == 0 ifTrue:[ setOfCategories := childrenPerCategory keys. @@ -688,8 +687,6 @@ ]. children ] - - ! treeViewClassCategoryIcon @@ -730,34 +727,16 @@ classSelected "after a class selection, read the allowed resource methods of the selected class" - ClassPresentation = #'Class Hierarchy' - ifTrue: [self selectionOfClassHierarchy value isNil ifTrue: [^nil]] - ifFalse: [self selectionOfClassCategories value isNil ifTrue: [^nil]]. - - self withWaitCursorDo: - [ - |clsName newContents class| - - resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes]. - - ClassPresentation = #'Class Hierarchy' - ifTrue: [clsName := (self selectionOfClassHierarchy value name upTo: $ ) asSymbol] - ifFalse: [clsName := (self selectionOfClassCategories value name upTo: $ ) asSymbol]. + |sel| - self valueOfClassName value: clsName. - self class lastSelection: clsName. - - class := Smalltalk at: clsName. - newContents := class class methodDictionary asOrderedCollection - select: [:m | m resources notNil - and: [resourceTypes includes: m resourceType] - ]. - newContents := newContents sort:[:m1 :m2 | m1 selector < m2 selector]. - newContents := newContents collect:[:m| (ResourceMethod new method:m)]. - - self listOfResourceMethods contents:newContents - . - ] +"/ ClassPresentation = #'Class Hierarchy' +"/ ifTrue: [sel := self selectionOfClassHierarchy value] +"/ ifFalse: [sel := self selectionOfClassCategories value]. +"/ +"/ sel notNil ifTrue:[ +"/ resourceClass := sel name. +"/ ]. + self updateResourceMethodList. ! classSelectionUpdate:clsPattern @@ -767,44 +746,49 @@ foundClass := Smalltalk at:(clsPattern printString asSymbol). ]. (foundClass isClass not or:[foundClass name ~= clsPattern]) - ifTrue: - [ + ifTrue: [ classes := allClasses select: [:cls| cls name size >= clsPattern size]. - 1 to: clsPattern size do: - [:i| + 1 to: clsPattern size do: [:i| classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)]. ]. foundClass := classes at: 1 ifAbsent: [nil] ]. - foundClass notNil - ifTrue: - [ - ClassPresentation = #'Class Hierarchy' - ifTrue: - [ - |searchArgs nonSuperclasses| - foundClass isPrivate + + foundClass notNil ifTrue: [ + foundClass isLoaded ifFalse:[ + foundClass autoload. + foundClass := Smalltalk at:foundClass name. + ]. + + ClassPresentation = #'Class Hierarchy' ifTrue: [ + |searchArgs nonSuperclasses hierItem| + + false "foundClass isPrivate" ifFalse: [searchArgs := foundClass withAllSuperclasses reverse] ifTrue: [searchArgs := foundClass owningClass withAllSuperclasses reverse. searchArgs add: foundClass] . (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]]. - self selectionOfClassHierarchy value: (self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs). + hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs. + hierItem notNil ifTrue:[ + self selectionOfClassHierarchy value:hierItem. + ]. ] - ifFalse: - [ - |searchArgs| - foundClass isPrivate + ifFalse: [ + |searchArgs hierItem| + + false "foundClass isPrivate" ifTrue: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass owningClass name with: foundClass name] ifFalse: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass name]. - self selectionOfClassCategories value: (self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs). + hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs. + hierItem notNil ifTrue:[ + self selectionOfClassCategories value: hierItem. + ]. ]. ]. self valueOfClassName value: clsPattern - - ! resourceDoubleClicked @@ -819,6 +803,49 @@ self selectionOfResourceMethod value notNil ifTrue: [self valueOfResourceSelector value: self selectionOfResourceMethod value selector] +! + +updateResourceMethodList + "read the allowed resource methods of the selected class" + + |class className item| + + resourceClass notNil ifTrue:[ + class := Smalltalk at:resourceClass asSymbol. + ]. + class isNil ifTrue:[ + ClassPresentation = #'Class Hierarchy' + ifTrue: [item := self selectionOfClassHierarchy value ] + ifFalse: [item := self selectionOfClassCategories value ]. + item notNil ifTrue:[ + className := item name. + class := Smalltalk at:className asSymbol + ]. + ]. + + class isNil ifTrue: [^self]. + + className := class theNonMetaclass name. + + self withWaitCursorDo: + [ + |newContents| + + resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes]. + + self valueOfClassName value: className. + self class lastSelection: className. + + newContents := class class methodDictionary asOrderedCollection + select: [:m | m resources notNil + and: [resourceTypes includes: m resourceType] + ]. + newContents := newContents sort:[:m1 :m2 | m1 selector < m2 selector]. + newContents := newContents collect:[:m| (ResourceMethod new method:m)]. + + self listOfResourceMethods contents:newContents + . + ] ! ! !ResourceSelectionBrowser methodsFor:'instance creation'! @@ -830,7 +857,7 @@ and aSelector, with allowed aResourceTypes" - |clsName clsNameString| + |clsName clsNameString cls| resourceMethod := aSelector. resourceTypes := aResourceTypes. @@ -838,15 +865,17 @@ resourceClass := nil. aClassOrSymbol isClass - ifTrue: [resourceClass := aClassOrSymbol name] + ifTrue: [cls := aClassOrSymbol. resourceClass := aClassOrSymbol name] ifFalse: [ aClassOrSymbol size > 0 ifTrue:[ - (Smalltalk at: aClassOrSymbol) notNil + (cls := Smalltalk at: aClassOrSymbol) notNil ifTrue: [resourceClass := aClassOrSymbol] ] ]. self valueOfResourceSelector value:(aSelector ? ''). - + cls notNil ifTrue:[ + "/ TODO: update tree + ]. self open. (clsName := self selectionOfClassHierarchy value) isNil ifTrue:[ @@ -890,8 +919,8 @@ (classSelection isNil or:[Smalltalk at: classSelection]) isNil ifTrue: [classSelection := self class lastSelection]. - (classSelection isNil or:[Smalltalk at: classSelection]) isNil - ifTrue: [classSelection := self treeViewContents]. +"/ (classSelection isNil or:[Smalltalk at: classSelection]) isNil +"/ ifTrue: [classSelection := self treeViewContents]. classSelectionBlock := [:clsPattern | self classSelectionUpdate:clsPattern]. self valueOfClassName value: classSelection. @@ -907,11 +936,10 @@ ]. classSelectionBlock value: self valueOfClassName value. - self classSelected. + self updateResourceMethodList. self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil). ^super postBuildWith:aBuilder - ! postOpenWith:aBuilder