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