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