Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Wed, 16 Aug 2017 13:58:23 +0200
changeset 3457 3f3ea99e8af5
parent 3456 4d4297bad4fa
child 3500 51cbdcf5b2cb
permissions -rw-r--r--
#FEATURE by cg
class: Tools::ViewTreeInspectorApplication
more menu-item menu actions
comment/format in: #selectedView
changed:
#objectToInspectOrBrowse:
#submenuMenuItemInterface:

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