cg@3531: "{ Encoding: utf8 }"
cg@3531: 
tz@425: "
tz@771:  COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@425:               All Rights Reserved
tz@425: 
tz@425:  This software is furnished under a license and may be used
tz@425:  only in accordance with the terms of that license and with the
tz@425:  inclusion of the above copyright notice. This software may not
tz@425:  be provided or otherwise made available to, or used by, any
tz@425:  other person. No title to or ownership of the software is
tz@425:  hereby transferred.
tz@425: "
cg@1384: "{ Package: 'stx:libtool2' }"
cg@1384: 
cg@3198: "{ NameSpace: Smalltalk }"
cg@3198: 
tz@425: SelectionBrowser subclass:#ResourceSelectionBrowser
tz@477: 	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
cg@3531: 		allClasses classSelectionBlock classFilter packageFilter
cg@3531: 		metaClassOnly existingOnly filter classPresentation'
cg@3531: 	classVariableNames:'LastClassPresentation'
tz@425: 	poolDictionaries:''
tz@619: 	category:'Interface-Dialogs'
tz@425: !
tz@425: 
tz@771: Object subclass:#ResourceMethod
tz@523: 	instanceVariableNames:'method icon resourceType selector'
tz@523: 	classVariableNames:''
tz@523: 	poolDictionaries:''
tz@523: 	privateIn:ResourceSelectionBrowser
tz@523: !
tz@523: 
tz@425: !ResourceSelectionBrowser class methodsFor:'documentation'!
tz@425: 
tz@425: copyright
tz@425: "
tz@771:  COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@425:               All Rights Reserved
tz@425: 
tz@425:  This software is furnished under a license and may be used
tz@425:  only in accordance with the terms of that license and with the
tz@425:  inclusion of the above copyright notice. This software may not
tz@425:  be provided or otherwise made available to, or used by, any
tz@425:  other person. No title to or ownership of the software is
tz@425:  hereby transferred.
tz@425: "
tz@425: 
tz@425: !
tz@425: 
tz@425: documentation
tz@425: "
tz@746:     The ResourceSelectionBrowser allows you to browse in class hierarchies
tz@771:     and to select resource methods for loading or to saving resource 
tz@771:     specifications (#canvas, #menu, etc.).
tz@771: 
tz@771:     [instance variables:]
tz@907:         resourceMethod          <Symbol>        selector of the resource spec
tz@907:         resourceClass           <Symbol>        class of the resource spec
tz@907:         resourceSuperclass      <Symbol>        root class of the tree list
tz@907:         resourceTypes           <Array>         allowed resource types
tz@907:         allClasses              <Array>         list of the subclasses of resourceSuperclass
tz@907:         classSelectionBlock     <Block>         by evaluating this block the class selection is done
cg@3531:         classFilter             <Block>         if non-nil, given a class, has to return true for a class to be shown
cg@3531:         packageFilter           <Block>         if non-nil, given a package, has to return true for a class to be shown
cg@3531:         existingOnly            <Boolean>       if set, only classes with existing resources are shown (for load dialogs);
cg@3531:                                                 otherwise, empty classes are also shown (for save dialogs)
tz@746: 
tz@504:     [start with:]
tz@907:         ResourceSelectionBrowser open
tz@504: 
tz@504:     [author:]
tz@907:         Thomas Zwick, eXept Software AG
tz@425: "
tz@425: ! !
tz@425: 
tz@425: !ResourceSelectionBrowser class methodsFor:'instance creation'!
tz@425: 
cg@1978: request:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
cg@3531:     "opens a ResourceSelectionBrowser; 
cg@3531:      return a Message-object (whoInfo) or nil."
cg@1978: 
cg@3531:     ^ (self 
cg@3531:         title:aTitle 
cg@3531:         onSuperclass:aSuperclass 
cg@3531:         andClass:aClassOrClassName andSelector:aSelector 
cg@3531:         withResourceTypes:resourceTypes
cg@3531:       ) openAndLetUserChoose
cg@1978: 
tz@649:     "
cg@1978:      ResourceSelectionBrowser
tz@906:         request: 'Select a Resource Selector'
tz@906:         onSuperclass: #ApplicationModel 
cg@3531:         andClass: MenuEditor andSelector: #menuItemImage 
tz@906:         withResourceTypes: #(image) 
tz@425:     "
tz@648: !
tz@648: 
cg@3531: title:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
cg@3531:     "creates and returns a ResourceSelectionBrowser but does not open it.
cg@3531:      To open,
cg@3531:         send the returned browser an openAndLetUserChoose message,
cg@3531:         which returns the selected resource method's info (whoInfo) or nil on cancel.
cg@3531:      Use this to set additional filters before opening"
cg@1034: 
cg@3531:     ^ (self new
cg@3531:         title: aTitle)
cg@3531:             onSuperclass:aSuperclass
cg@3531:             andClass:aClassOrClassName
cg@3531:             andSelector:aSelector
cg@3531:             withResourceTypes:resourceTypes
tz@648: 
cg@3531:     "
cg@3531:      (ResourceSelectionBrowser
cg@3531:         title: 'Select a Resource Selector'
cg@3531:         onSuperclass: #ApplicationModel 
cg@3531:         andClass: MenuEditor andSelector: #menuItemImage 
cg@3531:         withResourceTypes: #(image)
cg@3531:      ) openAndLetUserChoose
cg@3531:     "
tz@648: ! !
tz@648: 
tz@730: !ResourceSelectionBrowser class methodsFor:'image specs'!
tz@730: 
tz@906: iconCategory
sv@3117:     <resource: #image>
tz@906:     "This resource specification was automatically generated
tz@906:      by the ImageEditor of ST/X."
tz@906:     "Do not manually edit this!! If it is corrupted,
tz@906:      the ImageEditor may not be able to read the specification."
tz@906:     "
tz@906:      self iconCategory inspect
sv@3117:      ImageEditor openOnClass:self andSelector:#iconCategory"
sv@3117:     
sv@3117:     ^ Icon constantNamed:#'ResourceSelectionBrowser class iconCategory'
sv@3117:         ifAbsentPut:[
sv@3117:             (Depth4Image new)
sv@3117:                 width:18;
sv@3117:                 height:16;
sv@3117:                 photometric:(#palette);
sv@3117:                 bitsPerSample:(#( 4 ));
sv@3117:                 samplesPerPixel:(1);
sv@3117:                 bits:(ByteArray 
sv@3117:                             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');
sv@3117:                 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 ];
sv@3117:                 mask:((ImageMask new)
sv@3117:                             width:18;
sv@3117:                             height:16;
sv@3117:                             bits:(ByteArray 
sv@3117:                                         fromPackedString:'<@O@8@G@3?3@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@3?3@8@G@<@O@');
sv@3117:                             yourself);
sv@3117:                 yourself
sv@3117:         ]
cg@1493: !
tz@906: 
tz@730: iconClass
sv@3117:     <resource: #image>
tz@746:     "This resource specification was automatically generated
tz@746:      by the ImageEditor of ST/X."
tz@746:     "Do not manually edit this!! If it is corrupted,
tz@746:      the ImageEditor may not be able to read the specification."
tz@730:     "
cg@1404:      self iconClass inspect
sv@3117:      ImageEditor openOnClass:self andSelector:#iconClass"
sv@3117:     
sv@3117:     ^ Icon constantNamed:#'ResourceSelectionBrowser class iconClass'
sv@3117:         ifAbsentPut:[
sv@3117:             (Depth2Image new)
sv@3117:                 width:18;
sv@3117:                 height:16;
sv@3117:                 photometric:(#palette);
sv@3117:                 bitsPerSample:(#( 2 ));
sv@3117:                 samplesPerPixel:(1);
sv@3117:                 bits:(ByteArray 
sv@3117:                             fromPackedString:'@@@@@@@*****ABUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@A@@@@@@@@@@@@@b');
sv@3117:                 colorMapFromArray:#[ 0 0 0 170 170 170 255 255 255 ];
sv@3117:                 mask:((ImageMask new)
sv@3117:                             width:18;
sv@3117:                             height:16;
sv@3117:                             bits:(ByteArray 
sv@3117:                                         fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@');
sv@3117:                             yourself);
sv@3117:                 yourself
sv@3117:         ]
cg@1493: !
tz@730: 
tz@730: iconPrivateClass
sv@3117:     <resource: #image>
tz@746:     "This resource specification was automatically generated
tz@746:      by the ImageEditor of ST/X."
tz@746:     "Do not manually edit this!! If it is corrupted,
tz@746:      the ImageEditor may not be able to read the specification."
tz@730:     "
sv@3117:      ImageEditor openOnClass:self andSelector:#iconPrivateClass"
sv@3117:     
sv@3117:     ^ Icon constantNamed:#'ResourceSelectionBrowser class iconPrivateClass'
sv@3117:         ifAbsentPut:[
sv@3117:             (Depth2Image new)
sv@3117:                 width:18;
sv@3117:                 height:16;
sv@3117:                 photometric:(#palette);
sv@3117:                 bitsPerSample:(#( 2 ));
sv@3117:                 samplesPerPixel:(1);
sv@3117:                 bits:(ByteArray 
sv@3117:                             fromPackedString:'@@@@@@PUUUUU A****(@F*??* @Z+??*@A*/*>(OF*>+: @Z+??*@A*/?:(DF*>** @Z+:**@A*/**(@F*>** @Z****C2@@@@@@@@@@@@@b');
sv@3117:                 colorMapFromArray:#[ 0 0 0 255 255 255 170 170 170 255 0 0 ];
sv@3117:                 mask:((ImageMask new)
sv@3117:                             width:18;
sv@3117:                             height:16;
sv@3117:                             bits:(ByteArray 
sv@3117:                                         fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@');
sv@3117:                             yourself);
sv@3117:                 yourself
sv@3117:         ]
cg@1493: ! !
tz@730: 
tz@425: !ResourceSelectionBrowser class methodsFor:'interface specs'!
tz@425: 
tz@425: windowSpec
tz@746:     "This resource specification was automatically generated
tz@746:      by the UIPainter of ST/X."
tz@425: 
tz@746:     "Do not manually edit this!! If it is corrupted,
tz@746:      the UIPainter may not be able to read the specification."
tz@425: 
tz@425:     "
tz@425:      UIPainter new openOnClass:ResourceSelectionBrowser andSelector:#windowSpec
tz@425:      ResourceSelectionBrowser new openInterface:#windowSpec
tz@746:      ResourceSelectionBrowser open
tz@425:     "
tz@425: 
tz@425:     <resource: #canvas>
tz@425: 
cg@1384:     ^ 
cg@3531:     #(FullSpec
cg@3531:        name: windowSpec
cg@3531:        uuid: 'fb378b3c-07aa-11e8-8563-b8f6b1108e05'
cg@3531:        window: 
cg@3531:       (WindowSpec
cg@3531:          label: 'Resource Selection Browser'
cg@3531:          name: 'Resource Selection Browser'
cg@3531:          uuid: 'f1361a68-0791-11e8-8563-b8f6b1108e05'
cg@3531:          min: (Point 400 300)
cg@3531:          bounds: (Rectangle 0 0 644 460)
cg@3531:        )
cg@3531:        component: 
cg@3531:       (SpecCollection
cg@3531:          collection: (
cg@3531:           (VariableHorizontalPanelSpec
cg@3531:              name: 'VariableHorizontalPanel'
cg@3531:              layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 -36 1.0)
cg@3531:              uuid: 'f1361c5c-0791-11e8-8563-b8f6b1108e05'
cg@3531:              component: 
cg@3531:             (SpecCollection
cg@3531:                collection: (
cg@3531:                 (ViewSpec
cg@3531:                    name: 'Box1'
cg@3531:                    uuid: 'f1361df6-0791-11e8-8563-b8f6b1108e05'
cg@3531:                    component: 
cg@3531:                   (SpecCollection
cg@3531:                      collection: (
cg@3531:                       (HorizontalPanelViewSpec
cg@3531:                          name: 'HorizontalPanel2'
cg@3531:                          layout: (LayoutFrame 0 0 2 0 297 0 23 0)
cg@3531:                          uuid: 'f1361ebe-0791-11e8-8563-b8f6b1108e05'
cg@3531:                          horizontalLayout: leftSpace
cg@3531:                          verticalLayout: fit
cg@3531:                          horizontalSpace: 3
cg@3531:                          verticalSpace: 3
cg@3531:                          component: 
cg@3531:                         (SpecCollection
cg@3531:                            collection: (
cg@3531:                             (RadioButtonSpec
cg@3531:                                label: 'Flat'
cg@3531:                                name: 'RadioButton1'
cg@3531:                                uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
cg@3531:                                translateLabel: true
cg@3531:                                model: selectionOfClassPresentation
cg@3531:                                isTriggerOnDown: true
cg@3531:                                lampColor: (Color 0.0 0.0 0.0)
cg@3531:                                select: Flat
cg@3531:                                extent: (Point 80 21)
cg@3531:                              )
cg@3531:                             (RadioButtonSpec
cg@3531:                                label: 'Categories'
cg@3531:                                name: 'ClassCategoriesRadioButton'
cg@3531:                                uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
cg@3531:                                translateLabel: true
cg@3531:                                model: selectionOfClassPresentation
cg@3531:                                isTriggerOnDown: true
cg@3531:                                lampColor: (Color 0.0 0.0 0.0)
cg@3531:                                select: #'Class Categories'
cg@3531:                                extent: (Point 124 21)
cg@3531:                              )
cg@3531:                             (RadioButtonSpec
cg@3531:                                label: 'Hierarchy'
cg@3531:                                name: 'ClassHierarchyRadioButton'
cg@3531:                                uuid: 'f136233c-0791-11e8-8563-b8f6b1108e05'
cg@3531:                                translateLabel: true
cg@3531:                                model: selectionOfClassPresentation
cg@3531:                                isTriggerOnDown: true
cg@3531:                                lampColor: (Color 0.0 0.0 0.0)
cg@3531:                                select: #'Class Hierarchy'
cg@3531:                                extent: (Point 145 21)
cg@1384:                              )
cg@3531:                             )
cg@3531:                           
cg@3531:                          )
cg@3531:                        )
cg@3531:                       (SequenceViewSpec
cg@3531:                          name: 'listOfClassesView'
cg@3531:                          layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@3531:                          uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
cg@3531:                          tabable: true
cg@3531:                          model: indexOfSelectedClassInFlatList
cg@3531:                          hasHorizontalScrollBar: true
cg@3531:                          hasVerticalScrollBar: true
cg@3531:                          miniScrollerHorizontal: true
cg@3531:                          useIndex: true
cg@3531:                          sequenceList: listOfClassNames
cg@3531:                        )
cg@3531:                       (SelectionInTreeViewSpec
cg@3531:                          name: 'listOfClassHierarchyView'
cg@3531:                          layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@3531:                          uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
cg@3531:                          tabable: true
cg@3531:                          model: selectionOfClassHierarchy
cg@3531:                          hasHorizontalScrollBar: true
cg@3531:                          hasVerticalScrollBar: true
cg@3531:                          miniScrollerHorizontal: true
cg@3531:                          showDirectoryIndicatorForRoot: false
cg@3531:                          showDirectoryIndicator: true
cg@3531:                          valueChangeSelector: classSelected
cg@3531:                          hierarchicalList: rootOfClassHierarchy
cg@3531:                          validateDoubleClickSelector: validateDoubleClick:
cg@3531:                          contentsSelector: treeViewClassHierarchyContents
cg@3531:                          labelSelector: treeViewClassHierarchyLabel
cg@3531:                          childrenSelector: treeViewClassHierarchyChildren
cg@3531:                          iconSelector: treeViewClassHierarchyIcon
cg@3531:                          highlightMode: line
cg@3531:                        )
cg@3531:                       (SelectionInTreeViewSpec
cg@3531:                          name: 'listOfClassCategoriesView'
cg@3531:                          layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@3531:                          uuid: 'f13627ba-0791-11e8-8563-b8f6b1108e05'
cg@3531:                          tabable: true
cg@3531:                          model: selectionOfClassCategories
cg@3531:                          hasHorizontalScrollBar: true
cg@3531:                          hasVerticalScrollBar: true
cg@3531:                          miniScrollerHorizontal: true
cg@3531:                          showRoot: false
cg@3531:                          showDirectoryIndicator: true
cg@3531:                          valueChangeSelector: classSelected
cg@3531:                          hierarchicalList: rootOfClassCategories
cg@3531:                          validateDoubleClickSelector: validateDoubleClick:
cg@3531:                          childrenSelector: treeViewClassCategoryChildren
cg@3531:                          iconSelector: treeViewClassCategoryIcon
cg@3531:                          highlightMode: line
cg@3531:                        )
cg@3531:                       (InputFieldSpec
cg@3531:                          name: 'classNameInputField'
cg@3531:                          layout: (LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
cg@3531:                          uuid: 'f1362922-0791-11e8-8563-b8f6b1108e05'
cg@3531:                          tabable: true
cg@3531:                          model: classNameHolder
cg@3531:                          acceptOnLeave: true
cg@3531:                          acceptOnLostFocus: true
cg@3531:                          acceptOnPointerLeave: true
cg@1384:                        )
cg@3531:                       )
cg@3531:                     
cg@3531:                    )
cg@3531:                  )
cg@3531:                 (ViewSpec
cg@3531:                    name: 'Box2'
cg@3531:                    uuid: 'f1362aee-0791-11e8-8563-b8f6b1108e05'
cg@3531:                    component: 
cg@3531:                   (SpecCollection
cg@3531:                      collection: (
cg@3531:                       (VariableVerticalPanelSpec
cg@3531:                          name: 'ResourcePanel'
cg@3531:                          layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -24 1.0)
cg@3531:                          uuid: '51c4b91e-07a8-11e8-8563-b8f6b1108e05'
cg@3531:                          component: 
cg@3531:                         (SpecCollection
cg@3531:                            collection: (
cg@3531:                             (DataSetSpec
cg@3531:                                name: 'resourcesDataSetView'
cg@3531:                                uuid: 'f1362bac-0791-11e8-8563-b8f6b1108e05'
cg@3531:                                model: selectionOfResourceMethod
cg@3531:                                hasHorizontalScrollBar: true
cg@3531:                                hasVerticalScrollBar: true
cg@3531:                                miniScrollerHorizontal: true
cg@3531:                                rowClassName: 'ResourceSelectionBrowser::Row'
cg@3531:                                dataList: listOfResourceMethods
cg@3531:                                useIndex: false
cg@3531:                                has3Dseparators: true
cg@3531:                                doubleClickSelector: resourceDoubleClicked
cg@3531:                                columnHolder: resourceMethodColumns
cg@3531:                                valueChangeSelector: resourceSelected
cg@3531:                                verticalSpacing: 1
cg@3531:                              )
cg@3531:                             (ArbitraryComponentSpec
cg@3531:                                name: 'ImageView'
cg@3531:                                uuid: '51c4bd9c-07a8-11e8-8563-b8f6b1108e05'
cg@3531:                                hasBorder: false
cg@3531:                                component: ImageView
cg@3531:                              )
cg@3531:                             )
cg@3531:                           
cg@3531:                          )
cg@3531:                          handles: (Any 0.98999999999999999 1.0)
cg@1384:                        )
cg@3531:                       (InputFieldSpec
cg@3531:                          name: 'selectorInputField'
cg@3531:                          layout: (LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
cg@3531:                          uuid: 'f1362db4-0791-11e8-8563-b8f6b1108e05'
cg@3531:                          tabable: true
cg@3531:                          model: resourceSelectorHolder
cg@3531:                          acceptOnLeave: true
cg@3531:                          acceptOnLostFocus: true
cg@3531:                          acceptOnPointerLeave: true
cg@3531:                        )
cg@3531:                       )
cg@3531:                     
cg@3531:                    )
cg@1384:                  )
cg@3531:                 )
cg@3531:               
cg@3531:              )
cg@3531:              handles: (Any 0.5 1.0)
cg@3531:            )
cg@3531:           (HorizontalPanelViewSpec
cg@3531:              name: 'ButtonPanel'
cg@3531:              layout: (LayoutFrame 2 0.0 -30 1 -18 1.0 -4 1.0)
cg@3531:              uuid: 'f1362f3a-0791-11e8-8563-b8f6b1108e05'
cg@3531:              horizontalLayout: fit
cg@3531:              verticalLayout: fit
cg@3531:              reverseOrderIfOKAtLeft: true
cg@3531:              component: 
cg@3531:             (SpecCollection
cg@3531:                collection: (
cg@3531:                 (ActionButtonSpec
cg@3531:                    label: 'Help'
cg@3531:                    name: 'HelpButton'
cg@3531:                    activeHelpKey: dss
cg@3531:                    uuid: 'f136303e-0791-11e8-8563-b8f6b1108e05'
cg@3531:                    translateLabel: true
cg@3531:                    model: openHTMLDocument:
cg@3531:                    initiallyDisabled: true
cg@3531:                    enableChannel: helpEnabled
cg@3531:                    actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
cg@3531:                    extent: (Point 204 26)
cg@1384:                  )
cg@3531:                 (ActionButtonSpec
cg@3531:                    label: 'Cancel'
cg@3531:                    name: 'cancelButton'
cg@3531:                    activeHelpKey: commitCancel
cg@3531:                    uuid: 'f13631ba-0791-11e8-8563-b8f6b1108e05'
cg@3531:                    translateLabel: true
cg@3531:                    tabable: true
cg@3531:                    model: cancel
cg@3531:                    extent: (Point 204 26)
cg@3531:                  )
cg@3531:                 (ActionButtonSpec
cg@3531:                    label: 'OK'
cg@3531:                    name: 'okButton'
cg@3531:                    activeHelpKey: commitOK
cg@3531:                    uuid: 'f1363336-0791-11e8-8563-b8f6b1108e05'
cg@3531:                    translateLabel: true
cg@3531:                    tabable: true
cg@3531:                    model: accept
cg@3531:                    isDefault: true
cg@3531:                    extent: (Point 204 26)
cg@3531:                  )
cg@3531:                 )
cg@3531:               
cg@3531:              )
cg@3531:              keepSpaceForOSXResizeHandleH: true
cg@1384:            )
cg@3531:           )
cg@3531:         
cg@3531:        )
cg@3531:      )
tz@425: ! !
tz@425: 
tz@648: !ResourceSelectionBrowser class methodsFor:'list specs'!
tz@648: 
tz@822: tableColumnsForResourceMethodAttributes
tz@821:     "This resource specification was automatically generated
tz@821:      by the DataSetBuilder of ST/X."
tz@821: 
tz@821:     "Do not manually edit this!! If it is corrupted,
tz@821:      the DataSetBuilder may not be able to read the specification."
tz@821: 
tz@821:     "
tz@822:      DataSetBuilder new openOnClass:ResourceSelectionBrowser andSelector:#tableColumnsForResourceMethodAttributes
tz@821:     "
tz@821: 
tz@821:     <resource: #tableColumns>
tz@821: 
tz@648: 
tz@821:     ^ #(
tz@821:         #(#DataSetColumnSpec
tz@821:            #width: 20
tz@821:            #height: 20
tz@821:            #printSelector: #iconOn:
tz@821:            #canSelect: false
tz@821:        )
tz@821:         #(#DataSetColumnSpec
tz@821:            #label: ' Selector'
tz@821:            #labelAlignment: #left
tz@821:            #model: #selector
tz@821:            #canSelect: false
tz@821:        )
tz@821:         #(#DataSetColumnSpec
tz@821:            #label: ' Resource Type'
tz@821:            #labelAlignment: #left
tz@821:            #model: #resourceType
tz@821:            #canSelect: false
tz@821:        )
tz@821:      )
tz@648: ! !
tz@648: 
cg@3531: !ResourceSelectionBrowser methodsFor:'accessing'!
cg@3531: 
cg@3531: classFilter:aBlock
cg@3531:     "aBlock to return true/false, given a class.
cg@3531:      With false, it is not shown in the tree"
cg@3531: 
cg@3531:     classFilter := aBlock.
cg@3531: !
cg@3531: 
cg@3531: existingOnly:something
cg@3531:     existingOnly := something.
cg@3531: !
cg@3531: 
cg@3531: metaClassOnly:aBoolean
cg@3531:     "force selection to be limited to the metaclass"
cg@3531: 
cg@3531:     metaClassOnly := aBoolean.
cg@3531: !
cg@3531: 
cg@3531: packageFilter:aBlock
cg@3531:     "aBlock to return true/false, given a packageID.
cg@3531:      With false, the class is not shown in the tree"
cg@3531: 
cg@3531:     packageFilter := aBlock.
cg@3531: ! !
cg@3531: 
tz@425: !ResourceSelectionBrowser methodsFor:'aspects'!
tz@425: 
cg@1986: classNameHolder
cg@1986:     "returns the value holder for the name of the class"
cg@1986: 
cg@1986:     |holder|
cg@1986: 
cg@1986:     (holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[
cg@1986:         builder aspectAt:#valueOfClassName put:(holder :=  '' asValue).
cg@1986:         holder onChangeEvaluate:[self classSelectionUpdate:holder value].
cg@1986:     ].
cg@1986:     ^ holder
cg@1986: !
cg@1986: 
tz@773: helpEnabled
tz@773:     "returns whether there is a documentation file"
tz@773: 
tz@773:     ^true
tz@773: !
tz@773: 
cg@3531: indexOfSelectedClassInFlatList
cg@3531:     |holder|
cg@3531: 
cg@3531:     (holder := builder bindingAt:#indexOfSelectedClassInFlatList) isNil ifTrue:[
cg@3531:         builder aspectAt:#indexOfSelectedClassInFlatList put:(holder := nil asValue).
cg@3531:         holder onChangeEvaluate:[ 
cg@3531:             |clsName|
cg@3531: 
cg@3531:             clsName := self listOfClassNames at:holder value ifAbsent:nil.
cg@3531:             clsName notNil ifTrue:[
cg@3531:                 classSelectionBlock value:clsName  
cg@3531:             ]. 
cg@3531:         ]. 
cg@3531:     ].
cg@3531:     ^ holder
cg@3531: !
cg@3531: 
cg@3531: listOfClassNames
cg@3531:     "returns the value holder for the flat class list"
cg@3531: 
cg@3531:     |holder|
cg@3531: 
cg@3531: 
cg@3531:     (holder := builder bindingAt:#listOfClassNames) isNil ifTrue:[
cg@3531:         builder aspectAt:#listOfClassNames put: (holder := List new).
cg@3531:     ].
cg@3531:     ^ holder
cg@3531: !
cg@3531: 
tz@771: listOfResourceMethods
tz@771:     "returns the value holder for the list of the resource methods"
tz@648: 
cg@1184:     ^ builder listAspectFor:#listOfResourceMethods
tz@648: !
tz@648: 
tz@771: resourceMethodColumns
tz@771:     "returns the columns for the table of the resource methods as value holder"
tz@425: 
tz@425:     |holder|
tz@771:     (holder := builder bindingAt:#resourceMethodColumns) isNil ifTrue:[
tz@821:         builder aspectAt:#resourceMethodColumns put:(holder := List new).
tz@822:         holder addAll: (self class tableColumnsForResourceMethodAttributes collect: [:i| i decodeAsLiteralArray]).
tz@771:     ].
tz@771:     ^ holder
tz@771: !
tz@771: 
cg@1986: resourceSelectorHolder
cg@1986:     "returns the value holder for the name of the selector"
cg@1986: 
cg@3652:     ^ builder valueAspectFor:#resourceSelectorHolder initialValue:''
cg@3652: 
cg@3652:     "Modified: / 09-03-2019 / 22:19:19 / Claus Gittinger"
cg@1986: !
cg@1986: 
tz@906: rootOfClassCategories
tz@906:     "returns the value holder for the root of the class tree list"
tz@906: 
tz@906:     |holder|                                
tz@906: 
tz@906:     (holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[
cg@3531:         classPresentation = #'Class Categories' ifTrue: [
cg@3531:             builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')
cg@3531:         ].
tz@906:     ].
tz@906:     ^ holder
tz@906: !
tz@906: 
tz@906: rootOfClassHierarchy
tz@771:     "returns the value holder for the root of the class tree list"
tz@771: 
tz@771:     |holder|
tz@906: 
tz@906: 
tz@906:     (holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[
cg@3531:         classPresentation = #'Class Hierarchy' ifTrue: [
cg@3531:             builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)
cg@3531:         ]
tz@425:     ].
tz@425:     ^ holder
tz@425: !
tz@425: 
tz@906: selectionOfClassCategories
tz@906:     "returns the value holder for the selected class of the class tree list"
tz@906: 
tz@906:     |holder|           
tz@906:     (holder := builder bindingAt:#selectionOfClassCategories) isNil ifTrue:[
tz@906:         builder aspectAt:#selectionOfClassCategories put:(holder :=  ValueHolder new). 
tz@906:     ].
tz@906:     ^ holder
tz@906: !
tz@906: 
tz@906: selectionOfClassHierarchy
tz@771:     "returns the value holder for the selected class of the class tree list"
tz@425: 
tz@906:     |holder|           
tz@906:     (holder := builder bindingAt:#selectionOfClassHierarchy) isNil ifTrue:[
tz@906:         builder aspectAt:#selectionOfClassHierarchy put:(holder :=  ValueHolder new). 
tz@906:     ].
tz@906:     ^ holder
tz@906: !
tz@906: 
tz@906: selectionOfClassPresentation
cg@3531:     "returns the value holder for the selected class presentation
cg@3531:      (Flat, Hierarchy or Category)"
tz@906: 
tz@425:     |holder|
cg@1034: 
tz@906:     (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[
cg@3531:         builder 
cg@3531:             aspectAt:#selectionOfClassPresentation 
cg@3531:             put:(holder := RadioButtonGroup with: (classPresentation := classPresentation ? LastClassPresentation ? #'Class Categories')).
cg@1034: 
cg@3531:         holder onChangeEvaluate:[self classPresentationChanged ]. 
tz@425:     ].
tz@425:     ^ holder
tz@425: !
tz@425: 
tz@771: selectionOfResourceMethod
tz@771:     "returns the value holder for the selected resource method of the resource method list"
tz@425: 
cg@3652:     ^ builder valueAspectFor:#selectionOfResourceMethod initialValue:''
cg@3652: 
cg@3652:     "Modified: / 09-03-2019 / 22:19:30 / Claus Gittinger"
tz@425: !
tz@425: 
tz@467: valueOfClassName
sv@2309:     <resource: #obsolete>
tz@771:     "returns the value holder for the name of the class"
tz@467: 
cg@1986:     self obsoleteMethodWarning:'stupid name - use #classNameHolder'.
cg@1986:     ^ self classNameHolder
tz@467: !
tz@467: 
tz@771: valueOfResourceSelector
sv@2309:     <resource: #obsolete>
tz@771:     "returns the value holder for the name of the selector"
tz@425: 
cg@1986:     self obsoleteMethodWarning:'stupid name - use #resourceSelectorHolder'.
cg@1986:     ^ self resourceSelectorHolder
tz@425: ! !
tz@425: 
cg@3531: !ResourceSelectionBrowser methodsFor:'callbacks-user'!
tz@906: 
cg@3531: classPresentationChanged
cg@3531:     "returns the value holder for the selected class presentation
cg@3531:      (Flat, Hierarchy or Category)"
cg@1034: 
cg@3531:     |comp newRoot|
cg@1034: 
cg@3531:     classPresentation := LastClassPresentation := self selectionOfClassPresentation value.
cg@1034: 
cg@3531:     classPresentation == #'Flat' ifTrue:[
cg@3531:         self listOfClassNames isEmpty ifTrue:[ self updateListOfClasses ].
cg@3531:         comp := builder componentAt: #listOfClassesView.
cg@3531:     ] ifFalse:[
cg@3531:         classPresentation == #'Class Hierarchy' ifTrue:[
cg@3531:              comp := builder componentAt: #listOfClassHierarchyView.
cg@3531:              newRoot := self rootOfClassHierarchy.  
cg@3531:         ] ifFalse: [
cg@3531:             comp := builder componentAt: #listOfClassCategoriesView.
cg@3531:             newRoot := self rootOfClassCategories. 
cg@3531:         ].
cg@3531:         comp root:newRoot.
cg@1034:     ].
cg@1034: 
cg@3531:     comp raise; requestFocus.
cg@3531:     classSelectionBlock value:(self classNameHolder value)
cg@3531: !
cg@3531: 
cg@3531: classSelected
cg@3531:     "after a class selection, read the allowed resource methods of the selected class"
cg@3531: 
cg@3531:     |sel className|
cg@3531: 
cg@3531:     classPresentation = #'Class Hierarchy'
cg@3531: "/        ifTrue:  [sel := self selectionOfClassHierarchy value]
cg@3531:         ifFalse: [sel := self selectionOfClassCategories value].
cg@3531: 
cg@3531:     resourceClass := nil.
cg@3531:     sel notNil ifTrue:[
cg@3531:         sel contents ~~ #Category ifTrue:[
cg@3531:             className := sel name.
cg@3531:             resourceClass := Smalltalk classNamed:className.
cg@3531:         ]
cg@3531:     ].
cg@3531:     self updateResourceMethodList.
cg@3531: !
cg@3531: 
cg@3531: classSelectionUpdate:clsPattern
cg@3531:     "called when a new class is selected AND when switching presentation modes"
cg@3531: 
cg@3531:     |foundClass classes|  
cg@3531: 
cg@3531:     "/ because this is also called for presentation switch,
cg@3531:     "/ we cannot tune it this way...
cg@3531:     "/ (self classNameHolder value = clsPattern) ifTrue:[
cg@3531:     "/     resourceClass notNil ifTrue:[
cg@3531:     "/         resourceClass name = clsPattern ifTrue:[
cg@3531:     "/             ^ self 
cg@3531:     "/         ].
cg@3531:     "/     ].
cg@3531:     "/ ].
cg@1034: 
cg@3531:     clsPattern notNil ifTrue:[
cg@3531:         foundClass := Smalltalk classNamed:clsPattern.
cg@3531:     ].
cg@3531:     (foundClass isClass not or:[foundClass name ~= clsPattern])
cg@3531:     ifTrue: [
cg@3531:         classes := allClasses select: [:cls| cls name size >= clsPattern size].
cg@3531:         1 to: clsPattern size do: [:i|    
cg@3531:              classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)].
cg@3531:         ].    
cg@3531:         foundClass := classes at: 1 ifAbsent:[]. 
cg@3531:     ].          
cg@3531: 
cg@3531:     foundClass notNil ifTrue: [           
cg@3531:         foundClass := foundClass autoload.
cg@3531:         resourceClass := foundClass.
cg@3531: 
cg@3531:         classPresentation = #'Flat' ifTrue: [
cg@3531:             |index|
cg@3531: 
cg@3531:             index := self listOfClassNames indexOf:resourceClass name.
cg@3531:             self indexOfSelectedClassInFlatList value:index.
cg@3531:         ] ifFalse: [
cg@3531:             classPresentation = #'Class Hierarchy' ifTrue: [
cg@3531:                 |searchArgs nonSuperclasses hierItem|
cg@3531: 
cg@3531:                 false "foundClass isPrivate"
cg@3531:                     ifFalse: [searchArgs := foundClass withAllSuperclasses reversed]
cg@3531:                     ifTrue:  [searchArgs := foundClass owningClass withAllSuperclasses reversed. 
cg@3531:                               searchArgs add: foundClass].                                  
cg@3531:                 (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil 
cg@3531:                     ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
cg@3531: 
cg@3531:                 hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs.
cg@3531:                 hierItem notNil ifTrue:[
cg@3531:                     self selectionOfClassHierarchy value:hierItem.
cg@3531:                 ].
cg@3531:             ] ifFalse: [
cg@3531:                 |searchArgs hierItem|
cg@3531: 
cg@3531:                 false "foundClass isPrivate"
cg@3531:                     ifTrue:  [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass owningClass name with: foundClass name]
cg@3531:                     ifFalse: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass name].
cg@3531: 
cg@3531:                 hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs.
cg@3531:                 hierItem notNil ifTrue:[
cg@3531:                     self selectionOfClassCategories value: hierItem.
cg@3531:                 ].
cg@1034:             ].
cg@1034:         ].
cg@3531:     ].
cg@3531: 
cg@3531:     self classNameHolder value: clsPattern.
cg@3531:     self updateResourceMethodList.
cg@3531: !
cg@3531: 
cg@3531: resourceDoubleClicked
cg@3531:     "after a double click on resource method, accept it and close"
cg@3531: 
cg@3531:     accept value: true.
cg@3531:     self closeRequest
cg@3531: !
cg@3531: 
cg@3531: resourceSelected
cg@3531:     "after a click on a resource method, set its selector into the field"
cg@3531: 
cg@3531:     |selectedMethodInfo mthd|
cg@3531: 
cg@3531:     selectedMethodInfo := self selectionOfResourceMethod value.
cg@3531:     selectedMethodInfo notNil ifTrue: [
cg@3531:         self resourceSelectorHolder value:(selectedMethodInfo selector).
cg@3531:         mthd := selectedMethodInfo method.
cg@3531:         (mthd hasResource:#image) ifTrue:[
cg@3531:             (builder componentAt:#ImageView)
cg@3531:                 image:(mthd valueWithReceiver:nil arguments:#())
cg@3531:         ].
cg@1034:     ]
cg@3531: !
cg@2908: 
cg@3531: updateListOfClasses
cg@3531:     |names|
cg@3531: 
cg@3531:     classPresentation = #'Flat' ifTrue: [
cg@3531:         self listOfClassNames isEmpty ifTrue:[
cg@3531:             names := (Smalltalk allClasses asOrderedCollection sortBySelector:#name)
cg@3531:                         select:[:cls | self filterClass:cls]
cg@3531:                         thenCollect:[:cls | cls name].
cg@3531:             self listOfClassNames addAll:names.
cg@3531:         ]
cg@3531:     ]
tz@906: !
tz@906: 
cg@3531: updateResourceMethodList
cg@3531:     "read the allowed resource methods of the selected class"
cg@3531: 
cg@3531:     |class className item|
cg@3531: 
cg@3531:     (class := resourceClass) isNil ifTrue:[
cg@3531:         classPresentation = #'Class Hierarchy'
cg@3531:             ifTrue:  [item := self selectionOfClassHierarchy value ]
cg@3531:             ifFalse: [item := self selectionOfClassCategories value ].
tz@906: 
cg@3531:         item notNil ifTrue:[
cg@3531:             item contents ~~ #Category ifTrue:[
cg@3531:                 className := item name.
cg@3531:                 class := Smalltalk at:className asSymbol.
cg@3531:             ]
cg@3531:         ].
cg@3531:     ] ifFalse:[
cg@3531:         class := resourceClass
cg@3531:     ].
tz@906: 
cg@3531:     class isNil ifTrue: [
cg@3531:         self listOfResourceMethods contents:#().
cg@3531:         ^self
cg@3531:     ].
tz@632: 
cg@3531:     className := class name."/class theNonMetaclass name
cg@3531: 
cg@3531:     self withWaitCursorDo:[
cg@3531:         |newContents|           
cg@3531: 
cg@3531:         resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
tz@632: 
cg@3531:         self classNameHolder value: className.
cg@3531:         self class lastSelection: className.
cg@3531: 
cg@3531:         newContents := class theMetaclass methodDictionary asOrderedCollection 
cg@3531:                             select:[:m | resourceTypes includes: m resourceType].
cg@3531: 
cg@3531:         newContents := newContents sort:[:m1 :m2 | m1 selector < m2 selector].
cg@3531:         newContents := newContents collect:[:m| (ResourceMethod new method:m)].
cg@3531: 
cg@3531:         self listOfResourceMethods contents:newContents
cg@3531:                 .
cg@3531:     ]
tz@771: !
tz@771: 
tz@771: validateDoubleClick: aTreeItem
tz@771:     "returns whether a class may be selected"
tz@771: 
cg@1034:     |cont|
cg@1034: 
cg@1034:     ^ (cont := aTreeItem contents) ~= '' 
cg@1034:       and: [cont ~~ self treeViewClassHierarchyContents]       
tz@771: 
tz@771: 
tz@771: 
tz@632: ! !
tz@632: 
cg@3531: !ResourceSelectionBrowser methodsFor:'initialization'!
cg@1384: 
cg@3531: initialize
cg@3531:     "Invoked when a new instance is created."
cg@1384: 
cg@3531:     metaClassOnly := true.
cg@3531:     existingOnly := false.
cg@1732: 
cg@3531:     super initialize.
tz@425: ! !
tz@425: 
tz@425: !ResourceSelectionBrowser methodsFor:'instance creation'!
tz@425: 
cg@3531: onSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
cg@3531:     "create - but do not yet open
cg@3531:      a ResourceSelectionBrowser"
tz@425: 
cg@3531:     |cls|
tz@771: 
tz@517:     resourceMethod := aSelector.
tz@425:     resourceTypes := aResourceTypes.
tz@425:     resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol].
cg@802:     resourceClass := nil.
cg@802: 
cg@1978:     aClassOrClassName notNil ifTrue:[
cg@1978:         aClassOrClassName isClass ifTrue: [
cg@1978:             cls := aClassOrClassName. 
cg@1978:             resourceClass := aClassOrClassName
cg@1978:         ] ifFalse: [
cg@1978:             cls := Smalltalk classNamed: aClassOrClassName.
cg@1978:             cls notNil ifTrue:[
cg@1978:                 resourceClass := cls
cg@802:             ]
cg@1978:         ]
cg@1978:     ].            
cg@1986:     self resourceSelectorHolder value:(aSelector ? '').
cg@3531: ! !
cg@3531: 
cg@3531: !ResourceSelectionBrowser methodsFor:'startup & release'!
cg@3531: 
cg@3531: openAndLetUserChoose
cg@3531:     "opens the previously configured receiver;
cg@3531:      return a Message-object or nil"
cg@3531: 
cg@3531:     |selectedClass enteredClassName className cls|
cg@3531: 
tz@463:     self open.
tz@463: 
cg@1978:     (selectedClass := self selectionOfClassHierarchy value) isNil ifTrue:[
cg@1978:         (selectedClass := self selectionOfClassCategories value) isNil ifTrue:[
cg@1986:             (enteredClassName := self classNameHolder value) isNil ifTrue:[
cg@1086:                 accept value ifTrue:[
cg@1086:                     self warn:'No valid class selected/entered'.
cg@1086:                 ].
cg@1086:                 ^ nil
cg@1086:             ]
cg@1086:         ]
cg@1086:     ].
tz@693: 
cg@1978:     className := enteredClassName.    
cg@1978:     className isNil ifTrue:[
cg@1978:         className := selectedClass name
tz@425:     ].
cg@1978:     cls := Smalltalk classNamed:className.
cg@1978:     (cls isClass and:[accept value]) ifTrue:[            
cg@1986:         ^ Method::MethodWhoInfo class:cls selector:(self resourceSelectorHolder value)
cg@1086:     ].
cg@1086: 
cg@1086:     accept value ifTrue:[
cg@1086:         self warn:'No valid class selected/entered'.
cg@1086:     ].
cg@1086:     ^ nil
cg@802: 
cg@802:     "Modified: / 22.4.1998 / 14:51:03 / cg"
cg@3531: !
cg@3531: 
cg@3531: openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
cg@3531:     "opens a ResourceSelectionBrowser; return a Message-object or nil"
tz@425: 
cg@3531:     self 
cg@3531:         onSuperclass: aSuperclassOrSymbol 
cg@3531:         andClass:aClassOrClassName andSelector: aSelector 
cg@3531:         withResourceTypes: aResourceTypes.
cg@3531: 
cg@3531:     self openAndLetUserChoose
cg@3531: !
tz@425: 
tz@623: postBuildWith:aBuilder
tz@771:     "after building and before opening,  
tz@906:      create a class selection block, an entry completion block for the class name field"
tz@623: 
tz@771:     |classSelection classNameInputField|
cg@3531: 
cg@3531:     (resourceTypes notNil and:[(resourceTypes includesAny:#(image programImage))]) ifTrue:[
cg@3531:         (builder componentAt: #resourcesDataSetView)
cg@3531:             origin:0.0@0.0 extent:(1.0 @ 0.7).
cg@3531:         (builder componentAt: #ImageView) 
cg@3531:             origin:0.0@0.7 extent:(1.0 @ 0.3); beVisible.
cg@3531:         (builder componentAt: #ResourcePanel)
cg@3531:             resizeSubviews; sizeChanged:nil.
cg@3531:     ].
cg@3531: 
tz@906:     allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate].
cg@1978:     classSelection := resourceClass isNil ifTrue:[nil] ifFalse:[resourceClass name]. 
cg@802: 
cg@1978:     (classSelection isNil or:[ (Smalltalk classNamed: classSelection) isNil]) 
tz@689:         ifTrue: [classSelection :=  self class lastSelection].
cg@1732: "/    (classSelection isNil or:[Smalltalk at: classSelection]) isNil 
cg@1732: "/        ifTrue: [classSelection :=  self treeViewContents].
cg@802: 
cg@1384:     classSelectionBlock := [:clsPattern | self classSelectionUpdate:clsPattern].
cg@1986:     self classNameHolder value:classSelection.  
tz@771: 
cg@1920:     (classNameInputField := builder componentAt: #classNameInputField) 
cg@1920:         entryCompletionBlock:
cg@1920:             [:value|
cg@1920:                 |s what m|
cg@1920: 
cg@1920:                 s := classNameInputField contents withoutSpaces.
cg@1920:                 what := Smalltalk classnameCompletion:s inEnvironment:Smalltalk.
cg@1920:                 classNameInputField contents:what first.
cg@1920:                 (what at:2) size ~~ 1 ifTrue:[
cg@3528:                     classNameInputField device beepInEditor
cg@3531:                 ].
cg@3531:                 (Smalltalk classNamed:(what at:1)) notNil ifTrue:[
cg@3531:                     self classNameHolder value:(what at:1)
cg@3531:                 ].
cg@1920: "/                |what oldClassName|
cg@1920: "/                oldClassName := classNameInputField contents.
cg@1920: "/                what := Smalltalk classnameCompletion: value withoutSpaces.
cg@1920: "/                classNameInputField contents:what first.
cg@1920: "/                oldClassName = classNameInputField contents ifTrue:[classNameInputField flash].
cg@1920: "/                classSelectionBlock value: classNameInputField contents
cg@1920:             ].
tz@771: 
cg@1986:     classSelectionBlock value: self classNameHolder value.
cg@3531:     "/ self updateResourceMethodList. -- will be done automatically via change
tz@906:     self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
tz@909: 
tz@909:     ^super postBuildWith:aBuilder
tz@910: !
tz@910: 
tz@910: postOpenWith:aBuilder
tz@910:     "after opening and if turned on make hierarchy view visible"
tz@910: 
cg@3531:     classPresentation = #'Class Hierarchy' ifTrue: [
cg@3531:         (builder componentAt: #listOfClassHierarchyView) raise
cg@3531:     ].
cg@3531:     classPresentation = #'Flat' ifTrue: [
cg@3531:         self updateListOfClasses.
cg@3531:         (builder componentAt: #listOfClassesView) raise
cg@3531:     ].
tz@910: 
cg@2026:     super postOpenWith:aBuilder
tz@425: ! !
tz@425: 
cg@3531: !ResourceSelectionBrowser methodsFor:'tree building - category'!
cg@3531: 
cg@3531: filterClass:cls
cg@3531:     "true if cls is to be shown"
cg@3531: 
cg@3531:     classFilter notNil ifTrue:[
cg@3531:         (classFilter value:cls) ifFalse:[^ false].
cg@3531:     ].
cg@3531:     packageFilter notNil ifTrue:[
cg@3531:         (packageFilter value:cls package) ifFalse:[^ false].
cg@3531:     ].
cg@3531:     existingOnly == true ifTrue:[
cg@3531:         ^ cls theMetaclass methodDictionary 
cg@3531:             contains:[:m | 
cg@3531:                 resourceTypes includes:m resourceType
cg@3531:             ].
cg@3531:     ].
cg@3531:     ^ true
cg@3531: !
cg@3531: 
cg@3531: treeViewClassCategoryChildren
cg@3531:     "returns the children for the contents (class) of aTreeItem as a block"
cg@3531: 
cg@3531:     "/ cg: tz's algorithm was very-very slow, 
cg@3531:     "/ (it enumerated classes hundreds of times,
cg@3531:     "/  leading to a square runtime behavior
cg@3531:     "/  - i.e. very slow scrolling )
cg@3531:     "/ Speed up things by caching facts while enumerating
cg@3531:     "/ classes once only.
cg@3531: 
cg@3531:     |topClass childrenPerCategory privateClasses|
cg@3531: 
cg@3531:     topClass := self treeViewClassHierarchyContents.
cg@3531:     privateClasses := IdentitySet new.
cg@3531: 
cg@3531:     childrenPerCategory := Dictionary new.
cg@3531: 
cg@3531:     "/ collect all classes to be inserted into the tree(s)
cg@3531:     topClass withAllSubclassesDo:[:cls |
cg@3531:         |shown cat set|
cg@3531: 
cg@3531:         (self filterClass:cls) ifTrue:[
cg@3531:              cls isPrivate ifFalse:[
cg@3531:                 cat := cls category.
cg@3531:                 cat notNil ifTrue:[
cg@3531:                     (childrenPerCategory at:cat ifAbsentPut:[Set new]) add:cls
cg@3531:                 ].
cg@3531:             ] ifTrue:[
cg@3531:                 privateClasses add:cls
cg@3531:             ]
cg@3531:         ].
cg@3531:     ].
cg@3531: 
cg@3531:     "/ need the owningclasses in the tree
cg@3531:     privateClasses do:[:each |
cg@3531:         |owner|
cg@3531: 
cg@3531:         owner := each owningClass.
cg@3531:         (childrenPerCategory at:(owner category) ifAbsentPut:[Set new]) add:owner
cg@3531:     ].
cg@3531: 
cg@3531:     ^ [:aTreeItem|
cg@3531:         |cont children initialContents setOfCategories itemCategory setOfClasses|
cg@3531: 
cg@3531:         (cont := aTreeItem contents) isBehavior ifTrue:[
cg@3531:             children := privateClasses select:[:cls | cls owningClass == aTreeItem contents].
cg@3531:             children := children select:[:cls | self filterClass:cls].
cg@3531:             children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name].
cg@3531:             "/ children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child]
cg@3531:             children := children collect: [:child| TreeItem name:(child name) contents: child]
cg@3531:         ] ifFalse:[
cg@3531:             cont size == 0 ifTrue:[
cg@3531:                 setOfCategories := childrenPerCategory keys.
cg@3531:                 children := setOfCategories asSortedCollection.
cg@3531:                 children := children collect: [:nm | TreeItem name:nm contents:#Category]
cg@3531:             ] ifFalse:[
cg@3531:                 cont == #Category ifTrue:[
cg@3531:                     itemCategory := aTreeItem name.
cg@3531:                     setOfClasses := childrenPerCategory at:itemCategory ifAbsent:[Set new].
cg@3531:                     setOfClasses := setOfClasses select:[:cls | self filterClass:cls].
cg@3531:                     children := setOfClasses asOrderedCollection sort:[:c1 :c2 | c1 name <= c2 name].
cg@3531:                     children := children collect:[:child | TreeItem name:child name contents:child].
cg@3531:                 ] ifFalse:[
cg@3531:                     "/ huh ?
cg@3531:                     children := OrderedCollection new.
cg@3531:                 ]
cg@3531:             ].
cg@3531:         ].
cg@3531:         children
cg@3531:     ]
cg@3531: 
cg@3531:     "Modified: / 22-08-2012 / 19:44:59 / cg"
cg@3531: !
cg@3531: 
cg@3531: treeViewClassCategoryIcon
cg@3531:     "returns the icon for aTreeItem as a block"
cg@3531: 
cg@3531:     ^self treeViewClassHierarchyIcon
cg@3531: ! !
cg@3531: 
cg@3531: !ResourceSelectionBrowser methodsFor:'tree building - hierarchy'!
cg@3531: 
cg@3531: treeViewClassHierarchyChildren
cg@3531:     "returns the children for the contents (class) of aTreeItem as a block"
cg@3531: 
cg@3531:     "/ cg: tz's algorithm was very-very slow, 
cg@3531:     "/ (it enumerated classes hundreds of times,
cg@3531:     "/  leading to a square runtime behavior
cg@3531:     "/  - i.e. very slow scrolling )
cg@3531:     "/ Speed up things by caching facts while enumerating
cg@3531:     "/ classes once only.
cg@3531: 
cg@3531:     |subclassesAndPrivateClassesPerClass classesWithResourceOrResourceInAnySubclass|
cg@3531: 
cg@3531:     subclassesAndPrivateClassesPerClass := IdentityDictionary new.
cg@3531:     classesWithResourceOrResourceInAnySubclass := IdentitySet new.
cg@3531: 
cg@3531:     Smalltalk allClassesDo:[:cls |
cg@3531:         |owner superclass info|
cg@3531: 
cg@3531:         superclass := cls superclass.
cg@3531:         superclass notNil ifTrue:[
cg@3531:             info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil.
cg@3531:             info isNil ifTrue:[
cg@3531:                 subclassesAndPrivateClassesPerClass 
cg@3531:                         at:superclass 
cg@3531:                         put:(info := {IdentitySet new. IdentitySet new} ).
cg@3531:             ].
cg@3531:             (info at:1) add:cls
cg@3531:         ].
cg@3531:         (self filterClass:cls) ifTrue:[
cg@3531:             cls withAllSuperclassesDo:[:each |
cg@3531:                 classesWithResourceOrResourceInAnySubclass add:each
cg@3531:             ].
cg@3531:         ].
cg@3531:     ].
cg@3531: 
cg@3531:     ^ [:aTreeItem|
cg@3531:         |classes itemClass info|
cg@3531: 
cg@3531:         classes := OrderedCollection new. 
cg@3531:         itemClass := aTreeItem contents.
cg@3531:         info := subclassesAndPrivateClassesPerClass at:itemClass ifAbsent:nil.
cg@3531:         info notNil ifTrue:[
cg@3531:             classes addAll:((info at:1) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
cg@3531:             classes addAll:((info at:2) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
cg@3531:         ].
cg@3531:         classes select:[:cls | classesWithResourceOrResourceInAnySubclass includes:cls].
cg@3531:      ]
cg@3531: !
cg@3531: 
cg@3531: treeViewClassHierarchyContents
cg@3531:     "returns the contents of the root of the class tree list"
cg@3531: 
cg@3531:     |cls|
cg@3531: 
cg@3531:     resourceSuperclass notNil ifTrue:[
cg@3531:         cls := Smalltalk classNamed: resourceSuperclass.
cg@3531:     ].
cg@3531:     cls := cls ? Object.
cg@3531:     ^ cls
cg@3531: !
cg@3531: 
cg@3531: treeViewClassHierarchyIcon
cg@3531:     "returns the icon for aTreeItem as a block"
cg@3531: 
cg@3531:     ^[:aTreeItem|
cg@3531:         |icon|
cg@3531: 
cg@3531:         aTreeItem contents isClass ifTrue:[
cg@3531:             icon := self class iconClass.
cg@3531:             aTreeItem contents isPrivate ifTrue:[
cg@3531:                icon := self class iconPrivateClass
cg@3531:             ].
cg@3531:             icon
cg@3531:         ] ifFalse:[
cg@3531:             self class iconCategory
cg@3531:         ]
cg@3531:     ]
cg@3531: !
cg@3531: 
cg@3531: treeViewClassHierarchyLabel
cg@3531:     "returns the label for aTreeItem as a block"
cg@3531: 
cg@3531:     ^[:aTreeItem|
cg@3531:         |label superCls itemContents|
cg@3531: 
cg@3531:         itemContents := aTreeItem contents.
cg@3531:         label := itemContents name.
cg@3531: "/        (itemContents isPrivate 
cg@3531: "/        and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)])
cg@3531: "/            ifTrue: [label := label, ' (', superCls name, ')'].
cg@3531:         label
cg@3531:      ]
cg@3531: ! !
cg@3531: 
tz@771: !ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
tz@523: 
tz@523: iconOn:aGC
tz@771:     "registers and returns an icon indicating the resource type"
tz@523: 
cg@1524:     |cls sel image imageKey|
cg@1524: 
tz@730:     self resourceType isNil ifTrue: [^nil].
cg@1524: 
cg@1524:     icon isNil ifTrue:[
frank@1412:         ((self resourceType = #image) or: [resourceType = #fileImage])
cg@1524:         ifTrue:[  
cg@1524:             cls := method mclass theNonMetaclass.
cg@1524:             sel := method selector.
cg@1524:         ] ifFalse: [
frank@1412:             cls := SystemBrowser.
frank@1412:             sel := (resourceType, 'Icon') asSymbol.
frank@1412:         ].
frank@1412:         imageKey := (cls name, sel) asSymbol.
frank@1412:         (icon := aGC registeredImageAt: imageKey) isNil
cg@1524:         ifTrue: [       
frank@1412:             image := cls perform: sel.
cg@1524:             (image extent y > 18) ifTrue: [         
frank@1412:                 image := image magnifiedBy: 18/image extent y
frank@1412:             ].
frank@1412:             aGC registerImage: image key: imageKey.
frank@1412:             icon := aGC registeredImageAt: imageKey.
frank@1412:         ].
tz@730:     ].
tz@523:     ^icon
cg@1524: 
cg@1524:     "Modified: / 5.11.2001 / 16:48:35 / cg"
tz@523: !
tz@523: 
cg@3531: method
cg@3531:     ^ method
cg@3531: !
cg@3531: 
tz@523: method: aMethod
tz@771:     "sets aMethod"
tz@523: 
tz@523:     method := aMethod
tz@523: !
tz@523: 
tz@523: resourceType
tz@771:     "returns resourceType"
tz@523: 
tz@523:     resourceType isNil ifTrue: [resourceType := method resourceType].
tz@523:     ^resourceType
tz@523: !
tz@523: 
tz@523: selector
tz@771:     "returns selector"
tz@523: 
tz@523:     selector isNil ifTrue: [selector := method who methodSelector].
tz@523:     ^selector
tz@523: ! !
tz@523: 
tz@425: !ResourceSelectionBrowser class methodsFor:'documentation'!
tz@425: 
tz@425: version
tz@425:     ^ '$Header$'
cg@2760: !
cg@2760: 
cg@2760: version_CVS
cg@2760:     ^ '$Header$'
tz@425: ! !
sv@3117: