--- a/ResourceSelectionBrowser.st	Thu Feb 18 13:57:04 1999 +0100
+++ b/ResourceSelectionBrowser.st	Sat Feb 20 02:24:34 1999 +0100
@@ -96,11 +96,50 @@
 treeViewClassHierarchyChildren
     "returns the children for the contents (class) of aTreeItem as a block"
 
-    ^[:aTreeItem|
-        |classes|    
+    "/ 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. 
-        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]).
+        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
      ]
 !
@@ -117,19 +156,14 @@
 
     ^[:aTreeItem|
         |icon|
-        aTreeItem contents isClass
-        ifTrue:
-        [
+
+        aTreeItem contents isClass ifTrue:[
             icon := self iconClass.
-            aTreeItem contents isPrivate 
-            ifTrue:
-            [
+            aTreeItem contents isPrivate ifTrue:[
                icon := self iconPrivateClass
             ].
             icon
-        ]
-        ifFalse:
-        [
+        ] ifFalse:[
             self iconCategory
         ]
     ]
@@ -140,9 +174,12 @@
     "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)])
+        |label superCls itemContents|
+
+        itemContents := aTreeItem contents.
+        label := itemContents name.
+        (itemContents isPrivate 
+        and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)])
             ifTrue: [label := label, ' (', superCls name, ')'].
         label
      ]
@@ -530,11 +567,26 @@
     "returns the value holder for the selected class presentation"
 
     |holder|
+
     (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 onChangeSend: #value to: 
+            [
+                 |hv comp newRoot|
+
+                 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 valueOfClassName value
+            ]
     ].
     ^ holder
 !
@@ -574,31 +626,61 @@
 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
-     ]
+    "/ 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.
+
+    |allClasses topClass childrenPerCategory privateClasses|
+
+    topClass := self treeViewClassHierarchyContents.
+    allClasses := topClass withAllSubclasses.
+    privateClasses := IdentitySet new.
+
+    childrenPerCategory := Dictionary new.
+    allClasses do:[:cls |
+        |cat set|
+
+        cls isPrivate ifFalse:[
+            cat := cls category.
+            set := childrenPerCategory at:cat ifAbsent:nil.
+            set isNil ifTrue:[
+                childrenPerCategory at:cat put:(set := IdentitySet new).
+            ].
+            set add:cls
+        ] ifTrue:[
+            privateClasses add:cls
+        ]
+    ].
+
+    ^ [:aTreeItem|
+        |cont children initialContents setOfCategories itemCategory setOfClasses|
+
+        (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]
+        ] 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.
+                ]
+            ].
+        ].
+        children
+    ]
 
 
 !
@@ -619,14 +701,18 @@
     resourceSuperclass notNil ifTrue:[
         cls := Smalltalk at: resourceSuperclass.
     ].
-    ^ cls ? self class treeViewClassHierarchyContents
+    cls notNil ifTrue:[^ cls].
+    ^ self class treeViewClassHierarchyContents
 
 !
 
 validateDoubleClick: aTreeItem
     "returns whether a class may be selected"
 
-    ^aTreeItem contents ~= '' and: [aTreeItem contents ~~ self treeViewClassHierarchyContents]       
+    |cont|
+
+    ^ (cont := aTreeItem contents) ~= '' 
+      and: [cont ~~ self treeViewClassHierarchyContents]       
 
 
 
@@ -665,8 +751,7 @@
     "after a double click on resource method, accept it and close"
 
     accept value: true.
-
-    self close
+    self closeRequest
 !
 
 resourceSelected