ResourceSelectionBrowser.st
author Claus Gittinger <cg@exept.de>
Tue, 14 May 2019 09:46:21 +0200
changeset 3663 9d49ecf8661a
parent 3652 2b6236bab321
permissions -rw-r--r--
#UI_ENHANCEMENT by cg
class: TabListEditor class
changed:
#canvasSpec
#menu
#windowSpec
cg@3531
     1
"{ Encoding: utf8 }"
cg@3531
     2
tz@425
     3
"
tz@771
     4
 COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@425
     5
              All Rights Reserved
tz@425
     6
tz@425
     7
 This software is furnished under a license and may be used
tz@425
     8
 only in accordance with the terms of that license and with the
tz@425
     9
 inclusion of the above copyright notice. This software may not
tz@425
    10
 be provided or otherwise made available to, or used by, any
tz@425
    11
 other person. No title to or ownership of the software is
tz@425
    12
 hereby transferred.
tz@425
    13
"
cg@1384
    14
"{ Package: 'stx:libtool2' }"
cg@1384
    15
cg@3198
    16
"{ NameSpace: Smalltalk }"
cg@3198
    17
tz@425
    18
SelectionBrowser subclass:#ResourceSelectionBrowser
tz@477
    19
	instanceVariableNames:'resourceMethod resourceClass resourceSuperclass resourceTypes
cg@3531
    20
		allClasses classSelectionBlock classFilter packageFilter
cg@3531
    21
		metaClassOnly existingOnly filter classPresentation'
cg@3531
    22
	classVariableNames:'LastClassPresentation'
tz@425
    23
	poolDictionaries:''
tz@619
    24
	category:'Interface-Dialogs'
tz@425
    25
!
tz@425
    26
tz@771
    27
Object subclass:#ResourceMethod
tz@523
    28
	instanceVariableNames:'method icon resourceType selector'
tz@523
    29
	classVariableNames:''
tz@523
    30
	poolDictionaries:''
tz@523
    31
	privateIn:ResourceSelectionBrowser
tz@523
    32
!
tz@523
    33
tz@425
    34
!ResourceSelectionBrowser class methodsFor:'documentation'!
tz@425
    35
tz@425
    36
copyright
tz@425
    37
"
tz@771
    38
 COPYRIGHT (c) 1997-1998 by eXept Software AG
tz@425
    39
              All Rights Reserved
tz@425
    40
tz@425
    41
 This software is furnished under a license and may be used
tz@425
    42
 only in accordance with the terms of that license and with the
tz@425
    43
 inclusion of the above copyright notice. This software may not
tz@425
    44
 be provided or otherwise made available to, or used by, any
tz@425
    45
 other person. No title to or ownership of the software is
tz@425
    46
 hereby transferred.
tz@425
    47
"
tz@425
    48
tz@425
    49
!
tz@425
    50
tz@425
    51
documentation
tz@425
    52
"
tz@746
    53
    The ResourceSelectionBrowser allows you to browse in class hierarchies
tz@771
    54
    and to select resource methods for loading or to saving resource 
tz@771
    55
    specifications (#canvas, #menu, etc.).
tz@771
    56
tz@771
    57
    [instance variables:]
tz@907
    58
        resourceMethod          <Symbol>        selector of the resource spec
tz@907
    59
        resourceClass           <Symbol>        class of the resource spec
tz@907
    60
        resourceSuperclass      <Symbol>        root class of the tree list
tz@907
    61
        resourceTypes           <Array>         allowed resource types
tz@907
    62
        allClasses              <Array>         list of the subclasses of resourceSuperclass
tz@907
    63
        classSelectionBlock     <Block>         by evaluating this block the class selection is done
cg@3531
    64
        classFilter             <Block>         if non-nil, given a class, has to return true for a class to be shown
cg@3531
    65
        packageFilter           <Block>         if non-nil, given a package, has to return true for a class to be shown
cg@3531
    66
        existingOnly            <Boolean>       if set, only classes with existing resources are shown (for load dialogs);
cg@3531
    67
                                                otherwise, empty classes are also shown (for save dialogs)
tz@746
    68
tz@504
    69
    [start with:]
tz@907
    70
        ResourceSelectionBrowser open
tz@504
    71
tz@504
    72
    [author:]
tz@907
    73
        Thomas Zwick, eXept Software AG
tz@425
    74
"
tz@425
    75
! !
tz@425
    76
tz@425
    77
!ResourceSelectionBrowser class methodsFor:'instance creation'!
tz@425
    78
cg@1978
    79
request:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
cg@3531
    80
    "opens a ResourceSelectionBrowser; 
cg@3531
    81
     return a Message-object (whoInfo) or nil."
cg@3531
    82
cg@3531
    83
    ^ (self 
cg@3531
    84
        title:aTitle 
cg@3531
    85
        onSuperclass:aSuperclass 
cg@3531
    86
        andClass:aClassOrClassName andSelector:aSelector 
cg@3531
    87
        withResourceTypes:resourceTypes
cg@3531
    88
      ) openAndLetUserChoose
cg@3531
    89
cg@3531
    90
    "
cg@3531
    91
     ResourceSelectionBrowser
cg@3531
    92
        request: 'Select a Resource Selector'
cg@3531
    93
        onSuperclass: #ApplicationModel 
cg@3531
    94
        andClass: MenuEditor andSelector: #menuItemImage 
cg@3531
    95
        withResourceTypes: #(image) 
cg@3531
    96
    "
cg@3531
    97
!
cg@3531
    98
cg@3531
    99
title:aTitle onSuperclass:aSuperclass andClass:aClassOrClassName andSelector:aSelector withResourceTypes:resourceTypes
cg@3531
   100
    "creates and returns a ResourceSelectionBrowser but does not open it.
cg@3531
   101
     To open,
cg@3531
   102
        send the returned browser an openAndLetUserChoose message,
cg@3531
   103
        which returns the selected resource method's info (whoInfo) or nil on cancel.
cg@3531
   104
     Use this to set additional filters before opening"
cg@1978
   105
cg@1978
   106
    ^ (self new
cg@1978
   107
        title: aTitle)
cg@3531
   108
            onSuperclass:aSuperclass
cg@1978
   109
            andClass:aClassOrClassName
cg@1978
   110
            andSelector:aSelector
cg@1978
   111
            withResourceTypes:resourceTypes
cg@1978
   112
tz@649
   113
    "
cg@3531
   114
     (ResourceSelectionBrowser
cg@3531
   115
        title: 'Select a Resource Selector'
tz@906
   116
        onSuperclass: #ApplicationModel 
cg@3531
   117
        andClass: MenuEditor andSelector: #menuItemImage 
cg@3531
   118
        withResourceTypes: #(image)
cg@3531
   119
     ) openAndLetUserChoose
tz@425
   120
    "
tz@425
   121
! !
tz@425
   122
tz@730
   123
!ResourceSelectionBrowser class methodsFor:'image specs'!
tz@730
   124
tz@906
   125
iconCategory
sv@3117
   126
    <resource: #image>
tz@906
   127
    "This resource specification was automatically generated
tz@906
   128
     by the ImageEditor of ST/X."
tz@906
   129
    "Do not manually edit this!! If it is corrupted,
tz@906
   130
     the ImageEditor may not be able to read the specification."
tz@906
   131
    "
tz@906
   132
     self iconCategory inspect
sv@3117
   133
     ImageEditor openOnClass:self andSelector:#iconCategory"
sv@3117
   134
    
sv@3117
   135
    ^ Icon constantNamed:#'ResourceSelectionBrowser class iconCategory'
sv@3117
   136
        ifAbsentPut:[
sv@3117
   137
            (Depth4Image new)
sv@3117
   138
                width:18;
sv@3117
   139
                height:16;
sv@3117
   140
                photometric:(#palette);
sv@3117
   141
                bitsPerSample:(#( 4 ));
sv@3117
   142
                samplesPerPixel:(1);
sv@3117
   143
                bits:(ByteArray 
sv@3117
   144
                            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
   145
                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
   146
                mask:((ImageMask new)
sv@3117
   147
                            width:18;
sv@3117
   148
                            height:16;
sv@3117
   149
                            bits:(ByteArray 
sv@3117
   150
                                        fromPackedString:'<@O@8@G@3?3@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@7?;@3?3@8@G@<@O@');
sv@3117
   151
                            yourself);
sv@3117
   152
                yourself
sv@3117
   153
        ]
cg@1493
   154
!
tz@906
   155
tz@730
   156
iconClass
sv@3117
   157
    <resource: #image>
tz@746
   158
    "This resource specification was automatically generated
tz@746
   159
     by the ImageEditor of ST/X."
tz@746
   160
    "Do not manually edit this!! If it is corrupted,
tz@746
   161
     the ImageEditor may not be able to read the specification."
tz@730
   162
    "
cg@1404
   163
     self iconClass inspect
sv@3117
   164
     ImageEditor openOnClass:self andSelector:#iconClass"
sv@3117
   165
    
sv@3117
   166
    ^ Icon constantNamed:#'ResourceSelectionBrowser class iconClass'
sv@3117
   167
        ifAbsentPut:[
sv@3117
   168
            (Depth2Image new)
sv@3117
   169
                width:18;
sv@3117
   170
                height:16;
sv@3117
   171
                photometric:(#palette);
sv@3117
   172
                bitsPerSample:(#( 2 ));
sv@3117
   173
                samplesPerPixel:(1);
sv@3117
   174
                bits:(ByteArray 
sv@3117
   175
                            fromPackedString:'@@@@@@@*****ABUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@BUUUUT@IUUUUP@%UUUU@A@@@@@@@@@@@@@b');
sv@3117
   176
                colorMapFromArray:#[ 0 0 0 170 170 170 255 255 255 ];
sv@3117
   177
                mask:((ImageMask new)
sv@3117
   178
                            width:18;
sv@3117
   179
                            height:16;
sv@3117
   180
                            bits:(ByteArray 
sv@3117
   181
                                        fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@');
sv@3117
   182
                            yourself);
sv@3117
   183
                yourself
sv@3117
   184
        ]
cg@1493
   185
!
tz@730
   186
tz@730
   187
iconPrivateClass
sv@3117
   188
    <resource: #image>
tz@746
   189
    "This resource specification was automatically generated
tz@746
   190
     by the ImageEditor of ST/X."
tz@746
   191
    "Do not manually edit this!! If it is corrupted,
tz@746
   192
     the ImageEditor may not be able to read the specification."
tz@730
   193
    "
sv@3117
   194
     ImageEditor openOnClass:self andSelector:#iconPrivateClass"
sv@3117
   195
    
sv@3117
   196
    ^ Icon constantNamed:#'ResourceSelectionBrowser class iconPrivateClass'
sv@3117
   197
        ifAbsentPut:[
sv@3117
   198
            (Depth2Image new)
sv@3117
   199
                width:18;
sv@3117
   200
                height:16;
sv@3117
   201
                photometric:(#palette);
sv@3117
   202
                bitsPerSample:(#( 2 ));
sv@3117
   203
                samplesPerPixel:(1);
sv@3117
   204
                bits:(ByteArray 
sv@3117
   205
                            fromPackedString:'@@@@@@PUUUUU A****(@F*??* @Z+??*@A*/*>(OF*>+: @Z+??*@A*/?:(DF*>** @Z+:**@A*/**(@F*>** @Z****C2@@@@@@@@@@@@@b');
sv@3117
   206
                colorMapFromArray:#[ 0 0 0 255 255 255 170 170 170 255 0 0 ];
sv@3117
   207
                mask:((ImageMask new)
sv@3117
   208
                            width:18;
sv@3117
   209
                            height:16;
sv@3117
   210
                            bits:(ByteArray 
sv@3117
   211
                                        fromPackedString:'_?>@???@???@???@???@???@???@???@???@???@???@???@???@???@???@_?>@');
sv@3117
   212
                            yourself);
sv@3117
   213
                yourself
sv@3117
   214
        ]
cg@1493
   215
! !
tz@730
   216
tz@425
   217
!ResourceSelectionBrowser class methodsFor:'interface specs'!
tz@425
   218
tz@425
   219
windowSpec
tz@746
   220
    "This resource specification was automatically generated
tz@746
   221
     by the UIPainter of ST/X."
tz@425
   222
tz@746
   223
    "Do not manually edit this!! If it is corrupted,
tz@746
   224
     the UIPainter may not be able to read the specification."
tz@425
   225
tz@425
   226
    "
tz@425
   227
     UIPainter new openOnClass:ResourceSelectionBrowser andSelector:#windowSpec
tz@425
   228
     ResourceSelectionBrowser new openInterface:#windowSpec
tz@746
   229
     ResourceSelectionBrowser open
tz@425
   230
    "
tz@425
   231
tz@425
   232
    <resource: #canvas>
tz@425
   233
cg@1384
   234
    ^ 
cg@3531
   235
    #(FullSpec
cg@3531
   236
       name: windowSpec
cg@3531
   237
       uuid: 'fb378b3c-07aa-11e8-8563-b8f6b1108e05'
cg@3531
   238
       window: 
cg@3531
   239
      (WindowSpec
cg@3531
   240
         label: 'Resource Selection Browser'
cg@3531
   241
         name: 'Resource Selection Browser'
cg@3531
   242
         uuid: 'f1361a68-0791-11e8-8563-b8f6b1108e05'
cg@3531
   243
         min: (Point 400 300)
cg@3531
   244
         bounds: (Rectangle 0 0 644 460)
cg@3531
   245
       )
cg@3531
   246
       component: 
cg@3531
   247
      (SpecCollection
cg@3531
   248
         collection: (
cg@3531
   249
          (VariableHorizontalPanelSpec
cg@3531
   250
             name: 'VariableHorizontalPanel'
cg@3531
   251
             layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 -36 1.0)
cg@3531
   252
             uuid: 'f1361c5c-0791-11e8-8563-b8f6b1108e05'
cg@3531
   253
             component: 
cg@3531
   254
            (SpecCollection
cg@3531
   255
               collection: (
cg@3531
   256
                (ViewSpec
cg@3531
   257
                   name: 'Box1'
cg@3531
   258
                   uuid: 'f1361df6-0791-11e8-8563-b8f6b1108e05'
cg@3531
   259
                   component: 
cg@3531
   260
                  (SpecCollection
cg@3531
   261
                     collection: (
cg@3531
   262
                      (HorizontalPanelViewSpec
cg@3531
   263
                         name: 'HorizontalPanel2'
cg@3531
   264
                         layout: (LayoutFrame 0 0 2 0 297 0 23 0)
cg@3531
   265
                         uuid: 'f1361ebe-0791-11e8-8563-b8f6b1108e05'
cg@3531
   266
                         horizontalLayout: leftSpace
cg@3531
   267
                         verticalLayout: fit
cg@3531
   268
                         horizontalSpace: 3
cg@3531
   269
                         verticalSpace: 3
cg@3531
   270
                         component: 
cg@3531
   271
                        (SpecCollection
cg@3531
   272
                           collection: (
cg@3531
   273
                            (RadioButtonSpec
cg@3531
   274
                               label: 'Flat'
cg@3531
   275
                               name: 'RadioButton1'
cg@3531
   276
                               uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
cg@3531
   277
                               translateLabel: true
cg@3531
   278
                               model: selectionOfClassPresentation
cg@3531
   279
                               isTriggerOnDown: true
cg@3531
   280
                               lampColor: (Color 0.0 0.0 0.0)
cg@3531
   281
                               select: Flat
cg@3531
   282
                               extent: (Point 80 21)
cg@1384
   283
                             )
cg@3531
   284
                            (RadioButtonSpec
cg@3531
   285
                               label: 'Categories'
cg@3531
   286
                               name: 'ClassCategoriesRadioButton'
cg@3531
   287
                               uuid: 'f1362062-0791-11e8-8563-b8f6b1108e05'
cg@3531
   288
                               translateLabel: true
cg@3531
   289
                               model: selectionOfClassPresentation
cg@3531
   290
                               isTriggerOnDown: true
cg@3531
   291
                               lampColor: (Color 0.0 0.0 0.0)
cg@3531
   292
                               select: #'Class Categories'
cg@3531
   293
                               extent: (Point 124 21)
cg@3531
   294
                             )
cg@3531
   295
                            (RadioButtonSpec
cg@3531
   296
                               label: 'Hierarchy'
cg@3531
   297
                               name: 'ClassHierarchyRadioButton'
cg@3531
   298
                               uuid: 'f136233c-0791-11e8-8563-b8f6b1108e05'
cg@3531
   299
                               translateLabel: true
cg@3531
   300
                               model: selectionOfClassPresentation
cg@3531
   301
                               isTriggerOnDown: true
cg@3531
   302
                               lampColor: (Color 0.0 0.0 0.0)
cg@3531
   303
                               select: #'Class Hierarchy'
cg@3531
   304
                               extent: (Point 145 21)
cg@3531
   305
                             )
cg@3531
   306
                            )
cg@3531
   307
                          
cg@3531
   308
                         )
cg@1384
   309
                       )
cg@3531
   310
                      (SequenceViewSpec
cg@3531
   311
                         name: 'listOfClassesView'
cg@3531
   312
                         layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@3531
   313
                         uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
cg@3531
   314
                         tabable: true
cg@3531
   315
                         model: indexOfSelectedClassInFlatList
cg@3531
   316
                         hasHorizontalScrollBar: true
cg@3531
   317
                         hasVerticalScrollBar: true
cg@3531
   318
                         miniScrollerHorizontal: true
cg@3531
   319
                         useIndex: true
cg@3531
   320
                         sequenceList: listOfClassNames
cg@1384
   321
                       )
cg@3531
   322
                      (SelectionInTreeViewSpec
cg@3531
   323
                         name: 'listOfClassHierarchyView'
cg@3531
   324
                         layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@3531
   325
                         uuid: 'f13624d6-0791-11e8-8563-b8f6b1108e05'
cg@3531
   326
                         tabable: true
cg@3531
   327
                         model: selectionOfClassHierarchy
cg@3531
   328
                         hasHorizontalScrollBar: true
cg@3531
   329
                         hasVerticalScrollBar: true
cg@3531
   330
                         miniScrollerHorizontal: true
cg@3531
   331
                         showDirectoryIndicatorForRoot: false
cg@3531
   332
                         showDirectoryIndicator: true
cg@3531
   333
                         valueChangeSelector: classSelected
cg@3531
   334
                         hierarchicalList: rootOfClassHierarchy
cg@3531
   335
                         validateDoubleClickSelector: validateDoubleClick:
cg@3531
   336
                         contentsSelector: treeViewClassHierarchyContents
cg@3531
   337
                         labelSelector: treeViewClassHierarchyLabel
cg@3531
   338
                         childrenSelector: treeViewClassHierarchyChildren
cg@3531
   339
                         iconSelector: treeViewClassHierarchyIcon
cg@3531
   340
                         highlightMode: line
cg@3531
   341
                       )
cg@3531
   342
                      (SelectionInTreeViewSpec
cg@3531
   343
                         name: 'listOfClassCategoriesView'
cg@3531
   344
                         layout: (LayoutFrame 0 0.0 23 0.0 0 1.0 -24 1.0)
cg@3531
   345
                         uuid: 'f13627ba-0791-11e8-8563-b8f6b1108e05'
cg@3531
   346
                         tabable: true
cg@3531
   347
                         model: selectionOfClassCategories
cg@3531
   348
                         hasHorizontalScrollBar: true
cg@3531
   349
                         hasVerticalScrollBar: true
cg@3531
   350
                         miniScrollerHorizontal: true
cg@3531
   351
                         showRoot: false
cg@3531
   352
                         showDirectoryIndicator: true
cg@3531
   353
                         valueChangeSelector: classSelected
cg@3531
   354
                         hierarchicalList: rootOfClassCategories
cg@3531
   355
                         validateDoubleClickSelector: validateDoubleClick:
cg@3531
   356
                         childrenSelector: treeViewClassCategoryChildren
cg@3531
   357
                         iconSelector: treeViewClassCategoryIcon
cg@3531
   358
                         highlightMode: line
cg@3531
   359
                       )
cg@3531
   360
                      (InputFieldSpec
cg@3531
   361
                         name: 'classNameInputField'
cg@3531
   362
                         layout: (LayoutFrame 2 0.0 -22 1 -1 1.0 0 1)
cg@3531
   363
                         uuid: 'f1362922-0791-11e8-8563-b8f6b1108e05'
cg@3531
   364
                         tabable: true
cg@3531
   365
                         model: classNameHolder
cg@3531
   366
                         acceptOnLeave: true
cg@3531
   367
                         acceptOnLostFocus: true
cg@3531
   368
                         acceptOnPointerLeave: true
cg@3531
   369
                       )
cg@3531
   370
                      )
cg@3531
   371
                    
cg@3531
   372
                   )
cg@1384
   373
                 )
cg@3531
   374
                (ViewSpec
cg@3531
   375
                   name: 'Box2'
cg@3531
   376
                   uuid: 'f1362aee-0791-11e8-8563-b8f6b1108e05'
cg@3531
   377
                   component: 
cg@3531
   378
                  (SpecCollection
cg@3531
   379
                     collection: (
cg@3531
   380
                      (VariableVerticalPanelSpec
cg@3531
   381
                         name: 'ResourcePanel'
cg@3531
   382
                         layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -24 1.0)
cg@3531
   383
                         uuid: '51c4b91e-07a8-11e8-8563-b8f6b1108e05'
cg@3531
   384
                         component: 
cg@3531
   385
                        (SpecCollection
cg@3531
   386
                           collection: (
cg@3531
   387
                            (DataSetSpec
cg@3531
   388
                               name: 'resourcesDataSetView'
cg@3531
   389
                               uuid: 'f1362bac-0791-11e8-8563-b8f6b1108e05'
cg@3531
   390
                               model: selectionOfResourceMethod
cg@3531
   391
                               hasHorizontalScrollBar: true
cg@3531
   392
                               hasVerticalScrollBar: true
cg@3531
   393
                               miniScrollerHorizontal: true
cg@3531
   394
                               rowClassName: 'ResourceSelectionBrowser::Row'
cg@3531
   395
                               dataList: listOfResourceMethods
cg@3531
   396
                               useIndex: false
cg@3531
   397
                               has3Dseparators: true
cg@3531
   398
                               doubleClickSelector: resourceDoubleClicked
cg@3531
   399
                               columnHolder: resourceMethodColumns
cg@3531
   400
                               valueChangeSelector: resourceSelected
cg@3531
   401
                               verticalSpacing: 1
cg@3531
   402
                             )
cg@3531
   403
                            (ArbitraryComponentSpec
cg@3531
   404
                               name: 'ImageView'
cg@3531
   405
                               uuid: '51c4bd9c-07a8-11e8-8563-b8f6b1108e05'
cg@3531
   406
                               hasBorder: false
cg@3531
   407
                               component: ImageView
cg@3531
   408
                             )
cg@3531
   409
                            )
cg@3531
   410
                          
cg@3531
   411
                         )
cg@3531
   412
                         handles: (Any 0.98999999999999999 1.0)
cg@3531
   413
                       )
cg@3531
   414
                      (InputFieldSpec
cg@3531
   415
                         name: 'selectorInputField'
cg@3531
   416
                         layout: (LayoutFrame 2 0.0 -22 1 -2 1.0 0 1)
cg@3531
   417
                         uuid: 'f1362db4-0791-11e8-8563-b8f6b1108e05'
cg@3531
   418
                         tabable: true
cg@3531
   419
                         model: resourceSelectorHolder
cg@3531
   420
                         acceptOnLeave: true
cg@3531
   421
                         acceptOnLostFocus: true
cg@3531
   422
                         acceptOnPointerLeave: true
cg@3531
   423
                       )
cg@3531
   424
                      )
cg@3531
   425
                    
cg@3531
   426
                   )
cg@1384
   427
                 )
cg@3531
   428
                )
cg@3531
   429
              
cg@3531
   430
             )
cg@3531
   431
             handles: (Any 0.5 1.0)
cg@1384
   432
           )
cg@3531
   433
          (HorizontalPanelViewSpec
cg@3531
   434
             name: 'ButtonPanel'
cg@3531
   435
             layout: (LayoutFrame 2 0.0 -30 1 -18 1.0 -4 1.0)
cg@3531
   436
             uuid: 'f1362f3a-0791-11e8-8563-b8f6b1108e05'
cg@3531
   437
             horizontalLayout: fit
cg@3531
   438
             verticalLayout: fit
cg@3531
   439
             reverseOrderIfOKAtLeft: true
cg@3531
   440
             component: 
cg@3531
   441
            (SpecCollection
cg@3531
   442
               collection: (
cg@3531
   443
                (ActionButtonSpec
cg@3531
   444
                   label: 'Help'
cg@3531
   445
                   name: 'HelpButton'
cg@3531
   446
                   activeHelpKey: dss
cg@3531
   447
                   uuid: 'f136303e-0791-11e8-8563-b8f6b1108e05'
cg@3531
   448
                   translateLabel: true
cg@3531
   449
                   model: openHTMLDocument:
cg@3531
   450
                   initiallyDisabled: true
cg@3531
   451
                   enableChannel: helpEnabled
cg@3531
   452
                   actionValue: 'tools/uipainter/ResourceSelectionBrowser.html'
cg@3531
   453
                   extent: (Point 204 26)
cg@3531
   454
                 )
cg@3531
   455
                (ActionButtonSpec
cg@3531
   456
                   label: 'Cancel'
cg@3531
   457
                   name: 'cancelButton'
cg@3531
   458
                   activeHelpKey: commitCancel
cg@3531
   459
                   uuid: 'f13631ba-0791-11e8-8563-b8f6b1108e05'
cg@3531
   460
                   translateLabel: true
cg@3531
   461
                   tabable: true
cg@3531
   462
                   model: cancel
cg@3531
   463
                   extent: (Point 204 26)
cg@3531
   464
                 )
cg@3531
   465
                (ActionButtonSpec
cg@3531
   466
                   label: 'OK'
cg@3531
   467
                   name: 'okButton'
cg@3531
   468
                   activeHelpKey: commitOK
cg@3531
   469
                   uuid: 'f1363336-0791-11e8-8563-b8f6b1108e05'
cg@3531
   470
                   translateLabel: true
cg@3531
   471
                   tabable: true
cg@3531
   472
                   model: accept
cg@3531
   473
                   isDefault: true
cg@3531
   474
                   extent: (Point 204 26)
cg@3531
   475
                 )
cg@3531
   476
                )
cg@3531
   477
              
cg@3531
   478
             )
cg@3531
   479
             keepSpaceForOSXResizeHandleH: true
cg@3531
   480
           )
cg@3531
   481
          )
cg@3531
   482
        
cg@3531
   483
       )
cg@3531
   484
     )
tz@425
   485
! !
tz@425
   486
tz@648
   487
!ResourceSelectionBrowser class methodsFor:'list specs'!
tz@648
   488
tz@822
   489
tableColumnsForResourceMethodAttributes
tz@821
   490
    "This resource specification was automatically generated
tz@821
   491
     by the DataSetBuilder of ST/X."
tz@648
   492
tz@821
   493
    "Do not manually edit this!! If it is corrupted,
tz@821
   494
     the DataSetBuilder may not be able to read the specification."
tz@821
   495
tz@821
   496
    "
tz@822
   497
     DataSetBuilder new openOnClass:ResourceSelectionBrowser andSelector:#tableColumnsForResourceMethodAttributes
tz@821
   498
    "
tz@821
   499
tz@821
   500
    <resource: #tableColumns>
tz@821
   501
tz@821
   502
tz@821
   503
    ^ #(
tz@821
   504
        #(#DataSetColumnSpec
tz@821
   505
           #width: 20
tz@821
   506
           #height: 20
tz@821
   507
           #printSelector: #iconOn:
tz@821
   508
           #canSelect: false
tz@821
   509
       )
tz@821
   510
        #(#DataSetColumnSpec
tz@821
   511
           #label: ' Selector'
tz@821
   512
           #labelAlignment: #left
tz@821
   513
           #model: #selector
tz@821
   514
           #canSelect: false
tz@821
   515
       )
tz@821
   516
        #(#DataSetColumnSpec
tz@821
   517
           #label: ' Resource Type'
tz@821
   518
           #labelAlignment: #left
tz@821
   519
           #model: #resourceType
tz@821
   520
           #canSelect: false
tz@821
   521
       )
tz@821
   522
     )
tz@648
   523
! !
tz@648
   524
cg@3531
   525
!ResourceSelectionBrowser methodsFor:'accessing'!
cg@3531
   526
cg@3531
   527
classFilter:aBlock
cg@3531
   528
    "aBlock to return true/false, given a class.
cg@3531
   529
     With false, it is not shown in the tree"
cg@3531
   530
cg@3531
   531
    classFilter := aBlock.
cg@3531
   532
!
cg@3531
   533
cg@3531
   534
existingOnly:something
cg@3531
   535
    existingOnly := something.
cg@3531
   536
!
cg@3531
   537
cg@3531
   538
metaClassOnly:aBoolean
cg@3531
   539
    "force selection to be limited to the metaclass"
cg@3531
   540
cg@3531
   541
    metaClassOnly := aBoolean.
cg@3531
   542
!
cg@3531
   543
cg@3531
   544
packageFilter:aBlock
cg@3531
   545
    "aBlock to return true/false, given a packageID.
cg@3531
   546
     With false, the class is not shown in the tree"
cg@3531
   547
cg@3531
   548
    packageFilter := aBlock.
cg@3531
   549
! !
cg@3531
   550
tz@425
   551
!ResourceSelectionBrowser methodsFor:'aspects'!
tz@425
   552
cg@1986
   553
classNameHolder
cg@1986
   554
    "returns the value holder for the name of the class"
cg@1986
   555
cg@1986
   556
    |holder|
cg@1986
   557
cg@1986
   558
    (holder := builder bindingAt:#valueOfClassName) isNil ifTrue:[
cg@1986
   559
        builder aspectAt:#valueOfClassName put:(holder :=  '' asValue).
cg@1986
   560
        holder onChangeEvaluate:[self classSelectionUpdate:holder value].
cg@1986
   561
    ].
cg@1986
   562
    ^ holder
cg@1986
   563
!
cg@1986
   564
tz@773
   565
helpEnabled
tz@773
   566
    "returns whether there is a documentation file"
tz@773
   567
tz@773
   568
    ^true
tz@773
   569
!
tz@773
   570
cg@3531
   571
indexOfSelectedClassInFlatList
cg@3531
   572
    |holder|
cg@3531
   573
cg@3531
   574
    (holder := builder bindingAt:#indexOfSelectedClassInFlatList) isNil ifTrue:[
cg@3531
   575
        builder aspectAt:#indexOfSelectedClassInFlatList put:(holder := nil asValue).
cg@3531
   576
        holder onChangeEvaluate:[ 
cg@3531
   577
            |clsName|
cg@3531
   578
cg@3531
   579
            clsName := self listOfClassNames at:holder value ifAbsent:nil.
cg@3531
   580
            clsName notNil ifTrue:[
cg@3531
   581
                classSelectionBlock value:clsName  
cg@3531
   582
            ]. 
cg@3531
   583
        ]. 
cg@3531
   584
    ].
cg@3531
   585
    ^ holder
cg@3531
   586
!
cg@3531
   587
cg@3531
   588
listOfClassNames
cg@3531
   589
    "returns the value holder for the flat class list"
cg@3531
   590
cg@3531
   591
    |holder|
cg@3531
   592
cg@3531
   593
cg@3531
   594
    (holder := builder bindingAt:#listOfClassNames) isNil ifTrue:[
cg@3531
   595
        builder aspectAt:#listOfClassNames put: (holder := List new).
cg@3531
   596
    ].
cg@3531
   597
    ^ holder
cg@3531
   598
!
cg@3531
   599
tz@771
   600
listOfResourceMethods
tz@771
   601
    "returns the value holder for the list of the resource methods"
tz@648
   602
cg@1184
   603
    ^ builder listAspectFor:#listOfResourceMethods
tz@425
   604
!
tz@425
   605
tz@771
   606
resourceMethodColumns
tz@771
   607
    "returns the columns for the table of the resource methods as value holder"
tz@425
   608
tz@425
   609
    |holder|
tz@771
   610
    (holder := builder bindingAt:#resourceMethodColumns) isNil ifTrue:[
tz@821
   611
        builder aspectAt:#resourceMethodColumns put:(holder := List new).
tz@822
   612
        holder addAll: (self class tableColumnsForResourceMethodAttributes collect: [:i| i decodeAsLiteralArray]).
tz@425
   613
    ].
tz@425
   614
    ^ holder
tz@425
   615
!
tz@425
   616
cg@1986
   617
resourceSelectorHolder
cg@1986
   618
    "returns the value holder for the name of the selector"
cg@1986
   619
cg@3652
   620
    ^ builder valueAspectFor:#resourceSelectorHolder initialValue:''
cg@3652
   621
cg@3652
   622
    "Modified: / 09-03-2019 / 22:19:19 / Claus Gittinger"
cg@1986
   623
!
cg@1986
   624
tz@906
   625
rootOfClassCategories
tz@906
   626
    "returns the value holder for the root of the class tree list"
tz@906
   627
tz@906
   628
    |holder|                                
tz@906
   629
tz@906
   630
    (holder := builder bindingAt:#rootOfClassCategories) isNil ifTrue:[
cg@3531
   631
        classPresentation = #'Class Categories' ifTrue: [
cg@3531
   632
            builder aspectAt:#rootOfClassCategories put: (holder := TreeItem name: 'Categories')
cg@3531
   633
        ].
tz@906
   634
    ].
tz@906
   635
    ^ holder
tz@906
   636
!
tz@906
   637
tz@906
   638
rootOfClassHierarchy
tz@771
   639
    "returns the value holder for the root of the class tree list"
tz@425
   640
tz@425
   641
    |holder|
tz@906
   642
tz@906
   643
tz@906
   644
    (holder := builder bindingAt:#rootOfClassHierarchy) isNil ifTrue:[
cg@3531
   645
        classPresentation = #'Class Hierarchy' ifTrue: [
cg@3531
   646
            builder aspectAt:#rootOfClassHierarchy put: (holder := TreeItem new)
cg@3531
   647
        ]
tz@771
   648
    ].
tz@771
   649
    ^ holder
tz@771
   650
!
tz@771
   651
tz@906
   652
selectionOfClassCategories
tz@771
   653
    "returns the value holder for the selected class of the class tree list"
tz@771
   654
tz@906
   655
    |holder|           
tz@906
   656
    (holder := builder bindingAt:#selectionOfClassCategories) isNil ifTrue:[
tz@906
   657
        builder aspectAt:#selectionOfClassCategories put:(holder :=  ValueHolder new). 
tz@906
   658
    ].
tz@906
   659
    ^ holder
tz@906
   660
!
tz@906
   661
tz@906
   662
selectionOfClassHierarchy
tz@906
   663
    "returns the value holder for the selected class of the class tree list"
tz@906
   664
tz@906
   665
    |holder|           
tz@906
   666
    (holder := builder bindingAt:#selectionOfClassHierarchy) isNil ifTrue:[
tz@906
   667
        builder aspectAt:#selectionOfClassHierarchy put:(holder :=  ValueHolder new). 
tz@906
   668
    ].
tz@906
   669
    ^ holder
tz@906
   670
!
tz@906
   671
tz@906
   672
selectionOfClassPresentation
cg@3531
   673
    "returns the value holder for the selected class presentation
cg@3531
   674
     (Flat, Hierarchy or Category)"
tz@906
   675
tz@771
   676
    |holder|
cg@1034
   677
tz@906
   678
    (holder := builder bindingAt:#selectionOfClassPresentation) isNil ifTrue:[
cg@3531
   679
        builder 
cg@3531
   680
            aspectAt:#selectionOfClassPresentation 
cg@3531
   681
            put:(holder := RadioButtonGroup with: (classPresentation := classPresentation ? LastClassPresentation ? #'Class Categories')).
cg@1034
   682
cg@3531
   683
        holder onChangeEvaluate:[self classPresentationChanged ]. 
tz@771
   684
    ].
tz@771
   685
    ^ holder
tz@771
   686
!
tz@771
   687
tz@771
   688
selectionOfResourceMethod
tz@771
   689
    "returns the value holder for the selected resource method of the resource method list"
tz@771
   690
cg@3652
   691
    ^ builder valueAspectFor:#selectionOfResourceMethod initialValue:''
cg@3652
   692
cg@3652
   693
    "Modified: / 09-03-2019 / 22:19:30 / Claus Gittinger"
tz@425
   694
!
tz@425
   695
tz@467
   696
valueOfClassName
sv@2309
   697
    <resource: #obsolete>
tz@771
   698
    "returns the value holder for the name of the class"
tz@467
   699
cg@1986
   700
    self obsoleteMethodWarning:'stupid name - use #classNameHolder'.
cg@1986
   701
    ^ self classNameHolder
tz@467
   702
!
tz@467
   703
tz@771
   704
valueOfResourceSelector
sv@2309
   705
    <resource: #obsolete>
tz@771
   706
    "returns the value holder for the name of the selector"
tz@425
   707
cg@1986
   708
    self obsoleteMethodWarning:'stupid name - use #resourceSelectorHolder'.
cg@1986
   709
    ^ self resourceSelectorHolder
tz@425
   710
! !
tz@425
   711
cg@3531
   712
!ResourceSelectionBrowser methodsFor:'callbacks-user'!
tz@632
   713
cg@3531
   714
classPresentationChanged
cg@3531
   715
    "returns the value holder for the selected class presentation
cg@3531
   716
     (Flat, Hierarchy or Category)"
tz@906
   717
cg@3531
   718
    |comp newRoot|
cg@1034
   719
cg@3531
   720
    classPresentation := LastClassPresentation := self selectionOfClassPresentation value.
cg@1034
   721
cg@3531
   722
    classPresentation == #'Flat' ifTrue:[
cg@3531
   723
        self listOfClassNames isEmpty ifTrue:[ self updateListOfClasses ].
cg@3531
   724
        comp := builder componentAt: #listOfClassesView.
cg@3531
   725
    ] ifFalse:[
cg@3531
   726
        classPresentation == #'Class Hierarchy' ifTrue:[
cg@3531
   727
             comp := builder componentAt: #listOfClassHierarchyView.
cg@3531
   728
             newRoot := self rootOfClassHierarchy.  
cg@3531
   729
        ] ifFalse: [
cg@3531
   730
            comp := builder componentAt: #listOfClassCategoriesView.
cg@3531
   731
            newRoot := self rootOfClassCategories. 
cg@3531
   732
        ].
cg@3531
   733
        comp root:newRoot.
cg@1034
   734
    ].
cg@1034
   735
cg@3531
   736
    comp raise; requestFocus.
cg@3531
   737
    classSelectionBlock value:(self classNameHolder value)
tz@906
   738
!
tz@906
   739
tz@771
   740
classSelected
tz@771
   741
    "after a class selection, read the allowed resource methods of the selected class"
tz@730
   742
cg@3531
   743
    |sel className|
tz@906
   744
cg@3531
   745
    classPresentation = #'Class Hierarchy'
cg@1732
   746
"/        ifTrue:  [sel := self selectionOfClassHierarchy value]
cg@1919
   747
        ifFalse: [sel := self selectionOfClassCategories value].
cg@1919
   748
cg@3531
   749
    resourceClass := nil.
cg@1919
   750
    sel notNil ifTrue:[
cg@3531
   751
        sel contents ~~ #Category ifTrue:[
cg@3531
   752
            className := sel name.
cg@3531
   753
            resourceClass := Smalltalk classNamed:className.
cg@3531
   754
        ]
cg@1919
   755
    ].
cg@1732
   756
    self updateResourceMethodList.
tz@425
   757
!
tz@425
   758
cg@1384
   759
classSelectionUpdate:clsPattern
cg@3531
   760
    "called when a new class is selected AND when switching presentation modes"
cg@3531
   761
cg@1384
   762
    |foundClass classes|  
cg@1384
   763
cg@3531
   764
    "/ because this is also called for presentation switch,
cg@3531
   765
    "/ we cannot tune it this way...
cg@3531
   766
    "/ (self classNameHolder value = clsPattern) ifTrue:[
cg@3531
   767
    "/     resourceClass notNil ifTrue:[
cg@3531
   768
    "/         resourceClass name = clsPattern ifTrue:[
cg@3531
   769
    "/             ^ self 
cg@3531
   770
    "/         ].
cg@3531
   771
    "/     ].
cg@3531
   772
    "/ ].
cg@3531
   773
cg@1384
   774
    clsPattern notNil ifTrue:[
cg@3531
   775
        foundClass := Smalltalk classNamed:clsPattern.
cg@1384
   776
    ].
cg@1384
   777
    (foundClass isClass not or:[foundClass name ~= clsPattern])
cg@1732
   778
    ifTrue: [
cg@1384
   779
        classes := allClasses select: [:cls| cls name size >= clsPattern size].
cg@1732
   780
        1 to: clsPattern size do: [:i|    
cg@1384
   781
             classes := classes select: [:cls| (cls name at: i) == (clsPattern at: i)].
cg@1384
   782
        ].    
sv@1835
   783
        foundClass := classes at: 1 ifAbsent:[]. 
cg@1384
   784
    ].          
cg@1732
   785
cg@1732
   786
    foundClass notNil ifTrue: [           
sv@1835
   787
        foundClass := foundClass autoload.
cg@1978
   788
        resourceClass := foundClass.
cg@1732
   789
cg@3531
   790
        classPresentation = #'Flat' ifTrue: [
cg@3531
   791
            |index|
cg@1732
   792
cg@3531
   793
            index := self listOfClassNames indexOf:resourceClass name.
cg@3531
   794
            self indexOfSelectedClassInFlatList value:index.
cg@3531
   795
        ] ifFalse: [
cg@3531
   796
            classPresentation = #'Class Hierarchy' ifTrue: [
cg@3531
   797
                |searchArgs nonSuperclasses hierItem|
cg@1384
   798
cg@3531
   799
                false "foundClass isPrivate"
cg@3531
   800
                    ifFalse: [searchArgs := foundClass withAllSuperclasses reversed]
cg@3531
   801
                    ifTrue:  [searchArgs := foundClass owningClass withAllSuperclasses reversed. 
cg@3531
   802
                              searchArgs add: foundClass].                                  
cg@3531
   803
                (nonSuperclasses := self treeViewClassHierarchyContents allSuperclasses) notNil 
cg@3531
   804
                    ifTrue: [searchArgs := searchArgs reject: [:cls| nonSuperclasses includes: cls]].
cg@1732
   805
cg@3531
   806
                hierItem := self rootOfClassHierarchy detectChild:[:child :arg| child contents == arg] arguments:searchArgs.
cg@3531
   807
                hierItem notNil ifTrue:[
cg@3531
   808
                    self selectionOfClassHierarchy value:hierItem.
cg@3531
   809
                ].
cg@3531
   810
            ] ifFalse: [
cg@3531
   811
                |searchArgs hierItem|
cg@1384
   812
cg@3531
   813
                false "foundClass isPrivate"
cg@3531
   814
                    ifTrue:  [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass owningClass name with: foundClass name]
cg@3531
   815
                    ifFalse: [searchArgs := Array with: 'Categories' with: foundClass category with: foundClass name].
cg@3531
   816
cg@3531
   817
                hierItem := self rootOfClassCategories detectChild:[:child :arg| (child name upTo: $ ) = arg] arguments:searchArgs.
cg@3531
   818
                hierItem notNil ifTrue:[
cg@3531
   819
                    self selectionOfClassCategories value: hierItem.
cg@3531
   820
                ].
cg@1732
   821
            ].
cg@1384
   822
        ].
cg@1384
   823
    ].
cg@3531
   824
cg@1986
   825
    self classNameHolder value: clsPattern.
cg@1919
   826
    self updateResourceMethodList.
cg@1384
   827
!
cg@1384
   828
tz@425
   829
resourceDoubleClicked
tz@771
   830
    "after a double click on resource method, accept it and close"
tz@425
   831
tz@425
   832
    accept value: true.
cg@1034
   833
    self closeRequest
tz@425
   834
!
tz@425
   835
tz@425
   836
resourceSelected
tz@771
   837
    "after a click on a resource method, set its selector into the field"
tz@425
   838
cg@3531
   839
    |selectedMethodInfo mthd|
cg@3531
   840
cg@3531
   841
    selectedMethodInfo := self selectionOfResourceMethod value.
cg@3531
   842
    selectedMethodInfo notNil ifTrue: [
cg@3531
   843
        self resourceSelectorHolder value:(selectedMethodInfo selector).
cg@3531
   844
        mthd := selectedMethodInfo method.
cg@3531
   845
        (mthd hasResource:#image) ifTrue:[
cg@3531
   846
            (builder componentAt:#ImageView)
cg@3531
   847
                image:(mthd valueWithReceiver:nil arguments:#())
cg@3531
   848
        ].
cg@3531
   849
    ]
cg@3531
   850
!
cg@3531
   851
cg@3531
   852
updateListOfClasses
cg@3531
   853
    |names|
cg@3531
   854
cg@3531
   855
    classPresentation = #'Flat' ifTrue: [
cg@3531
   856
        self listOfClassNames isEmpty ifTrue:[
cg@3531
   857
            names := (Smalltalk allClasses asOrderedCollection sortBySelector:#name)
cg@3531
   858
                        select:[:cls | self filterClass:cls]
cg@3531
   859
                        thenCollect:[:cls | cls name].
cg@3531
   860
            self listOfClassNames addAll:names.
cg@3531
   861
        ]
cg@3531
   862
    ]
cg@1732
   863
!
cg@1732
   864
cg@1732
   865
updateResourceMethodList
cg@1732
   866
    "read the allowed resource methods of the selected class"
cg@1732
   867
cg@1732
   868
    |class className item|
cg@1732
   869
cg@1978
   870
    (class := resourceClass) isNil ifTrue:[
cg@3531
   871
        classPresentation = #'Class Hierarchy'
cg@1732
   872
            ifTrue:  [item := self selectionOfClassHierarchy value ]
cg@1732
   873
            ifFalse: [item := self selectionOfClassCategories value ].
cg@1978
   874
cg@1732
   875
        item notNil ifTrue:[
cg@3531
   876
            item contents ~~ #Category ifTrue:[
cg@3531
   877
                className := item name.
cg@3531
   878
                class := Smalltalk at:className asSymbol.
cg@3531
   879
            ]
cg@1732
   880
        ].
cg@3531
   881
    ] ifFalse:[
cg@3531
   882
        class := resourceClass
cg@1732
   883
    ].
cg@1732
   884
cg@3531
   885
    class isNil ifTrue: [
cg@3531
   886
        self listOfResourceMethods contents:#().
cg@3531
   887
        ^self
cg@3531
   888
    ].
cg@1732
   889
sr@2038
   890
    className := class name."/class theNonMetaclass name
cg@1732
   891
cg@1920
   892
    self withWaitCursorDo:[
cg@1732
   893
        |newContents|           
cg@1732
   894
cg@1732
   895
        resourceTypes isNil ifTrue: [resourceTypes := Method resourceTypes].
cg@1732
   896
cg@1986
   897
        self classNameHolder value: className.
cg@1732
   898
        self class lastSelection: className.
cg@1732
   899
cg@3531
   900
        newContents := class theMetaclass methodDictionary asOrderedCollection 
cg@3531
   901
                            select:[:m | resourceTypes includes: m resourceType].
cg@3531
   902
cg@1732
   903
        newContents := newContents sort:[:m1 :m2 | m1 selector < m2 selector].
cg@1732
   904
        newContents := newContents collect:[:m| (ResourceMethod new method:m)].
cg@1732
   905
cg@1732
   906
        self listOfResourceMethods contents:newContents
cg@1732
   907
                .
cg@1732
   908
    ]
cg@3531
   909
!
cg@3531
   910
cg@3531
   911
validateDoubleClick: aTreeItem
cg@3531
   912
    "returns whether a class may be selected"
cg@3531
   913
cg@3531
   914
    |cont|
cg@3531
   915
cg@3531
   916
    ^ (cont := aTreeItem contents) ~= '' 
cg@3531
   917
      and: [cont ~~ self treeViewClassHierarchyContents]       
cg@3531
   918
cg@3531
   919
cg@3531
   920
cg@3531
   921
! !
cg@3531
   922
cg@3531
   923
!ResourceSelectionBrowser methodsFor:'initialization'!
cg@3531
   924
cg@3531
   925
initialize
cg@3531
   926
    "Invoked when a new instance is created."
cg@3531
   927
cg@3531
   928
    metaClassOnly := true.
cg@3531
   929
    existingOnly := false.
cg@3531
   930
cg@3531
   931
    super initialize.
tz@425
   932
! !
tz@425
   933
tz@425
   934
!ResourceSelectionBrowser methodsFor:'instance creation'!
tz@425
   935
cg@3531
   936
onSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
cg@3531
   937
    "create - but do not yet open
cg@3531
   938
     a ResourceSelectionBrowser"
tz@425
   939
cg@3531
   940
    |cls|
tz@771
   941
tz@517
   942
    resourceMethod := aSelector.
tz@425
   943
    resourceTypes := aResourceTypes.
tz@425
   944
    resourceSuperclass := aSuperclassOrSymbol isClass ifTrue: [aSuperclassOrSymbol name] ifFalse: [aSuperclassOrSymbol].
cg@802
   945
    resourceClass := nil.
cg@802
   946
cg@1978
   947
    aClassOrClassName notNil ifTrue:[
cg@1978
   948
        aClassOrClassName isClass ifTrue: [
cg@1978
   949
            cls := aClassOrClassName. 
cg@1978
   950
            resourceClass := aClassOrClassName
cg@1978
   951
        ] ifFalse: [
cg@1978
   952
            cls := Smalltalk classNamed: aClassOrClassName.
cg@1978
   953
            cls notNil ifTrue:[
cg@1978
   954
                resourceClass := cls
cg@802
   955
            ]
cg@1978
   956
        ]
cg@1978
   957
    ].            
cg@1986
   958
    self resourceSelectorHolder value:(aSelector ? '').
cg@3531
   959
! !
cg@3531
   960
cg@3531
   961
!ResourceSelectionBrowser methodsFor:'startup & release'!
cg@3531
   962
cg@3531
   963
openAndLetUserChoose
cg@3531
   964
    "opens the previously configured receiver;
cg@3531
   965
     return a Message-object or nil"
cg@3531
   966
cg@3531
   967
    |selectedClass enteredClassName className cls|
cg@3531
   968
tz@463
   969
    self open.
tz@463
   970
cg@1978
   971
    (selectedClass := self selectionOfClassHierarchy value) isNil ifTrue:[
cg@1978
   972
        (selectedClass := self selectionOfClassCategories value) isNil ifTrue:[
cg@1986
   973
            (enteredClassName := self classNameHolder value) isNil ifTrue:[
cg@1086
   974
                accept value ifTrue:[
cg@1086
   975
                    self warn:'No valid class selected/entered'.
cg@1086
   976
                ].
cg@1086
   977
                ^ nil
cg@1086
   978
            ]
cg@1086
   979
        ]
cg@1086
   980
    ].
tz@906
   981
cg@1978
   982
    className := enteredClassName.    
cg@1978
   983
    className isNil ifTrue:[
cg@1978
   984
        className := selectedClass name
cg@1086
   985
    ].
cg@1978
   986
    cls := Smalltalk classNamed:className.
cg@1978
   987
    (cls isClass and:[accept value]) ifTrue:[            
cg@1986
   988
        ^ Method::MethodWhoInfo class:cls selector:(self resourceSelectorHolder value)
tz@425
   989
    ].
cg@1086
   990
cg@1086
   991
    accept value ifTrue:[
cg@1086
   992
        self warn:'No valid class selected/entered'.
cg@1086
   993
    ].
cg@1086
   994
    ^ nil
cg@802
   995
cg@802
   996
    "Modified: / 22.4.1998 / 14:51:03 / cg"
cg@3531
   997
!
tz@425
   998
cg@3531
   999
openOnSuperclass: aSuperclassOrSymbol andClass:aClassOrClassName andSelector: aSelector withResourceTypes: aResourceTypes
cg@3531
  1000
    "opens a ResourceSelectionBrowser; return a Message-object or nil"
cg@3531
  1001
cg@3531
  1002
    self 
cg@3531
  1003
        onSuperclass: aSuperclassOrSymbol 
cg@3531
  1004
        andClass:aClassOrClassName andSelector: aSelector 
cg@3531
  1005
        withResourceTypes: aResourceTypes.
cg@3531
  1006
cg@3531
  1007
    self openAndLetUserChoose
cg@3531
  1008
!
tz@425
  1009
tz@623
  1010
postBuildWith:aBuilder
tz@771
  1011
    "after building and before opening,  
tz@906
  1012
     create a class selection block, an entry completion block for the class name field"
tz@623
  1013
tz@771
  1014
    |classSelection classNameInputField|
cg@3531
  1015
cg@3531
  1016
    (resourceTypes notNil and:[(resourceTypes includesAny:#(image programImage))]) ifTrue:[
cg@3531
  1017
        (builder componentAt: #resourcesDataSetView)
cg@3531
  1018
            origin:0.0@0.0 extent:(1.0 @ 0.7).
cg@3531
  1019
        (builder componentAt: #ImageView) 
cg@3531
  1020
            origin:0.0@0.7 extent:(1.0 @ 0.3); beVisible.
cg@3531
  1021
        (builder componentAt: #ResourcePanel)
cg@3531
  1022
            resizeSubviews; sizeChanged:nil.
cg@3531
  1023
    ].
cg@3531
  1024
tz@906
  1025
    allClasses := self treeViewClassHierarchyContents withAllSubclasses reject: [:cls| cls isPrivate].
cg@1978
  1026
    classSelection := resourceClass isNil ifTrue:[nil] ifFalse:[resourceClass name]. 
cg@802
  1027
cg@1978
  1028
    (classSelection isNil or:[ (Smalltalk classNamed: classSelection) isNil]) 
tz@689
  1029
        ifTrue: [classSelection :=  self class lastSelection].
cg@1732
  1030
"/    (classSelection isNil or:[Smalltalk at: classSelection]) isNil 
cg@1732
  1031
"/        ifTrue: [classSelection :=  self treeViewContents].
cg@802
  1032
cg@1384
  1033
    classSelectionBlock := [:clsPattern | self classSelectionUpdate:clsPattern].
cg@1986
  1034
    self classNameHolder value:classSelection.  
tz@771
  1035
cg@1920
  1036
    (classNameInputField := builder componentAt: #classNameInputField) 
cg@1920
  1037
        entryCompletionBlock:
cg@1920
  1038
            [:value|
cg@1920
  1039
                |s what m|
cg@1920
  1040
cg@1920
  1041
                s := classNameInputField contents withoutSpaces.
cg@1920
  1042
                what := Smalltalk classnameCompletion:s inEnvironment:Smalltalk.
cg@1920
  1043
                classNameInputField contents:what first.
cg@1920
  1044
                (what at:2) size ~~ 1 ifTrue:[
cg@3528
  1045
                    classNameInputField device beepInEditor
cg@3531
  1046
                ].
cg@3531
  1047
                (Smalltalk classNamed:(what at:1)) notNil ifTrue:[
cg@3531
  1048
                    self classNameHolder value:(what at:1)
cg@3531
  1049
                ].
cg@1920
  1050
"/                |what oldClassName|
cg@1920
  1051
"/                oldClassName := classNameInputField contents.
cg@1920
  1052
"/                what := Smalltalk classnameCompletion: value withoutSpaces.
cg@1920
  1053
"/                classNameInputField contents:what first.
cg@1920
  1054
"/                oldClassName = classNameInputField contents ifTrue:[classNameInputField flash].
cg@1920
  1055
"/                classSelectionBlock value: classNameInputField contents
cg@1920
  1056
            ].
tz@623
  1057
cg@1986
  1058
    classSelectionBlock value: self classNameHolder value.
cg@3531
  1059
    "/ self updateResourceMethodList. -- will be done automatically via change
tz@906
  1060
    self selectionOfResourceMethod value: (self listOfResourceMethods detect: [:m| m selector == resourceMethod] ifNone: nil).
tz@909
  1061
tz@909
  1062
    ^super postBuildWith:aBuilder
tz@910
  1063
!
tz@910
  1064
tz@910
  1065
postOpenWith:aBuilder
tz@910
  1066
    "after opening and if turned on make hierarchy view visible"
tz@910
  1067
cg@3531
  1068
    classPresentation = #'Class Hierarchy' ifTrue: [
cg@3531
  1069
        (builder componentAt: #listOfClassHierarchyView) raise
cg@3531
  1070
    ].
cg@3531
  1071
    classPresentation = #'Flat' ifTrue: [
cg@3531
  1072
        self updateListOfClasses.
cg@3531
  1073
        (builder componentAt: #listOfClassesView) raise
cg@3531
  1074
    ].
tz@910
  1075
cg@2026
  1076
    super postOpenWith:aBuilder
tz@425
  1077
! !
tz@425
  1078
cg@3531
  1079
!ResourceSelectionBrowser methodsFor:'tree building - category'!
cg@3531
  1080
cg@3531
  1081
filterClass:cls
cg@3531
  1082
    "true if cls is to be shown"
cg@3531
  1083
cg@3531
  1084
    classFilter notNil ifTrue:[
cg@3531
  1085
        (classFilter value:cls) ifFalse:[^ false].
cg@3531
  1086
    ].
cg@3531
  1087
    packageFilter notNil ifTrue:[
cg@3531
  1088
        (packageFilter value:cls package) ifFalse:[^ false].
cg@3531
  1089
    ].
cg@3531
  1090
    existingOnly == true ifTrue:[
cg@3531
  1091
        ^ cls theMetaclass methodDictionary 
cg@3531
  1092
            contains:[:m | 
cg@3531
  1093
                resourceTypes includes:m resourceType
cg@3531
  1094
            ].
cg@3531
  1095
    ].
cg@3531
  1096
    ^ true
cg@3531
  1097
!
cg@3531
  1098
cg@3531
  1099
treeViewClassCategoryChildren
cg@3531
  1100
    "returns the children for the contents (class) of aTreeItem as a block"
cg@3531
  1101
cg@3531
  1102
    "/ cg: tz's algorithm was very-very slow, 
cg@3531
  1103
    "/ (it enumerated classes hundreds of times,
cg@3531
  1104
    "/  leading to a square runtime behavior
cg@3531
  1105
    "/  - i.e. very slow scrolling )
cg@3531
  1106
    "/ Speed up things by caching facts while enumerating
cg@3531
  1107
    "/ classes once only.
cg@3531
  1108
cg@3531
  1109
    |topClass childrenPerCategory privateClasses|
cg@3531
  1110
cg@3531
  1111
    topClass := self treeViewClassHierarchyContents.
cg@3531
  1112
    privateClasses := IdentitySet new.
cg@3531
  1113
cg@3531
  1114
    childrenPerCategory := Dictionary new.
cg@3531
  1115
cg@3531
  1116
    "/ collect all classes to be inserted into the tree(s)
cg@3531
  1117
    topClass withAllSubclassesDo:[:cls |
cg@3531
  1118
        |shown cat set|
cg@3531
  1119
cg@3531
  1120
        (self filterClass:cls) ifTrue:[
cg@3531
  1121
             cls isPrivate ifFalse:[
cg@3531
  1122
                cat := cls category.
cg@3531
  1123
                cat notNil ifTrue:[
cg@3531
  1124
                    (childrenPerCategory at:cat ifAbsentPut:[Set new]) add:cls
cg@3531
  1125
                ].
cg@3531
  1126
            ] ifTrue:[
cg@3531
  1127
                privateClasses add:cls
cg@3531
  1128
            ]
cg@3531
  1129
        ].
cg@3531
  1130
    ].
cg@3531
  1131
cg@3531
  1132
    "/ need the owningclasses in the tree
cg@3531
  1133
    privateClasses do:[:each |
cg@3531
  1134
        |owner|
cg@3531
  1135
cg@3531
  1136
        owner := each owningClass.
cg@3531
  1137
        (childrenPerCategory at:(owner category) ifAbsentPut:[Set new]) add:owner
cg@3531
  1138
    ].
cg@3531
  1139
cg@3531
  1140
    ^ [:aTreeItem|
cg@3531
  1141
        |cont children initialContents setOfCategories itemCategory setOfClasses|
cg@3531
  1142
cg@3531
  1143
        (cont := aTreeItem contents) isBehavior ifTrue:[
cg@3531
  1144
            children := privateClasses select:[:cls | cls owningClass == aTreeItem contents].
cg@3531
  1145
            children := children select:[:cls | self filterClass:cls].
cg@3531
  1146
            children := children asSortedCollection: [:c1 :c2| c1 name <= c2 name].
cg@3531
  1147
            "/ children := children collect: [:child| TreeItem name: child name , ' (', child superclass name, ')' contents: child]
cg@3531
  1148
            children := children collect: [:child| TreeItem name:(child name) contents: child]
cg@3531
  1149
        ] ifFalse:[
cg@3531
  1150
            cont size == 0 ifTrue:[
cg@3531
  1151
                setOfCategories := childrenPerCategory keys.
cg@3531
  1152
                children := setOfCategories asSortedCollection.
cg@3531
  1153
                children := children collect: [:nm | TreeItem name:nm contents:#Category]
cg@3531
  1154
            ] ifFalse:[
cg@3531
  1155
                cont == #Category ifTrue:[
cg@3531
  1156
                    itemCategory := aTreeItem name.
cg@3531
  1157
                    setOfClasses := childrenPerCategory at:itemCategory ifAbsent:[Set new].
cg@3531
  1158
                    setOfClasses := setOfClasses select:[:cls | self filterClass:cls].
cg@3531
  1159
                    children := setOfClasses asOrderedCollection sort:[:c1 :c2 | c1 name <= c2 name].
cg@3531
  1160
                    children := children collect:[:child | TreeItem name:child name contents:child].
cg@3531
  1161
                ] ifFalse:[
cg@3531
  1162
                    "/ huh ?
cg@3531
  1163
                    children := OrderedCollection new.
cg@3531
  1164
                ]
cg@3531
  1165
            ].
cg@3531
  1166
        ].
cg@3531
  1167
        children
cg@3531
  1168
    ]
cg@3531
  1169
cg@3531
  1170
    "Modified: / 22-08-2012 / 19:44:59 / cg"
cg@3531
  1171
!
cg@3531
  1172
cg@3531
  1173
treeViewClassCategoryIcon
cg@3531
  1174
    "returns the icon for aTreeItem as a block"
cg@3531
  1175
cg@3531
  1176
    ^self treeViewClassHierarchyIcon
cg@3531
  1177
! !
cg@3531
  1178
cg@3531
  1179
!ResourceSelectionBrowser methodsFor:'tree building - hierarchy'!
cg@3531
  1180
cg@3531
  1181
treeViewClassHierarchyChildren
cg@3531
  1182
    "returns the children for the contents (class) of aTreeItem as a block"
cg@3531
  1183
cg@3531
  1184
    "/ cg: tz's algorithm was very-very slow, 
cg@3531
  1185
    "/ (it enumerated classes hundreds of times,
cg@3531
  1186
    "/  leading to a square runtime behavior
cg@3531
  1187
    "/  - i.e. very slow scrolling )
cg@3531
  1188
    "/ Speed up things by caching facts while enumerating
cg@3531
  1189
    "/ classes once only.
cg@3531
  1190
cg@3531
  1191
    |subclassesAndPrivateClassesPerClass classesWithResourceOrResourceInAnySubclass|
cg@3531
  1192
cg@3531
  1193
    subclassesAndPrivateClassesPerClass := IdentityDictionary new.
cg@3531
  1194
    classesWithResourceOrResourceInAnySubclass := IdentitySet new.
cg@3531
  1195
cg@3531
  1196
    Smalltalk allClassesDo:[:cls |
cg@3531
  1197
        |owner superclass info|
cg@3531
  1198
cg@3531
  1199
        superclass := cls superclass.
cg@3531
  1200
        superclass notNil ifTrue:[
cg@3531
  1201
            info := subclassesAndPrivateClassesPerClass at:superclass ifAbsent:nil.
cg@3531
  1202
            info isNil ifTrue:[
cg@3531
  1203
                subclassesAndPrivateClassesPerClass 
cg@3531
  1204
                        at:superclass 
cg@3531
  1205
                        put:(info := {IdentitySet new. IdentitySet new} ).
cg@3531
  1206
            ].
cg@3531
  1207
            (info at:1) add:cls
cg@3531
  1208
        ].
cg@3531
  1209
        (self filterClass:cls) ifTrue:[
cg@3531
  1210
            cls withAllSuperclassesDo:[:each |
cg@3531
  1211
                classesWithResourceOrResourceInAnySubclass add:each
cg@3531
  1212
            ].
cg@3531
  1213
        ].
cg@3531
  1214
    ].
cg@3531
  1215
cg@3531
  1216
    ^ [:aTreeItem|
cg@3531
  1217
        |classes itemClass info|
cg@3531
  1218
cg@3531
  1219
        classes := OrderedCollection new. 
cg@3531
  1220
        itemClass := aTreeItem contents.
cg@3531
  1221
        info := subclassesAndPrivateClassesPerClass at:itemClass ifAbsent:nil.
cg@3531
  1222
        info notNil ifTrue:[
cg@3531
  1223
            classes addAll:((info at:1) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
cg@3531
  1224
            classes addAll:((info at:2) asSortedCollection: [:cls1 :cls2| cls1 name < cls2 name]).
cg@3531
  1225
        ].
cg@3531
  1226
        classes select:[:cls | classesWithResourceOrResourceInAnySubclass includes:cls].
cg@3531
  1227
     ]
cg@3531
  1228
!
cg@3531
  1229
cg@3531
  1230
treeViewClassHierarchyContents
cg@3531
  1231
    "returns the contents of the root of the class tree list"
cg@3531
  1232
cg@3531
  1233
    |cls|
cg@3531
  1234
cg@3531
  1235
    resourceSuperclass notNil ifTrue:[
cg@3531
  1236
        cls := Smalltalk classNamed: resourceSuperclass.
cg@3531
  1237
    ].
cg@3531
  1238
    cls := cls ? Object.
cg@3531
  1239
    ^ cls
cg@3531
  1240
!
cg@3531
  1241
cg@3531
  1242
treeViewClassHierarchyIcon
cg@3531
  1243
    "returns the icon for aTreeItem as a block"
cg@3531
  1244
cg@3531
  1245
    ^[:aTreeItem|
cg@3531
  1246
        |icon|
cg@3531
  1247
cg@3531
  1248
        aTreeItem contents isClass ifTrue:[
cg@3531
  1249
            icon := self class iconClass.
cg@3531
  1250
            aTreeItem contents isPrivate ifTrue:[
cg@3531
  1251
               icon := self class iconPrivateClass
cg@3531
  1252
            ].
cg@3531
  1253
            icon
cg@3531
  1254
        ] ifFalse:[
cg@3531
  1255
            self class iconCategory
cg@3531
  1256
        ]
cg@3531
  1257
    ]
cg@3531
  1258
!
cg@3531
  1259
cg@3531
  1260
treeViewClassHierarchyLabel
cg@3531
  1261
    "returns the label for aTreeItem as a block"
cg@3531
  1262
cg@3531
  1263
    ^[:aTreeItem|
cg@3531
  1264
        |label superCls itemContents|
cg@3531
  1265
cg@3531
  1266
        itemContents := aTreeItem contents.
cg@3531
  1267
        label := itemContents name.
cg@3531
  1268
"/        (itemContents isPrivate 
cg@3531
  1269
"/        and:[aTreeItem parent contents ~~ (superCls := itemContents superclass)])
cg@3531
  1270
"/            ifTrue: [label := label, ' (', superCls name, ')'].
cg@3531
  1271
        label
cg@3531
  1272
     ]
cg@3531
  1273
! !
cg@3531
  1274
tz@771
  1275
!ResourceSelectionBrowser::ResourceMethod methodsFor:'accessing'!
tz@523
  1276
tz@523
  1277
iconOn:aGC
tz@771
  1278
    "registers and returns an icon indicating the resource type"
tz@523
  1279
cg@1524
  1280
    |cls sel image imageKey|
cg@1524
  1281
tz@730
  1282
    self resourceType isNil ifTrue: [^nil].
cg@1524
  1283
cg@1524
  1284
    icon isNil ifTrue:[
frank@1412
  1285
        ((self resourceType = #image) or: [resourceType = #fileImage])
cg@1524
  1286
        ifTrue:[  
cg@1524
  1287
            cls := method mclass theNonMetaclass.
cg@1524
  1288
            sel := method selector.
cg@1524
  1289
        ] ifFalse: [
frank@1412
  1290
            cls := SystemBrowser.
frank@1412
  1291
            sel := (resourceType, 'Icon') asSymbol.
frank@1412
  1292
        ].
frank@1412
  1293
        imageKey := (cls name, sel) asSymbol.
frank@1412
  1294
        (icon := aGC registeredImageAt: imageKey) isNil
cg@1524
  1295
        ifTrue: [       
frank@1412
  1296
            image := cls perform: sel.
cg@1524
  1297
            (image extent y > 18) ifTrue: [         
frank@1412
  1298
                image := image magnifiedBy: 18/image extent y
frank@1412
  1299
            ].
frank@1412
  1300
            aGC registerImage: image key: imageKey.
frank@1412
  1301
            icon := aGC registeredImageAt: imageKey.
frank@1412
  1302
        ].
tz@730
  1303
    ].
tz@523
  1304
    ^icon
cg@1524
  1305
cg@1524
  1306
    "Modified: / 5.11.2001 / 16:48:35 / cg"
tz@523
  1307
!
tz@523
  1308
cg@3531
  1309
method
cg@3531
  1310
    ^ method
cg@3531
  1311
!
cg@3531
  1312
tz@523
  1313
method: aMethod
tz@771
  1314
    "sets aMethod"
tz@523
  1315
tz@523
  1316
    method := aMethod
tz@523
  1317
!
tz@523
  1318
tz@523
  1319
resourceType
tz@771
  1320
    "returns resourceType"
tz@523
  1321
tz@523
  1322
    resourceType isNil ifTrue: [resourceType := method resourceType].
tz@523
  1323
    ^resourceType
tz@523
  1324
!
tz@523
  1325
tz@523
  1326
selector
tz@771
  1327
    "returns selector"
tz@523
  1328
tz@523
  1329
    selector isNil ifTrue: [selector := method who methodSelector].
tz@523
  1330
    ^selector
tz@523
  1331
! !
tz@523
  1332
tz@425
  1333
!ResourceSelectionBrowser class methodsFor:'documentation'!
tz@425
  1334
tz@425
  1335
version
tz@425
  1336
    ^ '$Header$'
cg@2760
  1337
!
cg@2760
  1338
cg@2760
  1339
version_CVS
cg@2760
  1340
    ^ '$Header$'
tz@425
  1341
! !
sv@3117
  1342