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