ResourceSelectionBrowser.st
author Claus Gittinger <cg@exept.de>
Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570 4e663bc64364
parent 2441 a0c5da242681
child 2760 11963b80d72c
permissions -rw-r--r--
changed #requestPackage
tz@425
     1
"
tz@771
     2
 COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@425
     3
              All Rights Reserved
tz@425
     4
tz@425
     5
 This software is furnished under a license and may be used
tz@425
     6
 only in accordance with the terms of that license and with the
tz@425
     7
 inclusion of the above copyright notice. This software may not
tz@425
     8
 be provided or otherwise made available to, or used by, any
tz@425
     9
 other person. No title to or ownership of the software is
tz@425
    10
 hereby transferred.
tz@425
    11
"
cg@1384
    12
"{ Package: 'stx:libtool2' }"
cg@1384
    13
tz@425
    14
SelectionBrowser subclass:#ResourceSelectionBrowser
tz@477
    15
	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
tz@906
    16
		allClasses classSelectionBlock'
tz@906
    17
	classVariableNames:'ClassPresentation'
tz@425
    18
	poolDictionaries:''
tz@619
    19
	category:'Interface-Dialogs'
tz@425
    20
!
tz@425
    21
tz@771
    22
Object subclass:#ResourceMethod
tz@523
    23
	instanceVariableNames:'method icon resourceType selector'
tz@523
    24
	classVariableNames:''
tz@523
    25
	poolDictionaries:''
tz@523
    26
	privateIn:ResourceSelectionBrowser
tz@523
    27
!
tz@523
    28
tz@425
    29
!ResourceSelectionBrowser class methodsFor:'documentation'!
tz@425
    30
tz@425
    31
copyright
tz@425
    32
"
tz@771
    33
 COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@425
    34
              All Rights Reserved
tz@425
    35
tz@425
    36
 This software is furnished under a license and may be used
tz@425
    37
 only in accordance with the terms of that license and with the
tz@425
    38
 inclusion of the above copyright notice. This software may not
tz@425
    39
 be provided or otherwise made available to, or used by, any
tz@425
    40
 other person. No title to or ownership of the software is
tz@425
    41
 hereby transferred.
tz@425
    42
"
tz@425
    43
tz@425
    44
!
tz@425
    45
tz@425
    46
documentation
tz@425
    47
"
tz@746
    48
    The ResourceSelectionBrowser allows you to browse in class hierarchies
tz@771
    49
    and to select resource methods for loading or to saving resource 
tz@771
    50
    specifications (#canvas, #menu, etc.).
tz@771
    51
tz@771
    52
    [instance variables:]
tz@907
    53
        resourceMethod          <Symbol>        selector of the resource spec
tz@907
    54
        resourceClass           <Symbol>        class of the resource spec
tz@907
    55
        resourceSuperclass      <Symbol>        root class of the tree list
tz@907
    56
        resourceTypes           <Array>         allowed resource types
tz@907
    57
        allClasses              <Array>         list of the subclasses of resourceSuperclass
tz@907
    58
        classSelectionBlock     <Block>         by evaluating this block the class selection is done
tz@746
    59
tz@504
    60
    [start with:]
tz@907
    61
        ResourceSelectionBrowser open
tz@504
    62
tz@504
    63
    [author:]
tz@907
    64
        Thomas Zwick, eXept Software AG
tz@425
    65
"
tz@425
    66
! !
tz@425
    67
tz@425
    68
!ResourceSelectionBrowser class methodsFor:'instance creation'!
tz@425
    69
cg@1978
    70
request:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
cg@1978
    71
    "opens a ResourceSelectionBrowser; return a Message-object or nil."
cg@1978
    72
cg@1978
    73
    ^ (self new
cg@1978
    74
        title: aTitle)
cg@1978
    75
            openOnSuperclass:aSuperclass
cg@1978
    76
            andClass:aClassOrClassName
cg@1978
    77
            andSelector:aSelector
cg@1978
    78
            withResourceTypes:resourceTypes
cg@1978
    79
tz@649
    80
    "
cg@1978
    81
     ResourceSelectionBrowser
tz@906
    82
        request: 'Select a Resource Selector'
tz@906
    83
        onSuperclass: #ApplicationModel 
cg@1978
    84
        andClassNamed: #MenuEditor 
tz@906
    85
        andSelector: #menuItemImage 
tz@906
    86
        withResourceTypes: #(image) 
tz@425
    87
    "
tz@425
    88
! !
tz@425
    89
cg@1725
    90
!ResourceSelectionBrowser class methodsFor:'callbacks-default'!
tz@648
    91
tz@906
    92
treeViewClassHierarchyChildren
tz@771
    93
    "returns the children for the contents (class) of aTreeItem as a block"
tz@648
    94
cg@1034
    95
    "/ cg: tz's algorithm was very-very slow, 
cg@1034
    96
    "/ (it enumerated classes hundreds of times,
cg@1034
    97
    "/  leading to a square runtime behavior
cg@1034
    98
    "/  - i.e. very slow scrolling )
cg@1034
    99
    "/ Speed up things by caching facts while enumerating
cg@1034
   100
    "/ classes once only.
cg@1034
   101
cg@1034
   102
    |subclassesAndPrivateClassesPerClass|
cg@1034
   103
cg@1034
   104
    subclassesAndPrivateClassesPerClass := IdentityDictionary new.
cg@1034
   105
cg@1034
   106
    Smalltalk allClassesDo:[:cls |
cg@1034
   107
        |owner superclass info|
cg@1034
   108
cg@1732
   109
"/        (owner := cls owningClass) notNil ifTrue:[
cg@1732
   110
"/            info := subclassesAndPrivateClassesPerClass at:owner ifAbsent:nil.
cg@1732
   111
"/            info isNil ifTrue:[
cg@1732
   112
"/                subclassesAndPrivateClassesPerClass at:owner put:(info := Array with:IdentitySet new 
cg@1732
   113
"/                                                                                with:IdentitySet new).
cg@1732
   114
"/            ].
cg@1732
   115
"/            (info at:2) add:cls
cg@1732
   116
"/        ] ifFalse:[
cg@1034
   117
            superclass := cls superclass.
cg@1034
   118
            superclass notNil ifTrue:[
cg@1034
   119
                info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil.
cg@1034
   120
                info isNil ifTrue:[
cg@1034
   121
                    subclassesAndPrivateClassesPerClass at:superclass put:(info := Array with:IdentitySet new 
cg@1034
   122
                                                                                         with:IdentitySet new).
cg@1034
   123
                ].
cg@1034
   124
                (info at:1) add:cls
cg@1034
   125
            ]
cg@1732
   126
"/        ]
cg@1034
   127
    ].
cg@1034
   128
cg@1034
   129
    ^ [:aTreeItem|
cg@1034
   130
        |classes itemClass info|
cg@1034
   131
tz@906
   132
        classes := OrderedCollection new. 
cg@1034
   133
        itemClass := aTreeItem contents.
cg@1034
   134
        info := subclassesAndPrivateClassesPerClass at:itemClass ifAbsent:nil.
cg@1034
   135
        info notNil ifTrue:[
cg@1034
   136
            classes addAll:((info at:1) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
cg@1034
   137
            classes addAll:((info at:2) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
cg@1034
   138
        ].
tz@906
   139
        classes
tz@718
   140
     ]
tz@648
   141
!
tz@648
   142
tz@906
   143
treeViewClassHierarchyContents
tz@771
   144
    "returns the default contents of the root of the class tree list"
tz@648
   145
cg@802
   146
    ^ Object
tz@648
   147
tz@648
   148
!
tz@648
   149
tz@906
   150
treeViewClassHierarchyIcon
tz@771
   151
    "returns the icon for aTreeItem as a block"
tz@648
   152
tz@718
   153
    ^[:aTreeItem|
tz@906
   154
        |icon|
cg@1034
   155
cg@1034
   156
        aTreeItem contents isClass ifTrue:[
tz@906
   157
            icon := self iconClass.
cg@1034
   158
            aTreeItem contents isPrivate ifTrue:[
tz@906
   159
               icon := self iconPrivateClass
tz@906
   160
            ].
tz@906
   161
            icon
cg@1034
   162
        ] ifFalse:[
tz@906
   163
            self iconCategory
tz@906
   164
        ]
tz@771
   165
    ]
tz@648
   166
tz@648
   167
!
tz@648
   168
tz@906
   169
treeViewClassHierarchyLabel
tz@771
   170
    "returns the label for aTreeItem as a block"
tz@648
   171
tz@718
   172
    ^[:aTreeItem|
cg@1034
   173
        |label superCls itemContents|
cg@1034
   174
cg@1034
   175
        itemContents := aTreeItem contents.
cg@1034
   176
        label := itemContents name.
cg@1732
   177
"/        (itemContents isPrivate 
cg@1732
   178
"/        and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)])
cg@1732
   179
"/            ifTrue: [label := label, ' (', superCls name, ')'].
tz@906
   180
        label
tz@718
   181
     ]
tz@648
   182
! !
tz@648
   183
tz@730
   184
!ResourceSelectionBrowser class methodsFor:'image specs'!
tz@730
   185
tz@906
   186
iconCategory
tz@906
   187
    "This resource specification was automatically generated
tz@906
   188
     by the ImageEditor of ST/X."
tz@906
   189
tz@906
   190
    "Do not manually edit this!! If it is corrupted,
tz@906
   191
     the ImageEditor may not be able to read the specification."
tz@906
   192
tz@906
   193
    "
tz@906
   194
     self iconCategory inspect
tz@906
   195
     ImageEditor openOnClass:self andSelector:#iconCategory
tz@906
   196
    "
tz@906
   197
tz@906
   198
    <resource: #image>
tz@906
   199
tz@906
   200
    ^Icon
cg@2441
   201
        constantNamed:#'ResourceSelectionBrowser class iconCategory'
cg@1493
   202
        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:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); 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]
cg@1493
   203
!
tz@906
   204
tz@730
   205
iconClass
tz@746
   206
    "This resource specification was automatically generated
tz@746
   207
     by the ImageEditor of ST/X."
tz@746
   208
tz@746
   209
    "Do not manually edit this!! If it is corrupted,
tz@746
   210
     the ImageEditor may not be able to read the specification."
tz@746
   211
tz@730
   212
    "
cg@1404
   213
     self iconClass inspect
tz@746
   214
     ImageEditor openOnClass:self andSelector:#iconClass
tz@730
   215
    "
tz@730
   216
tz@730
   217
    <resource: #image>
tz@730
   218
tz@730
   219
    ^Icon
cg@2441
   220
        constantNamed:#'ResourceSelectionBrowser class iconClass'
cg@1493
   221
        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:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@') ; yourself); yourself]
cg@1493
   222
!
tz@730
   223
tz@730
   224
iconPrivateClass
tz@746
   225
    "This resource specification was automatically generated
tz@746
   226
     by the ImageEditor of ST/X."
tz@746
   227
tz@746
   228
    "Do not manually edit this!! If it is corrupted,
tz@746
   229
     the ImageEditor may not be able to read the specification."
tz@746
   230
tz@730
   231
    "
tz@746
   232
     ImageEditor openOnClass:self andSelector:#iconPrivateClass
tz@730
   233
    "
tz@730
   234
tz@730
   235
    <resource: #image>
tz@730
   236
tz@730
   237
    ^Icon
cg@2441
   238
        constantNamed:#'ResourceSelectionBrowser class iconPrivateClass'
cg@2441
   239
        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:((Depth1Image new) width: 18; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@') ; yourself); yourself]
cg@1493
   240
! !
tz@730
   241
tz@425
   242
!ResourceSelectionBrowser class methodsFor:'interface specs'!
tz@425
   243
tz@425
   244
windowSpec
tz@746
   245
    "This resource specification was automatically generated
tz@746
   246
     by the UIPainter of ST/X."
tz@425
   247
tz@746
   248
    "Do not manually edit this!! If it is corrupted,
tz@746
   249
     the UIPainter may not be able to read the specification."
tz@425
   250
tz@425
   251
    "
tz@425
   252
     UIPainter new openOnClass:ResourceSelectionBrowser andSelector:#windowSpec
tz@425
   253
     ResourceSelectionBrowser new openInterface:#windowSpec
tz@746
   254
     ResourceSelectionBrowser open
tz@425
   255
    "
tz@425
   256
tz@425
   257
    <resource: #canvas>
tz@425
   258
cg@1384
   259
    ^ 
cg@1751
   260
     #(FullSpec
cg@1751
   261
        name: windowSpec
cg@1751
   262
        window: 
cg@1751
   263
       (WindowSpec
cg@1751
   264
          label: 'Resource Selection Browser'
cg@1751
   265
          name: 'Resource Selection Browser'
cg@1751
   266
          min: (Point 400 300)
cg@1751
   267
          max: (Point 1152 864)
cg@1751
   268
          bounds: (Rectangle 12 22 612 372)
cg@1384
   269
        )
cg@1751
   270
        component: 
cg@1751
   271
       (SpecCollection
cg@1751
   272
          collection: (
cg@1751
   273
           (VariableHorizontalPanelSpec
cg@1751
   274
              name: 'VariableHorizontalPanel'
cg@1751
   275
              layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 -36 1.0)
cg@1751
   276
              component: 
cg@1751
   277
             (SpecCollection
cg@1751
   278
                collection: (
cg@1751
   279
                 (ViewSpec
cg@1751
   280
                    name: 'Box1'
cg@1751
   281
                    component: 
cg@1751
   282
                   (SpecCollection
cg@1751
   283
                      collection: (
cg@1751
   284
                       (HorizontalPanelViewSpec
cg@1751
   285
                          name: 'HorizontalPanel2'
cg@1751
   286
                          layout: (LayoutFrame 0 0 2 0 297 0 23 0)
cg@1751
   287
                          horizontalLayout: leftSpace
cg@1751
   288
                          verticalLayout: fit
cg@1751
   289
                          horizontalSpace: 3
cg@1751
   290
                          verticalSpace: 3
cg@1751
   291
                          component: 
cg@1751
   292
                         (SpecCollection
cg@1751
   293
                            collection: (
cg@1751
   294
                             (RadioButtonSpec
cg@1751
   295
                                label: 'Categories'
cg@1751
   296
                                name: 'ClassCategoriesRadioButton'
cg@1751
   297
                                translateLabel: true
cg@1751
   298
                                model: selectionOfClassPresentation
cg@1751
   299
                                isTriggerOnDown: true
cg@1751
   300
                                lampColor: (Color 0.0 0.0 0.0)
cg@1751
   301
                                select: #'Class Categories'
cg@1751
   302
                                extent: (Point 124 21)
tz@773
   303
                              )
cg@1751
   304
                             (RadioButtonSpec
cg@1751
   305
                                label: 'Hierarchy'
cg@1751
   306
                                name: 'ClassHierarchyRadioButton'
cg@1751
   307
                                translateLabel: true
cg@1751
   308
                                model: selectionOfClassPresentation
cg@1751
   309
                                isTriggerOnDown: true
cg@1751
   310
                                lampColor: (Color 0.0 0.0 0.0)
cg@1751
   311
                                select: #'Class Hierarchy'
cg@1751
   312
                                extent: (Point 145 21)
tz@773
   313
                              )
cg@1384
   314
                             )
cg@1384
   315
                           
tz@773
   316
                          )
tz@773
   317
                        )
cg@1751
   318
                       (SelectionInTreeViewSpec
cg@1751
   319
                          name: 'listOfClassHierarchyView'
cg@1751
   320
                          layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@1751
   321
                          tabable: true
cg@1751
   322
                          model: selectionOfClassHierarchy
cg@1751
   323
                          hasHorizontalScrollBar: true
cg@1751
   324
                          hasVerticalScrollBar: true
cg@1751
   325
                          miniScrollerHorizontal: true
cg@1751
   326
                          showDirectoryIndicatorForRoot: false
cg@1751
   327
                          showDirectoryIndicator: true
cg@1751
   328
                          valueChangeSelector: classSelected
cg@1751
   329
                          hierarchicalList: rootOfClassHierarchy
cg@1751
   330
                          validateDoubleClickSelector: validateDoubleClick:
cg@1751
   331
                          contentsSelector: treeViewClassHierarchyContents
cg@1751
   332
                          labelSelector: treeViewClassHierarchyLabel
cg@1751
   333
                          childrenSelector: treeViewClassHierarchyChildren
cg@1751
   334
                          iconSelector: treeViewClassHierarchyIcon
cg@1751
   335
                          highlightMode: line
cg@1384
   336
                        )
cg@1751
   337
                       (SelectionInTreeViewSpec
cg@1751
   338
                          name: 'listOfClassCategoriesView'
cg@1751
   339
                          layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@1751
   340
                          tabable: true
cg@1751
   341
                          model: selectionOfClassCategories
cg@1751
   342
                          hasHorizontalScrollBar: true
cg@1751
   343
                          hasVerticalScrollBar: true
cg@1751
   344
                          miniScrollerHorizontal: true
cg@1751
   345
                          showRoot: false
cg@1751
   346
                          showDirectoryIndicator: true
cg@1751
   347
                          valueChangeSelector: classSelected
cg@1751
   348
                          hierarchicalList: rootOfClassCategories
cg@1751
   349
                          validateDoubleClickSelector: validateDoubleClick:
cg@1751
   350
                          childrenSelector: treeViewClassCategoryChildren
cg@1751
   351
                          iconSelector: treeViewClassCategoryIcon
cg@1751
   352
                          highlightMode: line
cg@1384
   353
                        )
cg@1751
   354
                       (InputFieldSpec
cg@1751
   355
                          name: 'classNameInputField'
cg@1751
   356
                          layout: (LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
cg@1751
   357
                          tabable: true
cg@1986
   358
                          model: classNameHolder
cg@1751
   359
                          acceptOnLeave: true
cg@1751
   360
                          acceptOnLostFocus: true
cg@1751
   361
                          acceptOnPointerLeave: true
cg@1384
   362
                        )
cg@1384
   363
                       )
cg@1384
   364
                     
tz@773
   365
                    )
cg@1384
   366
                  )
cg@1751
   367
                 (ViewSpec
cg@1751
   368
                    name: 'Box2'
cg@1751
   369
                    component: 
cg@1751
   370
                   (SpecCollection
cg@1751
   371
                      collection: (
cg@1751
   372
                       (DataSetSpec
cg@1751
   373
                          name: 'resourcesDataSetView'
cg@1751
   374
                          layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -24 1.0)
cg@1751
   375
                          model: selectionOfResourceMethod
cg@1751
   376
                          hasHorizontalScrollBar: true
cg@1751
   377
                          hasVerticalScrollBar: true
cg@1751
   378
                          miniScrollerHorizontal: true
cg@1751
   379
                          rowClassName: 'ResourceSelectionBrowser::Row'
cg@1751
   380
                          dataList: listOfResourceMethods
cg@1751
   381
                          useIndex: false
cg@1751
   382
                          has3Dsepartors: true
cg@1751
   383
                          has3Dseparators: true
cg@1751
   384
                          doubleClickSelector: resourceDoubleClicked
cg@1751
   385
                          columnHolder: resourceMethodColumns
cg@1751
   386
                          valueChangeSelector: resourceSelected
cg@1751
   387
                          verticalSpacing: 1
tz@906
   388
                        )
cg@1751
   389
                       (InputFieldSpec
cg@1751
   390
                          name: 'selectorInputField'
cg@1751
   391
                          layout: (LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
cg@1751
   392
                          tabable: true
cg@1986
   393
                          model: resourceSelectorHolder
cg@1751
   394
                          acceptOnLeave: true
cg@1751
   395
                          acceptOnLostFocus: true
cg@1751
   396
                          acceptOnPointerLeave: true
cg@1384
   397
                        )
cg@1384
   398
                       )
cg@1384
   399
                     
tz@906
   400
                    )
cg@1384
   401
                  )
cg@1384
   402
                 )
cg@1384
   403
               
tz@773
   404
              )
cg@1751
   405
              handles: (Any 0.5 1.0)
cg@1384
   406
            )
cg@1751
   407
           (HorizontalPanelViewSpec
cg@1751
   408
              name: 'ButtonPanel'
cg@1751
   409
              layout: (LayoutFrame 2 0.0 -30 1 -2 1.0 -4 1.0)
cg@1751
   410
              horizontalLayout: fit
cg@1751
   411
              verticalLayout: fit
cg@1751
   412
              reverseOrderIfOKAtLeft: true
cg@1751
   413
              component: 
cg@1751
   414
             (SpecCollection
cg@1751
   415
                collection: (
cg@1751
   416
                 (ActionButtonSpec
cg@1751
   417
                    label: 'Help'
cg@1751
   418
                    name: 'HelpButton'
cg@1751
   419
                    activeHelpKey: dss
cg@1751
   420
                    model: openHTMLDocument:
cg@1751
   421
                    initiallyDisabled: true
cg@1751
   422
                    enableChannel: helpEnabled
cg@1751
   423
                    actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
cg@1751
   424
                    extent: (Point 196 26)
cg@1384
   425
                  )
cg@1751
   426
                 (ActionButtonSpec
cg@1751
   427
                    label: 'Cancel'
cg@1751
   428
                    name: 'cancelButton'
cg@1751
   429
                    activeHelpKey: commitCancel
cg@1751
   430
                    tabable: true
cg@1751
   431
                    model: cancel
cg@1751
   432
                    extent: (Point 197 26)
cg@1384
   433
                  )
cg@1751
   434
                 (ActionButtonSpec
cg@1751
   435
                    label: 'OK'
cg@1751
   436
                    name: 'okButton'
cg@1751
   437
                    activeHelpKey: commitOK
cg@1751
   438
                    tabable: true
cg@1751
   439
                    model: accept
cg@1751
   440
                    isDefault: true
cg@1751
   441
                    extent: (Point 197 26)
cg@1384
   442
                  )
cg@1384
   443
                 )
cg@1384
   444
               
cg@1384
   445
              )
cg@1384
   446
            )
cg@1384
   447
           )
cg@1384
   448
         
cg@1384
   449
        )
tz@425
   450
      )
tz@425
   451
! !
tz@425
   452
tz@648
   453
!ResourceSelectionBrowser class methodsFor:'list specs'!
tz@648
   454
tz@822
   455
tableColumnsForResourceMethodAttributes
tz@821
   456
    "This resource specification was automatically generated
tz@821
   457
     by the DataSetBuilder of ST/X."
tz@648
   458
tz@821
   459
    "Do not manually edit this!! If it is corrupted,
tz@821
   460
     the DataSetBuilder may not be able to read the specification."
tz@821
   461
tz@821
   462
    "
tz@822
   463
     DataSetBuilder new openOnClass:ResourceSelectionBrowser andSelector:#tableColumnsForResourceMethodAttributes
tz@821
   464
    "
tz@821
   465
tz@821
   466
    <resource: #tableColumns>
tz@821
   467
tz@821
   468
tz@821
   469
    ^ #(
tz@821
   470
        #(#DataSetColumnSpec
tz@821
   471
           #width: 20
tz@821
   472
           #height: 20
tz@821
   473
           #printSelector: #iconOn:
tz@821
   474
           #canSelect: false
tz@821
   475
       )
tz@821
   476
        #(#DataSetColumnSpec
tz@821
   477
           #label: ' Selector'
tz@821
   478
           #labelAlignment: #left
tz@821
   479
           #model: #selector
tz@821
   480
           #canSelect: false
tz@821
   481
       )
tz@821
   482
        #(#DataSetColumnSpec
tz@821
   483
           #label: ' Resource Type'
tz@821
   484
           #labelAlignment: #left
tz@821
   485
           #model: #resourceType
tz@821
   486
           #canSelect: false
tz@821
   487
       )
tz@821
   488
     )
tz@648
   489
! !
tz@648
   490
tz@425
   491
!ResourceSelectionBrowser methodsFor:'aspects'!
tz@425
   492
cg@1986
   493
classNameHolder
cg@1986
   494
    "returns the value holder for the name of the class"
cg@1986
   495
cg@1986
   496
    |holder|
cg@1986
   497
cg@1986
   498
    (holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[
cg@1986
   499
        builder aspectAt:#valueOfClassName put:(holder :=  '' asValue).
cg@1986
   500
        holder onChangeEvaluate:[self classSelectionUpdate:holder value].
cg@1986
   501
    ].
cg@1986
   502
    ^ holder
cg@1986
   503
!
cg@1986
   504
tz@773
   505
helpEnabled
tz@773
   506
    "returns whether there is a documentation file"
tz@773
   507
tz@773
   508
    ^true
tz@773
   509
!
tz@773
   510
tz@771
   511
listOfResourceMethods
tz@771
   512
    "returns the value holder for the list of the resource methods"
tz@648
   513
cg@1184
   514
    ^ builder listAspectFor:#listOfResourceMethods
tz@425
   515
!
tz@425
   516
tz@771
   517
resourceMethodColumns
tz@771
   518
    "returns the columns for the table of the resource methods as value holder"
tz@425
   519
tz@425
   520
    |holder|
tz@771
   521
    (holder := builder bindingAt:#resourceMethodColumns) isNil ifTrue:[
tz@821
   522
        builder aspectAt:#resourceMethodColumns put:(holder := List new).
tz@822
   523
        holder addAll: (self class tableColumnsForResourceMethodAttributes collect: [:i| i decodeAsLiteralArray]).
tz@425
   524
    ].
tz@425
   525
    ^ holder
tz@425
   526
!
tz@425
   527
cg@1986
   528
resourceSelectorHolder
cg@1986
   529
    "returns the value holder for the name of the selector"
cg@1986
   530
cg@1986
   531
    |holder|
cg@1986
   532
    (holder := builder bindingAt:#valueOfResourceSelector) isNil ifTrue:[
cg@1986
   533
        builder aspectAt:#valueOfResourceSelector put:(holder :=  '' asValue).
cg@1986
   534
    ].
cg@1986
   535
    ^ holder
cg@1986
   536
!
cg@1986
   537
tz@906
   538
rootOfClassCategories
tz@906
   539
    "returns the value holder for the root of the class tree list"
tz@906
   540
tz@906
   541
    |holder|                                
tz@906
   542
tz@906
   543
    (holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[
tz@906
   544
        ClassPresentation = #'Class Categories' ifTrue: [
tz@906
   545
        builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')].
tz@906
   546
    ].
tz@906
   547
    ^ holder
tz@906
   548
tz@906
   549
tz@906
   550
!
tz@906
   551
tz@906
   552
rootOfClassHierarchy
tz@771
   553
    "returns the value holder for the root of the class tree list"
tz@425
   554
tz@425
   555
    |holder|
tz@906
   556
tz@906
   557
tz@906
   558
    (holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[
tz@906
   559
        ClassPresentation = #'Class Hierarchy' ifTrue: [
tz@906
   560
        builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)]
tz@771
   561
    ].
tz@771
   562
    ^ holder
tz@771
   563
tz@771
   564
tz@771
   565
!
tz@771
   566
tz@906
   567
selectionOfClassCategories
tz@771
   568
    "returns the value holder for the selected class of the class tree list"
tz@771
   569
tz@906
   570
    |holder|           
tz@906
   571
    (holder := builder bindingAt:#selectionOfClassCategories) isNil ifTrue:[
tz@906
   572
        builder aspectAt:#selectionOfClassCategories put:(holder :=  ValueHolder new). 
tz@906
   573
    ].
tz@906
   574
    ^ holder
tz@906
   575
!
tz@906
   576
tz@906
   577
selectionOfClassHierarchy
tz@906
   578
    "returns the value holder for the selected class of the class tree list"
tz@906
   579
tz@906
   580
    |holder|           
tz@906
   581
    (holder := builder bindingAt:#selectionOfClassHierarchy) isNil ifTrue:[
tz@906
   582
        builder aspectAt:#selectionOfClassHierarchy put:(holder :=  ValueHolder new). 
tz@906
   583
    ].
tz@906
   584
    ^ holder
tz@906
   585
!
tz@906
   586
tz@906
   587
selectionOfClassPresentation
tz@906
   588
    "returns the value holder for the selected class presentation"
tz@906
   589
tz@771
   590
    |holder|
cg@1034
   591
tz@906
   592
    (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[
tz@906
   593
        builder aspectAt:#selectionOfClassPresentation put:(holder :=  RadioButtonGroup with: (ClassPresentation := ClassPresentation ? #'Class Categories')).
cg@1329
   594
        holder onChangeEvaluate: 
cg@1034
   595
            [
cg@1034
   596
                 |hv comp newRoot|
cg@1034
   597
cg@1034
   598
                 hv := holder value.
cg@1034
   599
                 ClassPresentation := hv.
cg@1034
   600
                 hv = #'Class Hierarchy' ifTrue:[
cg@1034
   601
                      comp := builder componentAt: #listOfClassHierarchyView.
cg@1034
   602
                      newRoot := self rootOfClassHierarchy.  
cg@1034
   603
                 ] ifFalse: [
cg@1034
   604
                      comp := builder componentAt: #listOfClassCategoriesView.
cg@1034
   605
                      newRoot := self rootOfClassCategories. 
cg@1034
   606
                 ].
cg@1034
   607
                 comp root:newRoot.
cg@1034
   608
                 comp raise. 
cg@1986
   609
                 classSelectionBlock value: self classNameHolder value
cg@1034
   610
            ]
tz@771
   611
    ].
tz@771
   612
    ^ holder
tz@771
   613
!
tz@771
   614
tz@771
   615
selectionOfResourceMethod
tz@771
   616
    "returns the value holder for the selected resource method of the resource method list"
tz@771
   617
tz@771
   618
    |holder|
tz@771
   619
    (holder := builder bindingAt:#selectionOfResourceMethod) isNil ifTrue:[
tz@771
   620
	builder aspectAt:#selectionOfResourceMethod put:(holder :=  '' asValue).
tz@425
   621
    ].
tz@425
   622
    ^ holder
tz@425
   623
!
tz@425
   624
tz@467
   625
valueOfClassName
sv@2309
   626
    <resource: #obsolete>
tz@771
   627
    "returns the value holder for the name of the class"
tz@467
   628
cg@1986
   629
    self obsoleteMethodWarning:'stupid name - use #classNameHolder'.
cg@1986
   630
    ^ self classNameHolder
tz@467
   631
!
tz@467
   632
tz@771
   633
valueOfResourceSelector
sv@2309
   634
    <resource: #obsolete>
tz@771
   635
    "returns the value holder for the name of the selector"
tz@425
   636
cg@1986
   637
    self obsoleteMethodWarning:'stupid name - use #resourceSelectorHolder'.
cg@1986
   638
    ^ self resourceSelectorHolder
tz@425
   639
! !
tz@425
   640
cg@1720
   641
!ResourceSelectionBrowser methodsFor:'callbacks-class list'!
tz@632
   642
tz@906
   643
treeViewClassCategoryChildren
tz@906
   644
    "returns the children for the contents (class) of aTreeItem as a block"
tz@906
   645
cg@1034
   646
    "/ cg: tz's algorithm was very-very slow, 
cg@1034
   647
    "/ (it enumerated classes hundreds of times,
cg@1034
   648
    "/  leading to a square runtime behavior
cg@1034
   649
    "/  - i.e. very slow scrolling )
cg@1034
   650
    "/ Speed up things by caching facts while enumerating
cg@1034
   651
    "/ classes once only.
cg@1034
   652
cg@1034
   653
    |allClasses topClass childrenPerCategory privateClasses|
cg@1034
   654
cg@1034
   655
    topClass := self treeViewClassHierarchyContents.
cg@1034
   656
    allClasses := topClass withAllSubclasses.
cg@1034
   657
    privateClasses := IdentitySet new.
cg@1034
   658
cg@1034
   659
    childrenPerCategory := Dictionary new.
cg@1034
   660
    allClasses do:[:cls |
cg@1034
   661
        |cat set|
cg@1034
   662
cg@1034
   663
        cls isPrivate ifFalse:[
cg@1034
   664
            cat := cls category.
cg@1034
   665
            set := childrenPerCategory at:cat ifAbsent:nil.
cg@1034
   666
            set isNil ifTrue:[
cg@1034
   667
                childrenPerCategory at:cat put:(set := IdentitySet new).
cg@1034
   668
            ].
cg@1034
   669
            set add:cls
cg@1034
   670
        ] ifTrue:[
cg@1034
   671
            privateClasses add:cls
cg@1034
   672
        ]
cg@1034
   673
    ].
cg@1034
   674
cg@1034
   675
    ^ [:aTreeItem|
cg@1034
   676
        |cont children initialContents setOfCategories itemCategory setOfClasses|
cg@1034
   677
cg@1034
   678
        (cont := aTreeItem contents) isBehavior ifTrue:[
cg@1034
   679
           children := privateClasses select:[:cls | cls owningClass == aTreeItem contents].
cg@1034
   680
           children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name].
cg@1732
   681
           "/ children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child]
cg@1732
   682
           children := children collect: [:child| TreeItem name:(child name) contents: child]
cg@1034
   683
        ] ifFalse:[
cg@1034
   684
            cont size == 0 ifTrue:[
cg@1034
   685
                setOfCategories := childrenPerCategory keys.
cg@1034
   686
                children := setOfCategories asSortedCollection.
cg@1034
   687
                children := children collect: [:nm | TreeItem name:nm contents:#Category]
cg@1034
   688
            ] ifFalse:[
cg@1034
   689
                cont == #Category ifTrue:[
cg@1034
   690
                    itemCategory := aTreeItem name.
cg@1034
   691
                    setOfClasses := childrenPerCategory at:itemCategory ifAbsent:[Set new].
cg@1034
   692
                    children := setOfClasses asOrderedCollection sort:[:c1 :c2 | c1 name <= c2 name].
cg@1034
   693
                    children := children collect:[:child | TreeItem name:child name contents:child].
cg@1034
   694
                ] ifFalse:[
cg@1034
   695
                    "/ huh ?
cg@1034
   696
                    children := OrderedCollection new.
cg@1034
   697
                ]
cg@1034
   698
            ].
cg@1034
   699
        ].
cg@1034
   700
        children
cg@1034
   701
    ]
tz@906
   702
!
tz@906
   703
tz@906
   704
treeViewClassCategoryIcon
tz@906
   705
    "returns the icon for aTreeItem as a block"
tz@906
   706
tz@906
   707
    ^self class treeViewClassHierarchyIcon
tz@906
   708
tz@906
   709
tz@906
   710
!
tz@906
   711
tz@906
   712
treeViewClassHierarchyContents
tz@771
   713
    "returns the contents of the root of the class tree list"
tz@632
   714
cg@802
   715
    |cls|
tz@632
   716
cg@802
   717
    resourceSuperclass notNil ifTrue:[
cg@1978
   718
        cls := Smalltalk classNamed: resourceSuperclass.
cg@802
   719
    ].
cg@1034
   720
    cls notNil ifTrue:[^ cls].
cg@1034
   721
    ^ self class treeViewClassHierarchyContents
tz@771
   722
!
tz@771
   723
tz@771
   724
validateDoubleClick: aTreeItem
tz@771
   725
    "returns whether a class may be selected"
tz@771
   726
cg@1034
   727
    |cont|
cg@1034
   728
cg@1034
   729
    ^ (cont := aTreeItem contents) ~= '' 
cg@1034
   730
      and: [cont ~~ self treeViewClassHierarchyContents]       
tz@771
   731
tz@771
   732
tz@771
   733
tz@632
   734
! !
tz@632
   735
cg@1720
   736
!ResourceSelectionBrowser methodsFor:'callbacks-user'!
tz@425
   737
tz@771
   738
classSelected
tz@771
   739
    "after a class selection, read the allowed resource methods of the selected class"
tz@730
   740
cg@1732
   741
    |sel|
tz@906
   742
cg@1919
   743
    ClassPresentation = #'Class Hierarchy'
cg@1732
   744
"/        ifTrue:  [sel := self selectionOfClassHierarchy value]
cg@1919
   745
        ifFalse: [sel := self selectionOfClassCategories value].
cg@1919
   746
cg@1919
   747
    sel notNil ifTrue:[
cg@1978
   748
        resourceClass := sel.
cg@1919
   749
    ].
cg@1732
   750
    self updateResourceMethodList.
tz@425
   751
!
tz@425
   752
cg@1384
   753
classSelectionUpdate:clsPattern
cg@1384
   754
    |foundClass classes|  
cg@1384
   755
cg@1384
   756
    clsPattern notNil ifTrue:[
cg@1384
   757
        foundClass := Smalltalk at:(clsPattern printString asSymbol).
cg@1384
   758
    ].
cg@1384
   759
    (foundClass isClass not or:[foundClass name ~= clsPattern])
cg@1732
   760
    ifTrue: [
cg@1384
   761
        classes := allClasses select: [:cls| cls name size >= clsPattern size].
cg@1732
   762
        1 to: clsPattern size do: [:i|    
cg@1384
   763
             classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)].
cg@1384
   764
        ].    
sv@1835
   765
        foundClass := classes at: 1 ifAbsent:[]. 
cg@1384
   766
    ].          
cg@1732
   767
cg@1732
   768
    foundClass notNil ifTrue: [           
sv@1835
   769
        foundClass := foundClass autoload.
cg@1978
   770
        resourceClass := foundClass.
cg@1732
   771
cg@1732
   772
        ClassPresentation = #'Class Hierarchy' ifTrue: [
cg@1732
   773
            |searchArgs nonSuperclasses hierItem|
cg@1732
   774
cg@1732
   775
            false "foundClass isPrivate"
cg@1384
   776
                ifFalse: [searchArgs := foundClass withAllSuperclasses reverse]
cg@1978
   777
                ifTrue:  [searchArgs := foundClass owningClass withAllSuperclasses reverse. 
cg@1978
   778
                          searchArgs add: foundClass].                                  
cg@1384
   779
            (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil 
cg@1384
   780
                ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
cg@1384
   781
cg@1732
   782
            hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs.
cg@1732
   783
            hierItem notNil ifTrue:[
cg@1732
   784
                self selectionOfClassHierarchy value:hierItem.
cg@1732
   785
            ].
sv@1835
   786
        ] ifFalse: [
cg@1732
   787
            |searchArgs hierItem|
cg@1732
   788
cg@1732
   789
            false "foundClass isPrivate"
cg@1384
   790
                ifTrue:  [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass owningClass name with: foundClass name]
cg@1384
   791
                ifFalse: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass name].
cg@1384
   792
cg@1732
   793
            hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs.
cg@1732
   794
            hierItem notNil ifTrue:[
cg@1732
   795
                self selectionOfClassCategories value: hierItem.
cg@1732
   796
            ].
cg@1384
   797
        ].
cg@1384
   798
    ].
cg@1986
   799
    self classNameHolder value: clsPattern.
cg@1919
   800
    self updateResourceMethodList.
cg@1384
   801
!
cg@1384
   802
tz@425
   803
resourceDoubleClicked
tz@771
   804
    "after a double click on resource method, accept it and close"
tz@425
   805
tz@425
   806
    accept value: true.
cg@1034
   807
    self closeRequest
tz@425
   808
!
tz@425
   809
tz@425
   810
resourceSelected
tz@771
   811
    "after a click on a resource method, set its selector into the field"
tz@425
   812
tz@771
   813
    self selectionOfResourceMethod value notNil
cg@1986
   814
        ifTrue: [self resourceSelectorHolder value: self selectionOfResourceMethod value selector]
cg@1732
   815
!
cg@1732
   816
cg@1732
   817
updateResourceMethodList
cg@1732
   818
    "read the allowed resource methods of the selected class"
cg@1732
   819
cg@1732
   820
    |class className item|
cg@1732
   821
cg@1978
   822
    (class := resourceClass) isNil ifTrue:[
cg@1732
   823
        ClassPresentation = #'Class Hierarchy'
cg@1732
   824
            ifTrue:  [item := self selectionOfClassHierarchy value ]
cg@1732
   825
            ifFalse: [item := self selectionOfClassCategories value ].
cg@1978
   826
cg@1732
   827
        item notNil ifTrue:[
cg@1732
   828
            className := item name.
cg@1732
   829
            class := Smalltalk at:className asSymbol
cg@1732
   830
        ].
cg@1732
   831
    ].
cg@1732
   832
cg@1732
   833
    class isNil ifTrue: [^self].
cg@1732
   834
sr@2038
   835
    className := class name."/class theNonMetaclass name
cg@1732
   836
cg@1920
   837
    self withWaitCursorDo:[
cg@1732
   838
        |newContents|           
cg@1732
   839
cg@1732
   840
        resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
cg@1732
   841
cg@1986
   842
        self classNameHolder value: className.
cg@1732
   843
        self class lastSelection: className.
cg@1732
   844
cg@1732
   845
        newContents := class class methodDictionary asOrderedCollection 
cg@1732
   846
                       select: [:m | m resources notNil 
cg@1732
   847
                                     and: [resourceTypes includes: m resourceType]
cg@1732
   848
                               ].
cg@1732
   849
        newContents := newContents sort:[:m1 :m2 | m1 selector < m2 selector].
cg@1732
   850
        newContents := newContents collect:[:m| (ResourceMethod new method:m)].
cg@1732
   851
cg@1732
   852
        self listOfResourceMethods contents:newContents
cg@1732
   853
                .
cg@1732
   854
    ]
tz@425
   855
! !
tz@425
   856
tz@425
   857
!ResourceSelectionBrowser methodsFor:'instance creation'!
tz@425
   858
cg@1978
   859
openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
cg@1978
   860
    "opens a ResourceSelectionBrowser; return a Message-object or nil"
tz@425
   861
cg@1978
   862
    |selectedClass enteredClassName className cls|
tz@771
   863
tz@517
   864
    resourceMethod := aSelector.
tz@425
   865
    resourceTypes := aResourceTypes.
tz@425
   866
    resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol].
cg@802
   867
    resourceClass := nil.
cg@802
   868
cg@1978
   869
    aClassOrClassName notNil ifTrue:[
cg@1978
   870
        aClassOrClassName isClass ifTrue: [
cg@1978
   871
            cls := aClassOrClassName. 
cg@1978
   872
            resourceClass := aClassOrClassName
cg@1978
   873
        ] ifFalse: [
cg@1978
   874
            cls := Smalltalk classNamed: aClassOrClassName.
cg@1978
   875
            cls notNil ifTrue:[
cg@1978
   876
                resourceClass := cls
cg@802
   877
            ]
cg@1978
   878
        ]
cg@1978
   879
    ].            
cg@1986
   880
    self resourceSelectorHolder value:(aSelector ? '').
tz@463
   881
    self open.
tz@463
   882
cg@1978
   883
    (selectedClass := self selectionOfClassHierarchy value) isNil ifTrue:[
cg@1978
   884
        (selectedClass := self selectionOfClassCategories value) isNil ifTrue:[
cg@1986
   885
            (enteredClassName := self classNameHolder value) isNil ifTrue:[
cg@1086
   886
                accept value ifTrue:[
cg@1086
   887
                    self warn:'No valid class selected/entered'.
cg@1086
   888
                ].
cg@1086
   889
                ^ nil
cg@1086
   890
            ]
cg@1086
   891
        ]
cg@1086
   892
    ].
tz@906
   893
cg@1978
   894
    className := enteredClassName.    
cg@1978
   895
    className isNil ifTrue:[
cg@1978
   896
        className := selectedClass name
cg@1086
   897
    ].
cg@1978
   898
    cls := Smalltalk classNamed:className.
cg@1978
   899
    (cls isClass and:[accept value]) ifTrue:[            
cg@1986
   900
        ^ Method::MethodWhoInfo class:cls selector:(self resourceSelectorHolder value)
tz@425
   901
    ].
cg@1086
   902
cg@1086
   903
    accept value ifTrue:[
cg@1086
   904
        self warn:'No valid class selected/entered'.
cg@1086
   905
    ].
cg@1086
   906
    ^ nil
cg@802
   907
cg@802
   908
    "Modified: / 22.4.1998 / 14:51:03 / cg"
tz@425
   909
! !
tz@425
   910
cg@1716
   911
!ResourceSelectionBrowser methodsFor:'startup & release'!
tz@425
   912
tz@623
   913
postBuildWith:aBuilder
tz@771
   914
    "after building and before opening,  
tz@906
   915
     create a class selection block, an entry completion block for the class name field"
tz@623
   916
tz@771
   917
    |classSelection classNameInputField|
tz@906
   918
     
tz@906
   919
    allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate].
cg@1978
   920
    classSelection := resourceClass isNil ifTrue:[nil] ifFalse:[resourceClass name]. 
cg@802
   921
cg@1978
   922
    (classSelection isNil or:[ (Smalltalk classNamed: classSelection) isNil]) 
tz@689
   923
        ifTrue: [classSelection :=  self class lastSelection].
cg@1732
   924
"/    (classSelection isNil or:[Smalltalk at: classSelection]) isNil 
cg@1732
   925
"/        ifTrue: [classSelection :=  self treeViewContents].
cg@802
   926
cg@1384
   927
    classSelectionBlock := [:clsPattern | self classSelectionUpdate:clsPattern].
cg@1986
   928
    self classNameHolder value:classSelection.  
tz@771
   929
cg@1920
   930
    (classNameInputField := builder componentAt: #classNameInputField) 
cg@1920
   931
        entryCompletionBlock:
cg@1920
   932
            [:value|
cg@1920
   933
                |s what m|
cg@1920
   934
cg@1920
   935
                s := classNameInputField contents withoutSpaces.
cg@1920
   936
                what := Smalltalk classnameCompletion:s inEnvironment:Smalltalk.
cg@1920
   937
                classNameInputField contents:what first.
cg@1920
   938
                (what at:2) size ~~ 1 ifTrue:[
cg@1920
   939
                    classNameInputField device beep
cg@1920
   940
                ]
cg@1920
   941
"/                |what oldClassName|
cg@1920
   942
"/                oldClassName := classNameInputField contents.
cg@1920
   943
"/                what := Smalltalk classnameCompletion: value withoutSpaces.
cg@1920
   944
"/                classNameInputField contents:what first.
cg@1920
   945
"/                oldClassName = classNameInputField contents ifTrue:[classNameInputField flash].
cg@1920
   946
"/                classSelectionBlock value: classNameInputField contents
cg@1920
   947
            ].
tz@623
   948
cg@1986
   949
    classSelectionBlock value: self classNameHolder value.
cg@1732
   950
    self updateResourceMethodList.
tz@906
   951
    self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
tz@909
   952
tz@909
   953
    ^super postBuildWith:aBuilder
tz@910
   954
!
tz@910
   955
tz@910
   956
postOpenWith:aBuilder
tz@910
   957
    "after opening and if turned on make hierarchy view visible"
tz@910
   958
tz@910
   959
    ClassPresentation = #'Class Hierarchy'
tz@910
   960
        ifTrue: [(builder componentAt: #listOfClassHierarchyView) raise].
tz@910
   961
cg@2026
   962
    super postOpenWith:aBuilder
tz@425
   963
! !
tz@425
   964
tz@771
   965
!ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
tz@523
   966
tz@523
   967
iconOn:aGC
tz@771
   968
    "registers and returns an icon indicating the resource type"
tz@523
   969
cg@1524
   970
    |cls sel image imageKey|
cg@1524
   971
tz@730
   972
    self resourceType isNil ifTrue: [^nil].
cg@1524
   973
cg@1524
   974
    icon isNil ifTrue:[
frank@1412
   975
        ((self resourceType = #image) or: [resourceType = #fileImage])
cg@1524
   976
        ifTrue:[  
cg@1524
   977
            cls := method mclass theNonMetaclass.
cg@1524
   978
            sel := method selector.
cg@1524
   979
        ] ifFalse: [
frank@1412
   980
            cls := SystemBrowser.
frank@1412
   981
            sel := (resourceType, 'Icon') asSymbol.
frank@1412
   982
        ].
frank@1412
   983
        imageKey := (cls name, sel) asSymbol.
frank@1412
   984
        (icon := aGC registeredImageAt: imageKey) isNil
cg@1524
   985
        ifTrue: [       
frank@1412
   986
            image := cls perform: sel.
cg@1524
   987
            (image extent y > 18) ifTrue: [         
frank@1412
   988
                image := image magnifiedBy: 18/image extent y
frank@1412
   989
            ].
frank@1412
   990
            aGC registerImage: image key: imageKey.
frank@1412
   991
            icon := aGC registeredImageAt: imageKey.
frank@1412
   992
        ].
tz@730
   993
    ].
tz@523
   994
    ^icon
cg@1524
   995
cg@1524
   996
    "Modified: / 5.11.2001 / 16:48:35 / cg"
tz@523
   997
!
tz@523
   998
tz@523
   999
method: aMethod
tz@771
  1000
    "sets aMethod"
tz@523
  1001
tz@523
  1002
    method := aMethod
tz@523
  1003
!
tz@523
  1004
tz@523
  1005
resourceType
tz@771
  1006
    "returns resourceType"
tz@523
  1007
tz@523
  1008
    resourceType isNil ifTrue: [resourceType := method resourceType].
tz@523
  1009
    ^resourceType
tz@523
  1010
!
tz@523
  1011
tz@523
  1012
selector
tz@771
  1013
    "returns selector"
tz@523
  1014
tz@523
  1015
    selector isNil ifTrue: [selector := method who methodSelector].
tz@523
  1016
    ^selector
tz@523
  1017
! !
tz@523
  1018
tz@425
  1019
!ResourceSelectionBrowser class methodsFor:'documentation'!
tz@425
  1020
tz@425
  1021
version
tz@425
  1022
    ^ '$Header$'
tz@425
  1023
! !