class presentation in categories added
authortz
Wed, 22 Jul 1998 16:56:33 +0200
changeset 906 8be0b8d1a2fd
parent 905 5f5d0a415c04
child 907 393a5860fc7d
class presentation in categories added
ResourceSelectionBrowser.st
--- a/ResourceSelectionBrowser.st	Wed Jul 22 13:18:55 1998 +0200
+++ b/ResourceSelectionBrowser.st	Wed Jul 22 16:56:33 1998 +0200
@@ -13,9 +13,8 @@
 
 SelectionBrowser subclass:#ResourceSelectionBrowser
 	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
-		allClasses classSelectionBlock readResourcesProcess
-		mayReadResources'
-	classVariableNames:''
+		allClasses classSelectionBlock'
+	classVariableNames:'ClassPresentation'
 	poolDictionaries:''
 	category:'Interface-Dialogs'
 !
@@ -72,75 +71,82 @@
 
 request: aTitle onSuperclass: aSuperclass andClass: aClass andSelector: aSelector withResourceTypes: resourceTypes
     "opens a ResourceSelectionBrowser 
-	with aTitle
-	on aSuperclassOrSymbol, 
-	and aClassOrSymbol, 
-	and aSelector,
-	with allowed aResourceTypes"
+        with aTitle
+        on aSuperclassOrSymbol, 
+        and aClassOrSymbol, 
+        and aSelector,
+        with allowed aResourceTypes"
     "
     ResourceSelectionBrowser
-	request: 'Select a Resource Selector'
-	onSuperclass: #ApplicationModel 
-	andClass: #ToolApplicationModel 
-	andSelector: #saveIcon 
-	withResourceTypes: #(image) 
+        request: 'Select a Resource Selector'
+        onSuperclass: #ApplicationModel 
+        andClass: #MenuEditor 
+        andSelector: #menuItemImage 
+        withResourceTypes: #(image) 
     "
 
     ^self new
-	title: aTitle;
-	openOnSuperclass: aSuperclass
-	andClass: aClass
-	andSelector: aSelector
-	withResourceTypes: resourceTypes
+        title: aTitle;
+        openOnSuperclass: aSuperclass
+        andClass: aClass
+        andSelector: aSelector
+        withResourceTypes: resourceTypes
 ! !
 
 !ResourceSelectionBrowser class methodsFor:'callbacks - default'!
 
-treeViewChildren
+treeViewClassHierarchyChildren
     "returns the children for the contents (class) of aTreeItem as a block"
 
     ^[:aTreeItem|
-	|classes|
-	classes := OrderedCollection new.    
-	classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:i1 :i2| i1 name < i2 name]).
-	classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]).
-	classes
+        |classes|    
+        classes := OrderedCollection new. 
+        classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
+        classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
+        classes
      ]
 !
 
-treeViewContents
+treeViewClassHierarchyContents
     "returns the default contents of the root of the class tree list"
 
     ^ Object
 
-    "Modified: / 22.4.1998 / 14:44:11 / cg"
 !
 
-treeViewIcon
+treeViewClassHierarchyIcon
     "returns the icon for aTreeItem as a block"
 
     ^[:aTreeItem|
-	|icon|
-	icon := self iconClass.
-	aTreeItem contents isPrivate 
-	ifTrue:
-	[
-	   icon := self iconPrivateClass
-	].
-	icon
+        |icon|
+        aTreeItem contents isClass
+        ifTrue:
+        [
+            icon := self iconClass.
+            aTreeItem contents isPrivate 
+            ifTrue:
+            [
+               icon := self iconPrivateClass
+            ].
+            icon
+        ]
+        ifFalse:
+        [
+            self iconCategory
+        ]
     ]
 
 !
 
-treeViewLabel
+treeViewClassHierarchyLabel
     "returns the label for aTreeItem as a block"
 
     ^[:aTreeItem|
-	|label superCls|
-	label := aTreeItem contents name.
-	(aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)])
-	    ifTrue: [label := label, ' (', superCls name, ')'].
-	label
+        |label superCls|
+        label := aTreeItem contents name.
+        (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)])
+            ifTrue: [label := label, ' (', superCls name, ')'].
+        label
      ]
 
 
@@ -148,6 +154,24 @@
 
 !ResourceSelectionBrowser class methodsFor:'image specs'!
 
+iconCategory
+    "This resource specification was automatically generated
+     by the ImageEditor of ST/X."
+
+    "Do not manually edit this!! If it is corrupted,
+     the ImageEditor may not be able to read the specification."
+
+    "
+     self iconCategory inspect
+     ImageEditor openOnClass:self andSelector:#iconCategory
+    "
+
+    <resource: #image>
+
+    ^Icon
+        constantNamed:#'ResourceSelectionBrowser iconCategory'
+        ifAbsentPut:[(Depth4Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'3L0@@@@@@L3L3L@@@@@@@@3L3@@3L3L3L0CL3@LQDQDQD#CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@L#L3L3L3CL3@@3L3L3L0CL3L@@@@@@@@3L3L0@@@@@@L3L') ; colorMapFromArray:#[0 0 0 255 255 255 170 170 170 127 127 127 255 0 0 0 255 0 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127]; mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'<@O@8@G@3?3@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@3?3@8@G@<@O@') ; yourself); yourself]!
+
 iconClass
     "This resource specification was automatically generated
      by the ImageEditor of ST/X."
@@ -205,11 +229,11 @@
           #window: 
            #(#WindowSpec
               #name: 'Resource Selection Browser'
-              #layout: #(#LayoutFrame 76 0 236 0 675 0 585 0)
+              #layout: #(#LayoutFrame 361 0 289 0 960 0 638 0)
               #label: 'Resource Selection Browser'
               #min: #(#Point 400 300)
               #max: #(#Point 1152 864)
-              #bounds: #(#Rectangle 76 236 676 586)
+              #bounds: #(#Rectangle 361 289 961 639)
               #usePreferredExtent: false
           )
           #component: 
@@ -229,30 +253,73 @@
                                #(#SpecCollection
                                   #collection: 
                                    #(
-                                     #(#LabelSpec
-                                        #name: 'ClassHierarchyLabel'
-                                        #layout: #(#LayoutFrame 0 0.0 2 0 0 1.0 23 0)
-                                        #label: ' Class Hierarchy:'
-                                        #level: 1
-                                        #adjust: #left
+                                     #(#HorizontalPanelViewSpec
+                                        #name: 'HorizontalPanel2'
+                                        #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0)
+                                        #component: 
+                                         #(#SpecCollection
+                                            #collection: 
+                                             #(
+                                               #(#RadioButtonSpec
+                                                  #name: 'ClassCategoriesRadioButton'
+                                                  #label: 'Class Categories'
+                                                  #translateLabel: true
+                                                  #model: #selectionOfClassPresentation
+                                                  #isTriggerOnDown: true
+                                                  #lampColor: #(#Color 0.0 0.0 0.0)
+                                                  #select: #'Class Categories'
+                                                  #extent: #(#Point 150 21)
+                                              )
+                                               #(#RadioButtonSpec
+                                                  #name: 'ClassHierarchyRadioButton'
+                                                  #label: 'Class Hierarchy'
+                                                  #translateLabel: true
+                                                  #model: #selectionOfClassPresentation
+                                                  #isTriggerOnDown: true
+                                                  #lampColor: #(#Color 0.0 0.0 0.0)
+                                                  #select: #'Class Hierarchy'
+                                                  #extent: #(#Point 145 21)
+                                              )
+                                            )
+                                        )
+                                        #horizontalLayout: #leftSpace
+                                        #verticalLayout: #fit
+                                        #horizontalSpace: 3
+                                        #verticalSpace: 3
                                     )
                                      #(#SelectionInTreeViewSpec
-                                        #name: 'listOfClassesView'
+                                        #name: 'listOfClassHierarchyView'
                                         #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -60 1.0)
                                         #tabable: true
-                                        #model: #selectionOfClass
+                                        #model: #selectionOfClassHierarchy
                                         #hasHorizontalScrollBar: true
                                         #hasVerticalScrollBar: true
                                         #miniScrollerHorizontal: true
                                         #showDirectoryIndicatorForRoot: false
                                         #showDirectoryIndicator: true
                                         #valueChangeSelector: #classSelected
-                                        #hierarchicalList: #rootOfClasses
+                                        #hierarchicalList: #rootOfClassHierarchy
                                         #validateDoubleClickSelector: #validateDoubleClick:
-                                        #contentsSelector: #treeViewContents
-                                        #labelSelector: #treeViewLabel
-                                        #childrenSelector: #treeViewChildren
-                                        #iconSelector: #treeViewIcon
+                                        #contentsSelector: #treeViewClassHierarchyContents
+                                        #labelSelector: #treeViewClassHierarchyLabel
+                                        #childrenSelector: #treeViewClassHierarchyChildren
+                                        #iconSelector: #treeViewClassHierarchyIcon
+                                    )
+                                     #(#SelectionInTreeViewSpec
+                                        #name: 'listOfClassCategoriesView'
+                                        #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -60 1.0)
+                                        #tabable: true
+                                        #model: #selectionOfClassCategories
+                                        #hasHorizontalScrollBar: true
+                                        #hasVerticalScrollBar: true
+                                        #miniScrollerHorizontal: true
+                                        #showDirectoryIndicatorForRoot: false
+                                        #showDirectoryIndicator: true
+                                        #valueChangeSelector: #classSelected
+                                        #hierarchicalList: #rootOfClassCategories
+                                        #validateDoubleClickSelector: #validateDoubleClick:
+                                        #childrenSelector: #treeViewClassCategoryChildren
+                                        #iconSelector: #treeViewClassCategoryIcon
                                     )
                                      #(#InputFieldSpec
                                         #name: 'classNameInputField'
@@ -260,48 +327,6 @@
                                         #tabable: true
                                         #model: #valueOfClassName
                                     )
-                                     #(#HorizontalPanelViewSpec
-                                        #name: 'HorizontalPanelView'
-                                        #layout: #(#LayoutFrame 0 0.0 -28 1 0 1.0 -4 1)
-                                        #component: 
-                                         #(#SpecCollection
-                                            #collection: 
-                                             #(
-                                               #(#LabelSpec
-                                                  #name: 'CreateLabel'
-                                                  #label: 'Create: '
-                                                  #adjust: #right
-                                                  #extent: #(#Point 72 24)
-                                              )
-                                               #(#ActionButtonSpec
-                                                  #name: 'CreateClassButton'
-                                                  #activeHelpKey: #dss
-                                                  #label: 'Class'
-                                                  #model: #createClass:
-                                                  #actionValue: 'class'
-                                                  #extent: #(#Point 72 24)
-                                              )
-                                               #(#ActionButtonSpec
-                                                  #name: 'CreateSubclassButton'
-                                                  #activeHelpKey: #dss
-                                                  #label: 'Subclass'
-                                                  #model: #createClass:
-                                                  #actionValue: 'subclass'
-                                                  #extent: #(#Point 72 24)
-                                              )
-                                               #(#ActionButtonSpec
-                                                  #name: 'CreatePrivateClassButton'
-                                                  #activeHelpKey: #dss
-                                                  #label: 'Private'
-                                                  #model: #createClass:
-                                                  #actionValue: 'private'
-                                                  #extent: #(#Point 73 24)
-                                              )
-                                            )
-                                        )
-                                        #horizontalLayout: #fit
-                                        #verticalLayout: #fit
-                                    )
                                   )
                               )
                           )
@@ -322,6 +347,7 @@
                                         #dataList: #listOfResourceMethods
                                         #useIndex: false
                                         #has3Dsepartors: true
+                                        #has3Dseparators: true
                                         #doubleClickSelector: #resourceDoubleClicked
                                         #columnHolder: #resourceMethodColumns
                                         #valueChangeSelector: #resourceSelected
@@ -333,45 +359,6 @@
                                         #tabable: true
                                         #model: #valueOfResourceSelector
                                     )
-                                     #(#HorizontalPanelViewSpec
-                                        #name: 'HorizontalPanel1'
-                                        #layout: #(#LayoutFrame 2 0.0 -28 1 -2 1.0 -4 1.0)
-                                        #component: 
-                                         #(#SpecCollection
-                                            #collection: 
-                                             #(
-                                               #(#ActionButtonSpec
-                                                  #name: 'HelpButton'
-                                                  #activeHelpKey: #dss
-                                                  #label: 'Help'
-                                                  #model: #openHTMLDocument:
-                                                  #initiallyDisabled: true
-                                                  #enableChannel: #helpEnabled
-                                                  #actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
-                                                  #extent: #(#Point 96 24)
-                                              )
-                                               #(#ActionButtonSpec
-                                                  #name: 'cancelButton'
-                                                  #activeHelpKey: #commitCancel
-                                                  #label: 'Cancel'
-                                                  #tabable: true
-                                                  #model: #cancel
-                                                  #extent: #(#Point 96 24)
-                                              )
-                                               #(#ActionButtonSpec
-                                                  #name: 'okButton'
-                                                  #activeHelpKey: #commitOK
-                                                  #label: 'OK'
-                                                  #tabable: true
-                                                  #model: #accept
-                                                  #isDefault: true
-                                                  #extent: #(#Point 96 24)
-                                              )
-                                            )
-                                        )
-                                        #horizontalLayout: #fit
-                                        #verticalLayout: #fit
-                                    )
                                   )
                               )
                           )
@@ -379,6 +366,45 @@
                     )
                     #handles: #(#Any 0.5 1.0)
                 )
+                 #(#HorizontalPanelViewSpec
+                    #name: 'HorizontalPanel1'
+                    #layout: #(#LayoutFrame 2 0.0 -30 1 -2 1.0 -4 1.0)
+                    #component: 
+                     #(#SpecCollection
+                        #collection: 
+                         #(
+                           #(#ActionButtonSpec
+                              #name: 'HelpButton'
+                              #activeHelpKey: #dss
+                              #label: 'Help'
+                              #model: #openHTMLDocument:
+                              #initiallyDisabled: true
+                              #enableChannel: #helpEnabled
+                              #actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
+                              #extent: #(#Point 196 26)
+                          )
+                           #(#ActionButtonSpec
+                              #name: 'cancelButton'
+                              #activeHelpKey: #commitCancel
+                              #label: 'Cancel'
+                              #tabable: true
+                              #model: #cancel
+                              #extent: #(#Point 196 26)
+                          )
+                           #(#ActionButtonSpec
+                              #name: 'okButton'
+                              #activeHelpKey: #commitOK
+                              #label: 'OK'
+                              #tabable: true
+                              #model: #accept
+                              #isDefault: true
+                              #extent: #(#Point 196 24)
+                          )
+                        )
+                    )
+                    #horizontalLayout: #fit
+                    #verticalLayout: #fit
+                )
               )
           )
       )
@@ -451,24 +477,64 @@
     ^ holder
 !
 
-rootOfClasses
+rootOfClassCategories
+    "returns the value holder for the root of the class tree list"
+
+    |holder|                                
+
+    (holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[
+        ClassPresentation = #'Class Categories' ifTrue: [
+        builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')].
+    ].
+    ^ holder
+
+
+!
+
+rootOfClassHierarchy
     "returns the value holder for the root of the class tree list"
 
     |holder|
-    (holder := builder bindingAt:#rootOfClasses) isNil ifTrue:[
-        builder aspectAt:#rootOfClasses put: (holder := TreeItem new)
+
+
+    (holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[
+        ClassPresentation = #'Class Hierarchy' ifTrue: [
+        builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)]
     ].
     ^ holder
 
 
 !
 
-selectionOfClass
+selectionOfClassCategories
+    "returns the value holder for the selected class of the class tree list"
+
+    |holder|           
+    (holder := builder bindingAt:#selectionOfClassCategories) isNil ifTrue:[
+        builder aspectAt:#selectionOfClassCategories put:(holder :=  ValueHolder new). 
+    ].
+    ^ holder
+!
+
+selectionOfClassHierarchy
     "returns the value holder for the selected class of the class tree list"
 
+    |holder|           
+    (holder := builder bindingAt:#selectionOfClassHierarchy) isNil ifTrue:[
+        builder aspectAt:#selectionOfClassHierarchy put:(holder :=  ValueHolder new). 
+    ].
+    ^ holder
+!
+
+selectionOfClassPresentation
+    "returns the value holder for the selected class presentation"
+
     |holder|
-    (holder := builder bindingAt:#selectionOfClass) isNil ifTrue:[
-	builder aspectAt:#selectionOfClass put:(holder :=  ValueHolder new).
+    (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[
+        builder aspectAt:#selectionOfClassPresentation put:(holder :=  RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')).
+        holder onChangeSend: #value to: [holder value = #'Class Hierarchy'
+            ifTrue:  [ClassPresentation := holder value.(builder componentAt: #listOfClassHierarchyView)  root: self rootOfClassHierarchy.  (builder componentAt: #listOfClassHierarchyView)  raise. classSelectionBlock value: self valueOfClassName value]
+            ifFalse: [ClassPresentation := holder value.(builder componentAt: #listOfClassCategoriesView) root: self rootOfClassCategories. (builder componentAt: #listOfClassCategoriesView) raise. classSelectionBlock value: self valueOfClassName value]]
     ].
     ^ holder
 !
@@ -486,9 +552,9 @@
 valueOfClassName
     "returns the value holder for the name of the class"
 
-    |holder|
+    |holder|                   
     (holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[
-	builder aspectAt:#valueOfClassName put:(holder :=  '' asValue).
+        builder aspectAt:#valueOfClassName put:(holder :=  '' asValue).
     ].
     ^ holder
 !
@@ -505,7 +571,47 @@
 
 !ResourceSelectionBrowser methodsFor:'callbacks - class list'!
 
-treeViewContents
+treeViewClassCategoryChildren
+    "returns the children for the contents (class) of aTreeItem as a block"
+
+    ^[:aTreeItem|
+        |children|
+         children := OrderedCollection new.
+         aTreeItem contents = ''
+         ifTrue:
+         [
+            children := (self treeViewClassHierarchyContents withAllSubclasses collect: [:cls| cls category]) asSet asSortedCollection.
+            children := children collect: [:child| TreeItem name: child contents: 'Category']
+         ].
+         aTreeItem contents = 'Category'
+         ifTrue:
+         [
+            children := self treeViewClassHierarchyContents withAllSubclasses select: [:cls| cls category = aTreeItem name and: [cls isPrivate not]].
+            children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name].
+            children := children collect: [:child| TreeItem name: child name contents: child]
+         ].
+         aTreeItem contents isClass
+         ifTrue:
+         [
+            children := aTreeItem contents privateClasses.
+            children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name].
+            children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child]
+         ].
+         children
+     ]
+
+
+!
+
+treeViewClassCategoryIcon
+    "returns the icon for aTreeItem as a block"
+
+    ^self class treeViewClassHierarchyIcon
+
+
+!
+
+treeViewClassHierarchyContents
     "returns the contents of the root of the class tree list"
 
     |cls|
@@ -513,7 +619,7 @@
     resourceSuperclass notNil ifTrue:[
         cls := Smalltalk at: resourceSuperclass.
     ].
-    ^ cls ? self class treeViewContents
+    ^ cls ? self class treeViewClassHierarchyContents
 
     "Modified: / 22.4.1998 / 14:43:19 / cg"
 !
@@ -521,7 +627,7 @@
 validateDoubleClick: aTreeItem
     "returns whether a class may be selected"
 
-    ^aTreeItem contents ~~ self treeViewContents
+    ^aTreeItem contents ~= '' and: [aTreeItem contents ~~ self treeViewClassHierarchyContents]       
 
 
 
@@ -532,12 +638,19 @@
 classSelected
     "after a class selection, read the allowed resource methods of the selected class"
 
-    (mayReadResources not or: [self selectionOfClass value isNil]) ifTrue: [^nil].
+    ClassPresentation = #'Class Hierarchy'
+        ifTrue:  [self selectionOfClassHierarchy  value isNil ifTrue: [^nil]]
+        ifFalse: [self selectionOfClassCategories value isNil ifTrue: [^nil]].
+
     self withWaitCursorDo:
     [
-        |clsName|
+        |clsName|           
         resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
-        clsName := (self selectionOfClass value name upTo: $ ) asSymbol.
+
+        ClassPresentation = #'Class Hierarchy'
+            ifTrue:  [clsName := (self selectionOfClassHierarchy  value name upTo: $ ) asSymbol]
+            ifFalse: [clsName := (self selectionOfClassCategories value name upTo: $ ) asSymbol].
+
         self valueOfClassName value: clsName.
         self class lastSelection: clsName.
         self listOfResourceMethods contents:
@@ -549,57 +662,6 @@
     ]
 !
 
-createClass: what
-    "creates a class, a subclass, or a private class of the selected class"
-
-    |clsCandidat cls|
-
-    clsCandidat := self valueOfClassName value asSymbol.
-
-    (Smalltalk at: clsCandidat) notNil 
-	ifTrue: [^self warn: 'Cannot create class ', clsCandidat asBoldText,
-		'!!\Key with that name in dictionary ' withCRs, 'Smalltalk' asBoldText, ' detected.'].
-
-    cls := self selectionOfClass value contents.
-    what = 'class' ifTrue: [cls := cls superclass].
-
-    cls isNil ifTrue: [^self warn: 'May not create class with superclass ', 'nil' asBoldText, '!!'].
-
-    what = 'private' 
-    ifFalse: 
-    [
-	cls subclass: clsCandidat
-	    instanceVariableNames:''
-	    classVariableNames:''
-	    poolDictionaries:''
-	    category: cls category
-    ]
-    ifTrue:
-    [
-	|superClsCandidate|
-	superClsCandidate := (Dialog 
-		request: 'Enter name of superclass of private class.'
-		initialAnswer: 'Object') asSymbol.
-	(Smalltalk at: superClsCandidate) isNil ifTrue: [^self warn: 'Class ', superClsCandidate asBoldText, ' does not exist!!'].
-
-	((superClsCandidate := Smalltalk at: superClsCandidate) isClass and: [superClsCandidate isPrivate not])
-	    ifFalse: [^self warn: 'May not create private class with superclass ', superClsCandidate asBoldText, '!!'].
-	superClsCandidate subclass: clsCandidat
-	    instanceVariableNames:''
-	    classVariableNames:''
-	    poolDictionaries:''
-	    privateIn: cls
-    ].
-
-    allClasses := Object withAllSubclasses.
-
-    what = 'class' 
-	ifTrue:  [self selectionOfClass value parent changed: #children]
-	ifFalse: [self selectionOfClass value changed: #children].
-
-    classSelectionBlock value: self valueOfClassName value 
-!
-
 resourceDoubleClicked
     "after a double click on resource method, accept it and close"
 
@@ -643,7 +705,9 @@
 
     self open.
 
-    (clsName := self selectionOfClass value) isNil ifTrue: [^nil].
+    (clsName := self selectionOfClassHierarchy value) isNil 
+        ifTrue:  [(clsName := self selectionOfClassCategories value) isNil ifTrue:  [^nil]].
+
     clsName := (clsName name upTo: $ ) asSymbol.
 
     ((Smalltalk at: clsName) isClass and: [accept value]) 
@@ -658,25 +722,13 @@
 
 !ResourceSelectionBrowser methodsFor:'startup / release'!
 
-closeCancel
-    "after a cancel, terminate readResourcesProcess"
-
-    readResourcesProcess notNil ifTrue: [readResourcesProcess terminate].
-
-    super closeCancel
-
-
-
-!
-
 postBuildWith:aBuilder
     "after building and before opening,  
-     create a class selection block, an entry completion block for the class name field, 
-     and select the class and the resource selector"
+     create a class selection block, an entry completion block for the class name field"
 
     |classSelection classNameInputField|
-
-    allClasses := self treeViewContents withAllSubclasses reject: [:cls| cls isPrivate].
+     
+    allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate].
     classSelection :=  resourceClass. 
 
     (classSelection isNil or:[Smalltalk at: classSelection]) isNil 
@@ -703,16 +755,29 @@
         ].          
         foundClass notNil
         ifTrue:
-        [                            
-            |superClasses nonSuperclasses item cls|
-            ((cls := Smalltalk at: classSelection) notNil and: [cls isPrivate])
-                ifFalse: [superClasses := foundClass withAllSuperclasses reverse]
-                ifTrue:  [superClasses := cls owningClass withAllSuperclasses reverse. superClasses add: cls]
-.                                  
-            (nonSuperclasses := self treeViewContents allSuperclasses) notNil 
-                ifTrue: [superClasses := superClasses reject: [:cls| nonSuperclasses includes: cls]].
-            item := self rootOfClasses detectChild:[:child :arg| child contents == arg] arguments:superClasses.
-            item notNil ifTrue:[self selectionOfClass value:item]  
+        [           
+            ClassPresentation = #'Class Hierarchy'
+            ifTrue:  
+            [
+                |searchArgs nonSuperclasses|
+                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).
+            ]
+            ifFalse: 
+            [
+                |searchArgs|
+                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).
+            ].
         ].
         self valueOfClassName value: clsPattern
     ].
@@ -720,27 +785,27 @@
 
     (classNameInputField := builder componentAt: #classNameInputField) entryCompletionBlock:
     [:value|
-        |what|
+        |what oldClassName|
+        oldClassName := classNameInputField contents.
         what := Smalltalk classnameCompletion: value withoutSpaces.
         classNameInputField contents:what first.
-        (what at:2) size ~~ 1 ifTrue:[Screen current beep].
+        oldClassName = classNameInputField contents ifTrue:[classNameInputField flash].
         classSelectionBlock value: classNameInputField contents
     ].
 
-    mayReadResources := false.
-    classSelectionBlock value: classSelection.
-
-    readResourcesProcess := 
-    [
-        mayReadResources := true.
-        self classSelected.
-        self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
-        readResourcesProcess := nil.
-    ] forkAt: 4. 
-
     ^super postBuildWith:aBuilder
 
-    "Modified: / 22.4.1998 / 14:48:22 / cg"
+!
+
+postOpenWith:aBuilder
+    "after opening, raise the the view do select class and resource method"
+
+    ClassPresentation = #'Class Hierarchy'
+            ifTrue:  [(builder componentAt: #listOfClassHierarchyView) raise].
+
+    classSelectionBlock value: self valueOfClassName value.
+    self classSelected.
+    self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
 ! !
 
 !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!