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