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