--- 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