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