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