Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Tue, 30 Oct 2018 16:30:12 +0100
changeset 3628 dae68c3b50a6
parent 3574 ea4dce86360d
child 3658 18137fdc0f76
permissions -rw-r--r--
#FEATURE by cg
class: Tools::ViewTreeInspectorApplication
added:
#doEditLanguageResources
#hasMasterApplication
comment/format in:
#doBrowse:
#hasApplication
changed: #objectToInspectOrBrowse:

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