94 !ResourceSelectionBrowser class methodsFor:'callbacks - default'! |
94 !ResourceSelectionBrowser class methodsFor:'callbacks - default'! |
95 |
95 |
96 treeViewClassHierarchyChildren |
96 treeViewClassHierarchyChildren |
97 "returns the children for the contents (class) of aTreeItem as a block" |
97 "returns the children for the contents (class) of aTreeItem as a block" |
98 |
98 |
99 ^[:aTreeItem| |
99 "/ cg: tz's algorithm was very-very slow, |
100 |classes| |
100 "/ (it enumerated classes hundreds of times, |
|
101 "/ leading to a square runtime behavior |
|
102 "/ - i.e. very slow scrolling ) |
|
103 "/ Speed up things by caching facts while enumerating |
|
104 "/ classes once only. |
|
105 |
|
106 |subclassesAndPrivateClassesPerClass| |
|
107 |
|
108 subclassesAndPrivateClassesPerClass := IdentityDictionary new. |
|
109 |
|
110 Smalltalk allClassesDo:[:cls | |
|
111 |owner superclass info| |
|
112 |
|
113 (owner := cls owningClass) notNil ifTrue:[ |
|
114 info := subclassesAndPrivateClassesPerClass at:owner ifAbsent:nil. |
|
115 info isNil ifTrue:[ |
|
116 subclassesAndPrivateClassesPerClass at:owner put:(info := Array with:IdentitySet new |
|
117 with:IdentitySet new). |
|
118 ]. |
|
119 (info at:2) add:cls |
|
120 ] ifFalse:[ |
|
121 superclass := cls superclass. |
|
122 superclass notNil ifTrue:[ |
|
123 info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil. |
|
124 info isNil ifTrue:[ |
|
125 subclassesAndPrivateClassesPerClass at:superclass put:(info := Array with:IdentitySet new |
|
126 with:IdentitySet new). |
|
127 ]. |
|
128 (info at:1) add:cls |
|
129 ] |
|
130 ] |
|
131 ]. |
|
132 |
|
133 ^ [:aTreeItem| |
|
134 |classes itemClass info| |
|
135 |
101 classes := OrderedCollection new. |
136 classes := OrderedCollection new. |
102 classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]). |
137 itemClass := aTreeItem contents. |
103 classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]). |
138 info := subclassesAndPrivateClassesPerClass at:itemClass ifAbsent:nil. |
|
139 info notNil ifTrue:[ |
|
140 classes addAll:((info at:1) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]). |
|
141 classes addAll:((info at:2) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]). |
|
142 ]. |
104 classes |
143 classes |
105 ] |
144 ] |
106 ! |
145 ! |
107 |
146 |
108 treeViewClassHierarchyContents |
147 treeViewClassHierarchyContents |
115 treeViewClassHierarchyIcon |
154 treeViewClassHierarchyIcon |
116 "returns the icon for aTreeItem as a block" |
155 "returns the icon for aTreeItem as a block" |
117 |
156 |
118 ^[:aTreeItem| |
157 ^[:aTreeItem| |
119 |icon| |
158 |icon| |
120 aTreeItem contents isClass |
159 |
121 ifTrue: |
160 aTreeItem contents isClass ifTrue:[ |
122 [ |
|
123 icon := self iconClass. |
161 icon := self iconClass. |
124 aTreeItem contents isPrivate |
162 aTreeItem contents isPrivate ifTrue:[ |
125 ifTrue: |
|
126 [ |
|
127 icon := self iconPrivateClass |
163 icon := self iconPrivateClass |
128 ]. |
164 ]. |
129 icon |
165 icon |
130 ] |
166 ] ifFalse:[ |
131 ifFalse: |
|
132 [ |
|
133 self iconCategory |
167 self iconCategory |
134 ] |
168 ] |
135 ] |
169 ] |
136 |
170 |
137 ! |
171 ! |
138 |
172 |
139 treeViewClassHierarchyLabel |
173 treeViewClassHierarchyLabel |
140 "returns the label for aTreeItem as a block" |
174 "returns the label for aTreeItem as a block" |
141 |
175 |
142 ^[:aTreeItem| |
176 ^[:aTreeItem| |
143 |label superCls| |
177 |label superCls itemContents| |
144 label := aTreeItem contents name. |
178 |
145 (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)]) |
179 itemContents := aTreeItem contents. |
|
180 label := itemContents name. |
|
181 (itemContents isPrivate |
|
182 and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)]) |
146 ifTrue: [label := label, ' (', superCls name, ')']. |
183 ifTrue: [label := label, ' (', superCls name, ')']. |
147 label |
184 label |
148 ] |
185 ] |
149 |
186 |
150 |
187 |
528 |
565 |
529 selectionOfClassPresentation |
566 selectionOfClassPresentation |
530 "returns the value holder for the selected class presentation" |
567 "returns the value holder for the selected class presentation" |
531 |
568 |
532 |holder| |
569 |holder| |
|
570 |
533 (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[ |
571 (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[ |
534 builder aspectAt:#selectionOfClassPresentation put:(holder := RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')). |
572 builder aspectAt:#selectionOfClassPresentation put:(holder := RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')). |
535 holder onChangeSend: #value to: [holder value = #'Class Hierarchy' |
573 holder onChangeSend: #value to: |
536 ifTrue: [ClassPresentation := holder value.(builder componentAt: #listOfClassHierarchyView) root: self rootOfClassHierarchy. (builder componentAt: #listOfClassHierarchyView) raise. classSelectionBlock value: self valueOfClassName value] |
574 [ |
537 ifFalse: [ClassPresentation := holder value.(builder componentAt: #listOfClassCategoriesView) root: self rootOfClassCategories. (builder componentAt: #listOfClassCategoriesView) raise. classSelectionBlock value: self valueOfClassName value]] |
575 |hv comp newRoot| |
|
576 |
|
577 hv := holder value. |
|
578 ClassPresentation := hv. |
|
579 hv = #'Class Hierarchy' ifTrue:[ |
|
580 comp := builder componentAt: #listOfClassHierarchyView. |
|
581 newRoot := self rootOfClassHierarchy. |
|
582 ] ifFalse: [ |
|
583 comp := builder componentAt: #listOfClassCategoriesView. |
|
584 newRoot := self rootOfClassCategories. |
|
585 ]. |
|
586 comp root:newRoot. |
|
587 comp raise. |
|
588 classSelectionBlock value: self valueOfClassName value |
|
589 ] |
538 ]. |
590 ]. |
539 ^ holder |
591 ^ holder |
540 ! |
592 ! |
541 |
593 |
542 selectionOfResourceMethod |
594 selectionOfResourceMethod |
572 !ResourceSelectionBrowser methodsFor:'callbacks - class list'! |
624 !ResourceSelectionBrowser methodsFor:'callbacks - class list'! |
573 |
625 |
574 treeViewClassCategoryChildren |
626 treeViewClassCategoryChildren |
575 "returns the children for the contents (class) of aTreeItem as a block" |
627 "returns the children for the contents (class) of aTreeItem as a block" |
576 |
628 |
577 ^[:aTreeItem| |
629 "/ cg: tz's algorithm was very-very slow, |
578 |children| |
630 "/ (it enumerated classes hundreds of times, |
579 children := OrderedCollection new. |
631 "/ leading to a square runtime behavior |
580 aTreeItem contents = '' |
632 "/ - i.e. very slow scrolling ) |
581 ifTrue: |
633 "/ Speed up things by caching facts while enumerating |
582 [ |
634 "/ classes once only. |
583 children := (self treeViewClassHierarchyContents withAllSubclasses collect: [:cls| cls category]) asSet asSortedCollection. |
635 |
584 children := children collect: [:child| TreeItem name: child contents: 'Category'] |
636 |allClasses topClass childrenPerCategory privateClasses| |
585 ]. |
637 |
586 aTreeItem contents = 'Category' |
638 topClass := self treeViewClassHierarchyContents. |
587 ifTrue: |
639 allClasses := topClass withAllSubclasses. |
588 [ |
640 privateClasses := IdentitySet new. |
589 children := self treeViewClassHierarchyContents withAllSubclasses select: [:cls| cls category = aTreeItem name and: [cls isPrivate not]]. |
641 |
590 children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name]. |
642 childrenPerCategory := Dictionary new. |
591 children := children collect: [:child| TreeItem name: child name contents: child] |
643 allClasses do:[:cls | |
592 ]. |
644 |cat set| |
593 aTreeItem contents isClass |
645 |
594 ifTrue: |
646 cls isPrivate ifFalse:[ |
595 [ |
647 cat := cls category. |
596 children := aTreeItem contents privateClasses. |
648 set := childrenPerCategory at:cat ifAbsent:nil. |
597 children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name]. |
649 set isNil ifTrue:[ |
598 children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child] |
650 childrenPerCategory at:cat put:(set := IdentitySet new). |
599 ]. |
651 ]. |
600 children |
652 set add:cls |
601 ] |
653 ] ifTrue:[ |
|
654 privateClasses add:cls |
|
655 ] |
|
656 ]. |
|
657 |
|
658 ^ [:aTreeItem| |
|
659 |cont children initialContents setOfCategories itemCategory setOfClasses| |
|
660 |
|
661 (cont := aTreeItem contents) isBehavior ifTrue:[ |
|
662 children := privateClasses select:[:cls | cls owningClass == aTreeItem contents]. |
|
663 children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name]. |
|
664 children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child] |
|
665 ] ifFalse:[ |
|
666 cont size == 0 ifTrue:[ |
|
667 setOfCategories := childrenPerCategory keys. |
|
668 children := setOfCategories asSortedCollection. |
|
669 children := children collect: [:nm | TreeItem name:nm contents:#Category] |
|
670 ] ifFalse:[ |
|
671 cont == #Category ifTrue:[ |
|
672 itemCategory := aTreeItem name. |
|
673 setOfClasses := childrenPerCategory at:itemCategory ifAbsent:[Set new]. |
|
674 children := setOfClasses asOrderedCollection sort:[:c1 :c2 | c1 name <= c2 name]. |
|
675 children := children collect:[:child | TreeItem name:child name contents:child]. |
|
676 ] ifFalse:[ |
|
677 "/ huh ? |
|
678 children := OrderedCollection new. |
|
679 ] |
|
680 ]. |
|
681 ]. |
|
682 children |
|
683 ] |
602 |
684 |
603 |
685 |
604 ! |
686 ! |
605 |
687 |
606 treeViewClassCategoryIcon |
688 treeViewClassCategoryIcon |
617 |cls| |
699 |cls| |
618 |
700 |
619 resourceSuperclass notNil ifTrue:[ |
701 resourceSuperclass notNil ifTrue:[ |
620 cls := Smalltalk at: resourceSuperclass. |
702 cls := Smalltalk at: resourceSuperclass. |
621 ]. |
703 ]. |
622 ^ cls ? self class treeViewClassHierarchyContents |
704 cls notNil ifTrue:[^ cls]. |
|
705 ^ self class treeViewClassHierarchyContents |
623 |
706 |
624 ! |
707 ! |
625 |
708 |
626 validateDoubleClick: aTreeItem |
709 validateDoubleClick: aTreeItem |
627 "returns whether a class may be selected" |
710 "returns whether a class may be selected" |
628 |
711 |
629 ^aTreeItem contents ~= '' and: [aTreeItem contents ~~ self treeViewClassHierarchyContents] |
712 |cont| |
|
713 |
|
714 ^ (cont := aTreeItem contents) ~= '' |
|
715 and: [cont ~~ self treeViewClassHierarchyContents] |
630 |
716 |
631 |
717 |
632 |
718 |
633 ! ! |
719 ! ! |
634 |
720 |