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