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