"

 COPYRIGHT (c) 1997 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.

"

SelectionBrowser subclass:#ResourceSelectionBrowser

	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes

		allClasses classSelectionBlock classAndResourceSelectionProcess'

	classVariableNames:''

	poolDictionaries:''

	category:'Interface-Dialogs'

!

Object subclass:#Row

	instanceVariableNames:'method icon resourceType selector'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ResourceSelectionBrowser

!

!ResourceSelectionBrowser class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997 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

"

    [start with:]

        ResourceSelectionBrowser open

    [author:]

        Thomas Zwick

"

! !

!ResourceSelectionBrowser class methodsFor:'instance creation'!

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

    "

    ResourceSelectionBrowser

        request: 'Select a Resource Selector'

        onSuperclass: #ApplicationModel 

        andClass: #ToolApplicationModel 

        andSelector: #saveIcon 

        withResourceTypes: #(image) 

    "

    ^self new

        title: aTitle;

        openOnSuperclass: aSuperclass

        andClass: aClass

        andSelector: aSelector

        withResourceTypes: resourceTypes

! !

!ResourceSelectionBrowser class methodsFor:'callbacks - default'!

treeViewChildren

    ^[:aTreeItem|

        |classes|

        classes := OrderedCollection new.    

        classes addAll: ((aTreeItem contents subclasses reject: [:cls| cls isPrivate]) asSortedCollection: [:i1 :i2| i1 name < i2 name]).

        classes addAll: (aTreeItem contents privateClasses asSortedCollection: [:i1 :i2| i1 name < i2 name]).

        classes

     ]

!

treeViewContents

    ^Smalltalk at: #Object

!

treeViewIcon

    ^[:aTreeItem|

        |icon|

        icon := self iconClass.

        aTreeItem contents isPrivate 

        ifTrue:

        [

           icon := self iconPrivateClass

        ].

    icon]

!

treeViewLabel

    ^[:aTreeItem|

        |label superCls|

        label := aTreeItem contents name.

        (aTreeItem contents isPrivate and: [aTreeItem parent contents ~~ (superCls := aTreeItem contents superclass)])

            ifTrue: [label := label, ' (', superCls name, ')'].

        label

     ]

! !

!ResourceSelectionBrowser class methodsFor:'image specs'!

iconClass

    "Generated by the Image Editor"

    "

    ImageEditor openOnClass:self andSelector:#iconClass

    "

    <resource: #image>

    ^Icon

        constantNamed:#'ResourceSelectionBrowser iconClass'

        ifAbsentPut:[(Depth2Image new) width: 18; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@UUUUUAQ****(@F**** @Z****@A****(@F**** @Z****@A****(LF**** TZ****@A****(@F**** @Z****@@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 170 170 170 255 0 0]; mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@') ; yourself); yourself]!

iconPrivateClass

    "Generated by the Image Editor"

    "

    ImageEditor openOnClass:self andSelector:#iconPrivateClass

    "

    <resource: #image>

    ^Icon

        constantNamed:#'ResourceSelectionBrowser 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****C0@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 170 170 170 255 0 0]; mask:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@') ; yourself); yourself]! !

!ResourceSelectionBrowser class methodsFor:'interface specs'!

windowSpec

    "this window spec was automatically generated by the ST/X UIPainter"

    "do not manually edit this - the painter/builder may not be able to

     handle the specification if its corrupted."

    "

     UIPainter new openOnClass:ResourceSelectionBrowser andSelector:#windowSpec

     ResourceSelectionBrowser new openInterface:#windowSpec

    "

    "ResourceSelectionBrowser open"

    <resource: #canvas>

    ^

       #(#FullSpec

          #window: 

           #(#WindowSpec

              #name: 'Resource Selection Browser'

              #layout: #(#LayoutFrame 197 0 172 0 796 0 521 0)

              #label: 'Resource Selection Browser'

              #min: #(#Point 400 300)

              #max: #(#Point 1152 864)

              #bounds: #(#Rectangle 197 172 797 522)

              #usePreferredExtent: false

          )

          #component: 

           #(#SpecCollection

              #collection: 

               #(

                 #(#VariableHorizontalPanelSpec

                    #name: 'variableHorizontalPanel'

                    #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 -40 1.0)

                    #component: 

                     #(#SpecCollection

                        #collection: 

                         #(

                           #(#ViewSpec

                              #name: 'view1'

                              #component: 

                               #(#SpecCollection

                                  #collection: 

                                   #(

                                     #(#SelectionInTreeViewSpec

                                        #name: 'listOfClassesView'

                                        #layout: #(#LayoutFrame 0 0.0 23 0.0 0 1.0 -22 1.0)

                                        #model: #selectionOfClass

                                        #hasHorizontalScrollBar: true

                                        #hasVerticalScrollBar: true

                                        #miniScrollerHorizontal: true

                                        #showDirectoryIndicatorForRoot: false

                                        #showDirectoryIndicator: true

                                        #valueChangeSelector: #classSelected:

                                        #hierarchicalList: #listOfClasses

                                        #contentsSelector: #treeViewContents

                                        #labelSelector: #treeViewLabel

                                        #childrenSelector: #treeViewChildren

                                        #iconSelector: #treeViewIcon

                                    )

                                     #(#InputFieldSpec

                                        #name: 'classNameInputField'

                                        #layout: #(#LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)

                                        #model: #valueOfClassName

                                    )

                                     #(#LabelSpec

                                        #name: 'ClassHierarchyLabel'

                                        #layout: #(#LayoutFrame 0 0 2 0 297 0 23 0)

                                        #label: ' Class Hierarchy'

                                        #level: 1

                                        #adjust: #left

                                    )

                                  )

                              )

                          )

                           #(#ViewSpec

                              #name: 'view2'

                              #component: 

                               #(#SpecCollection

                                  #collection: 

                                   #(

                                     #(#DataSetSpec

                                        #name: 'resourcesDataSetView'

                                        #layout: #(#LayoutFrame 2 0.0 2 0.0 -2 1.0 -22 1.0)

                                        #model: #selectionOfResource

                                        #hasHorizontalScrollBar: true

                                        #hasVerticalScrollBar: true

                                        #miniScrollerHorizontal: true

                                        #rowClassName: 'ResourceSelectionBrowser::Row'

                                        #dataList: #listOfResources

                                        #useIndex: false

                                        #has3Dsepartors: true

                                        #doubleClickSelector: #resourceDoubleClicked

                                        #columnHolder: #columnsOfDataSetView

                                        #valueChangeSelector: #resourceSelected

                                        #verticalSpacing: 1

                                    )

                                     #(#InputFieldSpec

                                        #name: 'selectorInputField'

                                        #layout: #(#LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)

                                        #model: #valueOfSelector

                                    )

                                  )

                              )

                          )

                        )

                    )

                    #handles: #(#Any 0.5 1.0)

                )

                 #(#UISubSpecification

                    #name: 'SubSpecification'

                    #layout: #(#LayoutFrame 301 0.0 -32 1 -2 1.0 -8 1.0)

                    #majorKey: #ToolApplicationModel

                    #minorKey: #windowSpecForCommitWithoutChannels

                )

                 #(#HorizontalPanelViewSpec

                    #name: 'HorizontalPanelView1'

                    #layout: #(#LayoutFrame 3 0 76 0.691429 300 0 0 0.977143)

                    #component: 

                     #(#SpecCollection

                        #collection: 

                         #(

                           #(#LabelSpec

                              #name: 'Label2'

                              #label: 'Create: '

                              #adjust: #right

                              #extent: #(#Point 67 24)

                          )

                           #(#ActionButtonSpec

                              #name: 'CreateClassButton'

                              #activeHelpKey: #dss

                              #label: 'Class'

                              #model: #createClass:

                              #actionValue: 'class'

                              #extent: #(#Point 72 24)

                          )

                           #(#ActionButtonSpec

                              #name: 'CreateSubclassButton'

                              #activeHelpKey: #dss

                              #label: 'Subclass'

                              #model: #createClass:

                              #actionValue: 'subclass'

                              #extent: #(#Point 72 24)

                          )

                           #(#ActionButtonSpec

                              #name: 'CreatePrivateClassButton'

                              #activeHelpKey: #dss

                              #label: 'Private'

                              #model: #createClass:

                              #actionValue: 'private'

                              #extent: #(#Point 72 24)

                          )

                        )

                    )

                    #horizontalLayout: #fit

                    #verticalLayout: #fit

                )

              )

          )

      )

! !

!ResourceSelectionBrowser class methodsFor:'list specs'!

columnsOfDataSetView

  ^ #(#(#DataSetColumnSpec

      #width: 20

      #height: 20

      #printSelector: #iconOn:

      #canSelect: false

  )

   #(#DataSetColumnSpec

      #label: ' Selector'

      #'labelAlignment:' #left

      #model: #selector

      #canSelect: false

  )

   (#DataSetColumnSpec

      #label: ' Resource Type'

      #'labelAlignment:' #left

      #model: #resourceType

      #canSelect: false

  ))

! !

!ResourceSelectionBrowser methodsFor:'accessing - views'!

classNameInputField

    ^builder componentAt: #classNameInputField

!

listOfClassesView

    ^builder componentAt: #listOfClassesView

! !

!ResourceSelectionBrowser methodsFor:'aspects'!

columnsOfDataSetView

    |holder|

    (holder := builder bindingAt:#columnsOfDataSetView) isNil ifTrue:[

        builder aspectAt:#columnsOfDataSetView put:(holder := List new).

        holder addAll: (self class columnsOfDataSetView collect: [:i| i decodeAsLiteralArray]).

    ].

    ^ holder

!

listOfClasses

    |holder|

    (holder := builder bindingAt:#listOfClasses) isNil ifTrue:[

        builder aspectAt:#listOfClasses put: (holder := TreeItem new)

    ].

    ^ holder

!

listOfResources

    |holder|

    (holder := builder bindingAt:#listOfResources) isNil ifTrue:[

        builder aspectAt:#listOfResources put:(holder :=  List new).

    ].

    ^ holder

!

selectionOfClass

    |holder|

    (holder := builder bindingAt:#selectionOfClass) isNil ifTrue:[

        builder aspectAt:#selectionOfClass put:(holder :=  ValueHolder new).

    ].

    ^ holder

!

selectionOfResource

    |holder|

    (holder := builder bindingAt:#selectionOfResource) isNil ifTrue:[

        builder aspectAt:#selectionOfResource put:(holder :=  '' asValue).

    ].

    ^ holder

!

valueOfClassName

    |holder|

    (holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[

        builder aspectAt:#valueOfClassName put:(holder :=  '' asValue).

    ].

    ^ holder

!

valueOfSelector

    |holder|

    (holder := builder bindingAt:#valueOfSelector) isNil ifTrue:[

        builder aspectAt:#valueOfSelector put:(holder :=  '' asValue).

    ].

    ^ holder

! !

!ResourceSelectionBrowser methodsFor:'callbacks - tree view'!

treeViewContents

    ^(Smalltalk at: resourceSuperclass) ? self class treeViewContents

! !

!ResourceSelectionBrowser methodsFor:'callbacks - user'!

classSelected: anIndex

    self selectionOfClass value isNil ifTrue: [^nil].

    self withWaitCursorDo:

    [

        |clsName|

        resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].

        clsName := ((self listOfClassesView list at: anIndex) upTo: $ ) asSymbol.

        self valueOfClassName value: clsName.

        self class lastSelection: clsName.

        self listOfResources contents:

            ((((Smalltalk at: clsName) 

                class methodDictionary

                asOrderedCollection select: 

                    [:m| m resources notNil and: [resourceTypes includes: m resourceType]]))

             collect: [:m| Row new method: m]).

    ]

!

createClass: what

    |clsCandidat cls|

    clsCandidat := self valueOfClassName value asSymbol.

    (Smalltalk at: clsCandidat) notNil 

        ifTrue: [^self warn: 'Cannot create class ', clsCandidat asBoldText,

                '!!\Key with that name in dictionary ' withCRs, 'Smalltalk' asBoldText, ' detected.'].

    cls := self selectionOfClass value contents.

    what = 'class' ifTrue: [cls := cls superclass].

    cls isNil ifTrue: [^self warn: 'May not create class with superclass ', 'nil' asBoldText, '!!'].

    what = 'private' 

    ifFalse: 

    [

        cls subclass: clsCandidat

            instanceVariableNames:''

            classVariableNames:''

            poolDictionaries:''

            category: cls category

    ]

    ifTrue:

    [

        |superClsCandidate|

        superClsCandidate := (Dialog 

                request: 'Enter name of superclass of private class.'

                initialAnswer: 'Object') asSymbol.

        (Smalltalk at: superClsCandidate) isNil ifTrue: [^self warn: 'Class ', superClsCandidate asBoldText, ' does not exist!!'].

        ((superClsCandidate := Smalltalk at: superClsCandidate) isClass and: [superClsCandidate isPrivate not])

            ifFalse: [^self warn: 'May not create private class with superclass ', superClsCandidate asBoldText, '!!'].

        superClsCandidate subclass: clsCandidat

            instanceVariableNames:''

            classVariableNames:''

            poolDictionaries:''

            privateIn: cls

    ].

    allClasses := Object withAllSubclasses.

    what = 'class' 

        ifTrue:  [self selectionOfClass value parent changed: #children]

        ifFalse: [self selectionOfClass value changed: #children].

    classSelectionBlock value: self valueOfClassName value 

!