#UI_ENHANCEMENT by cg draft
authorClaus Gittinger <cg@exept.de>
Fri, 02 Feb 2018 00:54:11 +0100
changeset 3531 cf715db898dd
parent 3530 e26aace861c6
child 3532 12b7b904b5e1
#UI_ENHANCEMENT by cg class: ResourceSelectionBrowser finally, some improvements to this ugly old beast added:15 methods comment/format in: #classSelected #postBuildWith: #postOpenWith: #rootOfClassCategories #treeViewClassHierarchyContents #updateResourceMethodList changed: #classSelectionUpdate: #listOfClasses #openOnSuperclass:andClass:andSelector:withResourceTypes: #resourceSelected #rootOfClassHierarchy #selectionOfClassPresentation #treeViewClassCategoryChildren #treeViewClassCategoryIcon category of: #openOnSuperclass:andClass:andSelector:withResourceTypes: #treeViewClassCategoryChildren #treeViewClassCategoryIcon #treeViewClassHierarchyContents #validateDoubleClick: class: ResourceSelectionBrowser class added: #title:onSuperclass:andClass:andSelector:withResourceTypes: removed: #treeViewClassHierarchyChildren #treeViewClassHierarchyContents #treeViewClassHierarchyIcon #treeViewClassHierarchyLabel comment/format in: #documentation #request:onSuperclass:andClass:andSelector:withResourceTypes: changed: #windowSpec class: ResourceSelectionBrowser::ResourceMethod added: #method
ResourceSelectionBrowser.st
--- a/ResourceSelectionBrowser.st	Thu Jan 25 21:35:49 2018 +0100
+++ b/ResourceSelectionBrowser.st	Fri Feb 02 00:54:11 2018 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1997-1998 by eXept Software AG
               All Rights Reserved
@@ -15,8 +17,9 @@
 
 SelectionBrowser subclass:#ResourceSelectionBrowser
 	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
-		allClasses classSelectionBlock'
-	classVariableNames:'ClassPresentation'
+		allClasses classSelectionBlock classFilter packageFilter
+		metaClassOnly existingOnly filter classPresentation'
+	classVariableNames:'LastClassPresentation'
 	poolDictionaries:''
 	category:'Interface-Dialogs'
 !
@@ -58,6 +61,10 @@
         resourceTypes           <Array>         allowed resource types
         allClasses              <Array>         list of the subclasses of resourceSuperclass
         classSelectionBlock     <Block>         by evaluating this block the class selection is done
+        classFilter             <Block>         if non-nil, given a class, has to return true for a class to be shown
+        packageFilter           <Block>         if non-nil, given a package, has to return true for a class to be shown
+        existingOnly            <Boolean>       if set, only classes with existing resources are shown (for load dialogs);
+                                                otherwise, empty classes are also shown (for save dialogs)
 
     [start with:]
         ResourceSelectionBrowser open
@@ -70,117 +77,47 @@
 !ResourceSelectionBrowser class methodsFor:'instance creation'!
 
 request:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
-    "opens a ResourceSelectionBrowser; return a Message-object or nil."
+    "opens a ResourceSelectionBrowser; 
+     return a Message-object (whoInfo) or nil."
 
-    ^ (self new
-        title: aTitle)
-            openOnSuperclass:aSuperclass
-            andClass:aClassOrClassName
-            andSelector:aSelector
-            withResourceTypes:resourceTypes
+    ^ (self 
+        title:aTitle 
+        onSuperclass:aSuperclass 
+        andClass:aClassOrClassName andSelector:aSelector 
+        withResourceTypes:resourceTypes
+      ) openAndLetUserChoose
 
     "
      ResourceSelectionBrowser
         request: 'Select a Resource Selector'
         onSuperclass: #ApplicationModel 
-        andClassNamed: #MenuEditor 
-        andSelector: #menuItemImage 
+        andClass: MenuEditor andSelector: #menuItemImage 
         withResourceTypes: #(image) 
     "
-! !
-
-!ResourceSelectionBrowser class methodsFor:'callbacks-default'!
-
-treeViewClassHierarchyChildren
-    "returns the children for the contents (class) of aTreeItem as a block"
-
-    "/ cg: tz's algorithm was very-very slow, 
-    "/ (it enumerated classes hundreds of times,
-    "/  leading to a square runtime behavior
-    "/  - i.e. very slow scrolling )
-    "/ Speed up things by caching facts while enumerating
-    "/ classes once only.
-
-    |subclassesAndPrivateClassesPerClass|
-
-    subclassesAndPrivateClassesPerClass := IdentityDictionary new.
-
-    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:[
-            superclass := cls superclass.
-            superclass notNil ifTrue:[
-                info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil.
-                info isNil ifTrue:[
-                    subclassesAndPrivateClassesPerClass at:superclass put:(info := Array with:IdentitySet new 
-                                                                                         with:IdentitySet new).
-                ].
-                (info at:1) add:cls
-            ]
-"/        ]
-    ].
-
-    ^ [:aTreeItem|
-        |classes itemClass info|
-
-        classes := OrderedCollection new. 
-        itemClass := aTreeItem contents.
-        info := subclassesAndPrivateClassesPerClass at:itemClass ifAbsent:nil.
-        info notNil ifTrue:[
-            classes addAll:((info at:1) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
-            classes addAll:((info at:2) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
-        ].
-        classes
-     ]
 !
 
-treeViewClassHierarchyContents
-    "returns the default contents of the root of the class tree list"
-
-    ^ Object
-
-!
-
-treeViewClassHierarchyIcon
-    "returns the icon for aTreeItem as a block"
-
-    ^[:aTreeItem|
-        |icon|
+title:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
+    "creates and returns a ResourceSelectionBrowser but does not open it.
+     To open,
+        send the returned browser an openAndLetUserChoose message,
+        which returns the selected resource method's info (whoInfo) or nil on cancel.
+     Use this to set additional filters before opening"
 
-        aTreeItem contents isClass ifTrue:[
-            icon := self iconClass.
-            aTreeItem contents isPrivate ifTrue:[
-               icon := self iconPrivateClass
-            ].
-            icon
-        ] ifFalse:[
-            self iconCategory
-        ]
-    ]
-
-!
+    ^ (self new
+        title: aTitle)
+            onSuperclass:aSuperclass
+            andClass:aClassOrClassName
+            andSelector:aSelector
+            withResourceTypes:resourceTypes
 
-treeViewClassHierarchyLabel
-    "returns the label for aTreeItem as a block"
-
-    ^[:aTreeItem|
-        |label superCls itemContents|
-
-        itemContents := aTreeItem contents.
-        label := itemContents name.
-"/        (itemContents isPrivate 
-"/        and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)])
-"/            ifTrue: [label := label, ' (', superCls name, ')'].
-        label
-     ]
+    "
+     (ResourceSelectionBrowser
+        title: 'Select a Resource Selector'
+        onSuperclass: #ApplicationModel 
+        andClass: MenuEditor andSelector: #menuItemImage 
+        withResourceTypes: #(image)
+     ) openAndLetUserChoose
+    "
 ! !
 
 !ResourceSelectionBrowser class methodsFor:'image specs'!
@@ -295,196 +232,256 @@
     <resource: #canvas>
 
     ^ 
-     #(FullSpec
-        name: windowSpec
-        window: 
-       (WindowSpec
-          label: 'Resource Selection Browser'
-          name: 'Resource Selection Browser'
-          min: (Point 400 300)
-          bounds: (Rectangle 12 22 612 372)
-        )
-        component: 
-       (SpecCollection
-          collection: (
-           (VariableHorizontalPanelSpec
-              name: 'VariableHorizontalPanel'
-              layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 -36 1.0)
-              component: 
-             (SpecCollection
-                collection: (
-                 (ViewSpec
-                    name: 'Box1'
-                    component: 
-                   (SpecCollection
-                      collection: (
-                       (HorizontalPanelViewSpec
-                          name: 'HorizontalPanel2'
-                          layout: (LayoutFrame 0 0 2 0 297 0 23 0)
-                          horizontalLayout: leftSpace
-                          verticalLayout: fit
-                          horizontalSpace: 3
-                          verticalSpace: 3
-                          component: 
-                         (SpecCollection
-                            collection: (
-                             (RadioButtonSpec
-                                label: 'Categories'
-                                name: 'ClassCategoriesRadioButton'
-                                translateLabel: true
-                                model: selectionOfClassPresentation
-                                isTriggerOnDown: true
-                                lampColor: (Color 0.0 0.0 0.0)
-                                select: #'Class Categories'
-                                extent: (Point 124 21)
-                              )
-                             (RadioButtonSpec
-                                label: 'Hierarchy'
-                                name: 'ClassHierarchyRadioButton'
-                                translateLabel: true
-                                model: selectionOfClassPresentation
-                                isTriggerOnDown: true
-                                lampColor: (Color 0.0 0.0 0.0)
-                                select: #'Class Hierarchy'
-                                extent: (Point 145 21)
-                              )
+    #(FullSpec
+       name: windowSpec
+       uuid: 'fb378b3c-07aa-11e8-8563-b8f6b1108e05'
+       window: 
+      (WindowSpec
+         label: 'Resource Selection Browser'
+         name: 'Resource Selection Browser'
+         uuid: 'f1361a68-0791-11e8-8563-b8f6b1108e05'
+         min: (Point 400 300)
+         bounds: (Rectangle 0 0 644 460)
+       )
+       component: 
+      (SpecCollection
+         collection: (
+          (VariableHorizontalPanelSpec
+             name: 'VariableHorizontalPanel'
+             layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 -36 1.0)
+             uuid: 'f1361c5c-0791-11e8-8563-b8f6b1108e05'
+             component: 
+            (SpecCollection
+               collection: (
+                (ViewSpec
+                   name: 'Box1'
+                   uuid: 'f1361df6-0791-11e8-8563-b8f6b1108e05'
+                   component: 
+                  (SpecCollection
+                     collection: (
+                      (HorizontalPanelViewSpec
+                         name: 'HorizontalPanel2'
+                         layout: (LayoutFrame 0 0 2 0 297 0 23 0)
+                         uuid: 'f1361ebe-0791-11e8-8563-b8f6b1108e05'
+                         horizontalLayout: leftSpace
+                         verticalLayout: fit
+                         horizontalSpace: 3
+                         verticalSpace: 3
+                         component: 
+                        (SpecCollection
+                           collection: (
+                            (RadioButtonSpec
+                               label: 'Flat'
+                               name: 'RadioButton1'
+                               uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
+                               translateLabel: true
+                               model: selectionOfClassPresentation
+                               isTriggerOnDown: true
+                               lampColor: (Color 0.0 0.0 0.0)
+                               select: Flat
+                               extent: (Point 80 21)
+                             )
+                            (RadioButtonSpec
+                               label: 'Categories'
+                               name: 'ClassCategoriesRadioButton'
+                               uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
+                               translateLabel: true
+                               model: selectionOfClassPresentation
+                               isTriggerOnDown: true
+                               lampColor: (Color 0.0 0.0 0.0)
+                               select: #'Class Categories'
+                               extent: (Point 124 21)
+                             )
+                            (RadioButtonSpec
+                               label: 'Hierarchy'
+                               name: 'ClassHierarchyRadioButton'
+                               uuid: 'f136233c-0791-11e8-8563-b8f6b1108e05'
+                               translateLabel: true
+                               model: selectionOfClassPresentation
+                               isTriggerOnDown: true
+                               lampColor: (Color 0.0 0.0 0.0)
+                               select: #'Class Hierarchy'
+                               extent: (Point 145 21)
                              )
-                           
-                          )
-                        )
-                       (SelectionInTreeViewSpec
-                          name: 'listOfClassHierarchyView'
-                          layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
-                          tabable: true
-                          model: selectionOfClassHierarchy
-                          hasHorizontalScrollBar: true
-                          hasVerticalScrollBar: true
-                          miniScrollerHorizontal: true
-                          showDirectoryIndicatorForRoot: false
-                          showDirectoryIndicator: true
-                          valueChangeSelector: classSelected
-                          hierarchicalList: rootOfClassHierarchy
-                          validateDoubleClickSelector: validateDoubleClick:
-                          contentsSelector: treeViewClassHierarchyContents
-                          labelSelector: treeViewClassHierarchyLabel
-                          childrenSelector: treeViewClassHierarchyChildren
-                          iconSelector: treeViewClassHierarchyIcon
-                          highlightMode: line
-                        )
-                       (SelectionInTreeViewSpec
-                          name: 'listOfClassCategoriesView'
-                          layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
-                          tabable: true
-                          model: selectionOfClassCategories
-                          hasHorizontalScrollBar: true
-                          hasVerticalScrollBar: true
-                          miniScrollerHorizontal: true
-                          showRoot: false
-                          showDirectoryIndicator: true
-                          valueChangeSelector: classSelected
-                          hierarchicalList: rootOfClassCategories
-                          validateDoubleClickSelector: validateDoubleClick:
-                          childrenSelector: treeViewClassCategoryChildren
-                          iconSelector: treeViewClassCategoryIcon
-                          highlightMode: line
-                        )
-                       (InputFieldSpec
-                          name: 'classNameInputField'
-                          layout: (LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
-                          tabable: true
-                          model: classNameHolder
-                          acceptOnLeave: true
-                          acceptOnLostFocus: true
-                          acceptOnPointerLeave: true
-                        )
+                            )
+                          
+                         )
+                       )
+                      (SequenceViewSpec
+                         name: 'listOfClassesView'
+                         layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
+                         uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
+                         tabable: true
+                         model: indexOfSelectedClassInFlatList
+                         hasHorizontalScrollBar: true
+                         hasVerticalScrollBar: true
+                         miniScrollerHorizontal: true
+                         useIndex: true
+                         sequenceList: listOfClassNames
+                       )
+                      (SelectionInTreeViewSpec
+                         name: 'listOfClassHierarchyView'
+                         layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
+                         uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
+                         tabable: true
+                         model: selectionOfClassHierarchy
+                         hasHorizontalScrollBar: true
+                         hasVerticalScrollBar: true
+                         miniScrollerHorizontal: true
+                         showDirectoryIndicatorForRoot: false
+                         showDirectoryIndicator: true
+                         valueChangeSelector: classSelected
+                         hierarchicalList: rootOfClassHierarchy
+                         validateDoubleClickSelector: validateDoubleClick:
+                         contentsSelector: treeViewClassHierarchyContents
+                         labelSelector: treeViewClassHierarchyLabel
+                         childrenSelector: treeViewClassHierarchyChildren
+                         iconSelector: treeViewClassHierarchyIcon
+                         highlightMode: line
+                       )
+                      (SelectionInTreeViewSpec
+                         name: 'listOfClassCategoriesView'
+                         layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
+                         uuid: 'f13627ba-0791-11e8-8563-b8f6b1108e05'
+                         tabable: true
+                         model: selectionOfClassCategories
+                         hasHorizontalScrollBar: true
+                         hasVerticalScrollBar: true
+                         miniScrollerHorizontal: true
+                         showRoot: false
+                         showDirectoryIndicator: true
+                         valueChangeSelector: classSelected
+                         hierarchicalList: rootOfClassCategories
+                         validateDoubleClickSelector: validateDoubleClick:
+                         childrenSelector: treeViewClassCategoryChildren
+                         iconSelector: treeViewClassCategoryIcon
+                         highlightMode: line
+                       )
+                      (InputFieldSpec
+                         name: 'classNameInputField'
+                         layout: (LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
+                         uuid: 'f1362922-0791-11e8-8563-b8f6b1108e05'
+                         tabable: true
+                         model: classNameHolder
+                         acceptOnLeave: true
+                         acceptOnLostFocus: true
+                         acceptOnPointerLeave: true
                        )
-                     
-                    )
-                  )
-                 (ViewSpec
-                    name: 'Box2'
-                    component: 
-                   (SpecCollection
-                      collection: (
-                       (DataSetSpec
-                          name: 'resourcesDataSetView'
-                          layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -24 1.0)
-                          model: selectionOfResourceMethod
-                          hasHorizontalScrollBar: true
-                          hasVerticalScrollBar: true
-                          miniScrollerHorizontal: true
-                          rowClassName: 'ResourceSelectionBrowser::Row'
-                          dataList: listOfResourceMethods
-                          useIndex: false
-                          has3Dsepartors: true
-                          has3Dseparators: true
-                          doubleClickSelector: resourceDoubleClicked
-                          columnHolder: resourceMethodColumns
-                          valueChangeSelector: resourceSelected
-                          verticalSpacing: 1
-                        )
-                       (InputFieldSpec
-                          name: 'selectorInputField'
-                          layout: (LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
-                          tabable: true
-                          model: resourceSelectorHolder
-                          acceptOnLeave: true
-                          acceptOnLostFocus: true
-                          acceptOnPointerLeave: true
-                        )
+                      )
+                    
+                   )
+                 )
+                (ViewSpec
+                   name: 'Box2'
+                   uuid: 'f1362aee-0791-11e8-8563-b8f6b1108e05'
+                   component: 
+                  (SpecCollection
+                     collection: (
+                      (VariableVerticalPanelSpec
+                         name: 'ResourcePanel'
+                         layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -24 1.0)
+                         uuid: '51c4b91e-07a8-11e8-8563-b8f6b1108e05'
+                         component: 
+                        (SpecCollection
+                           collection: (
+                            (DataSetSpec
+                               name: 'resourcesDataSetView'
+                               uuid: 'f1362bac-0791-11e8-8563-b8f6b1108e05'
+                               model: selectionOfResourceMethod
+                               hasHorizontalScrollBar: true
+                               hasVerticalScrollBar: true
+                               miniScrollerHorizontal: true
+                               rowClassName: 'ResourceSelectionBrowser::Row'
+                               dataList: listOfResourceMethods
+                               useIndex: false
+                               has3Dseparators: true
+                               doubleClickSelector: resourceDoubleClicked
+                               columnHolder: resourceMethodColumns
+                               valueChangeSelector: resourceSelected
+                               verticalSpacing: 1
+                             )
+                            (ArbitraryComponentSpec
+                               name: 'ImageView'
+                               uuid: '51c4bd9c-07a8-11e8-8563-b8f6b1108e05'
+                               hasBorder: false
+                               component: ImageView
+                             )
+                            )
+                          
+                         )
+                         handles: (Any 0.98999999999999999 1.0)
                        )
-                     
-                    )
-                  )
+                      (InputFieldSpec
+                         name: 'selectorInputField'
+                         layout: (LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
+                         uuid: 'f1362db4-0791-11e8-8563-b8f6b1108e05'
+                         tabable: true
+                         model: resourceSelectorHolder
+                         acceptOnLeave: true
+                         acceptOnLostFocus: true
+                         acceptOnPointerLeave: true
+                       )
+                      )
+                    
+                   )
                  )
-               
-              )
-              handles: (Any 0.5 1.0)
-            )
-           (HorizontalPanelViewSpec
-              name: 'ButtonPanel'
-              layout: (LayoutFrame 2 0.0 -30 1 -2 1.0 -4 1.0)
-              horizontalLayout: fit
-              verticalLayout: fit
-              reverseOrderIfOKAtLeft: true
-              component: 
-             (SpecCollection
-                collection: (
-                 (ActionButtonSpec
-                    label: 'Help'
-                    name: 'HelpButton'
-                    activeHelpKey: dss
-                    model: openHTMLDocument:
-                    initiallyDisabled: true
-                    enableChannel: helpEnabled
-                    actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
-                    extent: (Point 196 26)
-                  )
-                 (ActionButtonSpec
-                    label: 'Cancel'
-                    name: 'cancelButton'
-                    activeHelpKey: commitCancel
-                    tabable: true
-                    model: cancel
-                    extent: (Point 197 26)
-                  )
-                 (ActionButtonSpec
-                    label: 'OK'
-                    name: 'okButton'
-                    activeHelpKey: commitOK
-                    tabable: true
-                    model: accept
-                    isDefault: true
-                    extent: (Point 197 26)
-                  )
+                )
+              
+             )
+             handles: (Any 0.5 1.0)
+           )
+          (HorizontalPanelViewSpec
+             name: 'ButtonPanel'
+             layout: (LayoutFrame 2 0.0 -30 1 -18 1.0 -4 1.0)
+             uuid: 'f1362f3a-0791-11e8-8563-b8f6b1108e05'
+             horizontalLayout: fit
+             verticalLayout: fit
+             reverseOrderIfOKAtLeft: true
+             component: 
+            (SpecCollection
+               collection: (
+                (ActionButtonSpec
+                   label: 'Help'
+                   name: 'HelpButton'
+                   activeHelpKey: dss
+                   uuid: 'f136303e-0791-11e8-8563-b8f6b1108e05'
+                   translateLabel: true
+                   model: openHTMLDocument:
+                   initiallyDisabled: true
+                   enableChannel: helpEnabled
+                   actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
+                   extent: (Point 204 26)
                  )
-               
-              )
-            )
+                (ActionButtonSpec
+                   label: 'Cancel'
+                   name: 'cancelButton'
+                   activeHelpKey: commitCancel
+                   uuid: 'f13631ba-0791-11e8-8563-b8f6b1108e05'
+                   translateLabel: true
+                   tabable: true
+                   model: cancel
+                   extent: (Point 204 26)
+                 )
+                (ActionButtonSpec
+                   label: 'OK'
+                   name: 'okButton'
+                   activeHelpKey: commitOK
+                   uuid: 'f1363336-0791-11e8-8563-b8f6b1108e05'
+                   translateLabel: true
+                   tabable: true
+                   model: accept
+                   isDefault: true
+                   extent: (Point 204 26)
+                 )
+                )
+              
+             )
+             keepSpaceForOSXResizeHandleH: true
            )
-         
-        )
-      )
+          )
+        
+       )
+     )
 ! !
 
 !ResourceSelectionBrowser class methodsFor:'list specs'!
@@ -525,6 +522,32 @@
      )
 ! !
 
+!ResourceSelectionBrowser methodsFor:'accessing'!
+
+classFilter:aBlock
+    "aBlock to return true/false, given a class.
+     With false, it is not shown in the tree"
+
+    classFilter := aBlock.
+!
+
+existingOnly:something
+    existingOnly := something.
+!
+
+metaClassOnly:aBoolean
+    "force selection to be limited to the metaclass"
+
+    metaClassOnly := aBoolean.
+!
+
+packageFilter:aBlock
+    "aBlock to return true/false, given a packageID.
+     With false, the class is not shown in the tree"
+
+    packageFilter := aBlock.
+! !
+
 !ResourceSelectionBrowser methodsFor:'aspects'!
 
 classNameHolder
@@ -545,6 +568,35 @@
     ^true
 !
 
+indexOfSelectedClassInFlatList
+    |holder|
+
+    (holder := builder bindingAt:#indexOfSelectedClassInFlatList) isNil ifTrue:[
+        builder aspectAt:#indexOfSelectedClassInFlatList put:(holder := nil asValue).
+        holder onChangeEvaluate:[ 
+            |clsName|
+
+            clsName := self listOfClassNames at:holder value ifAbsent:nil.
+            clsName notNil ifTrue:[
+                classSelectionBlock value:clsName  
+            ]. 
+        ]. 
+    ].
+    ^ holder
+!
+
+listOfClassNames
+    "returns the value holder for the flat class list"
+
+    |holder|
+
+
+    (holder := builder bindingAt:#listOfClassNames) isNil ifTrue:[
+        builder aspectAt:#listOfClassNames put: (holder := List new).
+    ].
+    ^ holder
+!
+
 listOfResourceMethods
     "returns the value holder for the list of the resource methods"
 
@@ -578,12 +630,11 @@
     |holder|                                
 
     (holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[
-        ClassPresentation = #'Class Categories' ifTrue: [
-        builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')].
+        classPresentation = #'Class Categories' ifTrue: [
+            builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')
+        ].
     ].
     ^ holder
-
-
 !
 
 rootOfClassHierarchy
@@ -593,12 +644,11 @@
 
 
     (holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[
-        ClassPresentation = #'Class Hierarchy' ifTrue: [
-        builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)]
+        classPresentation = #'Class Hierarchy' ifTrue: [
+            builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)
+        ]
     ].
     ^ holder
-
-
 !
 
 selectionOfClassCategories
@@ -622,29 +672,17 @@
 !
 
 selectionOfClassPresentation
-    "returns the value holder for the selected class presentation"
+    "returns the value holder for the selected class presentation
+     (Flat, Hierarchy or Category)"
 
     |holder|
 
     (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[
-        builder aspectAt:#selectionOfClassPresentation put:(holder :=  RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')).
-        holder onChangeEvaluate: 
-            [
-                 |hv comp newRoot|
+        builder 
+            aspectAt:#selectionOfClassPresentation 
+            put:(holder := RadioButtonGroup with: (classPresentation := classPresentation ? LastClassPresentation ? #'Class Categories')).
 
-                 hv := holder value.
-                 ClassPresentation := hv.
-                 hv = #'Class Hierarchy' ifTrue:[
-                      comp := builder componentAt: #listOfClassHierarchyView.
-                      newRoot := self rootOfClassHierarchy.  
-                 ] ifFalse: [
-                      comp := builder componentAt: #listOfClassCategoriesView.
-                      newRoot := self rootOfClassCategories. 
-                 ].
-                 comp root:newRoot.
-                 comp raise. 
-                 classSelectionBlock value: self classNameHolder value
-            ]
+        holder onChangeEvaluate:[self classPresentationChanged ]. 
     ].
     ^ holder
 !
@@ -675,91 +713,203 @@
     ^ self resourceSelectorHolder
 ! !
 
-!ResourceSelectionBrowser methodsFor:'callbacks-class list'!
-
-treeViewClassCategoryChildren
-    "returns the children for the contents (class) of aTreeItem as a block"
+!ResourceSelectionBrowser methodsFor:'callbacks-user'!
 
-    "/ cg: tz's algorithm was very-very slow, 
-    "/ (it enumerated classes hundreds of times,
-    "/  leading to a square runtime behavior
-    "/  - i.e. very slow scrolling )
-    "/ Speed up things by caching facts while enumerating
-    "/ classes once only.
+classPresentationChanged
+    "returns the value holder for the selected class presentation
+     (Flat, Hierarchy or Category)"
 
-    |topClass childrenPerCategory privateClasses|
+    |comp newRoot|
 
-    topClass := self treeViewClassHierarchyContents.
-    privateClasses := IdentitySet new.
+    classPresentation := LastClassPresentation := self selectionOfClassPresentation value.
 
-    childrenPerCategory := Dictionary new.
-
-    topClass withAllSubclassesDo:[:cls |
-        |cat set|
-
-        cls isPrivate ifFalse:[
-            cat := cls category.
-            cat notNil ifTrue:[
-                set := childrenPerCategory at:cat ifAbsent:nil.
-                set isNil ifTrue:[
-                    childrenPerCategory at:cat put:(set := IdentitySet new).
-                ].
-                set add:cls
-            ].
-        ] ifTrue:[
-            privateClasses add:cls
-        ]
+    classPresentation == #'Flat' ifTrue:[
+        self listOfClassNames isEmpty ifTrue:[ self updateListOfClasses ].
+        comp := builder componentAt: #listOfClassesView.
+    ] ifFalse:[
+        classPresentation == #'Class Hierarchy' ifTrue:[
+             comp := builder componentAt: #listOfClassHierarchyView.
+             newRoot := self rootOfClassHierarchy.  
+        ] ifFalse: [
+            comp := builder componentAt: #listOfClassCategoriesView.
+            newRoot := self rootOfClassCategories. 
+        ].
+        comp root:newRoot.
     ].
 
-    ^ [:aTreeItem|
-        |cont children initialContents setOfCategories itemCategory setOfClasses|
+    comp raise; requestFocus.
+    classSelectionBlock value:(self classNameHolder value)
+!
+
+classSelected
+    "after a class selection, read the allowed resource methods of the selected class"
+
+    |sel className|
+
+    classPresentation = #'Class Hierarchy'
+"/        ifTrue:  [sel := self selectionOfClassHierarchy value]
+        ifFalse: [sel := self selectionOfClassCategories value].
+
+    resourceClass := nil.
+    sel notNil ifTrue:[
+        sel contents ~~ #Category ifTrue:[
+            className := sel name.
+            resourceClass := Smalltalk classNamed:className.
+        ]
+    ].
+    self updateResourceMethodList.
+!
+
+classSelectionUpdate:clsPattern
+    "called when a new class is selected AND when switching presentation modes"
+
+    |foundClass classes|  
+
+    "/ because this is also called for presentation switch,
+    "/ we cannot tune it this way...
+    "/ (self classNameHolder value = clsPattern) ifTrue:[
+    "/     resourceClass notNil ifTrue:[
+    "/         resourceClass name = clsPattern ifTrue:[
+    "/             ^ self 
+    "/         ].
+    "/     ].
+    "/ ].
 
-        (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) contents: child]
-        ] ifFalse:[
-            cont size == 0 ifTrue:[
-                setOfCategories := childrenPerCategory keys.
-                children := setOfCategories asSortedCollection.
-                children := children collect: [:nm | TreeItem name:nm contents:#Category]
-            ] ifFalse:[
-                cont == #Category ifTrue:[
-                    itemCategory := aTreeItem name.
-                    setOfClasses := childrenPerCategory at:itemCategory ifAbsent:[Set new].
-                    children := setOfClasses asOrderedCollection sort:[:c1 :c2 | c1 name <= c2 name].
-                    children := children collect:[:child | TreeItem name:child name contents:child].
-                ] ifFalse:[
-                    "/ huh ?
-                    children := OrderedCollection new.
-                ]
+    clsPattern notNil ifTrue:[
+        foundClass := Smalltalk classNamed:clsPattern.
+    ].
+    (foundClass isClass not or:[foundClass name ~= clsPattern])
+    ifTrue: [
+        classes := allClasses select: [:cls| cls name size >= clsPattern size].
+        1 to: clsPattern size do: [:i|    
+             classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)].
+        ].    
+        foundClass := classes at: 1 ifAbsent:[]. 
+    ].          
+
+    foundClass notNil ifTrue: [           
+        foundClass := foundClass autoload.
+        resourceClass := foundClass.
+
+        classPresentation = #'Flat' ifTrue: [
+            |index|
+
+            index := self listOfClassNames indexOf:resourceClass name.
+            self indexOfSelectedClassInFlatList value:index.
+        ] ifFalse: [
+            classPresentation = #'Class Hierarchy' ifTrue: [
+                |searchArgs nonSuperclasses hierItem|
+
+                false "foundClass isPrivate"
+                    ifFalse: [searchArgs := foundClass withAllSuperclasses reversed]
+                    ifTrue:  [searchArgs := foundClass owningClass withAllSuperclasses reversed. 
+                              searchArgs add: foundClass].                                  
+                (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil 
+                    ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
+
+                hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs.
+                hierItem notNil ifTrue:[
+                    self selectionOfClassHierarchy value:hierItem.
+                ].
+            ] 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].
+
+                hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs.
+                hierItem notNil ifTrue:[
+                    self selectionOfClassCategories value: hierItem.
+                ].
             ].
         ].
-        children
+    ].
+
+    self classNameHolder value: clsPattern.
+    self updateResourceMethodList.
+!
+
+resourceDoubleClicked
+    "after a double click on resource method, accept it and close"
+
+    accept value: true.
+    self closeRequest
+!
+
+resourceSelected
+    "after a click on a resource method, set its selector into the field"
+
+    |selectedMethodInfo mthd|
+
+    selectedMethodInfo := self selectionOfResourceMethod value.
+    selectedMethodInfo notNil ifTrue: [
+        self resourceSelectorHolder value:(selectedMethodInfo selector).
+        mthd := selectedMethodInfo method.
+        (mthd hasResource:#image) ifTrue:[
+            (builder componentAt:#ImageView)
+                image:(mthd valueWithReceiver:nil arguments:#())
+        ].
     ]
+!
 
-    "Modified: / 22-08-2012 / 19:44:59 / cg"
+updateListOfClasses
+    |names|
+
+    classPresentation = #'Flat' ifTrue: [
+        self listOfClassNames isEmpty ifTrue:[
+            names := (Smalltalk allClasses asOrderedCollection sortBySelector:#name)
+                        select:[:cls | self filterClass:cls]
+                        thenCollect:[:cls | cls name].
+            self listOfClassNames addAll:names.
+        ]
+    ]
 !
 
-treeViewClassCategoryIcon
-    "returns the icon for aTreeItem as a block"
+updateResourceMethodList
+    "read the allowed resource methods of the selected class"
+
+    |class className item|
+
+    (class := resourceClass) isNil ifTrue:[
+        classPresentation = #'Class Hierarchy'
+            ifTrue:  [item := self selectionOfClassHierarchy value ]
+            ifFalse: [item := self selectionOfClassCategories value ].
 
-    ^self class treeViewClassHierarchyIcon
-
-
-!
+        item notNil ifTrue:[
+            item contents ~~ #Category ifTrue:[
+                className := item name.
+                class := Smalltalk at:className asSymbol.
+            ]
+        ].
+    ] ifFalse:[
+        class := resourceClass
+    ].
 
-treeViewClassHierarchyContents
-    "returns the contents of the root of the class tree list"
+    class isNil ifTrue: [
+        self listOfResourceMethods contents:#().
+        ^self
+    ].
 
-    |cls|
+    className := class name."/class theNonMetaclass name
+
+    self withWaitCursorDo:[
+        |newContents|           
+
+        resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
 
-    resourceSuperclass notNil ifTrue:[
-        cls := Smalltalk classNamed: resourceSuperclass.
-    ].
-    cls notNil ifTrue:[^ cls].
-    ^ self class treeViewClassHierarchyContents
+        self classNameHolder value: className.
+        self class lastSelection: className.
+
+        newContents := class theMetaclass methodDictionary asOrderedCollection 
+                            select:[:m | 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
+                .
+    ]
 !
 
 validateDoubleClick: aTreeItem
@@ -774,133 +924,24 @@
 
 ! !
 
-!ResourceSelectionBrowser methodsFor:'callbacks-user'!
-
-classSelected
-    "after a class selection, read the allowed resource methods of the selected class"
-
-    |sel|
-
-    ClassPresentation = #'Class Hierarchy'
-"/        ifTrue:  [sel := self selectionOfClassHierarchy value]
-        ifFalse: [sel := self selectionOfClassCategories value].
-
-    sel notNil ifTrue:[
-        resourceClass := sel.
-    ].
-    self updateResourceMethodList.
-!
-
-classSelectionUpdate:clsPattern
-    |foundClass classes|  
+!ResourceSelectionBrowser methodsFor:'initialization'!
 
-    clsPattern notNil ifTrue:[
-        foundClass := Smalltalk at:(clsPattern printString asSymbol).
-    ].
-    (foundClass isClass not or:[foundClass name ~= clsPattern])
-    ifTrue: [
-        classes := allClasses select: [:cls| cls name size >= clsPattern size].
-        1 to: clsPattern size do: [:i|    
-             classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)].
-        ].    
-        foundClass := classes at: 1 ifAbsent:[]. 
-    ].          
-
-    foundClass notNil ifTrue: [           
-        foundClass := foundClass autoload.
-        resourceClass := foundClass.
-
-        ClassPresentation = #'Class Hierarchy' ifTrue: [
-            |searchArgs nonSuperclasses hierItem|
-
-            false "foundClass isPrivate"
-                ifFalse: [searchArgs := foundClass withAllSuperclasses reversed]
-                ifTrue:  [searchArgs := foundClass owningClass withAllSuperclasses reversed. 
-                          searchArgs add: foundClass].                                  
-            (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil 
-                ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
-
-            hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs.
-            hierItem notNil ifTrue:[
-                self selectionOfClassHierarchy value:hierItem.
-            ].
-        ] 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].
+initialize
+    "Invoked when a new instance is created."
 
-            hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs.
-            hierItem notNil ifTrue:[
-                self selectionOfClassCategories value: hierItem.
-            ].
-        ].
-    ].
-    self classNameHolder value: clsPattern.
-    self updateResourceMethodList.
-!
-
-resourceDoubleClicked
-    "after a double click on resource method, accept it and close"
-
-    accept value: true.
-    self closeRequest
-!
-
-resourceSelected
-    "after a click on a resource method, set its selector into the field"
-
-    self selectionOfResourceMethod value notNil
-        ifTrue: [self resourceSelectorHolder value: self selectionOfResourceMethod value selector]
-!
-
-updateResourceMethodList
-    "read the allowed resource methods of the selected class"
-
-    |class className item|
+    metaClassOnly := true.
+    existingOnly := false.
 
-    (class := resourceClass) 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 name."/class theNonMetaclass name
-
-    self withWaitCursorDo:[
-        |newContents|           
-
-        resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
-
-        self classNameHolder 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
-                .
-    ]
+    super initialize.
 ! !
 
 !ResourceSelectionBrowser methodsFor:'instance creation'!
 
-openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
-    "opens a ResourceSelectionBrowser; return a Message-object or nil"
+onSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
+    "create - but do not yet open
+     a ResourceSelectionBrowser"
 
-    |selectedClass enteredClassName className cls|
+    |cls|
 
     resourceMethod := aSelector.
     resourceTypes := aResourceTypes.
@@ -919,6 +960,16 @@
         ]
     ].            
     self resourceSelectorHolder value:(aSelector ? '').
+! !
+
+!ResourceSelectionBrowser methodsFor:'startup & release'!
+
+openAndLetUserChoose
+    "opens the previously configured receiver;
+     return a Message-object or nil"
+
+    |selectedClass enteredClassName className cls|
+
     self open.
 
     (selectedClass := self selectionOfClassHierarchy value) isNil ifTrue:[
@@ -947,16 +998,34 @@
     ^ nil
 
     "Modified: / 22.4.1998 / 14:51:03 / cg"
-! !
+!
+
+openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
+    "opens a ResourceSelectionBrowser; return a Message-object or nil"
 
-!ResourceSelectionBrowser methodsFor:'startup & release'!
+    self 
+        onSuperclass: aSuperclassOrSymbol 
+        andClass:aClassOrClassName andSelector: aSelector 
+        withResourceTypes: aResourceTypes.
+
+    self openAndLetUserChoose
+!
 
 postBuildWith:aBuilder
     "after building and before opening,  
      create a class selection block, an entry completion block for the class name field"
 
     |classSelection classNameInputField|
-     
+
+    (resourceTypes notNil and:[(resourceTypes includesAny:#(image programImage))]) ifTrue:[
+        (builder componentAt: #resourcesDataSetView)
+            origin:0.0@0.0 extent:(1.0 @ 0.7).
+        (builder componentAt: #ImageView) 
+            origin:0.0@0.7 extent:(1.0 @ 0.3); beVisible.
+        (builder componentAt: #ResourcePanel)
+            resizeSubviews; sizeChanged:nil.
+    ].
+
     allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate].
     classSelection := resourceClass isNil ifTrue:[nil] ifFalse:[resourceClass name]. 
 
@@ -978,7 +1047,10 @@
                 classNameInputField contents:what first.
                 (what at:2) size ~~ 1 ifTrue:[
                     classNameInputField device beepInEditor
-                ]
+                ].
+                (Smalltalk classNamed:(what at:1)) notNil ifTrue:[
+                    self classNameHolder value:(what at:1)
+                ].
 "/                |what oldClassName|
 "/                oldClassName := classNameInputField contents.
 "/                what := Smalltalk classnameCompletion: value withoutSpaces.
@@ -988,7 +1060,7 @@
             ].
 
     classSelectionBlock value: self classNameHolder value.
-    self updateResourceMethodList.
+    "/ self updateResourceMethodList. -- will be done automatically via change
     self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
 
     ^super postBuildWith:aBuilder
@@ -997,12 +1069,213 @@
 postOpenWith:aBuilder
     "after opening and if turned on make hierarchy view visible"
 
-    ClassPresentation = #'Class Hierarchy'
-        ifTrue: [(builder componentAt: #listOfClassHierarchyView) raise].
+    classPresentation = #'Class Hierarchy' ifTrue: [
+        (builder componentAt: #listOfClassHierarchyView) raise
+    ].
+    classPresentation = #'Flat' ifTrue: [
+        self updateListOfClasses.
+        (builder componentAt: #listOfClassesView) raise
+    ].
 
     super postOpenWith:aBuilder
 ! !
 
+!ResourceSelectionBrowser methodsFor:'tree building - category'!
+
+filterClass:cls
+    "true if cls is to be shown"
+
+    classFilter notNil ifTrue:[
+        (classFilter value:cls) ifFalse:[^ false].
+    ].
+    packageFilter notNil ifTrue:[
+        (packageFilter value:cls package) ifFalse:[^ false].
+    ].
+    existingOnly == true ifTrue:[
+        ^ cls theMetaclass methodDictionary 
+            contains:[:m | 
+                resourceTypes includes:m resourceType
+            ].
+    ].
+    ^ true
+!
+
+treeViewClassCategoryChildren
+    "returns the children for the contents (class) of aTreeItem as a block"
+
+    "/ cg: tz's algorithm was very-very slow, 
+    "/ (it enumerated classes hundreds of times,
+    "/  leading to a square runtime behavior
+    "/  - i.e. very slow scrolling )
+    "/ Speed up things by caching facts while enumerating
+    "/ classes once only.
+
+    |topClass childrenPerCategory privateClasses|
+
+    topClass := self treeViewClassHierarchyContents.
+    privateClasses := IdentitySet new.
+
+    childrenPerCategory := Dictionary new.
+
+    "/ collect all classes to be inserted into the tree(s)
+    topClass withAllSubclassesDo:[:cls |
+        |shown cat set|
+
+        (self filterClass:cls) ifTrue:[
+             cls isPrivate ifFalse:[
+                cat := cls category.
+                cat notNil ifTrue:[
+                    (childrenPerCategory at:cat ifAbsentPut:[Set new]) add:cls
+                ].
+            ] ifTrue:[
+                privateClasses add:cls
+            ]
+        ].
+    ].
+
+    "/ need the owningclasses in the tree
+    privateClasses do:[:each |
+        |owner|
+
+        owner := each owningClass.
+        (childrenPerCategory at:(owner category) ifAbsentPut:[Set new]) add:owner
+    ].
+
+    ^ [:aTreeItem|
+        |cont children initialContents setOfCategories itemCategory setOfClasses|
+
+        (cont := aTreeItem contents) isBehavior ifTrue:[
+            children := privateClasses select:[:cls | cls owningClass == aTreeItem contents].
+            children := children select:[:cls | self filterClass:cls].
+            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) contents: child]
+        ] ifFalse:[
+            cont size == 0 ifTrue:[
+                setOfCategories := childrenPerCategory keys.
+                children := setOfCategories asSortedCollection.
+                children := children collect: [:nm | TreeItem name:nm contents:#Category]
+            ] ifFalse:[
+                cont == #Category ifTrue:[
+                    itemCategory := aTreeItem name.
+                    setOfClasses := childrenPerCategory at:itemCategory ifAbsent:[Set new].
+                    setOfClasses := setOfClasses select:[:cls | self filterClass:cls].
+                    children := setOfClasses asOrderedCollection sort:[:c1 :c2 | c1 name <= c2 name].
+                    children := children collect:[:child | TreeItem name:child name contents:child].
+                ] ifFalse:[
+                    "/ huh ?
+                    children := OrderedCollection new.
+                ]
+            ].
+        ].
+        children
+    ]
+
+    "Modified: / 22-08-2012 / 19:44:59 / cg"
+!
+
+treeViewClassCategoryIcon
+    "returns the icon for aTreeItem as a block"
+
+    ^self treeViewClassHierarchyIcon
+! !
+
+!ResourceSelectionBrowser methodsFor:'tree building - hierarchy'!
+
+treeViewClassHierarchyChildren
+    "returns the children for the contents (class) of aTreeItem as a block"
+
+    "/ cg: tz's algorithm was very-very slow, 
+    "/ (it enumerated classes hundreds of times,
+    "/  leading to a square runtime behavior
+    "/  - i.e. very slow scrolling )
+    "/ Speed up things by caching facts while enumerating
+    "/ classes once only.
+
+    |subclassesAndPrivateClassesPerClass classesWithResourceOrResourceInAnySubclass|
+
+    subclassesAndPrivateClassesPerClass := IdentityDictionary new.
+    classesWithResourceOrResourceInAnySubclass := IdentitySet new.
+
+    Smalltalk allClassesDo:[:cls |
+        |owner superclass info|
+
+        superclass := cls superclass.
+        superclass notNil ifTrue:[
+            info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil.
+            info isNil ifTrue:[
+                subclassesAndPrivateClassesPerClass 
+                        at:superclass 
+                        put:(info := {IdentitySet new. IdentitySet new} ).
+            ].
+            (info at:1) add:cls
+        ].
+        (self filterClass:cls) ifTrue:[
+            cls withAllSuperclassesDo:[:each |
+                classesWithResourceOrResourceInAnySubclass add:each
+            ].
+        ].
+    ].
+
+    ^ [:aTreeItem|
+        |classes itemClass info|
+
+        classes := OrderedCollection new. 
+        itemClass := aTreeItem contents.
+        info := subclassesAndPrivateClassesPerClass at:itemClass ifAbsent:nil.
+        info notNil ifTrue:[
+            classes addAll:((info at:1) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
+            classes addAll:((info at:2) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
+        ].
+        classes select:[:cls | classesWithResourceOrResourceInAnySubclass includes:cls].
+     ]
+!
+
+treeViewClassHierarchyContents
+    "returns the contents of the root of the class tree list"
+
+    |cls|
+
+    resourceSuperclass notNil ifTrue:[
+        cls := Smalltalk classNamed: resourceSuperclass.
+    ].
+    cls := cls ? Object.
+    ^ cls
+!
+
+treeViewClassHierarchyIcon
+    "returns the icon for aTreeItem as a block"
+
+    ^[:aTreeItem|
+        |icon|
+
+        aTreeItem contents isClass ifTrue:[
+            icon := self class iconClass.
+            aTreeItem contents isPrivate ifTrue:[
+               icon := self class iconPrivateClass
+            ].
+            icon
+        ] ifFalse:[
+            self class iconCategory
+        ]
+    ]
+!
+
+treeViewClassHierarchyLabel
+    "returns the label for aTreeItem as a block"
+
+    ^[:aTreeItem|
+        |label superCls itemContents|
+
+        itemContents := aTreeItem contents.
+        label := itemContents name.
+"/        (itemContents isPrivate 
+"/        and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)])
+"/            ifTrue: [label := label, ' (', superCls name, ')'].
+        label
+     ]
+! !
+
 !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
 
 iconOn:aGC
@@ -1037,6 +1310,10 @@
     "Modified: / 5.11.2001 / 16:48:35 / cg"
 !
 
+method
+    ^ method
+!
+
 method: aMethod
     "sets aMethod"