"

 COPYRIGHT (c) 1997-1998 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice. This software may not

 be provided or otherwise made available to, or used by, any

 other person. No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libtool2' }"

"{ NameSpace: Smalltalk }"

SelectionBrowser subclass:#ResourceSelectionBrowser

	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes

		allClasses classSelectionBlock'

	classVariableNames:'ClassPresentation'

	poolDictionaries:''

	category:'Interface-Dialogs'

!

Object subclass:#ResourceMethod

	instanceVariableNames:'method icon resourceType selector'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ResourceSelectionBrowser

!

!ResourceSelectionBrowser class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997-1998 by eXept Software AG

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice. This software may not

 be provided or otherwise made available to, or used by, any

 other person. No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    The ResourceSelectionBrowser allows you to browse in class hierarchies

    and to select resource methods for loading or to saving resource 

    specifications (#canvas, #menu, etc.).

    [instance variables:]

        resourceMethod          <Symbol>        selector of the resource spec

        resourceClass           <Symbol>        class of the resource spec

        resourceSuperclass      <Symbol>        root class of the tree list

        resourceTypes           <Array>         allowed resource types

        allClasses              <Array>         list of the subclasses of resourceSuperclass

        classSelectionBlock     <Block>         by evaluating this block the class selection is done

    [start with:]

        ResourceSelectionBrowser open

    [author:]

        Thomas Zwick, eXept Software AG

"

! !

!ResourceSelectionBrowser class methodsFor:'instance creation'!

request:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes

    "opens a ResourceSelectionBrowser; return a Message-object or nil."

    ^ (self new

        title: aTitle)

            openOnSuperclass:aSuperclass

            andClass:aClassOrClassName

            andSelector:aSelector

            withResourceTypes:resourceTypes

    "

     ResourceSelectionBrowser

        request: 'Select a Resource Selector'

        onSuperclass: #ApplicationModel 

        andClassNamed: #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|

        aTreeItem contents isClass ifTrue:[

            icon := self iconClass.

            aTreeItem contents isPrivate ifTrue:[

               icon := self iconPrivateClass

            ].

            icon

        ] ifFalse:[

            self 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 class methodsFor:'image specs'!

iconCategory

    <resource: #image>

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self iconCategory inspect

     ImageEditor openOnClass:self andSelector:#iconCategory"

    ^ Icon constantNamed:#'ResourceSelectionBrowser class iconCategory'

        ifAbsentPut:[

            (Depth4Image new)

                width:18;

                height:16;

                photometric:(#palette);

                bitsPerSample:(#( 4 ));

                samplesPerPixel:(1);

                bits:(ByteArray 

                            fromPackedString:'3L0@@@@@@L3L3L@@@@@@@@3L3@@3L3L3L0CL3@LQDQDQD#CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@LRH"H"H3CL3@L#L3L3L3CL3@@3L3L3L0CL3L@@@@@@@@3L3L0@@@@@@L3L');

                colorMapFromArray:#[ 0 0 0 255 255 255 170 170 170 127 127 127 255 0 0 0 255 0 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127 ];

                mask:((ImageMask new)

                            width:18;

                            height:16;

                            bits:(ByteArray 

                                        fromPackedString:'<@O@8@G@3?3@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@3?3@8@G@<@O@');

                            yourself);

                yourself

        ]

!

iconClass

    <resource: #image>

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self iconClass inspect

     ImageEditor openOnClass:self andSelector:#iconClass"

    ^ Icon constantNamed:#'ResourceSelectionBrowser class iconClass'

        ifAbsentPut:[

            (Depth2Image new)

                width:18;

                height:16;

                photometric:(#palette);

                bitsPerSample:(#( 2 ));

                samplesPerPixel:(1);

                bits:(ByteArray 

                            fromPackedString:'@@@@@@@*****ABUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@A@@@@@@@@@@@@@b');

                colorMapFromArray:#[ 0 0 0 170 170 170 255 255 255 ];

                mask:((ImageMask new)

                            width:18;

                            height:16;

                            bits:(ByteArray 

                                        fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@');

                            yourself);

                yourself

        ]

!

iconPrivateClass

    <resource: #image>

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     ImageEditor openOnClass:self andSelector:#iconPrivateClass"

    ^ Icon constantNamed:#'ResourceSelectionBrowser class iconPrivateClass'

        ifAbsentPut:[

            (Depth2Image new)

                width:18;

                height:16;

                photometric:(#palette);

                bitsPerSample:(#( 2 ));

                samplesPerPixel:(1);

                bits:(ByteArray 

                            fromPackedString:'@@@@@@PUUUUU A****(@F*??* @Z+??*@A*/*>(OF*>+: @Z+??*@A*/?:(DF*>** @Z+:**@A*/**(@F*>** @Z****C2@@@@@@@@@@@@@b');

                colorMapFromArray:#[ 0 0 0 255 255 255 170 170 170 255 0 0 ];

                mask:((ImageMask new)

                            width:18;

                            height:16;

                            bits:(ByteArray 

                                        fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@');

                            yourself);

                yourself

        ]

! !

!ResourceSelectionBrowser class methodsFor:'interface specs'!

windowSpec

    "This resource specification was automatically generated

     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIPainter may not be able to read the specification."

    "

     UIPainter new openOnClass:ResourceSelectionBrowser andSelector:#windowSpec

     ResourceSelectionBrowser new openInterface:#windowSpec

     ResourceSelectionBrowser open

    "

    <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)

                              )

                             )

                          )

                        )

                       (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

                        )

                       )

                    )

                  )

                 (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

                        )

                       )

                    )

                  )

                 )

              )

              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)

                  )

                 )

              )

            )

           )

        )

      )

! !

!ResourceSelectionBrowser class methodsFor:'list specs'!