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