ResourceSelectionBrowser.st
author Patrik Svestka <patrik.svestka@gmail.com>
Wed, 14 Nov 2018 12:07:51 +0100
branchjv
changeset 3630 5e718e0a754e
parent 3198 d0f01dc022bb
child 3528 f697558c47cd
permissions -rw-r--r--
Issue #239: Fix all Smalltak/X source files to be in unicode (UTF8 without BOM) and prefixed by "{ Encoding: utf8 }" when any unicode character is present

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