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