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