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