Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Thu, 04 Feb 2010 11:18:16 +0100
changeset 2757 6c83d6b487b2
parent 2748 76f6fd319918
child 2758 c61fe917957a
permissions -rw-r--r--
changed:
#toolbarMenu
#windowSpec
     1 "
     2  COPYRIGHT (c) 2007 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 "{ NameSpace: Tools }"
    15 
    16 ToolApplicationModel subclass:#ViewTreeInspectorApplication
    17 	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
    18 		motionAction process followFocusChannel showNamesHolder'
    19 	classVariableNames:''
    20 	poolDictionaries:''
    21 	category:'Interface-Smalltalk'
    22 !
    23 
    24 Object subclass:#MenuDesc
    25 	instanceVariableNames:'title value action'
    26 	classVariableNames:''
    27 	poolDictionaries:''
    28 	privateIn:ViewTreeInspectorApplication
    29 !
    30 
    31 HierarchicalItem subclass:#ViewTreeItem
    32 	instanceVariableNames:'widget isDrawnShown exists xOffsetAdditionalName'
    33 	classVariableNames:'HandleExtent'
    34 	poolDictionaries:''
    35 	privateIn:ViewTreeInspectorApplication
    36 !
    37 
    38 ValueModel subclass:#ViewTreeModel
    39 	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
    40 		inputEventAction mappedViewAction beforeSelectionChangedAction
    41 		icons timedUpdateTask selectOnClickHolder testModeChannel
    42 		hasTargetWidgetChannel'
    43 	classVariableNames:''
    44 	poolDictionaries:''
    45 	privateIn:ViewTreeInspectorApplication
    46 !
    47 
    48 HierarchicalList subclass:#ItemList
    49 	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
    50 	classVariableNames:''
    51 	poolDictionaries:''
    52 	privateIn:ViewTreeInspectorApplication::ViewTreeModel
    53 !
    54 
    55 !ViewTreeInspectorApplication class methodsFor:'documentation'!
    56 
    57 copyright
    58 "
    59  COPYRIGHT (c) 2007 by eXept Software AG
    60               All Rights Reserved
    61 
    62  This software is furnished under a license and may be used
    63  only in accordance with the terms of that license and with the
    64  inclusion of the above copyright notice.   This software may not
    65  be provided or otherwise made available to, or used by, any
    66  other person.  No title to or ownership of the software is
    67  hereby transferred.
    68 "
    69 !
    70 
    71 documentation
    72 "
    73      Small application showing a ViewTreeModel use.
    74 
    75      It displays a hierarchical list of a selected TopView and
    76      all its contained subViews.
    77      Useful to have a look at subcomponents - to see how views
    78      are structured.
    79 
    80 
    81     [Instance variables:]
    82         model           <ViewTreeModel>      the used ViewTreeModel
    83         clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
    84         clickedPoint    <Point>              point where the motion action started from.
    85         motionAction    <Action>             (oneArg-) action called durring buttonMotion.
    86 
    87 
    88     [author:]
    89         Claus Atzkern
    90 
    91     [see also:]
    92         ViewTreeModel
    93         ViewTreeItem
    94 "
    95 ! !
    96 
    97 !ViewTreeInspectorApplication class methodsFor:'initialization'!
    98 
    99 initialize
   100     "add myself to the launcher menu
   101     "
   102     self installInLauncher.
   103 !
   104 
   105 installInLauncher
   106     "add myself to the launcher menu"
   107 
   108     |menuItem icon|
   109 
   110     NewLauncher isNil ifTrue:[^ self].
   111     "/ cg - disabled. the icon is too ugly.
   112     ^ self.
   113 
   114     icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
   115 
   116     menuItem := MenuItem new 
   117                     label: 'View Tree Inspector';
   118                     value: [ ViewTreeInspectorApplication open];
   119                     isButton: true;
   120                     icon: icon;
   121                     nameKey: #viewInspect.
   122 
   123     menuItem startGroup:#right.
   124     NewLauncher addMenuItem:menuItem in:'toolbar'
   125                    position:#( #before #help)
   126                       space:false.
   127 
   128 "
   129 self installInLauncher
   130 self removeFromLauncher
   131 "
   132 !
   133 
   134 postAutoload
   135     "add myself to the launcher menu
   136     "
   137     self installInLauncher.
   138 "
   139 self installInLauncher
   140 self removeFromLauncher
   141 "
   142 !
   143 
   144 removeFromLauncher
   145     "remove myself from the launcher menu
   146     "
   147     NewLauncher isNil ifTrue:[^ self].
   148     NewLauncher removeUserTool:#viewInspect
   149 
   150 "
   151 self installInLauncher
   152 self removeFromLauncher
   153 "
   154 !
   155 
   156 unload
   157     "class is about to be unloaded - remove myself from the launcher menu
   158     "
   159     self removeFromLauncher.
   160     super unload.
   161 ! !
   162 
   163 !ViewTreeInspectorApplication class methodsFor:'image specs'!
   164 
   165 pickWindowIcon
   166     "This resource specification was automatically generated
   167      by the ImageEditor of ST/X."
   168 
   169     "Do not manually edit this!! If it is corrupted,
   170      the ImageEditor may not be able to read the specification."
   171 
   172     "
   173      self pickWindowIcon inspect
   174      ImageEditor openOnClass:self andSelector:#pickWindowIcon
   175      Icon flushCachedIcons
   176     "
   177 
   178     <resource: #image>
   179 
   180     ^Icon
   181         constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon'
   182         ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
   183 ,;N3,;N3,;N3,;N3,;N3,;N3,;N3,3H<P38;M3P,H2@^GA(VEQHQCP0KA D<[&-%XU=WST%BN#D!!GQ$TD@(IBP\BQF)+Z6E_U4-FPCX+G1,WEA@JBP$HAT23
   184 ,;N3,;N3,;N3,;N$():Z&IRR&1!!^,;N3,;N3,;N3,;N$)JJ^&)"T$),0W[N3,;N3,;N3,;N3,:R"'')*X%IJWK523,;N3,;N3,0@@@KN3)JJ^&)"T$"5Z,;N3
   185 ,;N3@@B3-KL@@JJ^&)"T$)D*V[N3,;N3@KN3-KR4)JH@&)"T$)*MJE"3,;N3,0B3)JJ4&*R"@I*X%IJZ#RYV,;N3,0B3@JR"-JR"-I(@%IJV%H %U[N3,;L@
   186 -@B4-KR4-KR4@IRR%IJEIER3,;N3@KL@)JJ4():4&@BO#9RR!!RIS,;N3,;L@,:R"-JJ^& BT#8>O#8H"T+N3,;N3@KN$@@@@'')(@%H>O#(>AH%F3,;N3,;L@
   187 @JR4'' @@%IJO#8>O RIO,;N3,;N3):P@@@BX%IJO#8>O#7<"S*63,;N$():Z&IRR&IRR#8>O#8=>H"&-,;N$():Z&IRR&)"T$(>O#8>O @<)R$!!GQTD?OS$8
   188 MSL.I2H"H"H"H"HO,;N3,;N3,;N3,;N3,;N3,;N3,;N3,0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 0 50 164 0 50 171 0 137 0 0 206 0 1 50 177 2 56 178 3 64 241 3 67 246 3 73 255 4 74 255 5 63 191 7 66 194 10 71 196 10 79 255 12 59 167 12 82 255 14 77 199 18 83 201 19 88 255 21 91 255 23 89 204 27 95 206 28 97 255 29 72 179 30 100 255 32 101 209 36 106 255 36 107 211 39 109 255 41 113 214 45 115 255 45 119 216 48 118 255 50 87 176 50 125 219 51 88 176 51 88 177 52 89 178 52 90 178 53 90 178 53 127 212 54 91 179 54 123 255 54 131 221 55 92 180 55 95 181 56 93 180 56 94 181 57 127 255 57 149 229 58 99 184 58 137 224 61 104 187 63 132 255 63 143 226 64 108 190 66 113 193 66 135 255 67 149 229 68 157 232 69 117 196 71 155 231 72 122 199 72 141 255 75 126 202 75 144 255 75 160 234 77 163 236 78 131 206 80 149 255 81 136 209 84 140 212 84 153 255 87 145 215 88 157 255 91 168 235 93 161 255 94 154 222 96 157 223 96 165 255 97 159 225 98 160 225 98 162 226 99 163 227 100 165 228 101 166 229 101 170 255 102 167 230 103 169 231 104 170 232 104 173 255 105 172 233 105 174 234 106 175 235 109 178 255 112 180 255 117 186 255 119 187 255 122 154 245 125 160 253 125 193 255 126 161 253 126 194 255 127 162 254 130 165 254 132 200 255 132 201 255 133 60 36 135 170 255 139 207 255 140 175 255 144 179 255 149 184 255 153 188 255 157 192 255 162 196 255 166 200 255 170 204 255 174 208 255 174 218 230 177 212 255 181 215 255 185 219 255 188 222 255 191 225 255 212 211 224 218 217 230 219 219 230 220 220 231 222 221 232 223 223 233 225 224 234 225 225 234 226 226 237 227 226 235 227 227 236 227 227 238 228 228 237 229 229 239 231 230 238 231 231 238 231 231 240 232 232 241 233 232 239 233 233 240 234 234 242 235 234 241 236 236 243 237 236 242 237 237 244 238 237 243 238 238 244 239 238 243 239 239 245 240 239 244 241 240 245 241 241 246 241 241 247 242 242 246 242 242 247 243 243 247 243 243 248 244 244 248 244 244 249 245 244 247 246 246 249 246 246 250 247 246 249 247 247 250 248 248 251 249 249 250 249 249 251 250 250 251 250 250 252 251 251 252 251 251 253 253 253 254 254 254 255 255 255 255 0 0 0]; mask:((Depth1Image new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@C????????????????????????????????????????????????????????????????????????????????@@@C') ; yourself); yourself]
   189 ! !
   190 
   191 !ViewTreeInspectorApplication class methodsFor:'interface specs'!
   192 
   193 windowSpec
   194     "This resource specification was automatically generated
   195      by the UIPainter of ST/X."
   196 
   197     "Do not manually edit this!! If it is corrupted,
   198      the UIPainter may not be able to read the specification."
   199 
   200     "
   201      UIPainter new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#windowSpec
   202      Tools::ViewTreeInspectorApplication new openInterface:#windowSpec
   203      Tools::ViewTreeInspectorApplication open
   204     "
   205 
   206     <resource: #canvas>
   207 
   208     ^ 
   209      #(FullSpec
   210         name: windowSpec
   211         window: 
   212        (WindowSpec
   213           label: 'View Tree Inspector'
   214           name: 'View Tree Inspector'
   215           min: (Point 10 10)
   216           max: (Point 1024 9999)
   217           bounds: (Rectangle 0 0 381 654)
   218           menu: menu
   219         )
   220         component: 
   221        (SpecCollection
   222           collection: (
   223            (MenuPanelSpec
   224               name: 'toolbarMenu'
   225               layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0)
   226               menu: toolbarMenu
   227               textDefault: true
   228             )
   229            (HierarchicalListViewSpec
   230               name: 'List'
   231               layout: (LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
   232               level: 1
   233               model: model
   234               menu: middleButtonMenu
   235               hasHorizontalScrollBar: true
   236               hasVerticalScrollBar: true
   237               miniScrollerHorizontal: true
   238               miniScrollerVertical: false
   239               listModel: listOfItems
   240               multipleSelectOk: true
   241               useIndex: false
   242               highlightMode: label
   243               showLeftIndicators: false
   244               indicatorSelector: indicatorClicked:
   245               useDefaultIcons: false
   246               postBuildCallback: postBuildTree:
   247             )
   248            )
   249          
   250         )
   251       )
   252 ! !
   253 
   254 !ViewTreeInspectorApplication class methodsFor:'menu specs'!
   255 
   256 menu
   257     "This resource specification was automatically generated
   258      by the MenuEditor of ST/X."
   259 
   260     "Do not manually edit this!! If it is corrupted,
   261      the MenuEditor may not be able to read the specification."
   262 
   263     "
   264      MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
   265      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
   266     "
   267 
   268     <resource: #menu>
   269 
   270     ^ 
   271      #(Menu
   272         (
   273          (MenuItem
   274             label: 'File'
   275             translateLabel: true
   276             submenu: 
   277            (Menu
   278               (
   279                (MenuItem
   280                   label: 'Pick a View'
   281                   itemValue: doPickViews
   282                   translateLabel: true
   283                 )
   284                (MenuItem
   285                   enabled: hasTargetWidgetChannel
   286                   label: 'Release Picked View'
   287                   itemValue: doUnpick
   288                   translateLabel: true
   289                 )
   290                (MenuItem
   291                   label: '-'
   292                 )
   293                (MenuItem
   294                   label: 'Settings'
   295                   translateLabel: true
   296                   submenu: 
   297                  (Menu
   298                     (
   299                      (MenuItem
   300                         label: 'Test Mode'
   301                         translateLabel: true
   302                         hideMenuOnActivated: false
   303                         indication: testModeChannel
   304                       )
   305                      (MenuItem
   306                         enabled: testModeChannel
   307                         label: 'Follow Focus'
   308                         translateLabel: true
   309                         hideMenuOnActivated: false
   310                         indication: followFocusChannel
   311                       )
   312                      (MenuItem
   313                         label: '-'
   314                       )
   315                      (MenuItem
   316                         label: 'Select on Click'
   317                         translateLabel: true
   318                         hideMenuOnActivated: false
   319                         indication: selectOnClickHolder
   320                       )
   321                      (MenuItem
   322                         label: '-'
   323                       )
   324                      (MenuItem
   325                         label: 'Show Name of Widgets'
   326                         translateLabel: true
   327                         hideMenuOnActivated: false
   328                         indication: showNamesHolder
   329                       )
   330                      )
   331                     nil
   332                     nil
   333                   )
   334                 )
   335                (MenuItem
   336                   label: '-'
   337                 )
   338                (MenuItem
   339                   label: 'Exit'
   340                   itemValue: closeRequest
   341                   translateLabel: true
   342                 )
   343                )
   344               nil
   345               nil
   346             )
   347           )
   348          (MenuItem
   349             enabled: hasSingleSelectionHolder
   350             label: 'Selection'
   351             translateLabel: true
   352             submenuChannel: middleButtonMenu
   353           )
   354          (MenuItem
   355             label: 'Application'
   356             translateLabel: true
   357             submenu: 
   358            (Menu
   359               (
   360                (MenuItem
   361                   enabled: hasSingleSelectionHolder
   362                   label: 'Browse'
   363                   itemValue: doBrowse:
   364                   translateLabel: true
   365                   argument: application
   366                 )
   367                (MenuItem
   368                   enabled: hasSingleSelectionHolder
   369                   label: 'Inspect'
   370                   itemValue: doInspect:
   371                   translateLabel: true
   372                   argument: application
   373                 )
   374                (MenuItem
   375                   label: '-'
   376                 )
   377                (MenuItem
   378                   enabled: hasTargetWidgetChannel
   379                   label: 'All Applications'
   380                   translateLabel: true
   381                   submenuChannel: submenuApplications:
   382                 )
   383                )
   384               nil
   385               nil
   386             )
   387           )
   388          (MenuItem
   389             label: 'Widget'
   390             translateLabel: true
   391             submenu: 
   392            (Menu
   393               (
   394                (MenuItem
   395                   enabled: hasSingleSelectionHolder
   396                   label: 'Browse'
   397                   itemValue: doBrowse:
   398                   translateLabel: true
   399                   argument: view
   400                 )
   401                (MenuItem
   402                   enabled: hasSingleSelectionHolder
   403                   label: 'Inspect'
   404                   itemValue: doInspect:
   405                   translateLabel: true
   406                   argument: view
   407                 )
   408                (MenuItem
   409                   label: '-'
   410                 )
   411                (MenuItem
   412                   enabled: hasTargetWidgetChannel
   413                   label: 'All Components'
   414                   translateLabel: true
   415                   startGroup: right
   416                   submenuChannel: submenuComponents:
   417                 )
   418                )
   419               nil
   420               nil
   421             )
   422           )
   423          (MenuItem
   424             label: 'Help'
   425             translateLabel: true
   426             startGroup: conditionalRight
   427             submenu: 
   428            (Menu
   429               (
   430                (MenuItem
   431                   label: 'Documentation'
   432                   itemValue: openDocumentation
   433                   translateLabel: true
   434                 )
   435                (MenuItem
   436                   label: '-'
   437                 )
   438                (MenuItem
   439                   label: 'About this Application...'
   440                   itemValue: openAboutThisApplication
   441                   translateLabel: true
   442                 )
   443                )
   444               nil
   445               nil
   446             )
   447           )
   448          )
   449         nil
   450         nil
   451       )
   452 !
   453 
   454 middleButtonMenu
   455     "This resource specification was automatically generated
   456      by the MenuEditor of ST/X."
   457 
   458     "Do not manually edit this!! If it is corrupted,
   459      the MenuEditor may not be able to read the specification."
   460 
   461     "
   462      MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
   463      (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
   464     "
   465 
   466     <resource: #menu>
   467 
   468     ^ 
   469      #(Menu
   470         (
   471          (MenuItem
   472             label: 'Geometry'
   473             translateLabel: true
   474             submenuChannel: submenuGeometry:
   475             keepLinkedMenu: true
   476           )
   477          (MenuItem
   478             label: 'Interface'
   479             translateLabel: true
   480             submenuChannel: submenuInterface:
   481             keepLinkedMenu: true
   482           )
   483          (MenuItem
   484             label: 'Visibility'
   485             translateLabel: true
   486             submenuChannel: submenuVisibility:
   487             keepLinkedMenu: true
   488           )
   489          (MenuItem
   490             label: '-'
   491           )
   492          (MenuItem
   493             label: 'Browse View Class'
   494             itemValue: doBrowse:
   495             translateLabel: true
   496             argument: view
   497           )
   498          (MenuItem
   499             label: 'Browse Model Class'
   500             itemValue: doBrowse:
   501             translateLabel: true
   502             isVisible: hasModel
   503             argument: model
   504           )
   505          (MenuItem
   506             label: 'Browse Application Class'
   507             itemValue: doBrowse:
   508             translateLabel: true
   509             isVisible: hasApplication
   510             argument: application
   511           )
   512          (MenuItem
   513             label: 'Browse Controller Class'
   514             itemValue: doBrowse:
   515             translateLabel: true
   516             isVisible: hasController
   517             argument: controller
   518           )
   519          (MenuItem
   520             label: '-'
   521           )
   522          (MenuItem
   523             label: 'Inspect View'
   524             itemValue: doInspect:
   525             translateLabel: true
   526             argument: view
   527           )
   528          (MenuItem
   529             label: 'Inspect Window Group'
   530             itemValue: doInspect:
   531             translateLabel: true
   532             argument: group
   533           )
   534          (MenuItem
   535             label: 'Inspect Model'
   536             itemValue: doInspect:
   537             translateLabel: true
   538             isVisible: hasModel
   539             argument: model
   540           )
   541          (MenuItem
   542             label: 'Inspect Application'
   543             itemValue: doInspect:
   544             translateLabel: true
   545             isVisible: hasApplication
   546             argument: application
   547           )
   548          (MenuItem
   549             label: 'Inspect Controller'
   550             itemValue: doInspect:
   551             translateLabel: true
   552             isVisible: hasController
   553             argument: controller
   554           )
   555          (MenuItem
   556             label: '-'
   557           )
   558          (MenuItem
   559             label: 'Flash'
   560             itemValue: doFlash
   561             translateLabel: true
   562           )
   563          (MenuItem
   564             label: '-'
   565           )
   566          (MenuItem
   567             label: 'Destroy'
   568             itemValue: doDestroy
   569             translateLabel: true
   570           )
   571          (MenuItem
   572             label: '-'
   573           )
   574          (MenuItem
   575             label: 'Instance Variables'
   576             translateLabel: true
   577             submenuChannel: submenuInspector:
   578             keepLinkedMenu: true
   579           )
   580          (MenuItem
   581             label: '='
   582           )
   583          (MenuItem
   584             label: ''
   585           )
   586          (MenuItem
   587             enabled: selectedComponentHasChildren
   588             label: 'Applications'
   589             nameKey: single
   590             translateLabel: true
   591             submenuChannel: submenuApplications:
   592             keepLinkedMenu: true
   593           )
   594          (MenuItem
   595             enabled: selectedComponentHasChildren
   596             label: 'Components'
   597             nameKey: single
   598             translateLabel: true
   599             submenuChannel: submenuComponents:
   600             keepLinkedMenu: true
   601           )
   602          )
   603         nil
   604         nil
   605       )
   606 !
   607 
   608 toolbarMenu
   609     "This resource specification was automatically generated
   610      by the MenuEditor of ST/X."
   611 
   612     "Do not manually edit this!! If it is corrupted,
   613      the MenuEditor may not be able to read the specification."
   614 
   615     "
   616      MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#toolbarMenu
   617      (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication toolbarMenu)) startUp
   618     "
   619 
   620     <resource: #menu>
   621 
   622     ^ 
   623      #(Menu
   624         (
   625          (MenuItem
   626             label: 'Pick a View'
   627             itemValue: doPickViews
   628             translateLabel: false
   629             isButton: true
   630             hideMenuOnActivated: false
   631             labelImage: (ResourceRetriever #'Tools::ViewTreeInspectorApplication' pickWindowIcon)
   632           )
   633          (MenuItem
   634             enabled: hasTargetWidgetChannel
   635             label: 'Release Picked View'
   636             isButton: true
   637             itemValue: doUnpick
   638             translateLabel: true
   639             labelImage: (ResourceRetriever ToolbarIconLibrary undoIcon)
   640           )
   641          (MenuItem
   642             label: '-'
   643           )
   644          (MenuItem
   645             enabled: hasSingleSelectionHolder
   646             label: 'Browse Application'
   647             itemValue: doBrowse:
   648             translateLabel: false
   649             isButton: true
   650             hideMenuOnActivated: false
   651             labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
   652             argument: application
   653           )
   654          (MenuItem
   655             enabled: hasSingleSelectionHolder
   656             label: 'Inspect Application'
   657             itemValue: doInspect:
   658             translateLabel: false
   659             isButton: true
   660             hideMenuOnActivated: false
   661             labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon)
   662             argument: application
   663           )
   664          )
   665         nil
   666         nil
   667       )
   668 ! !
   669 
   670 !ViewTreeInspectorApplication class methodsFor:'startup'!
   671 
   672 openInPickMode
   673     |app|
   674 
   675     app := self new.
   676     app open.
   677     app doPickViews.
   678 ! !
   679 
   680 !ViewTreeInspectorApplication methodsFor:'actions'!
   681 
   682 indicatorClicked:anIndex
   683     |item sensor|
   684 
   685     item := model listOfItems at:anIndex ifAbsent:nil.
   686 
   687     item notNil ifTrue:[
   688         (     (sensor := self window sensor) notNil
   689          and:[(sensor ctrlDown or:[sensor shiftDown])]
   690         ) ifTrue:[
   691             item recursiveToggleExpand
   692         ] ifFalse:[
   693             item toggleExpand
   694         ]
   695     ].
   696 ! !
   697 
   698 !ViewTreeInspectorApplication methodsFor:'aspects'!
   699 
   700 followFocusChannel
   701     "boolean holder, which indicates whether selection changed dependend on the focus view"
   702 
   703     ^ followFocusChannel
   704 !
   705 
   706 hasSingleSelectionHolder
   707     "boolean holder, true if one item is selected"
   708 
   709     ^ hasSingleSelectionHolder
   710 !
   711 
   712 hasTargetWidgetChannel
   713     "answer the channel which is set to true if a target widget exists"
   714 
   715     ^ model hasTargetWidgetChannel
   716 !
   717 
   718 listOfItems
   719     "returns the hierarchical list of items"
   720 
   721     ^ model listOfItems
   722 !
   723 
   724 model
   725     "returns my selection model, a ViewTreeModel"
   726 
   727     ^ model
   728 !
   729 
   730 selectOnClickHolder
   731     "boolean holder, which indicates whether the selection will change on click"
   732 
   733     ^ model selectOnClickHolder
   734 !
   735 
   736 showNamesHolder
   737     "boolean holder, which indicates whether application names or widget names
   738      as additional text are shown for the items"
   739 
   740     ^ showNamesHolder
   741 !
   742 
   743 testModeChannel
   744     "answer a boolean channel which describes the behaviour how to process
   745      events on the target view.
   746 
   747      false: all input events are eaten and the selection is shown on the target view.
   748      true:  no  input events are eaten and no  selection is shown on the target view."
   749 
   750     ^ model testModeChannel
   751 ! !
   752 
   753 !ViewTreeInspectorApplication methodsFor:'change & update'!
   754 
   755 selectionChanged
   756     "called if the selection changed"
   757 
   758     |info view item|
   759 
   760     item := model selectedItem.
   761 
   762     item notNil ifTrue:[ |state|
   763         view := item widget.
   764 
   765         view id isNil ifTrue:[
   766             state := 'no ID'.
   767         ] ifFalse:[
   768             view shown ifTrue:[
   769                 state := 'visible'.
   770             ] ifFalse:[
   771                 state := 'invisible'
   772             ].
   773         ].
   774         info := '%1 [%2] - %3' bindWith:(view class name)
   775                                    with:(view name ? '') with:state allBold.
   776 
   777     ] ifFalse:[
   778         info := ''
   779     ].
   780     hasSingleSelectionHolder value:(view notNil).
   781 !
   782 
   783 update:something with:someArgument from:aModel
   784     |oldSelection|
   785 
   786     aModel == showNamesHolder ifTrue:[
   787         oldSelection := model selectedItem.
   788         model selectedItem:nil.
   789         self listOfItems showWidgetNames:(aModel value).
   790         model selectedItem:oldSelection.
   791         ^ self
   792     ].
   793 
   794     aModel == model ifTrue:[
   795         self selectionChanged.
   796         ^ self
   797     ].
   798 
   799     super update:something with:someArgument from:aModel.
   800 ! !
   801 
   802 !ViewTreeInspectorApplication methodsFor:'event processing'!
   803 
   804 processButtonMotionEvent:ev
   805     "handle a button motion event"
   806 
   807     |click rootView|
   808 
   809     motionAction isNil ifTrue:[^ self].
   810 
   811     (rootView := model rootView) isNil ifTrue:[
   812         clickedItem := motionAction := nil.
   813         ^ self
   814     ].
   815 
   816     click := rootView device
   817             translatePoint:((ev x)@ (ev y))
   818             fromView:(ev view)
   819             toView:rootView.
   820 
   821     click = clickedPoint ifFalse:[
   822         (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
   823             motionAction value:click
   824         ]
   825     ].
   826 !
   827 
   828 processButtonPressEvent:ev
   829     "handle a buttopn press event"
   830 
   831     |rootView sensor lastRectangle|
   832 
   833     rootView    := model rootView.
   834     sensor      := model rootView sensor.
   835     clickedItem := model listOfItems detectItemRespondsToView:(ev view).
   836 
   837     (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
   838         clickedItem notNil ifTrue:[
   839             self selectOnClickHolder value ifTrue:[
   840                 model toggleSelectItem:clickedItem
   841             ].
   842         ].
   843         clickedItem := motionAction := nil.
   844         ^ self
   845     ].
   846 
   847     clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
   848     lastRectangle := nil.
   849 
   850     motionAction :=[:p|
   851         rootView    := model rootView device rootView.
   852         rootView    := model rootView.
   853         clickedItem := nil.
   854 
   855         rootView xoring:[
   856             lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
   857                                 ifFalse:[ rootView clippedByChildren:false ].
   858 
   859             p isNil ifTrue:[
   860                 rootView clippedByChildren:true.
   861                 motionAction := nil.
   862             ] ifFalse:[
   863                 lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
   864                 rootView displayRectangle:lastRectangle.
   865             ].
   866             rootView flush.
   867         ].
   868         lastRectangle
   869     ].
   870 !
   871 
   872 processButtonReleaseEvent:anEvent
   873     "handle a button release event"
   874 
   875     |rootView rectangle newItems widget origin|
   876 
   877     (rootView := model rootView) isNil ifTrue:[
   878         clickedItem := motionAction := nil.
   879         ^ self
   880     ].
   881     motionAction isNil ifTrue:[ ^ self ].
   882     clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
   883 
   884     rectangle := motionAction value:nil.
   885     rectangle isNil ifTrue:[^ self].
   886 
   887     newItems := OrderedCollection new.
   888 
   889     model rootItem recursiveDo:[:anItem|
   890         widget := anItem widget.
   891         origin := widget originRelativeTo:rootView.
   892 
   893         (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
   894             newItems add:anItem.
   895         ]
   896     ].
   897     model value:newItems.
   898 !
   899 
   900 processEvent:anEvent
   901     "process an event"
   902 
   903     |button menu|
   904 
   905     anEvent isKeyPressEvent ifTrue:[ ^ self processKeyPressEvent:anEvent ].
   906     anEvent isButtonEvent  ifFalse:[ ^ self ].
   907 
   908     button := anEvent button.
   909 
   910     (button == 2 or:[button == #menu]) ifTrue:[
   911         motionAction isNil ifTrue:[
   912             anEvent isButtonPressEvent ifTrue:[
   913                 self selectOnClickHolder value ifTrue:[
   914                     menu := self middleButtonMenu value.
   915                     menu notNil ifTrue:[
   916                         menu := MenuPanel menu:(Menu new fromLiteralArrayEncoding:menu)
   917                                       receiver:self.
   918                         menu startUp.
   919                     ]
   920                 ].
   921             ].
   922             clickedItem := nil.
   923         ].
   924         ^ self
   925     ].
   926 
   927     anEvent isButtonPressEvent  ifTrue:[ ^ self processButtonPressEvent:anEvent  ].
   928     anEvent isButtonMotionEvent ifTrue:[ ^ self processButtonMotionEvent:anEvent ].
   929 
   930     anEvent isButtonReleaseEvent ifTrue:[
   931         self selectOnClickHolder value ifTrue:[
   932             self processButtonReleaseEvent:anEvent
   933         ].
   934     ].
   935     clickedItem := motionAction := nil.
   936 
   937     anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
   938         self selectOnClickHolder value ifTrue:[
   939             self doInspect:#view.
   940         ].
   941     ].
   942 !
   943 
   944 processKeyPressEvent:anEvent
   945     "process an key press event"
   946 
   947     |item prnt idx key max next|
   948 
   949     key := anEvent key.
   950     key isSymbol ifFalse:[^ self].
   951 
   952     key == #Delete    ifTrue:[ ^ self doDestroy ].
   953     key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
   954 
   955     (   key == #CursorUp
   956     or:[key == #CursorDown
   957     or:[key == #CursorLeft
   958     or:[key == #CursorRight]]]
   959     ) ifFalse:[
   960         ^ self
   961     ].
   962     item := model selectedItem.
   963 
   964     item isNil ifTrue:[
   965         ^ model selectedItem:(model first ? model rootItem)
   966     ].
   967 
   968     prnt := item parent.
   969     prnt isNil ifTrue:[
   970         "/ is the root item
   971         (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
   972                                                   ifFalse:[item := item at:1 ifAbsent:item].
   973 
   974       ^ model selectedItem:item
   975     ].
   976     key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
   977 
   978     key == #CursorRight ifTrue:[
   979         next := item at:1 ifAbsent:nil.
   980         next notNil ifTrue:[ model selectedItem:next ].
   981       ^ self
   982     ].
   983 
   984     max := prnt size.
   985 
   986     key == #CursorUp ifTrue:[
   987         idx := prnt identityIndexOf:item.
   988         idx == 1 ifTrue:[idx := max + 1].
   989         model selectedItem:(prnt at:idx - 1).
   990       ^ self.
   991     ].
   992 
   993     key == #CursorDown ifTrue:[
   994         idx := prnt identityIndexOf:item.
   995         idx == max ifTrue:[idx := 0].
   996         model selectedItem:(prnt at:idx + 1).
   997       ^ self.
   998     ].
   999 !
  1000 
  1001 processMappedView:aView
  1002     "process a mapped event"
  1003 
  1004     |parent anchor|
  1005 
  1006     parent := self listOfItems detectItemRespondsToView:aView.
  1007     parent isNil ifTrue:[ ^ self ].
  1008 
  1009     NotFoundSignal handle:[:ex|
  1010         "contained subvies used by spec are not yet created;
  1011          thus we have to wait until last used subview is build
  1012         "
  1013         anchor := nil.
  1014     ] do:[
  1015         anchor := parent class buildViewsFrom:(parent widget).
  1016     ].
  1017     anchor notNil ifTrue:[
  1018         parent updateFromChildren:anchor children.
  1019     ].
  1020 ! !
  1021 
  1022 !ViewTreeInspectorApplication methodsFor:'initialization & release'!
  1023 
  1024 closeDownViews
  1025     "release the grapped application"
  1026 
  1027     process := nil.
  1028     super closeDownViews.
  1029     self doUnpick.
  1030 !
  1031 
  1032 initialize
  1033     "setup my model and channels"
  1034 
  1035     super initialize.
  1036 
  1037     hasSingleSelectionHolder := false asValue.
  1038     followFocusChannel       := false asValue.
  1039 
  1040     model := ViewTreeModel new.
  1041     model inputEventAction:[:ev| self processEvent:ev ].
  1042     model mappedViewAction:[:vw| self processMappedView:vw ].
  1043     model application:self.
  1044     model addDependent:self.
  1045 
  1046 
  1047     showNamesHolder := false asValue.
  1048     showNamesHolder addDependent:self.
  1049 !
  1050 
  1051 postBuildTree:aTree
  1052     treeView := aTree scrolledView.
  1053     treeView hasConstantHeight:true.
  1054 ! !
  1055 
  1056 !ViewTreeInspectorApplication methodsFor:'menu queries'!
  1057 
  1058 hasApplication
  1059     "returns true if the current selected view has an application"
  1060 
  1061     |view|
  1062 
  1063     view := self selectedView.
  1064   ^ (view notNil and:[view application notNil])
  1065 !
  1066 
  1067 hasController
  1068     "returns true if the current selected item's view has a controller
  1069      other than nil or the view itself"
  1070 
  1071     |view controller|
  1072 
  1073     view := self selectedView.
  1074 
  1075     view notNil ifTrue:[
  1076         controller := view controller.
  1077       ^ (controller notNil and:[controller ~~ view])
  1078     ].
  1079     ^ false
  1080 !
  1081 
  1082 hasModel
  1083     "returns true if the current selected view has a model"
  1084 
  1085     |view|
  1086 
  1087     view := self selectedView.
  1088   ^ (view notNil and:[view model notNil])
  1089 ! !
  1090 
  1091 !ViewTreeInspectorApplication methodsFor:'menu specs'!
  1092 
  1093 middleButtonMenu
  1094     "returns the middleButton menu for the single selected item or nil"
  1095 
  1096     ^ [ model selectedItem notNil ifTrue:[self class middleButtonMenu]
  1097                                  ifFalse:[nil]
  1098       ]
  1099 !
  1100 
  1101 submenuApplications:aMenu
  1102     |applications menu item list addBlock|
  1103 
  1104     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
  1105                                               ifFalse:[model rootItem].
  1106     item isNil ifTrue:[^ nil].
  1107 
  1108     applications := IdentityDictionary new.
  1109 
  1110     addBlock := [:el| |cls ctr|
  1111         cls := self resolveApplicationClassFor:el.
  1112 
  1113         cls notNil ifTrue:[
  1114             ctr := applications at:cls ifAbsent:0.
  1115             applications at:cls put:(ctr + 1).
  1116         ].
  1117     ].
  1118     item recursiveDo:addBlock.
  1119     addBlock value:item.
  1120 
  1121     applications isEmpty ifTrue:[^ nil ].
  1122     list := SortedCollection sortBlock:[:a :b| a title < b title ].
  1123 
  1124     applications keysAndValuesDo:[:cls :ctr|
  1125        list add:(MenuDesc title:(cls name)
  1126                           value:(ctr printString)
  1127                          action:[self doSelectNextOfApplicationClass:cls startingIn:item]
  1128                  ).
  1129     ].
  1130 
  1131     menu := MenuDesc buildFromList:list onGC:aMenu.
  1132     menu do:[:el|
  1133         el hideMenuOnActivated:false
  1134     ].
  1135     ^ menu
  1136 !
  1137 
  1138 submenuComponents:aMenu
  1139     |widgets list total menu item|
  1140 
  1141     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
  1142                                               ifFalse:[model rootItem].
  1143     item isNil ifTrue:[^ nil].
  1144 
  1145     widgets := IdentityDictionary new.
  1146     total   := 0.
  1147 
  1148     item recursiveDo:[:el| |cls ctr|
  1149         cls := el widget.
  1150 
  1151         cls notNil ifTrue:[
  1152             cls := cls class.
  1153             ctr := widgets at:cls ifAbsent:0.
  1154             widgets at:cls put:(ctr + 1).
  1155             total := total + 1.
  1156         ].
  1157     ].
  1158     total == 0 ifTrue:[^ nil].
  1159     list := SortedCollection sortBlock:[:a :b| a title < b title ].
  1160 
  1161     widgets keysAndValuesDo:[:cls :ctr|
  1162         list add:(MenuDesc title:(cls name)
  1163                            value:(ctr printString)
  1164                           action:[self doSelectNextOfClass:cls startingIn:item]
  1165                  ).
  1166     ].
  1167     list := list asOrderedCollection.
  1168     list add:(MenuDesc separator).
  1169     list add:(MenuDesc title:'Total' value:(total printString)).
  1170     menu := MenuDesc buildFromList:list onGC:aMenu.
  1171     menu do:[:el|
  1172         el hideMenuOnActivated:false
  1173     ].
  1174     ^ menu
  1175 !
  1176 
  1177 submenuGeometry:aMenu
  1178     "builds and returns the geometry submenu"
  1179 
  1180     |view point inst list x y|
  1181 
  1182     view := self selectedView.
  1183     view isNil ifTrue:[^ nil].
  1184 
  1185     list := OrderedCollection new.
  1186 
  1187     "/ origin
  1188     point := view relativeOrigin.
  1189     point isNil ifTrue:[ point := view origin ].
  1190 
  1191     x := view left.
  1192     y := view top.
  1193 
  1194     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
  1195                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
  1196 
  1197     list add:(MenuDesc title:'origin' value:inst).
  1198 
  1199     "/ corner
  1200     point := view relativeCorner.
  1201     point isNil ifTrue:[ point := view corner ].
  1202 
  1203     x := view right.
  1204     y := view bottom.
  1205 
  1206     (x == point x and:[y == point y]) ifTrue:[ inst := point ]
  1207                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
  1208 
  1209     list add:(MenuDesc title:'corner' value:inst).
  1210 
  1211     "/ extent
  1212     (point := view relativeExtent) isNil ifTrue:[point := view extent].
  1213     list add:(MenuDesc title:'extent' value:point).
  1214 
  1215     "/ preferred extent
  1216     list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
  1217     list add:(MenuDesc separator).
  1218 
  1219     "/ view insets
  1220     inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
  1221                                          with:(view rightInset)
  1222                                          with:(view topInset)
  1223                                          with:(view bottomInset).
  1224 
  1225     list add:(MenuDesc title:'insets'      value:inst).
  1226     list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
  1227     list add:(MenuDesc title:'level'       value:(view level)).
  1228     list add:(MenuDesc separator).
  1229 
  1230     (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
  1231     list add:(MenuDesc title:'layout' value:inst).
  1232 
  1233     (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
  1234     list add:(MenuDesc title:'transformation' value:inst).
  1235 
  1236   ^ MenuDesc buildFromList:list onGC:aMenu
  1237 !
  1238 
  1239 submenuInspector:aMenu
  1240     "builds and returns the inspector submenu"
  1241 
  1242     |view list n names label value|
  1243 
  1244     view := self selectedView.
  1245     view isNil ifTrue:[^ nil].
  1246 
  1247     n := view class instSize.
  1248     n > 0 ifFalse:[^ nil ].
  1249 
  1250     list  := OrderedCollection new:n.
  1251     names := view class allInstVarNames.
  1252 
  1253     1 to:n do:[:i| |action|
  1254         label := (names at:i) printString.
  1255         value := view instVarAt:i.
  1256         value isNil ifTrue:[
  1257             value  := '------'.
  1258             action := nil.
  1259         ] ifFalse:[
  1260             value  := value displayString contractAtEndTo:40.
  1261             action := [(view instVarAt:i) inspect].
  1262         ].
  1263         list add:(MenuDesc title:label value:value action:action).
  1264     ].
  1265 
  1266     ^ MenuDesc buildFromList:list onGC:aMenu
  1267 !
  1268 
  1269 submenuInterface:aMenu
  1270     "builds and returns the interface submenu"
  1271 
  1272     |view label inst value list|
  1273 
  1274     view := self selectedView.
  1275     view isNil ifTrue:[^ nil].
  1276 
  1277     list := OrderedCollection new.
  1278 
  1279     inst  := view controller.
  1280     value := nil.
  1281 
  1282     inst isNil ifTrue:[
  1283         label := nil
  1284     ] ifFalse:[
  1285         inst == view ifTrue:[ label := '== view itself' ]
  1286                     ifFalse:[ label := inst displayString.
  1287                               value := [view controller inspect].
  1288                             ].
  1289     ].
  1290     list add:(MenuDesc title:'controller' value:label action:value).
  1291 
  1292     inst := view delegate.
  1293     inst notNil ifTrue:[
  1294         list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
  1295     ].
  1296 
  1297     inst := view application.
  1298 
  1299     inst notNil ifTrue:[ |topAppl|
  1300         list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
  1301 
  1302         topAppl := inst topApplication.
  1303 
  1304         (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
  1305             list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
  1306         ].
  1307     ].
  1308     list add:(MenuDesc separator).
  1309 
  1310     (view respondsTo:#'model:') ifTrue:[
  1311         inst := model.
  1312 
  1313         inst isNil ifTrue:[ label := value := nil ]
  1314                   ifFalse:[ label := inst displayString.
  1315                             value := [ view model inspect ].
  1316                           ].
  1317 
  1318         list add:(MenuDesc title:'model' value:label action:value).
  1319 
  1320         (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
  1321             view modelInterface keysAndValuesDo:[:key : val|
  1322                 val isNil ifTrue:[ label := nil ]
  1323                          ifFalse:[ label := val displayString ].
  1324 
  1325                 list add:(MenuDesc title:('      - ', key) value:label ).
  1326             ]
  1327         ].
  1328     ].
  1329 
  1330     (view respondsTo:#enableChannel) ifTrue:[
  1331         inst := view enableChannel.
  1332 
  1333         inst isNil ifTrue:[ label := value := nil ]
  1334                   ifFalse:[ label := inst displayString.
  1335                             value := [ view enableChannel inspect ].
  1336                           ].
  1337 
  1338         list add:(MenuDesc title:'enableChannel' value:label action:value).
  1339     ].
  1340 
  1341     list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
  1342 
  1343     (view respondsTo:#listHolder) ifTrue:[
  1344         inst := view listHolder.
  1345 
  1346         inst isNil ifTrue:[ label := value := nil ]
  1347                   ifFalse:[ label := inst class printString.
  1348                             value := [ view listHolder inspect ].
  1349                           ].
  1350         list add:(MenuDesc title:'listHolder' value:label action:value).
  1351     ].
  1352 
  1353     (view respondsTo:#list) ifTrue:[
  1354         inst := view list.
  1355 
  1356         inst isNil ifTrue:[ label := value := nil ]
  1357                   ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
  1358                             value := [ view list inspect ].
  1359                           ].
  1360 
  1361         list add:(MenuDesc title:'list' value:label action:value).
  1362     ].
  1363 
  1364     list last isSeparator ifTrue:[ list removeLast ].
  1365   ^ MenuDesc buildFromList:list onGC:aMenu
  1366 !
  1367 
  1368 submenuVisibility:aMenu
  1369     "builds and returns the geometry submenu"
  1370 
  1371     |view list value|
  1372 
  1373     view := self selectedView.
  1374     view isNil ifTrue:[^ nil].
  1375 
  1376     list := OrderedCollection new.
  1377 
  1378     list add:(MenuDesc title:'device'     value:(view device printString)).
  1379     list add:(MenuDesc title:'drawableId' value:(view id)).
  1380     list add:(MenuDesc title:'gcId'       value:(view gcId)).
  1381 
  1382     list add:(MenuDesc separator).
  1383 
  1384     list add:(MenuDesc title:'shown'    value:(view shown)).
  1385     list add:(MenuDesc title:'realized' value:(view realized)).
  1386 
  1387     list add:(MenuDesc separator).
  1388 
  1389     list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
  1390 
  1391     (value := view visibilityChannel) isNil ifTrue:[
  1392         list add:(MenuDesc title:'visibilityChannel' value:'------').
  1393     ] ifFalse:[
  1394         list add:(MenuDesc title:'visibilityChannel'
  1395                            value:(value displayString)
  1396                           action:[view visibilityChannel inspect]).
  1397     ].
  1398 
  1399         
  1400   ^ MenuDesc buildFromList:list onGC:aMenu
  1401 ! !
  1402 
  1403 !ViewTreeInspectorApplication methodsFor:'private'!
  1404 
  1405 selectFocusView
  1406     |rootView focusItem focusView|
  1407 
  1408     rootView := model rootView.
  1409 
  1410     (rootView notNil and:[rootView shown]) ifTrue:[
  1411         focusView := rootView windowGroup focusView.
  1412     ].
  1413     focusView isNil ifTrue:[^ self ].
  1414 
  1415     focusItem := model selectedItem.
  1416 
  1417     (focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
  1418         ^ self
  1419     ].
  1420     focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].
  1421 
  1422     focusItem notNil ifTrue:[
  1423         model selectItem:focusItem.
  1424     ].        
  1425 !
  1426 
  1427 setRootItem:aRootItemOrNil
  1428     |theProcess|
  1429 
  1430     aRootItemOrNil isNil ifTrue:[
  1431         process := nil.
  1432     ] ifFalse:[
  1433         "/ expand tree to level 3
  1434         aRootItemOrNil do:[:aRootChild|
  1435             aRootChild do:[:aSubChild| aSubChild expand ].
  1436             aRootChild expand.
  1437         ].
  1438         aRootItemOrNil expand.
  1439 
  1440         process isNil ifTrue:[
  1441             theProcess := process :=
  1442                 Process for:[   |update testModeChannel|
  1443 
  1444                                 update := false.
  1445                                 testModeChannel := model testModeChannel.
  1446 
  1447                                 [process == theProcess] whileTrue:[
  1448                                     Delay waitForSeconds:0.5.
  1449 
  1450                                     (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
  1451                                         (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
  1452                                             self selectFocusView.
  1453                                         ].
  1454                                         update ifTrue:[
  1455                                             self updateShownStatus.
  1456                                         ].
  1457                                         update := update not.
  1458                                     ].
  1459                                 ].
  1460 
  1461                              ] priority:8.
  1462             theProcess name:'ViewTreeInspector - Follow Focus'.
  1463             theProcess resume.
  1464         ].
  1465     ].
  1466     model rootItem:aRootItemOrNil.
  1467 !
  1468 
  1469 updateShownStatus
  1470     |rootItem min max visState listIdx visY0 visY1 height damage|
  1471 
  1472     rootItem := model rootItem.
  1473     (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
  1474 
  1475     max := 0.
  1476     min := 9999999.
  1477 
  1478     rootItem recursiveEachVisibleItemDo:[:anItem|
  1479         visState := (anItem widget shown).
  1480 
  1481         visState ~~ anItem isDrawnShown ifTrue:[
  1482             anItem isDrawnShown:visState.
  1483             listIdx := treeView identityIndexOf:anItem.
  1484 
  1485             listIdx > 0 ifTrue:[    
  1486                 max := max max:listIdx.
  1487                 min := min min:listIdx.
  1488             ].
  1489         ].
  1490     ].
  1491     max < min ifTrue:[^ self].
  1492     max := max + 1.
  1493 
  1494     visY0  := (treeView yVisibleOfLine:min) max:0.
  1495     visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
  1496     height := visY1 - visY0.
  1497     
  1498     height > 2 ifTrue:[
  1499         treeView shown ifTrue:[
  1500             damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
  1501             treeView invalidateDeviceRectangle:damage repairNow:false.
  1502         ].
  1503     ].
  1504 ! !
  1505 
  1506 !ViewTreeInspectorApplication methodsFor:'selection'!
  1507 
  1508 selectedView
  1509     "answer the selected view or nil"
  1510 
  1511     |item|
  1512 
  1513     item := model selectedItem.
  1514     item notNil ifTrue:[ ^ item widget ].
  1515   ^ nil
  1516 ! !
  1517 
  1518 !ViewTreeInspectorApplication methodsFor:'testing'!
  1519 
  1520 resolveApplicationClassFor:aTreeItem
  1521     aTreeItem isApplicationClass ifTrue:[
  1522        ^ aTreeItem applicationClass
  1523     ].
  1524     ^ nil
  1525 !
  1526 
  1527 selectedComponentHasChildren
  1528     |item|
  1529 
  1530     item := model selectedItem.
  1531     ^ (item notNil and:[item hasChildren])
  1532 ! !
  1533 
  1534 !ViewTreeInspectorApplication methodsFor:'user operations'!
  1535 
  1536 doBrowse:what
  1537     "open browser on:
  1538         #view           browse class
  1539         #model          browse model class
  1540         #application    browse application class
  1541         #controller     browse controller class
  1542     "
  1543     |view inst|
  1544 
  1545     view := self selectedView.
  1546     view isNil ifTrue:[^ self].
  1547 
  1548              what == #view        ifTrue:[ inst := view ]
  1549     ifFalse:[what == #model       ifTrue:[ inst := view model ]
  1550     ifFalse:[what == #application ifTrue:[ inst := view application ]
  1551     ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
  1552     ifFalse:[
  1553         ^ self
  1554     ]]]].
  1555 
  1556     inst notNil ifTrue:[
  1557         inst class browserClass openInClass:(inst class) selector:nil
  1558     ].
  1559 !
  1560 
  1561 doDestroy
  1562     "destroy the current selected view"
  1563 
  1564     |item parent|
  1565 
  1566     item := model selectedItem.
  1567     item isNil ifTrue:[ ^ self].
  1568 
  1569     parent := item parent.
  1570 
  1571     parent isNil ifTrue:[
  1572         "/ the root
  1573         model withSelectionHiddenDo:[item deleteAll].
  1574       ^ self
  1575     ].
  1576 
  1577     model withSelectionHiddenDo:[
  1578         |idx nsel|
  1579 
  1580         idx := parent identityIndexOf:item.
  1581 
  1582         idx == parent size ifTrue:[
  1583             nsel := parent at:(idx - 1) ifAbsent:parent
  1584         ] ifFalse:[
  1585             nsel := parent at:(idx + 1)
  1586         ].
  1587         model setValue:nil.
  1588         item delete.
  1589 
  1590         parent isLayoutContainer ifTrue:[
  1591             parent widget sizeChanged:nil
  1592         ].
  1593         model value:nsel.
  1594     ].
  1595 !
  1596 
  1597 doFlash
  1598     "flash the selected view"
  1599 
  1600     |view|
  1601 
  1602     view := self selectedView.
  1603     view isNil ifTrue:[ ^ self].
  1604 
  1605     view shown ifTrue:[
  1606         model withSelectionHiddenDo:[
  1607             view perform:#flash ifNotUnderstood:nil.
  1608         ].
  1609     ].
  1610 !
  1611 
  1612 doInspect:what
  1613     "open inspector on:
  1614         #view           inspect class
  1615         #group          inspect windowGroup
  1616         #model          inspect model
  1617         #application    inspect application
  1618         #controller     inspect controller
  1619     "
  1620     |inst|
  1621 
  1622     inst := self selectedView.
  1623     inst isNil ifTrue:[^ self].
  1624 
  1625              what == #group       ifTrue:[ inst := inst windowGroup ]
  1626     ifFalse:[what == #model       ifTrue:[ inst := inst model ]
  1627     ifFalse:[what == #application ifTrue:[ inst := inst application ]
  1628     ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
  1629 
  1630     inst notNil ifTrue:[ inst inspect ].
  1631 !
  1632 
  1633 doPickViews
  1634     "pick a window's topView"
  1635 
  1636     |window|
  1637 
  1638     self doUnpick.
  1639 
  1640     window := Screen current viewFromUser.
  1641     window isNil ifTrue:[^ self].
  1642 
  1643     window := window topView.
  1644 
  1645     (    window == Screen current rootView
  1646      or:[window == self window topView]
  1647     ) ifTrue:[
  1648         ^ self
  1649     ].
  1650     self setRootItem:(ViewTreeItem buildViewsFrom:window).
  1651 !
  1652 
  1653 doSelectNextOfApplicationClass:aClass startingIn:anItem
  1654     |startItem firstFound searchNext|
  1655 
  1656     startItem  := model last.
  1657     searchNext := startItem notNil.        
  1658     firstFound := nil.
  1659 
  1660     anItem recursiveDo:[:el|
  1661         el == startItem ifTrue:[
  1662             searchNext := false
  1663         ] ifFalse:[
  1664             (self resolveApplicationClassFor:el) == aClass ifTrue:[
  1665                 searchNext ifFalse:[^ model selectItem:el].
  1666 
  1667                 firstFound isNil ifTrue:[
  1668                     firstFound := el
  1669                 ]
  1670             ]
  1671         ]
  1672     ].
  1673     firstFound notNil ifTrue:[
  1674         self window beep.
  1675         model selectItem:firstFound
  1676     ].
  1677 !
  1678 
  1679 doSelectNextOfClass:aClass startingIn:anItem
  1680     |startItem firstFound searchNext|
  1681 
  1682     startItem  := model last.
  1683     searchNext := startItem notNil.        
  1684     firstFound := nil.
  1685 
  1686     anItem recursiveDo:[:el|
  1687         el == startItem ifTrue:[
  1688             searchNext := false
  1689         ] ifFalse:[
  1690             el widget class == aClass ifTrue:[
  1691                 searchNext ifFalse:[^ model selectItem:el].
  1692 
  1693                 firstFound isNil ifTrue:[
  1694                     firstFound := el
  1695                 ]
  1696             ]
  1697         ]
  1698     ].
  1699     firstFound notNil ifTrue:[
  1700         self window beep.
  1701         model selectItem:firstFound
  1702     ].
  1703 !
  1704 
  1705 doUnpick
  1706     "release current picked window and contained subwindows"
  1707 
  1708     self setRootItem:nil.
  1709 !
  1710 
  1711 openDocumentation
  1712     HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
  1713 ! !
  1714 
  1715 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
  1716 
  1717 buildFromList:aList onGC:aMenu
  1718     |tabSpec menu w menuPanel|
  1719 
  1720     w := 0.
  1721     aList do:[:el| w := w max:(el widthOn:aMenu) ].
  1722 
  1723     tabSpec := TabulatorSpecification new.
  1724     tabSpec unit:#pixel.
  1725     tabSpec positions:#(0     1.5 ).
  1726     tabSpec align:#(#left #left).
  1727 
  1728     w := w + 15.
  1729     tabSpec positions:(Array with:0 with:w).
  1730 
  1731     menu := Menu new.
  1732 
  1733     aList do:[:el|
  1734         menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
  1735     ].
  1736     menuPanel := MenuPanel menu:menu.
  1737     ^ menuPanel
  1738 ! !
  1739 
  1740 !ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
  1741 
  1742 separator
  1743     ^ self new
  1744 !
  1745 
  1746 title:aTitle value:aValue
  1747     ^ self title:aTitle value:aValue action:nil
  1748 !
  1749 
  1750 title:aTitle value:aValue action:anAction
  1751     ^ self new title:aTitle value:aValue action:anAction
  1752 ! !
  1753 
  1754 !ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
  1755 
  1756 title
  1757     ^ title
  1758 ! !
  1759 
  1760 !ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
  1761 
  1762 asMenuItemWithTabulatorSpecification:aTabSpec
  1763     |array|
  1764 
  1765     title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
  1766 
  1767     array := Array with:(title, ':') with:'------'.
  1768 
  1769     value notNil ifTrue:[
  1770         array at:2 put:(value printString, ' ')
  1771     ].
  1772 
  1773   ^ MenuItem label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
  1774              value:action
  1775 ! !
  1776 
  1777 !ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
  1778 
  1779 title:aTitle value:aValue action:anAction
  1780     "test for separator
  1781     "
  1782     title  := aTitle withoutSeparators.
  1783     action := anAction.
  1784 
  1785     aValue notNil ifTrue:[
  1786         value := aValue printString.
  1787 
  1788         value size > 70 ifTrue:[
  1789             value := value copyFrom:1 to:70.
  1790             value := value, '...'
  1791         ]
  1792     ].
  1793 ! !
  1794 
  1795 !ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
  1796 
  1797 isSeparator
  1798     ^ title isNil
  1799 !
  1800 
  1801 widthOn:aGC
  1802     title isNil ifTrue:[^ 5].  "/ separator
  1803   ^ title widthOn:aGC
  1804 ! !
  1805 
  1806 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'!
  1807 
  1808 buildViewsFrom:aView
  1809     "build the items starting from a source view;
  1810      returns the anhor.
  1811     "
  1812     |item subViews subItems|
  1813 
  1814     aView isNil ifTrue:[^ nil].
  1815 
  1816     item     := self forView:aView.
  1817     subViews := aView subViews.
  1818 
  1819     subViews notEmptyOrNil ifTrue:[
  1820         subItems := OrderedCollection new.
  1821         subViews do:[:aSubView|
  1822             subItems add:(self buildViewsFrom:aSubView).
  1823         ].
  1824         item children:subItems.
  1825     ].
  1826     ^ item
  1827 ! !
  1828 
  1829 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'!
  1830 
  1831 documentation
  1832 "
  1833     ViewTreeItems represants a pickable object within a ViewTreeModel.
  1834     The class is used to build up the hierarchical tree.
  1835 
  1836     [Instance variables:]
  1837         widget        <View>            the widget represented by the item
  1838         spec          <UISpecification> the UISpecification or nil
  1839 
  1840     [Class variables:]
  1841         HandleExtent  <Point>           keeps the extent of a handle
  1842 
  1843 
  1844     [author:]
  1845         Claus Atzkern
  1846 
  1847     [see also:]
  1848         HierarchicalItem
  1849         ViewTreeModel
  1850 "
  1851 !
  1852 
  1853 version
  1854     ^ '$Header$'
  1855 ! !
  1856 
  1857 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
  1858 
  1859 initialize
  1860     "set the extent of the Handle
  1861     "
  1862     HandleExtent := 6@6.
  1863 ! !
  1864 
  1865 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'!
  1866 
  1867 forView:aView
  1868     |item|
  1869 
  1870     item := self basicNew initialize.
  1871     item forView:aView.
  1872   ^ item
  1873 !
  1874 
  1875 new
  1876     self error:'not allowed'.
  1877   ^ nil
  1878 !
  1879 
  1880 on:aView withSpec:aSpec
  1881     |item|
  1882 
  1883     item := self basicNew initialize.
  1884     item on:aView withSpec:aSpec.
  1885   ^ item
  1886 ! !
  1887 
  1888 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'!
  1889 
  1890 applicationClass
  1891     |appl|
  1892 
  1893     widget notNil ifTrue:[
  1894         appl := widget application.
  1895         appl notNil ifTrue:[^ appl class ].
  1896     ].
  1897     ^ nil
  1898 !
  1899 
  1900 isDrawnShown
  1901     "returns true if the last display operations was done during the widget was shown
  1902     "
  1903     ^ isDrawnShown
  1904 !
  1905 
  1906 isDrawnShown:aBoolean
  1907     isDrawnShown := aBoolean.
  1908 !
  1909 
  1910 rootView
  1911     "returns the widget assigned to the root or nil
  1912     "
  1913     ^ parent rootView
  1914 !
  1915 
  1916 specClass
  1917     "returns the spec-class assigned to the item
  1918     "
  1919     ^ widget specClass
  1920 !
  1921 
  1922 treeModel
  1923     "returns the assigned treeModel, an instance of ViewTreeModel
  1924     "
  1925     ^ parent treeModel
  1926 !
  1927 
  1928 widget
  1929     "returns the widget assigned to the item
  1930     "
  1931     ^ widget
  1932 ! !
  1933 
  1934 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'!
  1935 
  1936 boundsRelativeToRoot
  1937     "returns the bounds relative to the root widget
  1938     "
  1939     ^ self originRelativeToRoot extent:(widget extent)
  1940 !
  1941 
  1942 cornerRelativeToRoot
  1943     "returns the corner relative to the root widget
  1944     "
  1945     ^ self originRelativeToRoot + (widget extent)
  1946 !
  1947 
  1948 extent
  1949     "returns the extent of the widget
  1950     "
  1951     ^ widget extent
  1952 !
  1953 
  1954 layoutType
  1955     "returns the type of layout assigned to the wiget; nil if the
  1956      superView cannot resize its sub widgets
  1957     "
  1958     |layout specClass superView|
  1959 
  1960     (superView := widget superView) isNil ifTrue:[
  1961         ^ #Extent
  1962     ].
  1963         
  1964     specClass := superView specClass.
  1965 
  1966     (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
  1967         ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
  1968     ].
  1969 
  1970     (layout := widget geometryLayout) isNil ifTrue:[
  1971         ^ #Extent
  1972     ].
  1973 
  1974     layout isLayout ifTrue:[
  1975         layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].
  1976         layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].
  1977         layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].
  1978     ] ifFalse:[
  1979         layout isRectangle          ifTrue:[ ^ #Rectangle ].
  1980         layout isPoint              ifTrue:[ ^ #Point ].
  1981 
  1982     ].
  1983     Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  1984   ^ nil
  1985 !
  1986 
  1987 originRelativeToRoot
  1988     "returns the origin relative to the root widget
  1989     "
  1990     ^ widget originRelativeTo:(self rootView)
  1991 ! !
  1992 
  1993 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'!
  1994 
  1995 children
  1996     "redefined: optimize
  1997     "
  1998     ^ children
  1999 !
  2000 
  2001 hasChildren
  2002     |subViews list item|
  2003 
  2004     children size ~~ 0 ifTrue:[
  2005         ^ true
  2006     ].
  2007     isExpanded := false.
  2008     subViews   := widget subViews.
  2009 
  2010     subViews size == 0 ifTrue:[^ false].
  2011 
  2012     list := OrderedCollection new.
  2013 
  2014     subViews do:[:aSubView|
  2015         item := self class buildViewsFrom:aSubView.
  2016         item parent:self.
  2017         list add:item.
  2018     ].
  2019     children := list.
  2020     ^ true
  2021 !
  2022 
  2023 size
  2024     "redefined: returns list of children
  2025     "
  2026     ^ children size
  2027 ! !
  2028 
  2029 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'!
  2030 
  2031 additionalLabelForItem:anItem
  2032     "answer an additional item for an Item or nil"
  2033 
  2034     parent notNil ifTrue:[
  2035         ^ parent additionalLabelForItem:anItem
  2036     ].
  2037     ^ nil
  2038 !
  2039 
  2040 displayIcon:anIcon atX:x y:y on:aGC
  2041     |x0 y0 y1 w|
  2042 
  2043     super displayIcon:anIcon atX:x y:y on:aGC.
  2044 
  2045     self exists ifFalse:[
  2046         aGC paint:(Color red).
  2047 
  2048         y0 := y + 1.
  2049         y1 := y + anIcon height - 2.
  2050 
  2051         x0 := x - 1.
  2052         w  := anIcon width.
  2053 
  2054         2 timesRepeat:[
  2055             aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
  2056             aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
  2057             x0 := x0 + 1.
  2058         ].
  2059     ].
  2060 !
  2061 
  2062 displayOn:aGC x:x y:y h:h
  2063     |labelHeight additionalName label isValidAndShown|
  2064 
  2065     label := self label.
  2066     label isEmptyOrNil ifTrue:[^ self].
  2067 
  2068     widget id isNil ifTrue:[
  2069         isDrawnShown := false.
  2070 
  2071         self exists ifFalse:[
  2072             xOffsetAdditionalName := nil.
  2073         ].
  2074         isValidAndShown := false.
  2075     ] ifFalse:[
  2076         isValidAndShown := widget shown.
  2077     ].
  2078     isValidAndShown ifFalse:[
  2079         label := Text string:label emphasis:#italic
  2080     ].
  2081 
  2082     labelHeight := self heightOn:aGC.
  2083     self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
  2084 
  2085     xOffsetAdditionalName notNil ifTrue:[
  2086         additionalName := self additionalLabelForItem:self.
  2087 
  2088         additionalName notNil ifTrue:[
  2089             self displayLabel:additionalName
  2090                             h:labelHeight on:aGC
  2091                             x:(x + xOffsetAdditionalName)
  2092                             y:y
  2093                             h:h.
  2094         ] ifFalse:[
  2095             xOffsetAdditionalName := nil.
  2096         ].
  2097     ].
  2098 !
  2099 
  2100 recursiveAdditionalNameBehaviourChanged
  2101     width := xOffsetAdditionalName := nil.
  2102 
  2103     children notNil ifTrue:[
  2104         children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
  2105     ].
  2106 !
  2107 
  2108 widthOn:aGC
  2109     "return the width of the receiver, if it is to be displayed on aGC
  2110     "
  2111     |additionalName|
  2112 
  2113     width isNil ifTrue:[
  2114         width := self widthOf:(self label) on:aGC.
  2115         width := width + 2.
  2116 
  2117         additionalName := self additionalLabelForItem:self.
  2118 
  2119         additionalName notNil ifTrue:[
  2120             xOffsetAdditionalName := width + 10.
  2121             width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
  2122             width := width + 2.
  2123         ] ifFalse:[
  2124             xOffsetAdditionalName := nil.
  2125         ].
  2126     ].
  2127     ^ width
  2128 ! !
  2129 
  2130 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'!
  2131 
  2132 handlesDo:aTwoArgAction
  2133     "evaluate the two arg block on each handle; the arguments to the block is
  2134      the rectangle relative to the rootView and the handle type which is
  2135      set to nil if not resizeable.
  2136 
  2137      TYPES:     type    position( X - Y )
  2138                 -------------------------        
  2139                 #LT     Left   - Top
  2140                 #LC     Left   - Center
  2141                 #LB     Left   - Bottom
  2142                 #CT     Center - Top
  2143                 #CB     Center - Bottom
  2144                 #RT     Right  - Top
  2145                 #RC     Right  - Center
  2146                 #RB     Right  - Bottom
  2147 
  2148                 nil     ** handle not pickable **
  2149     "
  2150     |type relOrg relCrn maxExt rootView w h
  2151      xL    "{ Class:SmallInteger }"
  2152      xC    "{ Class:SmallInteger }"
  2153      xR    "{ Class:SmallInteger }"
  2154      yT    "{ Class:SmallInteger }"
  2155      yC    "{ Class:SmallInteger }"
  2156      yB    "{ Class:SmallInteger }"
  2157     |
  2158     rootView := self rootView.
  2159     relOrg   := widget originRelativeTo:rootView.
  2160     relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
  2161 
  2162     relOrg   := relOrg - (HandleExtent // 2).
  2163     relCrn   := relOrg + widget extent.
  2164     maxExt   := rootView extent - HandleExtent.
  2165 
  2166     xL := relOrg x max:0.
  2167     xR := relCrn x min:(maxExt x).
  2168     xC := xR + xL // 2.
  2169 
  2170     yT := relOrg y max:0.
  2171     yB := relCrn y min:(maxExt y).
  2172     yC := yB + yT // 2.
  2173 
  2174     type := self layoutType.
  2175     w   := HandleExtent x.
  2176     h   := HandleExtent y.
  2177 
  2178     (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
  2179         aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
  2180         aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
  2181         aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
  2182         aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
  2183         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2184         aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
  2185         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2186         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2187       ^ self
  2188     ].
  2189 
  2190     aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
  2191     aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
  2192     aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
  2193 
  2194     type == #Extent ifTrue:[
  2195         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2196         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2197         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2198       ^ self
  2199     ].
  2200     aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
  2201 !
  2202 
  2203 recursiveEachVisibleItemDo:anOneArgBlock
  2204     "recursive evaluate the block on each child which is visible
  2205     "
  2206     (isExpanded and:[children size > 0]) ifTrue:[
  2207         children do:[:aChild|
  2208             anOneArgBlock value:aChild.
  2209             aChild recursiveEachVisibleItemDo:anOneArgBlock.
  2210         ]
  2211     ].
  2212 !
  2213 
  2214 subViewsDo:aOneArgBlock
  2215     "evaluate aBlock for all subviews other than InputView's   
  2216     "
  2217     |subViews|
  2218 
  2219     subViews := widget subViews.
  2220 
  2221     subViews notNil ifTrue:[
  2222         subViews do:aOneArgBlock
  2223     ].
  2224 ! !
  2225 
  2226 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
  2227 
  2228 forView:aView
  2229     widget := aView.
  2230 !
  2231 
  2232 initialize
  2233     "setup default attributes
  2234     "
  2235     super initialize.
  2236     isDrawnShown := false.
  2237     isExpanded   := false.
  2238     children     := OrderedCollection new.
  2239 ! !
  2240 
  2241 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
  2242 
  2243 delete
  2244     "delete self and all contained items; the assigned views are destroyed
  2245      in case of rootView, only the children are deleted
  2246     "
  2247     parent isHierarchicalItem ifTrue:[
  2248         self criticalDo:[
  2249             parent remove:self.
  2250             widget destroy.
  2251         ]
  2252     ] ifFalse:[
  2253         self deleteAll
  2254     ].
  2255 !
  2256 
  2257 deleteAll
  2258     "delete all contained items; the assigned views are destroyed
  2259     "
  2260     children size == 0 ifTrue:[^ self].
  2261 
  2262     self criticalDo:[
  2263         self nonCriticalDo:[:el| el widget destroy ].
  2264         self removeAll
  2265     ].
  2266 ! !
  2267 
  2268 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
  2269 
  2270 asLayoutFrame
  2271     "convert the layout of the widget to a LayoutFrame;
  2272     "
  2273     |extent layout newLyt lftFrc lftOff topFrc topOff|
  2274 
  2275     layout := widget geometryLayout.
  2276 
  2277     layout isNil ifTrue:[
  2278         ^ widget bounds asLayout
  2279     ].
  2280 
  2281     layout isLayout ifFalse:[
  2282         layout isRectangle ifTrue:[
  2283             ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
  2284                            topOffset:(layout top) bottomOffset:(layout bottom)
  2285         ].
  2286         layout isPoint ifTrue:[
  2287             extent := widget extent.
  2288           ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
  2289                          topOffset:(layout y) bottomOffset:(layout y + extent y)
  2290         ].
  2291 
  2292         Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2293       ^ nil
  2294     ].
  2295 
  2296     layout isLayoutFrame ifTrue:[ ^ layout copy ].    
  2297 
  2298     lftFrc := layout leftFraction.
  2299     lftOff := layout leftOffset.
  2300     topFrc := layout topFraction.
  2301     topOff := layout topOffset.
  2302     extent := widget extent.
  2303 
  2304     newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
  2305                          rightFraction:lftFrc offset:(lftOff + extent x)
  2306                            topFraction:topFrc offset:topOff
  2307                         bottomFraction:topFrc offset:(topOff + extent y).
  2308 
  2309     (      layout isAlignmentOrigin
  2310      and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
  2311     ) ifTrue:[
  2312         |svRc prBd dlta|
  2313 
  2314         svRc := widget superView viewRectangle.
  2315         prBd := widget preferredBounds.
  2316 
  2317         dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
  2318                  - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
  2319                 ) rounded.
  2320 
  2321         newLyt   leftOffset:(lftOff + dlta x).
  2322         newLyt  rightOffset:(lftOff + extent x + dlta x).
  2323         newLyt    topOffset:(topOff + dlta y).
  2324         newLyt bottomOffset:(topOff + extent y + dlta y).
  2325     ].
  2326     ^ newLyt
  2327 !
  2328 
  2329 moveLeft:l top:t
  2330     "move the widget n pixele left and right
  2331     "
  2332     |layout|
  2333 
  2334     self isMoveable ifFalse:[ ^ self ].
  2335 
  2336     (layout := widget geometryLayout) isNil ifTrue:[
  2337         "Extent"
  2338         widget origin:(widget origin + (l@t)).
  2339       ^ self
  2340     ].
  2341 
  2342     layout := layout copy.
  2343 
  2344     layout isLayout ifTrue:[
  2345         layout leftOffset:(layout leftOffset + l)
  2346                 topOffset:(layout topOffset  + t).
  2347 
  2348         layout isLayoutFrame ifTrue:[
  2349             layout  rightOffset:(layout rightOffset  + l).
  2350             layout bottomOffset:(layout bottomOffset + t).
  2351         ]
  2352 
  2353     ] ifFalse:[
  2354         layout isRectangle ifTrue:[
  2355             layout setLeft:(layout left + l).
  2356             layout  setTop:(layout top  + t).
  2357         ] ifFalse:[
  2358             layout isPoint ifFalse:[^ self].
  2359             layout x:(layout x + l) y:(layout y + t).
  2360         ]
  2361     ].
  2362     widget geometryLayout:layout.
  2363 !
  2364 
  2365 resizeLeft:l top:t right:r bottom:b
  2366     "resize the widget measured in pixels
  2367     "
  2368     |layout|
  2369 
  2370     self isResizeable ifFalse:[
  2371         ^ self
  2372     ].
  2373 
  2374     (layout := widget geometryLayout) isNil ifTrue:[
  2375         "Extent"
  2376         (r == l and:[b == t]) ifFalse:[
  2377             widget extent:(widget computeExtent + ((r-l) @ (b-t))).
  2378         ].
  2379         ^ self
  2380     ].
  2381 
  2382     layout isLayout ifTrue:[
  2383         layout := layout copy.
  2384 
  2385         layout leftOffset:(layout leftOffset + l)
  2386                 topOffset:(layout topOffset  + t).
  2387 
  2388         layout isLayoutFrame ifTrue:[
  2389             layout bottomOffset:(layout bottomOffset + b).
  2390             layout  rightOffset:(layout rightOffset  + r).
  2391         ]
  2392     ] ifFalse:[
  2393         layout isRectangle ifFalse:[^ self].
  2394         layout := layout copy.
  2395 
  2396         layout left:(layout left   + l)
  2397               right:(layout right  + r)
  2398                 top:(layout top    + t)
  2399              bottom:(layout bottom + b).
  2400     ].
  2401     widget geometryLayout:layout.
  2402 ! !
  2403 
  2404 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
  2405 
  2406 updateChildren
  2407     |list|
  2408 
  2409     self do:[:el|
  2410         el exists ifTrue:[
  2411             el updateChildren.
  2412         ] ifFalse:[
  2413             list isNil ifTrue:[list := OrderedCollection new].
  2414             list add:el.
  2415         ]
  2416     ].
  2417     list notNil ifTrue:[
  2418         list do:[:el| self remove:el ].
  2419     ].
  2420 !
  2421 
  2422 updateFromChildren:mergedList
  2423     "update my children against the list of items derived from
  2424      the merged list.
  2425     "
  2426 
  2427     mergedList size == 0 ifTrue:[ ^ self removeAll ].
  2428     children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
  2429 
  2430     self criticalDo:[
  2431         self nonCriticalDo:[:el| |wdg|
  2432             wdg := el widget.
  2433             mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
  2434         ].
  2435 
  2436         mergedList keysAndValuesDo:[:i :el| |wdg e2|
  2437             wdg := el widget.
  2438 
  2439             e2  := self at:i ifAbsent:nil.
  2440 
  2441             (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
  2442                 self add:el beforeIndex:i
  2443             ]
  2444         ]
  2445     ].
  2446 ! !
  2447 
  2448 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
  2449 
  2450 icon
  2451     "get the icon used for presentation
  2452     "
  2453     |specClass model|
  2454 
  2455     specClass := self specClass.
  2456     specClass isNil ifTrue:[^ nil].
  2457 
  2458     model := self treeModel.
  2459 
  2460     model notNil ifTrue:[
  2461         ^ model iconAt:specClass ifNonePut:[specClass icon]
  2462     ].
  2463     ^ specClass icon
  2464 !
  2465 
  2466 label
  2467     "get the label used for presentation
  2468     "
  2469     ^ self string
  2470 !
  2471 
  2472 printOn:aStream
  2473     "append a a printed representation of the item to aStream
  2474     "
  2475     aStream nextPutAll:(self string)
  2476 !
  2477 
  2478 string
  2479     "get the string
  2480     "
  2481     ^ widget class name.
  2482 ! !
  2483 
  2484 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
  2485 
  2486 canChangeLayout
  2487     "returns true if the layout of the widget can be changed and the
  2488      layout is not organized by its superView
  2489     "
  2490     ^ self isResizeable
  2491 !
  2492 
  2493 canResizeSubComponents
  2494     "returns true if the widget can resize its sub components
  2495     "
  2496     |specClass|
  2497 
  2498     specClass := self specClass.
  2499 
  2500     specClass notNil ifTrue:[
  2501         ^ specClass canResizeSubComponents
  2502     ].
  2503     ^ false
  2504 !
  2505 
  2506 exists
  2507     widget id notNil ifTrue:[^ true ].
  2508 
  2509     exists ~~ false ifTrue:[
  2510         exists := false.
  2511 
  2512         widget superView notNil ifTrue:[
  2513             (parent isHierarchicalItem and:[parent exists]) ifTrue:[
  2514                 exists := (parent widget subViews includesIdentical:widget).
  2515             ].
  2516         ].
  2517     ].
  2518     ^ exists
  2519 !
  2520 
  2521 isApplicationClass
  2522     |cls|
  2523 
  2524     cls := widget class.
  2525 
  2526     ^ (    cls == ApplicationSubView
  2527         or:[cls == ApplicationWindow
  2528         or:[cls == SubCanvas]]
  2529       ) 
  2530 !
  2531 
  2532 isSelected
  2533     |model|
  2534 
  2535     model := self treeModel.
  2536     model notNil ifTrue:[^ model isSelected:self].
  2537     ^ false
  2538 !
  2539 
  2540 supportsSubComponents
  2541     "returns true if the widget supports sub components
  2542     "
  2543     |specClass|
  2544 
  2545     widget isScrollWrapper ifTrue:[
  2546         ^ false
  2547     ].
  2548     specClass := self specClass.
  2549 
  2550     specClass notNil ifTrue:[
  2551         ^ specClass supportsSubComponents
  2552     ].
  2553     ^ false
  2554 ! !
  2555 
  2556 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
  2557 
  2558 isInLayoutContainer
  2559     "returns true if the widget is in a layout container
  2560     "
  2561     |sv specClass|
  2562 
  2563     sv := widget superView.
  2564 
  2565     sv notNil ifTrue:[
  2566         specClass := sv specClass.
  2567 
  2568         specClass notNil ifTrue:[
  2569             ^ specClass isLayoutContainer
  2570         ].
  2571     ].
  2572     ^ false
  2573 !
  2574 
  2575 isLayoutContainer
  2576     "answer whether corresponding view instances of the spec class can contain
  2577      (and arrange) other view
  2578     "
  2579     |specClass|
  2580 
  2581     specClass := self specClass.
  2582 
  2583     specClass notNil ifTrue:[
  2584         ^ specClass isLayoutContainer
  2585     ].
  2586     ^ false
  2587 !
  2588 
  2589 isMoveable
  2590     "returns true if the widget is not in a layout container
  2591     "
  2592     self isInLayoutContainer ifFalse:[
  2593         ^ widget superView notNil
  2594     ].
  2595     ^ false
  2596 !
  2597 
  2598 isResizeable
  2599     "returns true if the widget is resizeable
  2600     "
  2601     |sv specClass|
  2602 
  2603     sv := widget superView.
  2604 
  2605     sv notNil ifTrue:[
  2606         specClass := sv specClass.
  2607 
  2608         specClass notNil ifTrue:[
  2609             ^ specClass canResizeSubComponents
  2610         ].
  2611     ].
  2612     ^ false
  2613 ! !
  2614 
  2615 !ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
  2616 
  2617 documentation
  2618 "
  2619     Instances of ViewTreeModel can be used as model on a View and all
  2620     it contained subviews for a HierarchicalListView.
  2621     The model keeps two values, the hierarchical representation of the views
  2622     and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
  2623     It shows the selected items highlighted.
  2624 
  2625 
  2626     [Instance variables:]
  2627         lockSema            <Semaphore>         lock selection notifications and redraws
  2628 
  2629         testModeChannel     <ValueHolder>       true, than running in test mode.
  2630 
  2631         hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
  2632 
  2633         selection           <Sequence or nil>   selected items or nil
  2634 
  2635         hiddenLevel         <Integer>           internal use; redrawing the selection
  2636                                                 only is done if the counter is 0.
  2637 
  2638         listOfItems         <HierarchicalList>  hiearchical list build from existing items.
  2639 
  2640         selectedSuperItems  <Sequence>          list of selected super items; items selected
  2641                                                 but not contained in another selected item.
  2642 
  2643         inputEventAction    <Action>            called for each InputEvent
  2644 
  2645         mappedViewAction    <Action>            called for a new mapped view which
  2646                                                 can not be found in the current item list.
  2647 
  2648         beforeSelectionChangedAction <Action>   called before the selection changed
  2649 
  2650     [author:]
  2651         Claus Atzkern
  2652 
  2653     [see also:]
  2654         ViewTreeItem
  2655 "
  2656 !
  2657 
  2658 examples
  2659 "
  2660     example 1: pick any window and show views and contained views
  2661                                                                                 [exBegin]
  2662     |top sel model panel|
  2663 
  2664     model := ViewTreeModel new.
  2665     top   := StandardSystemView new; extent:440@400.
  2666     sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
  2667     sel bottomInset:24.
  2668 
  2669     panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
  2670     panel topInset:-24.
  2671     panel horizontalLayout:#fitSpace.
  2672 
  2673     Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
  2674     Button label:'Pick Views' action:[  |win|
  2675                                         (     (win := Screen current viewFromUser) notNil
  2676                                          and:[(win := win topView) ~~ Screen current rootView
  2677                                          and:[win ~~ top]]
  2678                                         ) ifTrue:[
  2679                                             model rootItem:(ViewTreeItem buildViewsFrom:win)
  2680                                         ] ifFalse:[
  2681                                             model rootItem:nil
  2682                                         ]
  2683                                      ] in:panel.
  2684 
  2685     sel  multipleSelectOk:true.
  2686     sel              list:model listOfItems.
  2687     sel             model:model.
  2688     sel          useIndex:false.
  2689 
  2690     sel doubleClickAction:[:i| |el|
  2691         el := model listOfItems at:i.
  2692         el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
  2693     ].
  2694     sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
  2695 
  2696     model inputEventAction:[:anEvent| |item|
  2697         anEvent isButtonEvent ifTrue:[
  2698             anEvent isButtonPressEvent ifTrue:[
  2699                 model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
  2700             ] ifFalse:[
  2701                 anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
  2702                     (item := model selectedItem) notNil ifTrue:[item widget inspect]
  2703                 ]
  2704             ]
  2705         ]
  2706     ].
  2707 
  2708     top openAndWait.
  2709     [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
  2710 
  2711                                                                                 [exEnd]
  2712 "
  2713 ! !
  2714 
  2715 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
  2716 
  2717 application:anApplication
  2718     listOfItems application:anApplication.
  2719 !
  2720 
  2721 rootItem
  2722     "get the rootItem the event viewer is established on
  2723     "
  2724     ^ listOfItems root
  2725 !
  2726 
  2727 rootItem:anItem
  2728     "set the rootItem the event viewer is established on
  2729     "
  2730     |expanded|
  2731 
  2732     timedUpdateTask := nil.
  2733     self deselect.
  2734 
  2735     lockSema critical:[
  2736         anItem notNil ifTrue:[ expanded := anItem isExpanded ]
  2737                      ifFalse:[ expanded := false ].
  2738 
  2739         self value:nil.
  2740         listOfItems root:anItem.
  2741 
  2742         anItem notNil ifTrue:[
  2743             timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
  2744             timedUpdateTask name:'Update'.
  2745             timedUpdateTask resume.
  2746         ].
  2747     ].
  2748 
  2749     (expanded and:[anItem notNil]) ifTrue:[
  2750         anItem expand
  2751     ].
  2752     ^ anItem
  2753 !
  2754 
  2755 rootView
  2756     "get the top widget the event viewer is established on, a View
  2757     "
  2758     ^ listOfItems rootView
  2759 ! !
  2760 
  2761 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
  2762 
  2763 beforeSelectionChangedAction
  2764     "none argument action which is called before
  2765      the selection changed
  2766     "
  2767     ^ beforeSelectionChangedAction
  2768 !
  2769 
  2770 beforeSelectionChangedAction:aNoneArgBlock
  2771     "none argument action which is called before
  2772      the selection changed
  2773     "
  2774     beforeSelectionChangedAction := aNoneArgBlock.
  2775 !
  2776 
  2777 inputEventAction
  2778     "called for each input event; the argument to the action is the WindowEvent
  2779     "
  2780     ^ inputEventAction
  2781 !
  2782 
  2783 inputEventAction:aOneArgActionTheEvent
  2784     "called for each input event; the argument to the action is the WindowEvent
  2785     "
  2786     inputEventAction := aOneArgActionTheEvent.
  2787 !
  2788 
  2789 mappedViewAction
  2790     "called for a new mapped view which can not be found
  2791      in the current item list
  2792     "
  2793     ^ mappedViewAction
  2794 !
  2795 
  2796 mappedViewAction:aOneArgBlockTheMappedView
  2797     "called for a new mapped view which can not be found
  2798      in the current item list
  2799     "
  2800     mappedViewAction := aOneArgBlockTheMappedView
  2801 ! !
  2802 
  2803 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
  2804 
  2805 iconAt:aKey ifNonePut:aNoneArgBlock
  2806     |icon view|
  2807 
  2808     icon := icons at:aKey ifAbsent:nil.
  2809     icon notNil ifTrue:[^ icon].
  2810 
  2811     icon := aNoneArgBlock value.
  2812     icon isNil ifTrue:[^ nil].
  2813 
  2814     view := self rootView.
  2815     view isNil ifTrue:[^ icon].
  2816 
  2817     icon := icon copy onDevice:(view device).
  2818     icon isImage ifTrue:[
  2819         icon clearMaskedPixels.
  2820     ].
  2821     icons at:aKey put:icon.
  2822     ^ icon
  2823 ! !
  2824 
  2825 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'!
  2826 
  2827 signalHiddenLevel
  2828     "show the selection if signaled; increments hiddenLevel
  2829      see: #waitHiddenLevel
  2830     "
  2831     (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
  2832         hiddenLevel := 0.
  2833         self invalidateSelection.
  2834     ].
  2835 !
  2836 
  2837 waitHiddenLevel
  2838     "hide the selection until signaled; increments hiddenLevel
  2839      see: #signalHiddenLevel
  2840     "
  2841     self redrawUnselected:selection andLock:true
  2842 !
  2843 
  2844 withSelectionHiddenDo:aNoneArgumentBlock
  2845     "apply block with selection hidden
  2846     "
  2847 
  2848     [   self waitHiddenLevel.
  2849 
  2850         aNoneArgumentBlock value
  2851 
  2852     ] valueNowOrOnUnwindDo:[
  2853         self signalHiddenLevel.
  2854     ].
  2855 ! !
  2856 
  2857 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'!
  2858 
  2859 hasTargetWidgetChannel
  2860     "answer the channel which is set to true if a target widget exists"
  2861 
  2862     ^ hasTargetWidgetChannel
  2863 !
  2864 
  2865 listOfItems
  2866     "hiearchical list build from existing items"
  2867 
  2868     ^ listOfItems
  2869 !
  2870 
  2871 selectOnClickHolder
  2872     "boolean holder, which indicates whether the selection will change on click
  2873     "
  2874     ^ selectOnClickHolder
  2875 !
  2876 
  2877 testModeChannel
  2878     "answer a boolean channel which describes the behaviour how to process
  2879      events on the target view.
  2880 
  2881      false: all input events are eaten and the selection is shown on the target view.
  2882      true:  no  input events are eaten and no  selection is shown on the target view."
  2883 
  2884     ^ testModeChannel
  2885 ! !
  2886 
  2887 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'!
  2888 
  2889 targetWidgetChanged
  2890     hasTargetWidgetChannel value:(self rootItem notNil).
  2891 !
  2892 
  2893 timedUpdateTaskCycle
  2894     |view myTaskId|
  2895 
  2896     myTaskId := timedUpdateTask.
  2897 
  2898     listOfItems root notNil ifTrue:[
  2899         view := listOfItems root widget.
  2900     ].
  2901 
  2902     [ view notNil ] whileTrue:[
  2903         Delay waitForSeconds:0.5.
  2904         
  2905         (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
  2906             view := nil.
  2907         ] ifTrue:[
  2908             (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
  2909                 view sensor pushUserEvent:#updateChildren for:self.
  2910             ].
  2911         ].
  2912     ].
  2913     timedUpdateTask == myTaskId ifTrue:[
  2914         timedUpdateTask := nil.
  2915         listOfItems root:nil.
  2916     ].
  2917 !
  2918 
  2919 update:something with:someArgument from:aModel
  2920 
  2921     aModel == testModeChannel ifTrue:[
  2922         (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
  2923             testModeChannel value ifTrue:[
  2924                 self redrawUnselected:selection andLock:false checkTestMode:false.
  2925             ] ifFalse:[
  2926                 self invalidateSelection.
  2927             ].
  2928         ].
  2929         ^ self
  2930     ].
  2931     super update:something with:someArgument from:aModel.
  2932 !
  2933 
  2934 updateChildren
  2935     |rootItem|
  2936 
  2937     rootItem := listOfItems root.
  2938     rootItem isNil ifTrue:[^ self].
  2939 
  2940     rootItem exists ifFalse:[
  2941         listOfItems root:nil.
  2942     ] ifTrue:[
  2943         rootItem updateChildren.
  2944     ].
  2945 ! !
  2946 
  2947 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'!
  2948 
  2949 processEvent:anEvent
  2950     "catch and process all WindowEvents for the rootComponent and its contained
  2951      widgets; redraw selection in case of damage...
  2952      return true, if the event was eaten"
  2953 
  2954     |evView item rootView testMode|
  2955 
  2956     evView := anEvent view.
  2957     evView isNil ifTrue:[
  2958         (anEvent isMessageSendEvent not or:[anEvent receiver ~~ self]) ifTrue:[
  2959             ^ false
  2960         ].
  2961         anEvent value.
  2962         ^ true.
  2963     ].
  2964     rootView := listOfItems rootView.
  2965     rootView isNil ifTrue:[ ^ false ].
  2966 
  2967     anEvent isConfigureEvent ifTrue:[
  2968         hiddenLevel == 0 ifTrue:[
  2969             self redrawUnselected:selection andLock:false.
  2970         ].
  2971         ^ false
  2972     ].
  2973 
  2974     "/ check whether view is contained within the rootView
  2975     (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
  2976         ^ false
  2977     ].
  2978 
  2979     anEvent isInputEvent ifFalse:[
  2980         anEvent isDamage ifTrue:[
  2981             hiddenLevel == 0 ifTrue:[self invalidateSelection].
  2982             ^ false
  2983         ].
  2984 
  2985         anEvent isMapEvent ifTrue:[
  2986             mappedViewAction notNil ifTrue:[
  2987                 item := listOfItems recursiveDetect:[:el| el widget == evView].
  2988                 item isNil ifTrue:[ mappedViewAction value:evView ]
  2989             ].
  2990             ^ false
  2991         ].
  2992 
  2993         anEvent type == #terminate ifTrue:[
  2994             item := listOfItems recursiveDetect:[:el| el widget == evView].
  2995             item notNil ifTrue:[ self processTerminateForItem:item ].
  2996             ^ false
  2997         ].
  2998         ^ false
  2999     ].
  3000     testMode := testModeChannel value.
  3001 
  3002     anEvent isFocusEvent ifTrue:[
  3003         evView == rootView ifTrue:[
  3004             self invalidateSelection
  3005         ].
  3006         ^ testMode not.
  3007     ].
  3008     anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
  3009 
  3010     testMode ifFalse:[
  3011         inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
  3012     ] ifTrue:[
  3013         anEvent isButtonPressEvent ifTrue:[
  3014             selectOnClickHolder value ifTrue:[
  3015                 self selectItem:(listOfItems detectItemRespondsToView:evView).
  3016             ].
  3017         ]
  3018     ].
  3019 
  3020     (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
  3021         hiddenLevel := 1.
  3022         self signalHiddenLevel.
  3023     ].
  3024 
  3025     ^ testMode not
  3026 !
  3027 
  3028 processTerminateForItem:anItem
  3029     "received terminate for an item
  3030     "
  3031     anItem remove.
  3032 ! !
  3033 
  3034 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'!
  3035 
  3036 initialize
  3037     "setup the default attributes
  3038     "
  3039     super initialize.
  3040 
  3041     hiddenLevel           := 0.
  3042     lockSema              := RecursionLock new.
  3043     listOfItems           := ItemList new on:self.
  3044     selectedSuperItems    := #().
  3045     icons                 := IdentityDictionary new.
  3046 
  3047     hasTargetWidgetChannel := false asValue.
  3048     selectOnClickHolder    := true asValue.
  3049 
  3050     testModeChannel := false asValue.
  3051     testModeChannel addDependent:self.
  3052 ! !
  3053 
  3054 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'!
  3055 
  3056 invalidateSelection
  3057     "invalidate the current selection
  3058     "
  3059     |topView|
  3060 
  3061     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3062 
  3063     (     hiddenLevel == 0
  3064      and:[selection notNil
  3065      and:[(topView := listOfItems rootView) notNil
  3066      and:[topView shown]]]
  3067     ) ifTrue:[
  3068         topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
  3069     ]
  3070 !
  3071 
  3072 recursiveRepair:theDamages startIn:aView relativeTo:aRootView
  3073     "repair all views and contained views, which intersects the damage.
  3074      !!!! all damages repaired are removed from the list of damages !!!!
  3075     "
  3076     |color relOrg damage subViews repaired
  3077      bwWidth    "{ Class:SmallInteger }"
  3078      x          "{ Class:SmallInteger }"
  3079      y          "{ Class:SmallInteger }"
  3080      w          "{ Class:SmallInteger }"
  3081      h          "{ Class:SmallInteger }"
  3082      relOrgX    "{ Class:SmallInteger }"
  3083      relOrgY    "{ Class:SmallInteger }"
  3084      width      "{ Class:SmallInteger }"
  3085      height     "{ Class:SmallInteger }"
  3086      size       "{ Class:SmallInteger }"
  3087     |
  3088     (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
  3089 
  3090     subViews := aView subViews.
  3091 
  3092     subViews size ~~ 0 ifTrue:[
  3093         subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
  3094         theDamages isEmpty ifTrue:[ ^ self ].
  3095     ].
  3096 
  3097     relOrg  := aView originRelativeTo:aRootView.
  3098     bwWidth := aView borderWidth.
  3099     size    := theDamages size.
  3100 
  3101     "/ compute relative origin starting from border left@top
  3102     relOrgX := relOrg x - bwWidth.
  3103     relOrgY := relOrg y - bwWidth.
  3104     width   := aView width  + bwWidth + bwWidth.
  3105     height  := aView height + bwWidth + bwWidth.
  3106 
  3107     size to:1 by:-1 do:[:anIndex|
  3108         repaired := damage := theDamages at:anIndex.
  3109 
  3110         "/ compute the rectangle into the view
  3111         y := damage top  - relOrgY.
  3112         x := damage left - relOrgX.
  3113         w := damage width.
  3114         h := damage height.
  3115 
  3116         x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
  3117         y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
  3118         x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
  3119         y + h > height ifTrue:[ h := height - y.    repaired := nil ].
  3120 
  3121         (w > 0 and:[h > 0]) ifTrue:[
  3122             bwWidth ~~ 0 ifTrue:[
  3123                 color isNil ifTrue:[
  3124                     "/ must force redraw of border
  3125                     color := aView borderColor.
  3126                     aView borderColor:(Color colorId:1).
  3127                     aView borderColor:color.
  3128                 ].
  3129                 w := w - bwWidth.
  3130                 h := h - bwWidth.
  3131 
  3132                 (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
  3133                 (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
  3134 
  3135                 h > 0 ifFalse:[w := 0].         "/ later testing on width only
  3136             ].
  3137 
  3138             w > 0 ifTrue:[
  3139                 aView clearRectangleX:x y:y width:w height:h.
  3140                 aView exposeX:x y:y width:w height:h
  3141             ].
  3142             repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
  3143         ]
  3144     ].
  3145 !
  3146 
  3147 redrawSelection
  3148     "redraw all items selected
  3149     "
  3150     |topView size|
  3151 
  3152     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3153 
  3154     (     hiddenLevel == 0
  3155      and:[(size := selection size) > 0
  3156      and:[(topView := listOfItems rootView) notNil
  3157      and:[topView shown
  3158      and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
  3159     ) ifFalse:[
  3160         ^ self
  3161     ].
  3162 
  3163     lockSema critical:[
  3164         |list|
  3165 
  3166         list := selection.
  3167 
  3168         list size > 0 ifTrue:[
  3169             topView paint:(Color black).
  3170             topView clippedByChildren:false.
  3171 
  3172             list keysAndValuesReverseDo:[:anIndex :anItem|
  3173                 (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
  3174 
  3175                 anItem handlesDo:[:aRect :what|
  3176                     what isNil ifTrue:[topView displayRectangle:aRect]
  3177                               ifFalse:[topView    fillRectangle:aRect]
  3178                 ]
  3179             ].
  3180             topView clippedByChildren:true.
  3181         ].
  3182     ].
  3183 !
  3184 
  3185 redrawUnselected:aList andLock:doLock
  3186     "redraw all items unselected; if doLock is true, the hiddenLevel
  3187      is incremented and thus the select mechanism is locked.
  3188     "
  3189     self redrawUnselected:aList andLock:doLock checkTestMode:true.
  3190 !
  3191 
  3192 redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
  3193     "redraw all items unselected; if doLock is true, the hiddenLevel
  3194      is incremented and thus the select mechanism is locked.
  3195     "
  3196     |rootView damages subViews x y w h|
  3197 
  3198     doLock ifTrue:[
  3199         hiddenLevel := hiddenLevel + 1.
  3200         hiddenLevel ~~ 1 ifTrue:[^ self].
  3201     ] ifFalse:[
  3202         hiddenLevel ~~ 0 ifTrue:[^ self].
  3203     ].
  3204     checkTestMode ifTrue:[
  3205         testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3206     ].
  3207 
  3208     (     aList size ~~ 0
  3209      and:[(rootView := listOfItems rootView) notNil
  3210      and:[rootView shown]]
  3211     ) ifFalse:[
  3212         ^ self
  3213     ].
  3214 
  3215     lockSema critical:[
  3216         damages := OrderedCollection new:(8 * aList size).
  3217 
  3218         aList do:[:item|
  3219             item handlesDo:[:handle :what|
  3220                 damages reverseDo:[:el|
  3221                     (el intersects:handle) ifTrue:[
  3222                         damages removeIdentical:el.
  3223 
  3224                         handle left:(handle left   min:el left)
  3225                               right:(handle right  max:el right)
  3226                                 top:(handle top    min:el top)
  3227                              bottom:(handle bottom max:el bottom)
  3228                     ]
  3229                 ].                        
  3230                 damages add:handle
  3231             ]
  3232         ].
  3233 
  3234         damages do:[:el|
  3235             x := el left.
  3236             y := el top.
  3237             w := el width.
  3238             h := el height.
  3239 
  3240             rootView clearRectangleX:x y:y width:w height:h.
  3241             rootView         exposeX:x y:y width:w height:h.
  3242         ].
  3243 
  3244         (subViews := rootView subViews) notNil ifTrue:[
  3245             subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
  3246         ].
  3247     ].
  3248 ! !
  3249 
  3250 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'!
  3251 
  3252 isInTestMode
  3253     "answer false, all input events are eaten and the selection is shown on the target view.
  3254      answer true,  no  input events are eaten and no  selection is shown on the target view."
  3255 
  3256     ^ testModeChannel value
  3257 ! !
  3258 
  3259 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'!
  3260 
  3261 at:anIndex
  3262     "returns the selected item at an index or nil
  3263     "
  3264     selection notNil ifTrue:[
  3265         ^ selection at:anIndex ifAbsent:nil
  3266     ].
  3267     ^ nil
  3268 !
  3269 
  3270 at:anIndex ifAbsent:aBlock
  3271     "returns the selected item at an index or the result of the block
  3272     "
  3273     selection notNil ifTrue:[
  3274         ^ selection at:anIndex ifAbsent:aBlock
  3275     ].
  3276     ^ aBlock value
  3277 !
  3278 
  3279 first
  3280     "returns the first selected item or nil
  3281     "
  3282     ^ self at:1
  3283 !
  3284 
  3285 last
  3286     "returns the last selected item or nil
  3287     "
  3288     ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
  3289 !
  3290 
  3291 selectedItem
  3292     "returns the single selected item or nil (size ~~ 1 nil is returned)
  3293     "
  3294     ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
  3295 !
  3296 
  3297 selectedSuperItems
  3298     "returs the list of selected superItems; items selected
  3299      but not contained in another selected item.
  3300     "
  3301     ^ selectedSuperItems
  3302 !
  3303 
  3304 size
  3305     "returns the number of items selected
  3306     "
  3307     ^ selection size
  3308 ! !
  3309 
  3310 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'!
  3311 
  3312 add:item
  3313     "add an item to the current selection
  3314     "
  3315     |newSelect|
  3316 
  3317     item isNil ifTrue:[^ item].
  3318 
  3319     lockSema critical:[
  3320         selection isNil ifTrue:[
  3321             newSelect := Array with:item.
  3322         ] ifFalse:[
  3323             (self includes:item) ifFalse:[
  3324                 newSelect := selection copyWith:item
  3325             ]
  3326         ].
  3327 
  3328         newSelect size ~~ selection size ifTrue:[
  3329             item makeVisible.
  3330             self value:newSelect
  3331         ]
  3332     ].
  3333     ^ item
  3334 !
  3335 
  3336 addAll:aCollectionOfItems
  3337     "add a collection of items to the current selection
  3338     "
  3339     |newSelect|
  3340 
  3341     aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
  3342 
  3343     lockSema critical:[
  3344         selection isNil ifTrue:[
  3345             newSelect := Array withAll:aCollectionOfItems.
  3346         ] ifFalse:[
  3347             newSelect := OrderedCollection withAll:selection.
  3348 
  3349             aCollectionOfItems do:[:el|
  3350                 (selection includesIdentical:el) ifFalse:[newSelect add:el]
  3351             ].
  3352         ].
  3353         self value:newSelect.
  3354     ].
  3355     ^ aCollectionOfItems
  3356 !
  3357 
  3358 deselect
  3359     "clear the selection
  3360     "
  3361     self value:nil.
  3362 !
  3363 
  3364 remove:item
  3365     "remove the item from the current selection
  3366     "
  3367     |newSelect|
  3368 
  3369     item isNil ifTrue:[^ nil].
  3370 
  3371     lockSema critical:[
  3372         (selection notNil and:[selection includesIdentical:item]) ifTrue:[
  3373             selection size == 1 ifTrue:[ newSelect := nil ]
  3374                                ifFalse:[ newSelect := selection copyWithout:item ].
  3375 
  3376             self value:newSelect
  3377         ].
  3378     ].
  3379     ^ item
  3380 !
  3381 
  3382 removeAll
  3383     "clear the selection
  3384     "
  3385     self deselect.
  3386 !
  3387 
  3388 removeAll:loItems
  3389     "remove all items of the collection from the current selection
  3390     "
  3391     |newSelect|
  3392 
  3393     selection   isNil ifTrue:[ ^ loItems ].
  3394     loItems size == 0 ifTrue:[ ^ loItems ].
  3395 
  3396     lockSema critical:[
  3397         selection notNil ifTrue:[
  3398             newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
  3399             self value:newSelect.
  3400         ]
  3401     ].
  3402     ^ loItems
  3403 !
  3404 
  3405 selectAll
  3406     "select all items
  3407     "
  3408     |root newSelection|
  3409 
  3410     root := listOfItems root.
  3411 
  3412     root isNil ifTrue:[
  3413         newSelection := nil
  3414     ] ifFalse:[
  3415         newSelection := OrderedCollection new.
  3416         root recursiveDo:[:el| newSelection add:el ].
  3417     ].
  3418     self value:newSelection.
  3419 !
  3420 
  3421 selectItem:anItem
  3422     "set the current selection to the item
  3423     "
  3424     self value:anItem
  3425 !
  3426 
  3427 selectRootItem
  3428     "set the current selection to the root item
  3429     "
  3430     self value:(self rootItem).
  3431 !
  3432 
  3433 selectedItem:anItem
  3434     "set the current selection to the item
  3435     "
  3436     self selectItem:anItem.
  3437 !
  3438 
  3439 toggleSelectItem:anItem
  3440     "toggle selection-state of the item; add or remove the item from the
  3441      current selection.
  3442     "
  3443     anItem notNil ifTrue:[
  3444         (self includes:anItem) ifTrue:[self remove:anItem]
  3445                               ifFalse:[self add:anItem]
  3446     ].
  3447     ^ anItem
  3448 ! !
  3449 
  3450 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'!
  3451 
  3452 collect:aBlock
  3453     "for each element in the selection, evaluate the argument, aBlock
  3454      and return a new collection with the results
  3455     "
  3456     |res|
  3457 
  3458     res := OrderedCollection new.
  3459     self do:[:el| res add:(aBlock value:el)].
  3460   ^ res
  3461 !
  3462 
  3463 do:aOneArgBlock
  3464     "evaluate the argument, aBlock for each item in the selection
  3465     "
  3466     |cashedSelection|
  3467 
  3468     cashedSelection := selection.
  3469     cashedSelection isNil ifTrue:[^ nil].
  3470   ^ cashedSelection do:aOneArgBlock
  3471 !
  3472 
  3473 from:start do:aOneArgBlock
  3474     "evaluate the argument, aBlock for the items starting at index start
  3475     "
  3476     |cashedSelection|
  3477 
  3478     cashedSelection := selection.
  3479     cashedSelection isNil ifTrue:[^ nil].
  3480   ^ cashedSelection from:start do:aOneArgBlock
  3481 !
  3482 
  3483 from:start to:stop do:aOneArgBlock
  3484     "evaluate the argument, aBlock for the items with index start to
  3485      stop in the selection.
  3486     "
  3487     |cashedSelection|
  3488 
  3489     cashedSelection := selection.
  3490     cashedSelection isNil ifTrue:[^ nil].
  3491   ^ cashedSelection from:start to:stop do:aOneArgBlock
  3492 !
  3493 
  3494 reverseDo:aOneArgBlock
  3495     "evaluate the argument, aBlock for each item in the selection
  3496     "
  3497     |cashedSelection|
  3498 
  3499     cashedSelection := selection.
  3500     cashedSelection isNil ifTrue:[^ nil].
  3501   ^ cashedSelection reverseDo:aOneArgBlock
  3502 !
  3503 
  3504 select:aBlock
  3505     "return a new collection with all elements from the selection, for which
  3506      the argument aBlock evaluates to true.
  3507     "
  3508     |res|
  3509 
  3510     res := OrderedCollection new.
  3511     self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
  3512   ^ res
  3513 ! !
  3514 
  3515 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'!
  3516 
  3517 changed:aParameter with:oldSelection
  3518     "update the visibility staus of the current selection
  3519     "
  3520     |unselected rootView rootItem selSize|
  3521 
  3522     selSize := selection size.
  3523 
  3524     selSize == 0 ifTrue:[
  3525         selectedSuperItems := #().
  3526     ] ifFalse:[
  3527         selSize == 1 ifTrue:[
  3528             selectedSuperItems := Array with:(selection at:1).
  3529         ] ifFalse:[
  3530             rootItem := listOfItems root.
  3531 
  3532             (selection includesIdentical:rootItem) ifTrue:[
  3533                 selectedSuperItems := Array with:rootItem.
  3534             ] ifFalse:[
  3535                 selectedSuperItems := OrderedCollection new:selSize.
  3536 
  3537                 selection do:[:anItem|
  3538                     anItem parentsDetect:[:el| selection includesIdentical:el ]
  3539                                   ifNone:[ selectedSuperItems add:anItem ].
  3540                 ].
  3541             ]
  3542         ]
  3543     ].
  3544 
  3545     (     hiddenLevel == 0
  3546      and:[(rootView := listOfItems rootView) notNil
  3547      and:[rootView shown]]
  3548     ) ifTrue:[
  3549         selSize == 0 ifTrue:[
  3550             "/ must redraw the old selection unselected
  3551             self redrawUnselected:oldSelection andLock:false
  3552         ] ifFalse:[
  3553             self invalidateSelection.
  3554 
  3555             oldSelection size ~~ 0 ifTrue:[
  3556                 "/ must redraw all elements no longer in the selection
  3557                 unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
  3558                 self redrawUnselected:unselected andLock:false.
  3559             ]
  3560         ]
  3561     ].
  3562     super changed:aParameter with:oldSelection.
  3563 !
  3564 
  3565 setValue:aNewSelection 
  3566     "set the selection without notifying
  3567     "
  3568     |newSelect idx|
  3569 
  3570     newSelect := nil.
  3571 
  3572     aNewSelection notNil ifTrue:[
  3573         lockSema critical:[
  3574             aNewSelection isCollection ifFalse:[
  3575                 (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
  3576                     newSelect := selection
  3577                 ] ifFalse:[
  3578                     newSelect := Array with:aNewSelection.
  3579                 ]
  3580             ] ifTrue:[
  3581                 aNewSelection notEmpty ifTrue:[
  3582                     aNewSelection size ~~ selection size ifTrue:[
  3583                         newSelect := aNewSelection copy.
  3584                     ] ifFalse:[
  3585                         idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
  3586 
  3587                         idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
  3588                                 ifFalse:[newSelect := selection ].
  3589                     ]
  3590                 ]
  3591             ]
  3592         ].
  3593     ].
  3594     newSelect ~~ selection ifTrue:[
  3595         beforeSelectionChangedAction value.
  3596         selection := newSelect.
  3597         selection notNil ifTrue:[selection do:[:el| el makeVisible]]
  3598     ].
  3599 !
  3600 
  3601 triggerValue:aValue
  3602     "set my value & send change notifications to my dependents.
  3603      Send the change message even if the value didn't change.
  3604     "
  3605     |oldSelection|
  3606 
  3607     lockSema critical:[
  3608         oldSelection := selection.
  3609         self setValue:aValue.
  3610         self changed:#value with:oldSelection
  3611     ]
  3612 !
  3613 
  3614 value
  3615     "returns the current selection
  3616     "
  3617     ^ selection ? #()
  3618 !
  3619 
  3620 value:aValue
  3621     "change the current selection and send change notifications to my
  3622      dependents if it changed.
  3623     "
  3624     |oldSelection|
  3625 
  3626     lockSema critical:[
  3627         oldSelection := selection.
  3628         self setValue:aValue.
  3629 
  3630         oldSelection == selection ifFalse:[
  3631             self changed:#value with:oldSelection
  3632         ]
  3633     ].
  3634 ! !
  3635 
  3636 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'!
  3637 
  3638 detect:aBlock
  3639     "evaluate the argument, aBlock for each item in the selection until
  3640      the block returns true; in this case return the element which caused
  3641      the true evaluation.
  3642      If none of the evaluations returns true, an error is raised
  3643     "
  3644     ^ self detect:aBlock ifNone:[self errorNotFound]
  3645 !
  3646 
  3647 detect:aBlock ifNone:exceptionBlock
  3648     "evaluate the argument, aBlock for each item in the selection until the
  3649      block returns true; in this case return the element which caused the
  3650      true evaluation.
  3651      If none of the evaluations returns true, the result of the evaluation
  3652      of the exceptionBlock is returned
  3653     "
  3654     |cashedSelection|
  3655 
  3656     cashedSelection := selection.
  3657     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  3658   ^ cashedSelection detect:aBlock ifNone:exceptionBlock
  3659 !
  3660 
  3661 detectLast:aBlock
  3662     "evaluate the argument, aBlock for each item in the selection until
  3663      the block returns true; in this case return the element which caused
  3664      the true evaluation. The items are processed in reverse order.
  3665      If none of the evaluations returns true, an error is raised
  3666     "
  3667     ^ self detectLast:aBlock ifNone:[self errorNotFound]
  3668 !
  3669 
  3670 detectLast:aBlock ifNone:exceptionBlock
  3671     "evaluate the argument, aBlock for each item in the selection until
  3672      the block returns true; in this case return the element which caused
  3673      the true evaluation. The items are processed in reverse order.
  3674      If none of the evaluations returns true, the result of the evaluation
  3675      of the exceptionBlock is returned
  3676     "
  3677     |cashedSelection|
  3678 
  3679     cashedSelection := selection.
  3680     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  3681   ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
  3682 ! !
  3683 
  3684 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'!
  3685 
  3686 includes:anItem
  3687     "returns true if the item is in the current selection
  3688     "
  3689     |cashedSelection|
  3690 
  3691     cashedSelection := selection.
  3692     cashedSelection isNil ifTrue:[^ false].
  3693  ^  cashedSelection includesIdentical:anItem
  3694 !
  3695 
  3696 includesAll:aCollection
  3697     "return true, if all items of the collection are included in the current selection
  3698     "
  3699     |cashedSelection|
  3700 
  3701     aCollection size ~~ 0 ifTrue:[
  3702         cashedSelection := selection.
  3703         cashedSelection isNil ifTrue:[ ^ false ].
  3704 
  3705         aCollection do:[:el|
  3706             (cashedSelection includesIdentical:el) ifFalse:[^ false]
  3707         ]
  3708     ].
  3709     ^ true
  3710 !
  3711 
  3712 includesAny:aCollection
  3713     "return true, if the any item of the collection is in the current selection
  3714     "
  3715     |cashedSelection|
  3716 
  3717     aCollection notNil ifTrue:[
  3718         cashedSelection := selection.
  3719 
  3720         cashedSelection notNil ifTrue:[
  3721             aCollection do:[:el|
  3722                 (cashedSelection includesIdentical:el) ifTrue:[^ true]
  3723             ]
  3724         ]
  3725     ].
  3726     ^ false
  3727 !
  3728 
  3729 includesIdentical:anItem
  3730     "returns true if the item is in the current selection
  3731     "
  3732     ^ self includes:anItem
  3733 !
  3734 
  3735 isEmpty
  3736     "returns true if the current selection is empty
  3737     "
  3738     ^ selection size == 0
  3739 !
  3740 
  3741 isSelected:anItem
  3742     "returns true if the item is in the current selection
  3743     "
  3744     ^ self includes:anItem
  3745 !
  3746 
  3747 notEmpty
  3748     "returns true if the current selection is not empty
  3749     "
  3750     ^ selection size ~~ 0
  3751 ! !
  3752 
  3753 !ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'!
  3754 
  3755 documentation
  3756 "
  3757     Kind of HierarchicalList class which contains all the visible
  3758     ViewTreeItem's and the root, the anchor of the hierarchical list.
  3759 
  3760     [Instance variables:]
  3761         treeModel       <ViewTreeModel>         all events are delegated to
  3762         eventHook       <BlockValue>            save and resore the pre/post -EventHook
  3763 
  3764 
  3765     [author:]
  3766         Claus Atzkern
  3767 
  3768     [see also:]
  3769         HierarchicalList
  3770         ViewTreeModel
  3771         ViewTreeItem
  3772 "
  3773 ! !
  3774 
  3775 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'!
  3776 
  3777 root:theRoot
  3778     "set the root item; delegate events to my treeModel
  3779     "
  3780     |rootView|
  3781 
  3782     theRoot == root ifTrue:[^ self].
  3783 
  3784     rootView := self rootView.
  3785     super root:theRoot.
  3786 
  3787     rootView notNil ifTrue:[ |wgrp|
  3788         wgrp := rootView windowGroup.
  3789 
  3790         wgrp notNil ifTrue:[
  3791            wgrp removePreEventHook:treeModel.
  3792            wgrp removePostEventHook:self.
  3793         ].
  3794     ].
  3795 
  3796     super root:theRoot.
  3797     rootView := self rootView.
  3798 
  3799     rootView notNil ifTrue:[
  3800         "must setup a task because there might not exist a windowGroup at the moment
  3801         "
  3802         [   |wgrp|
  3803 
  3804             [rootView == self rootView] whileTrue:[
  3805                 wgrp := rootView windowGroup.
  3806                 wgrp notNil ifTrue:[
  3807                     rootView := nil.
  3808                     wgrp addPreEventHook:treeModel.
  3809                     wgrp addPostEventHook:self.
  3810                 ] ifFalse:[
  3811                     Delay waitForMilliseconds:100.
  3812                 ].
  3813             ].
  3814 
  3815         ] forkAt:(Processor userSchedulingPriority + 2).
  3816     ].
  3817     treeModel notNil ifTrue:[
  3818         treeModel targetWidgetChanged.
  3819     ].
  3820     
  3821     ^ root.
  3822 !
  3823 
  3824 rootView
  3825     "returns the widget assigned to the root or nil
  3826     "
  3827     ^ root notNil ifTrue:[root widget] ifFalse:[nil]
  3828 !
  3829 
  3830 treeModel
  3831     "returne the treeModel, a ViewTreeModel
  3832     "
  3833     ^ treeModel
  3834 ! !
  3835 
  3836 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'!
  3837 
  3838 additionalLabelForItem:anItem
  3839     "answer the additional lable for an item or nil"
  3840 
  3841     |applClass|
  3842 
  3843     showWidgetNames == true ifTrue:[
  3844         ^ '[', anItem widget name, ']'
  3845     ].
  3846 
  3847     anItem isApplicationClass ifTrue:[
  3848         applClass := anItem applicationClass.
  3849 
  3850         applClass notNil ifTrue:[
  3851             ^ ('[', applClass name, ']')
  3852         ].
  3853     ].
  3854     ^ nil
  3855 !
  3856 
  3857 showWidgetNames
  3858     "answer true if the additional text is the widget name
  3859      otherwise the name of the application"
  3860 
  3861     ^ showWidgetNames ? false
  3862 !
  3863 
  3864 showWidgetNames:aBoolean
  3865     "set true if the additional text is the widget name
  3866      otherwise the name of the application"
  3867 
  3868     self showWidgetNames == aBoolean ifFalse:[
  3869         showWidgetNames := aBoolean.
  3870 
  3871         root notNil ifTrue:[
  3872             root recursiveAdditionalNameBehaviourChanged.
  3873             self changed.
  3874         ].
  3875     ].
  3876 ! !
  3877 
  3878 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'!
  3879 
  3880 processEvent:anEvent
  3881     "post process event
  3882     "
  3883     ^ treeModel isInTestMode not
  3884 ! !
  3885 
  3886 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'!
  3887 
  3888 on:aModel
  3889     "set the model, a ViewTreeModel
  3890     "
  3891     treeModel := aModel.
  3892     showRoot  := true.
  3893     showWidgetNames := false.
  3894 ! !
  3895 
  3896 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'!
  3897 
  3898 detectItemRespondsToView:aView
  3899     "returns the bottom-most item which contains the view
  3900     "
  3901     |view item topView|
  3902 
  3903     root notNil ifTrue:[
  3904         view    := aView.
  3905         topView := root widget.
  3906 
  3907         [ view notNil ] whileTrue:[
  3908             topView == view ifTrue:[^ root].
  3909             item := root recursiveDetect:[:el| el widget == view ].
  3910             item notNil ifTrue:[^ item].
  3911             view := view superView
  3912         ]
  3913     ].
  3914     ^ nil
  3915 !
  3916 
  3917 recursiveDetect:aOneOrgBlock
  3918     "recursive find the first child, for which evaluation 
  3919      of the block returns true; if none nil is returned
  3920     "
  3921     root notNil ifTrue:[
  3922         (aOneOrgBlock value:root) ifTrue:[ ^ root ].
  3923       ^ root recursiveDetect:aOneOrgBlock
  3924     ].
  3925     ^ nil
  3926 ! !
  3927 
  3928 !ViewTreeInspectorApplication class methodsFor:'documentation'!
  3929 
  3930 version
  3931     ^ '$Header$'
  3932 !
  3933 
  3934 version_CVS
  3935     ^ '$Header$'
  3936 ! !
  3937 
  3938 ViewTreeInspectorApplication initialize!
  3939 ViewTreeInspectorApplication::ViewTreeItem initialize!