Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Tue, 19 May 2015 20:36:55 +0200
changeset 3216 41118d54b47c
parent 3213 33e1f779fa15
child 3217 af9fd0c681e0
permissions -rw-r--r--
class: Tools::ViewTreeInspectorApplication
     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     relOrg   := widget originRelativeTo:rootView.
  2640     relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
  2641 
  2642     relOrg   := relOrg - (HandleExtent // 2).
  2643     relCrn   := relOrg + widget extent.
  2644     maxExt   := rootView extent - HandleExtent.
  2645 
  2646     xL := relOrg x max:0.
  2647     xR := relCrn x min:(maxExt x).
  2648     xC := xR + xL // 2.
  2649 
  2650     yT := relOrg y max:0.
  2651     yB := relCrn y min:(maxExt y).
  2652     yC := yB + yT // 2.
  2653 
  2654     type := self layoutType.
  2655     w   := HandleExtent x.
  2656     h   := HandleExtent y.
  2657 
  2658     (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
  2659         aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
  2660         aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
  2661         aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
  2662         aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
  2663         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2664         aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
  2665         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2666         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2667       ^ self
  2668     ].
  2669 
  2670     aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
  2671     aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
  2672     aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
  2673 
  2674     type == #Extent ifTrue:[
  2675         aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
  2676         aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
  2677         aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
  2678       ^ self
  2679     ].
  2680     aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
  2681 !
  2682 
  2683 recursiveEachVisibleItemDo:anOneArgBlock
  2684     "recursive evaluate the block on each child which is visible
  2685     "
  2686     (isExpanded and:[children size > 0]) ifTrue:[
  2687         children do:[:aChild|
  2688             anOneArgBlock value:aChild.
  2689             aChild recursiveEachVisibleItemDo:anOneArgBlock.
  2690         ]
  2691     ].
  2692 !
  2693 
  2694 subViewsDo:aOneArgBlock
  2695     "evaluate aBlock for all subviews other than InputView's   
  2696     "
  2697     |subViews|
  2698 
  2699     subViews := widget subViews.
  2700 
  2701     subViews notNil ifTrue:[
  2702         subViews do:aOneArgBlock
  2703     ].
  2704 ! !
  2705 
  2706 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
  2707 
  2708 forView:aView
  2709     widget := aView.
  2710 !
  2711 
  2712 initialize
  2713     "setup default attributes
  2714     "
  2715     super initialize.
  2716     isDrawnShown := false.
  2717     isExpanded   := false.
  2718     children     := OrderedCollection new.
  2719 ! !
  2720 
  2721 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
  2722 
  2723 delete
  2724     "delete self and all contained items; the assigned views are destroyed
  2725      in case of rootView, only the children are deleted
  2726     "
  2727     parent isHierarchicalItem ifTrue:[
  2728         self criticalDo:[
  2729             parent remove:self.
  2730             widget destroy.
  2731         ]
  2732     ] ifFalse:[
  2733         self deleteAll
  2734     ].
  2735 !
  2736 
  2737 deleteAll
  2738     "delete all contained items; the assigned views are destroyed
  2739     "
  2740     children size == 0 ifTrue:[^ self].
  2741 
  2742     self criticalDo:[
  2743         self nonCriticalDo:[:el| el widget destroy ].
  2744         self removeAll
  2745     ].
  2746 ! !
  2747 
  2748 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
  2749 
  2750 asLayoutFrame
  2751     "convert the layout of the widget to a LayoutFrame;
  2752     "
  2753     |extent layout newLyt lftFrc lftOff topFrc topOff|
  2754 
  2755     layout := widget geometryLayout.
  2756 
  2757     layout isNil ifTrue:[
  2758         ^ widget bounds asLayout
  2759     ].
  2760 
  2761     layout isLayout ifFalse:[
  2762         layout isRectangle ifTrue:[
  2763             ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
  2764                            topOffset:(layout top) bottomOffset:(layout bottom)
  2765         ].
  2766         layout isPoint ifTrue:[
  2767             extent := widget extent.
  2768           ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
  2769                          topOffset:(layout y) bottomOffset:(layout y + extent y)
  2770         ].
  2771 
  2772         Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
  2773       ^ nil
  2774     ].
  2775 
  2776     layout isLayoutFrame ifTrue:[ ^ layout copy ].    
  2777 
  2778     lftFrc := layout leftFraction.
  2779     lftOff := layout leftOffset.
  2780     topFrc := layout topFraction.
  2781     topOff := layout topOffset.
  2782     extent := widget extent.
  2783 
  2784     newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
  2785                          rightFraction:lftFrc offset:(lftOff + extent x)
  2786                            topFraction:topFrc offset:topOff
  2787                         bottomFraction:topFrc offset:(topOff + extent y).
  2788 
  2789     (      layout isAlignmentOrigin
  2790      and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
  2791     ) ifTrue:[
  2792         |svRc prBd dlta|
  2793 
  2794         svRc := widget superView viewRectangle.
  2795         prBd := widget preferredBounds.
  2796 
  2797         dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
  2798                  - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
  2799                 ) rounded.
  2800 
  2801         newLyt   leftOffset:(lftOff + dlta x).
  2802         newLyt  rightOffset:(lftOff + extent x + dlta x).
  2803         newLyt    topOffset:(topOff + dlta y).
  2804         newLyt bottomOffset:(topOff + extent y + dlta y).
  2805     ].
  2806     ^ newLyt
  2807 !
  2808 
  2809 moveLeft:l top:t
  2810     "move the widget n pixele left and right
  2811     "
  2812     |layout|
  2813 
  2814     self isMoveable ifFalse:[ ^ self ].
  2815 
  2816     (layout := widget geometryLayout) isNil ifTrue:[
  2817         "Extent"
  2818         widget origin:(widget origin + (l@t)).
  2819       ^ self
  2820     ].
  2821 
  2822     layout := layout copy.
  2823 
  2824     layout isLayout ifTrue:[
  2825         layout leftOffset:(layout leftOffset + l)
  2826                 topOffset:(layout topOffset  + t).
  2827 
  2828         layout isLayoutFrame ifTrue:[
  2829             layout  rightOffset:(layout rightOffset  + l).
  2830             layout bottomOffset:(layout bottomOffset + t).
  2831         ]
  2832 
  2833     ] ifFalse:[
  2834         layout isRectangle ifTrue:[
  2835             layout setLeft:(layout left + l).
  2836             layout  setTop:(layout top  + t).
  2837         ] ifFalse:[
  2838             layout isPoint ifFalse:[^ self].
  2839             layout x:(layout x + l) y:(layout y + t).
  2840         ]
  2841     ].
  2842     widget geometryLayout:layout.
  2843 !
  2844 
  2845 resizeLeft:l top:t right:r bottom:b
  2846     "resize the widget measured in pixels
  2847     "
  2848     |layout|
  2849 
  2850     self isResizeable ifFalse:[
  2851         ^ self
  2852     ].
  2853 
  2854     (layout := widget geometryLayout) isNil ifTrue:[
  2855         "Extent"
  2856         (r == l and:[b == t]) ifFalse:[
  2857             widget extent:(widget computeExtent + ((r-l) @ (b-t))).
  2858         ].
  2859         ^ self
  2860     ].
  2861 
  2862     layout isLayout ifTrue:[
  2863         layout := layout copy.
  2864 
  2865         layout leftOffset:(layout leftOffset + l)
  2866                 topOffset:(layout topOffset  + t).
  2867 
  2868         layout isLayoutFrame ifTrue:[
  2869             layout bottomOffset:(layout bottomOffset + b).
  2870             layout  rightOffset:(layout rightOffset  + r).
  2871         ]
  2872     ] ifFalse:[
  2873         layout isRectangle ifFalse:[^ self].
  2874         layout := layout copy.
  2875 
  2876         layout left:(layout left   + l)
  2877               right:(layout right  + r)
  2878                 top:(layout top    + t)
  2879              bottom:(layout bottom + b).
  2880     ].
  2881     widget geometryLayout:layout.
  2882 ! !
  2883 
  2884 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
  2885 
  2886 updateChildren
  2887     |queue|
  2888 
  2889     queue := OrderedCollection new.
  2890     queue add:self.
  2891 
  2892     self criticalDo:[
  2893         [queue notEmpty] whileTrue:[
  2894             |toRemove  elProcessed|
  2895 
  2896             elProcessed := queue removeFirst.
  2897             toRemove := nil.
  2898             elProcessed nonCriticalDo:[:el|
  2899                 el exists ifTrue:[
  2900                     queue add:el.
  2901                 ] ifFalse:[
  2902                     toRemove isNil ifTrue:[toRemove := OrderedCollection new].
  2903                     toRemove add:el.
  2904                 ]
  2905             ].
  2906             toRemove notNil ifTrue:[
  2907                 toRemove do:[:el| elProcessed remove:el ].
  2908             ].
  2909         ].
  2910     ].
  2911 !
  2912 
  2913 updateFromChildren:mergedList
  2914     "update my children against the list of items derived from
  2915      the merged list.
  2916     "
  2917 
  2918     mergedList size == 0 ifTrue:[ ^ self removeAll ].
  2919     children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
  2920 
  2921     self criticalDo:[
  2922         self nonCriticalDo:[:el| |wdg|
  2923             wdg := el widget.
  2924             mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
  2925         ].
  2926 
  2927         mergedList keysAndValuesDo:[:i :el| |wdg e2|
  2928             wdg := el widget.
  2929 
  2930             e2  := self at:i ifAbsent:nil.
  2931 
  2932             (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
  2933                 self add:el beforeIndex:i
  2934             ]
  2935         ]
  2936     ].
  2937 ! !
  2938 
  2939 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
  2940 
  2941 icon
  2942     "get the icon used for presentation
  2943     "
  2944     |specClass model|
  2945 
  2946     specClass := self specClass.
  2947     specClass isNil ifTrue:[^ nil].
  2948 
  2949     model := self treeModel.
  2950 
  2951     model notNil ifTrue:[
  2952         ^ model iconAt:specClass ifNonePut:[specClass icon]
  2953     ].
  2954     ^ specClass icon
  2955 !
  2956 
  2957 label
  2958     "get the label used for presentation
  2959     "
  2960     ^ self string
  2961 !
  2962 
  2963 printOn:aStream
  2964     "append a a printed representation of the item to aStream
  2965     "
  2966     aStream nextPutAll:(self string)
  2967 !
  2968 
  2969 string
  2970     "get the string
  2971     "
  2972     ^ widget class name.
  2973 ! !
  2974 
  2975 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
  2976 
  2977 canChangeLayout
  2978     "returns true if the layout of the widget can be changed and the
  2979      layout is not organized by its superView
  2980     "
  2981     ^ self isResizeable
  2982 !
  2983 
  2984 canResizeSubComponents
  2985     "returns true if the widget can resize its sub components
  2986     "
  2987     |specClass|
  2988 
  2989     specClass := self specClass.
  2990 
  2991     specClass notNil ifTrue:[
  2992         ^ specClass canResizeSubComponents
  2993     ].
  2994     ^ false
  2995 !
  2996 
  2997 exists
  2998     widget id notNil ifTrue:[^ true ].
  2999 
  3000     exists ~~ false ifTrue:[
  3001         exists := false.
  3002 
  3003         widget superView notNil ifTrue:[
  3004             (parent isHierarchicalItem and:[parent exists]) ifTrue:[
  3005                 exists := (parent widget subViews includesIdentical:widget).
  3006             ].
  3007         ].
  3008     ].
  3009     ^ exists
  3010 !
  3011 
  3012 isApplicationClass
  3013     |cls|
  3014 
  3015     cls := widget class.
  3016 
  3017     ^ (    cls == ApplicationSubView
  3018         or:[cls == ApplicationWindow
  3019         or:[cls == SubCanvas]]
  3020       ) 
  3021 !
  3022 
  3023 isSelected
  3024     |model|
  3025 
  3026     model := self treeModel.
  3027     model notNil ifTrue:[^ model isSelected:self].
  3028     ^ false
  3029 !
  3030 
  3031 supportsSubComponents
  3032     "returns true if the widget supports sub components
  3033     "
  3034     |specClass|
  3035 
  3036     widget isScrollWrapper ifTrue:[
  3037         ^ false
  3038     ].
  3039     specClass := self specClass.
  3040 
  3041     specClass notNil ifTrue:[
  3042         ^ specClass supportsSubComponents
  3043     ].
  3044     ^ false
  3045 ! !
  3046 
  3047 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
  3048 
  3049 isInLayoutContainer
  3050     "returns true if the widget is in a layout container
  3051     "
  3052     |sv specClass|
  3053 
  3054     sv := widget superView.
  3055 
  3056     sv notNil ifTrue:[
  3057         specClass := sv specClass.
  3058 
  3059         specClass notNil ifTrue:[
  3060             ^ specClass isLayoutContainer
  3061         ].
  3062     ].
  3063     ^ false
  3064 !
  3065 
  3066 isLayoutContainer
  3067     "answer whether corresponding view instances of the spec class can contain
  3068      (and arrange) other view
  3069     "
  3070     |specClass|
  3071 
  3072     specClass := self specClass.
  3073 
  3074     specClass notNil ifTrue:[
  3075         ^ specClass isLayoutContainer
  3076     ].
  3077     ^ false
  3078 !
  3079 
  3080 isMoveable
  3081     "returns true if the widget is not in a layout container
  3082     "
  3083     self isInLayoutContainer ifFalse:[
  3084         ^ widget superView notNil
  3085     ].
  3086     ^ false
  3087 !
  3088 
  3089 isResizeable
  3090     "returns true if the widget is resizeable
  3091     "
  3092     |sv specClass|
  3093 
  3094     sv := widget superView.
  3095 
  3096     sv notNil ifTrue:[
  3097         specClass := sv specClass.
  3098 
  3099         specClass notNil ifTrue:[
  3100             ^ specClass canResizeSubComponents
  3101         ].
  3102     ].
  3103     ^ false
  3104 ! !
  3105 
  3106 !ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
  3107 
  3108 documentation
  3109 "
  3110     Instances of ViewTreeModel can be used as model on a View and all
  3111     it contained subviews for a HierarchicalListView.
  3112     The model keeps two values, the hierarchical representation of the views
  3113     and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
  3114     It shows the selected items highlighted.
  3115 
  3116 
  3117     [Instance variables:]
  3118         lockSema            <Semaphore>         lock selection notifications and redraws
  3119 
  3120         testModeChannel     <ValueHolder>       true, than running in test mode.
  3121 
  3122         hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
  3123 
  3124         selection           <Sequence or nil>   selected items or nil
  3125 
  3126         hiddenLevel         <Integer>           internal use; redrawing the selection
  3127                                                 only is done if the counter is 0.
  3128 
  3129         listOfItems         <HierarchicalList>  hiearchical list build from existing items.
  3130 
  3131         selectedSuperItems  <Sequence>          list of selected super items; items selected
  3132                                                 but not contained in another selected item.
  3133 
  3134         inputEventAction    <Action>            called for each InputEvent
  3135 
  3136         mappedViewAction    <Action>            called for a new mapped view which
  3137                                                 can not be found in the current item list.
  3138 
  3139         beforeSelectionChangedAction <Action>   called before the selection changed
  3140 
  3141     [author:]
  3142         Claus Atzkern
  3143 
  3144     [see also:]
  3145         ViewTreeItem
  3146 "
  3147 !
  3148 
  3149 examples
  3150 "
  3151     example 1: pick any window and show views and contained views
  3152                                                                                 [exBegin]
  3153     |top sel model panel|
  3154 
  3155     model := ViewTreeModel new.
  3156     top   := StandardSystemView new; extent:440@400.
  3157     sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
  3158     sel bottomInset:24.
  3159 
  3160     panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
  3161     panel topInset:-24.
  3162     panel horizontalLayout:#fitSpace.
  3163 
  3164     Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
  3165     Button label:'Pick Views' action:[  |win|
  3166                                         (     (win := Screen current viewFromUser) notNil
  3167                                          and:[(win := win topView) ~~ Screen current rootView
  3168                                          and:[win ~~ top]]
  3169                                         ) ifTrue:[
  3170                                             model rootItem:(ViewTreeItem buildViewsFrom:win)
  3171                                         ] ifFalse:[
  3172                                             model rootItem:nil
  3173                                         ]
  3174                                      ] in:panel.
  3175 
  3176     sel  multipleSelectOk:true.
  3177     sel              list:model listOfItems.
  3178     sel             model:model.
  3179     sel          useIndex:false.
  3180 
  3181     sel doubleClickAction:[:i| |el|
  3182         el := model listOfItems at:i.
  3183         el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
  3184     ].
  3185     sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
  3186 
  3187     model inputEventAction:[:anEvent| |item|
  3188         anEvent isButtonEvent ifTrue:[
  3189             anEvent isButtonPressEvent ifTrue:[
  3190                 model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
  3191             ] ifFalse:[
  3192                 anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
  3193                     (item := model selectedItem) notNil ifTrue:[item widget inspect]
  3194                 ]
  3195             ]
  3196         ]
  3197     ].
  3198 
  3199     top openAndWait.
  3200     [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
  3201 
  3202                                                                                 [exEnd]
  3203 "
  3204 ! !
  3205 
  3206 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
  3207 
  3208 application:anApplication
  3209     listOfItems application:anApplication.
  3210 !
  3211 
  3212 catchEvents:aBoolean
  3213     catchEvents := aBoolean.
  3214     aBoolean ifFalse:[
  3215         self redrawUnselected:selection andLock:false checkTestMode:false.
  3216     ].
  3217 !
  3218 
  3219 path
  3220     "Return a XPath like path to this item"
  3221 
  3222     | view views|
  3223 
  3224     selection isNil ifTrue:[ ^ nil ].
  3225     selection isCollection ifTrue:[ 
  3226         selection size ~~ 1 ifTrue:[ ^ nil ].
  3227         view := selection anElement widget.
  3228     ] ifFalse:[ 
  3229         view := selection widget.
  3230     ].
  3231     views := OrderedCollection new.
  3232     [ view notNil ] whileTrue:[ 
  3233         views add: view.
  3234         view := view superView.
  3235     ].
  3236     views removeLast.
  3237     ^ String streamContents:[ :s|
  3238         views reverseDo:[:each |
  3239             s nextPutAll:'/'.
  3240             s nextPutAll: each name asString "storeString".
  3241         ].
  3242     ]
  3243 
  3244     "Created: / 19-05-2014 / 18:15:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
  3245 !
  3246 
  3247 rootItem
  3248     "get the rootItem the event viewer is established on
  3249     "
  3250     ^ listOfItems root
  3251 !
  3252 
  3253 rootItem:anItem
  3254     "set the rootItem the event viewer is established on
  3255     "
  3256     |expanded|
  3257 
  3258     timedUpdateTask := nil.
  3259     self deselect.
  3260 
  3261     lockSema critical:[
  3262         anItem notNil ifTrue:[ expanded := anItem isExpanded ]
  3263                      ifFalse:[ expanded := false ].
  3264 
  3265         self value:nil.
  3266         listOfItems root:anItem.
  3267 
  3268         anItem notNil ifTrue:[
  3269             timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
  3270             timedUpdateTask name:'Update'.
  3271             timedUpdateTask resume.
  3272         ].
  3273     ].
  3274 
  3275     (expanded and:[anItem notNil]) ifTrue:[
  3276         anItem expand
  3277     ].
  3278     ^ anItem
  3279 !
  3280 
  3281 rootView
  3282     "get the top widget the event viewer is established on, a View
  3283     "
  3284     ^ listOfItems rootView
  3285 ! !
  3286 
  3287 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
  3288 
  3289 beforeSelectionChangedAction
  3290     "none argument action which is called before
  3291      the selection changed
  3292     "
  3293     ^ beforeSelectionChangedAction
  3294 !
  3295 
  3296 beforeSelectionChangedAction:aNoneArgBlock
  3297     "none argument action which is called before
  3298      the selection changed
  3299     "
  3300     beforeSelectionChangedAction := aNoneArgBlock.
  3301 !
  3302 
  3303 inputEventAction
  3304     "called for each input event; the argument to the action is the WindowEvent
  3305     "
  3306     ^ inputEventAction
  3307 !
  3308 
  3309 inputEventAction:aOneArgActionTheEvent
  3310     "called for each input event; the argument to the action is the WindowEvent
  3311     "
  3312     inputEventAction := aOneArgActionTheEvent.
  3313 !
  3314 
  3315 mappedViewAction
  3316     "called for a new mapped view which can not be found
  3317      in the current item list
  3318     "
  3319     ^ mappedViewAction
  3320 !
  3321 
  3322 mappedViewAction:aOneArgBlockTheMappedView
  3323     "called for a new mapped view which can not be found
  3324      in the current item list
  3325     "
  3326     mappedViewAction := aOneArgBlockTheMappedView
  3327 ! !
  3328 
  3329 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
  3330 
  3331 iconAt:aKey ifNonePut:aNoneArgBlock
  3332     |icon view|
  3333 
  3334     icon := icons at:aKey ifAbsent:nil.
  3335     icon notNil ifTrue:[^ icon].
  3336 
  3337     icon := aNoneArgBlock value.
  3338     icon isNil ifTrue:[^ nil].
  3339 
  3340     view := self rootView.
  3341     view isNil ifTrue:[^ icon].
  3342 
  3343     icon := icon copy onDevice:(view device).
  3344     icon isImage ifTrue:[
  3345         icon clearMaskedPixels.
  3346     ].
  3347     icons at:aKey put:icon.
  3348     ^ icon
  3349 ! !
  3350 
  3351 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'!
  3352 
  3353 signalHiddenLevel
  3354     "show the selection if signaled; increments hiddenLevel
  3355      see: #waitHiddenLevel
  3356     "
  3357     (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
  3358         hiddenLevel := 0.
  3359         self invalidateSelection.
  3360     ].
  3361 !
  3362 
  3363 waitHiddenLevel
  3364     "hide the selection until signaled; increments hiddenLevel
  3365      see: #signalHiddenLevel
  3366     "
  3367     self redrawUnselected:selection andLock:true
  3368 !
  3369 
  3370 withSelectionHiddenDo:aNoneArgumentBlock
  3371     "apply block with selection hidden
  3372     "
  3373 
  3374     [   self waitHiddenLevel.
  3375 
  3376         aNoneArgumentBlock value
  3377 
  3378     ] valueNowOrOnUnwindDo:[
  3379         self signalHiddenLevel.
  3380     ].
  3381 ! !
  3382 
  3383 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'!
  3384 
  3385 hasTargetWidgetChannel
  3386     "answer the channel which is set to true if a target widget exists"
  3387 
  3388     ^ hasTargetWidgetChannel
  3389 !
  3390 
  3391 listOfItems
  3392     "hiearchical list build from existing items"
  3393 
  3394     ^ listOfItems
  3395 !
  3396 
  3397 selectOnClickHolder
  3398     "boolean holder, which indicates whether the selection will change on click
  3399     "
  3400     ^ selectOnClickHolder
  3401 !
  3402 
  3403 testModeChannel
  3404     "answer a boolean channel which describes the behaviour how to process
  3405      events on the target view.
  3406 
  3407      false: all input events are eaten and the selection is shown on the target view.
  3408      true:  no  input events are eaten and no  selection is shown on the target view."
  3409 
  3410     ^ testModeChannel
  3411 ! !
  3412 
  3413 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'!
  3414 
  3415 targetWidgetChanged
  3416     hasTargetWidgetChannel value:(self rootItem notNil).
  3417 !
  3418 
  3419 timedUpdateTaskCycle
  3420     |view myTaskId|
  3421 
  3422     myTaskId := timedUpdateTask.
  3423 
  3424     listOfItems root notNil ifTrue:[
  3425         view := listOfItems root widget.
  3426     ].
  3427 
  3428     [ view notNil ] whileTrue:[
  3429         Delay waitForSeconds:0.5.
  3430         
  3431         (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
  3432             view := nil.
  3433         ] ifTrue:[
  3434             (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
  3435                 view sensor pushUserEvent:#updateChildren for:self.
  3436             ].
  3437         ].
  3438     ].
  3439     timedUpdateTask == myTaskId ifTrue:[
  3440         timedUpdateTask := nil.
  3441         listOfItems root:nil.
  3442     ].
  3443 !
  3444 
  3445 update:something with:someArgument from:aModel
  3446 
  3447     aModel == testModeChannel ifTrue:[
  3448         (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
  3449             testModeChannel value ifTrue:[
  3450                 self redrawUnselected:selection andLock:false checkTestMode:false.
  3451             ] ifFalse:[
  3452                 self invalidateSelection.
  3453             ].
  3454         ].
  3455         ^ self
  3456     ].
  3457     super update:something with:someArgument from:aModel.
  3458 !
  3459 
  3460 updateChildren
  3461     |rootItem|
  3462 
  3463     rootItem := listOfItems root.
  3464     rootItem isNil ifTrue:[^ self].
  3465 
  3466     rootItem exists ifFalse:[
  3467         listOfItems root:nil.
  3468     ] ifTrue:[
  3469         rootItem updateChildren.
  3470     ].
  3471 ! !
  3472 
  3473 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'!
  3474 
  3475 processEvent:anEvent
  3476     "catch and process all WindowEvents for the rootComponent and its contained
  3477      widgets; redraw selection in case of damage...
  3478      return true, if the event was eaten"
  3479 
  3480     |evView item rootView testMode|
  3481 
  3482     catchEvents ifFalse:[^ false].
  3483 
  3484     evView := anEvent view.
  3485     evView isNil ifTrue:[
  3486         (anEvent isMessageSendEvent not or:[anEvent receiver ~~ self]) ifTrue:[
  3487             ^ false
  3488         ].
  3489         anEvent value.
  3490         ^ true.
  3491     ].
  3492     rootView := listOfItems rootView.
  3493     rootView isNil ifTrue:[ ^ false ].
  3494 
  3495     anEvent isConfigureEvent ifTrue:[
  3496         hiddenLevel == 0 ifTrue:[
  3497             self redrawUnselected:selection andLock:false.
  3498         ].
  3499         ^ false
  3500     ].
  3501 
  3502     "/ check whether view is contained within the rootView
  3503     (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
  3504         ^ false
  3505     ].
  3506 
  3507     anEvent isInputEvent ifFalse:[
  3508         anEvent isDamage ifTrue:[
  3509             hiddenLevel == 0 ifTrue:[self invalidateSelection].
  3510             ^ false
  3511         ].
  3512 
  3513         anEvent isMapEvent ifTrue:[
  3514             mappedViewAction notNil ifTrue:[
  3515                 item := listOfItems recursiveDetect:[:el| el widget == evView].
  3516                 item isNil ifTrue:[ mappedViewAction value:evView ]
  3517             ].
  3518             ^ false
  3519         ].
  3520 
  3521         anEvent type == #terminate ifTrue:[
  3522             item := listOfItems recursiveDetect:[:el| el widget == evView].
  3523             item notNil ifTrue:[ self processTerminateForItem:item ].
  3524             ^ false
  3525         ].
  3526         ^ false
  3527     ].
  3528     testMode := testModeChannel value.
  3529 
  3530     anEvent isFocusEvent ifTrue:[
  3531         evView == rootView ifTrue:[
  3532             self invalidateSelection
  3533         ].
  3534         ^ testMode not.
  3535     ].
  3536     anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
  3537 
  3538     testMode ifFalse:[
  3539         inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
  3540     ] ifTrue:[
  3541         anEvent isButtonPressEvent ifTrue:[
  3542             selectOnClickHolder value ifTrue:[
  3543                 self selectItem:(listOfItems detectItemRespondsToView:evView).
  3544             ].
  3545         ]
  3546     ].
  3547 
  3548     (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
  3549         hiddenLevel := 1.
  3550         self signalHiddenLevel.
  3551     ].
  3552 
  3553     ^ testMode not
  3554 !
  3555 
  3556 processTerminateForItem:anItem
  3557     "received terminate for an item
  3558     "
  3559     anItem remove.
  3560 ! !
  3561 
  3562 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'!
  3563 
  3564 initialize
  3565     "setup the default attributes
  3566     "
  3567     super initialize.
  3568 
  3569     hiddenLevel           := 0.
  3570     lockSema              := RecursionLock new.
  3571     listOfItems           := ItemList new on:self.
  3572     selectedSuperItems    := #().
  3573     icons                 := IdentityDictionary new.
  3574     catchEvents           := true.
  3575 
  3576     hasTargetWidgetChannel := false asValue.
  3577     selectOnClickHolder    := true asValue.
  3578 
  3579     testModeChannel := false asValue.
  3580     testModeChannel addDependent:self.
  3581 ! !
  3582 
  3583 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'!
  3584 
  3585 invalidateSelection
  3586     "invalidate the current selection
  3587     "
  3588     |topView|
  3589 
  3590     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3591 
  3592     (     hiddenLevel == 0
  3593      and:[selection notNil
  3594      and:[(topView := listOfItems rootView) notNil
  3595      and:[topView shown]]]
  3596     ) ifTrue:[
  3597         topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
  3598     ]
  3599 !
  3600 
  3601 recursiveRepair:theDamages startIn:aView relativeTo:aRootView
  3602     "repair all views and contained views, which intersects the damage.
  3603      !!!! all damages repaired are removed from the list of damages !!!!
  3604     "
  3605     |color relOrg damage subViews repaired
  3606      bwWidth    "{ Class:SmallInteger }"
  3607      x          "{ Class:SmallInteger }"
  3608      y          "{ Class:SmallInteger }"
  3609      w          "{ Class:SmallInteger }"
  3610      h          "{ Class:SmallInteger }"
  3611      relOrgX    "{ Class:SmallInteger }"
  3612      relOrgY    "{ Class:SmallInteger }"
  3613      width      "{ Class:SmallInteger }"
  3614      height     "{ Class:SmallInteger }"
  3615      size       "{ Class:SmallInteger }"
  3616     |
  3617     (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
  3618 
  3619     subViews := aView subViews.
  3620 
  3621     subViews size ~~ 0 ifTrue:[
  3622         subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
  3623         theDamages isEmpty ifTrue:[ ^ self ].
  3624     ].
  3625 
  3626     relOrg  := aView originRelativeTo:aRootView.
  3627     bwWidth := aView borderWidth.
  3628     size    := theDamages size.
  3629 
  3630     "/ compute relative origin starting from border left@top
  3631     relOrgX := relOrg x - bwWidth.
  3632     relOrgY := relOrg y - bwWidth.
  3633     width   := aView width  + bwWidth + bwWidth.
  3634     height  := aView height + bwWidth + bwWidth.
  3635 
  3636     size to:1 by:-1 do:[:anIndex|
  3637         repaired := damage := theDamages at:anIndex.
  3638 
  3639         "/ compute the rectangle into the view
  3640         y := damage top  - relOrgY.
  3641         x := damage left - relOrgX.
  3642         w := damage width.
  3643         h := damage height.
  3644 
  3645         x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
  3646         y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
  3647         x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
  3648         y + h > height ifTrue:[ h := height - y.    repaired := nil ].
  3649 
  3650         (w > 0 and:[h > 0]) ifTrue:[
  3651             bwWidth ~~ 0 ifTrue:[
  3652                 color isNil ifTrue:[
  3653                     "/ must force redraw of border
  3654                     color := aView borderColor.
  3655                     aView borderColor:(Color colorId:1).
  3656                     aView borderColor:color.
  3657                 ].
  3658                 w := w - bwWidth.
  3659                 h := h - bwWidth.
  3660 
  3661                 (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
  3662                 (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
  3663 
  3664                 h > 0 ifFalse:[w := 0].         "/ later testing on width only
  3665             ].
  3666 
  3667             w > 0 ifTrue:[
  3668                 aView clearRectangleX:x y:y width:w height:h.
  3669                 aView exposeX:x y:y width:w height:h
  3670             ].
  3671             repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
  3672         ]
  3673     ].
  3674 !
  3675 
  3676 redrawSelection
  3677     "redraw all items selected
  3678     "
  3679     |topView size|
  3680 
  3681     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3682 
  3683     (     hiddenLevel == 0
  3684      and:[(size := selection size) > 0
  3685      and:[(topView := listOfItems rootView) notNil
  3686      and:[topView shown
  3687      and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
  3688     ) ifFalse:[
  3689         ^ self
  3690     ].
  3691 
  3692     lockSema critical:[
  3693         |list|
  3694 
  3695         list := selection.
  3696 
  3697         list size > 0 ifTrue:[
  3698             topView paint:(Color black).
  3699             topView clippedByChildren:false.
  3700 
  3701             list keysAndValuesReverseDo:[:anIndex :anItem|
  3702                 (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
  3703 
  3704                 anItem handlesDo:[:aRect :what|
  3705                     what isNil ifTrue:[topView displayRectangle:aRect]
  3706                               ifFalse:[topView    fillRectangle:aRect]
  3707                 ]
  3708             ].
  3709             topView clippedByChildren:true.
  3710         ].
  3711     ].
  3712 !
  3713 
  3714 redrawUnselected:aList andLock:doLock
  3715     "redraw all items unselected; if doLock is true, the hiddenLevel
  3716      is incremented and thus the select mechanism is locked.
  3717     "
  3718     self redrawUnselected:aList andLock:doLock checkTestMode:true.
  3719 !
  3720 
  3721 redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
  3722     "redraw all items unselected; if doLock is true, the hiddenLevel
  3723      is incremented and thus the select mechanism is locked.
  3724     "
  3725     |rootView damages subViews x y w h|
  3726 
  3727     doLock ifTrue:[
  3728         hiddenLevel := hiddenLevel + 1.
  3729         hiddenLevel ~~ 1 ifTrue:[^ self].
  3730     ] ifFalse:[
  3731         hiddenLevel ~~ 0 ifTrue:[^ self].
  3732     ].
  3733     checkTestMode ifTrue:[
  3734         testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
  3735     ].
  3736 
  3737     (     aList size ~~ 0
  3738      and:[(rootView := listOfItems rootView) notNil
  3739      and:[rootView shown]]
  3740     ) ifFalse:[
  3741         ^ self
  3742     ].
  3743 
  3744     lockSema critical:[
  3745         damages := OrderedCollection new:(8 * aList size).
  3746 
  3747         aList do:[:item|
  3748             item handlesDo:[:handle :what|
  3749                 damages reverseDo:[:el|
  3750                     (el intersects:handle) ifTrue:[
  3751                         damages removeIdentical:el.
  3752 
  3753                         handle left:(handle left   min:el left)
  3754                               right:(handle right  max:el right)
  3755                                 top:(handle top    min:el top)
  3756                              bottom:(handle bottom max:el bottom)
  3757                     ]
  3758                 ].                        
  3759                 damages add:handle
  3760             ]
  3761         ].
  3762 
  3763         damages do:[:el|
  3764             x := el left.
  3765             y := el top.
  3766             w := el width.
  3767             h := el height.
  3768 
  3769             rootView clearRectangleX:x y:y width:w height:h.
  3770             rootView         exposeX:x y:y width:w height:h.
  3771         ].
  3772 
  3773         (subViews := rootView subViews) notNil ifTrue:[
  3774             subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
  3775         ].
  3776     ].
  3777 ! !
  3778 
  3779 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'!
  3780 
  3781 isInTestMode
  3782     "answer false, all input events are eaten and the selection is shown on the target view.
  3783      answer true,  no  input events are eaten and no  selection is shown on the target view."
  3784 
  3785     ^ testModeChannel value
  3786 ! !
  3787 
  3788 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'!
  3789 
  3790 at:anIndex
  3791     "returns the selected item at an index or nil
  3792     "
  3793     selection notNil ifTrue:[
  3794         ^ selection at:anIndex ifAbsent:nil
  3795     ].
  3796     ^ nil
  3797 !
  3798 
  3799 at:anIndex ifAbsent:aBlock
  3800     "returns the selected item at an index or the result of the block
  3801     "
  3802     selection notNil ifTrue:[
  3803         ^ selection at:anIndex ifAbsent:aBlock
  3804     ].
  3805     ^ aBlock value
  3806 !
  3807 
  3808 first
  3809     "returns the first selected item or nil
  3810     "
  3811     ^ self at:1
  3812 !
  3813 
  3814 last
  3815     "returns the last selected item or nil
  3816     "
  3817     ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
  3818 !
  3819 
  3820 selectedItem
  3821     "returns the single selected item or nil (size ~~ 1 nil is returned)
  3822     "
  3823     ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
  3824 !
  3825 
  3826 selectedSuperItems
  3827     "returs the list of selected superItems; items selected
  3828      but not contained in another selected item.
  3829     "
  3830     ^ selectedSuperItems
  3831 !
  3832 
  3833 size
  3834     "returns the number of items selected
  3835     "
  3836     ^ selection size
  3837 ! !
  3838 
  3839 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'!
  3840 
  3841 add:item
  3842     "add an item to the current selection
  3843     "
  3844     |newSelect|
  3845 
  3846     item isNil ifTrue:[^ item].
  3847 
  3848     lockSema critical:[
  3849         selection isNil ifTrue:[
  3850             newSelect := Array with:item.
  3851         ] ifFalse:[
  3852             (self includes:item) ifFalse:[
  3853                 newSelect := selection copyWith:item
  3854             ]
  3855         ].
  3856 
  3857         newSelect size ~~ selection size ifTrue:[
  3858             item makeVisible.
  3859             self value:newSelect
  3860         ]
  3861     ].
  3862     ^ item
  3863 !
  3864 
  3865 addAll:aCollectionOfItems
  3866     "add a collection of items to the current selection
  3867     "
  3868     |newSelect|
  3869 
  3870     aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
  3871 
  3872     lockSema critical:[
  3873         selection isNil ifTrue:[
  3874             newSelect := Array withAll:aCollectionOfItems.
  3875         ] ifFalse:[
  3876             newSelect := OrderedCollection withAll:selection.
  3877 
  3878             aCollectionOfItems do:[:el|
  3879                 (selection includesIdentical:el) ifFalse:[newSelect add:el]
  3880             ].
  3881         ].
  3882         self value:newSelect.
  3883     ].
  3884     ^ aCollectionOfItems
  3885 !
  3886 
  3887 deselect
  3888     "clear the selection
  3889     "
  3890     self value:nil.
  3891 !
  3892 
  3893 remove:item
  3894     "remove the item from the current selection
  3895     "
  3896     |newSelect|
  3897 
  3898     item isNil ifTrue:[^ nil].
  3899 
  3900     lockSema critical:[
  3901         (selection notNil and:[selection includesIdentical:item]) ifTrue:[
  3902             selection size == 1 ifTrue:[ newSelect := nil ]
  3903                                ifFalse:[ newSelect := selection copyWithout:item ].
  3904 
  3905             self value:newSelect
  3906         ].
  3907     ].
  3908     ^ item
  3909 !
  3910 
  3911 removeAll
  3912     "clear the selection
  3913     "
  3914     self deselect.
  3915 !
  3916 
  3917 removeAll:loItems
  3918     "remove all items of the collection from the current selection
  3919     "
  3920     |newSelect|
  3921 
  3922     selection   isNil ifTrue:[ ^ loItems ].
  3923     loItems size == 0 ifTrue:[ ^ loItems ].
  3924 
  3925     lockSema critical:[
  3926         selection notNil ifTrue:[
  3927             newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
  3928             self value:newSelect.
  3929         ]
  3930     ].
  3931     ^ loItems
  3932 !
  3933 
  3934 selectAll
  3935     "select all items
  3936     "
  3937     |root newSelection|
  3938 
  3939     root := listOfItems root.
  3940 
  3941     root isNil ifTrue:[
  3942         newSelection := nil
  3943     ] ifFalse:[
  3944         newSelection := OrderedCollection new.
  3945         root recursiveDo:[:el| newSelection add:el ].
  3946     ].
  3947     self value:newSelection.
  3948 !
  3949 
  3950 selectItem:anItem
  3951     "set the current selection to the item
  3952     "
  3953     self value:anItem
  3954 !
  3955 
  3956 selectRootItem
  3957     "set the current selection to the root item
  3958     "
  3959     self value:(self rootItem).
  3960 !
  3961 
  3962 selectedItem:anItem
  3963     "set the current selection to the item
  3964     "
  3965     self selectItem:anItem.
  3966 !
  3967 
  3968 toggleSelectItem:anItem
  3969     "toggle selection-state of the item; add or remove the item from the
  3970      current selection.
  3971     "
  3972     anItem notNil ifTrue:[
  3973         (self includes:anItem) ifTrue:[self remove:anItem]
  3974                               ifFalse:[self add:anItem]
  3975     ].
  3976     ^ anItem
  3977 ! !
  3978 
  3979 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'!
  3980 
  3981 collect:aBlock
  3982     "for each element in the selection, evaluate the argument, aBlock
  3983      and return a new collection with the results
  3984     "
  3985     |res|
  3986 
  3987     res := OrderedCollection new.
  3988     self do:[:el| res add:(aBlock value:el)].
  3989   ^ res
  3990 !
  3991 
  3992 do:aOneArgBlock
  3993     "evaluate the argument, aBlock for each item in the selection
  3994     "
  3995     |cashedSelection|
  3996 
  3997     cashedSelection := selection.
  3998     cashedSelection isNil ifTrue:[^ nil].
  3999   ^ cashedSelection do:aOneArgBlock
  4000 !
  4001 
  4002 from:start do:aOneArgBlock
  4003     "evaluate the argument, aBlock for the items starting at index start
  4004     "
  4005     |cashedSelection|
  4006 
  4007     cashedSelection := selection.
  4008     cashedSelection isNil ifTrue:[^ nil].
  4009   ^ cashedSelection from:start do:aOneArgBlock
  4010 !
  4011 
  4012 from:start to:stop do:aOneArgBlock
  4013     "evaluate the argument, aBlock for the items with index start to
  4014      stop in the selection.
  4015     "
  4016     |cashedSelection|
  4017 
  4018     cashedSelection := selection.
  4019     cashedSelection isNil ifTrue:[^ nil].
  4020   ^ cashedSelection from:start to:stop do:aOneArgBlock
  4021 !
  4022 
  4023 reverseDo:aOneArgBlock
  4024     "evaluate the argument, aBlock for each item in the selection
  4025     "
  4026     |cashedSelection|
  4027 
  4028     cashedSelection := selection.
  4029     cashedSelection isNil ifTrue:[^ nil].
  4030   ^ cashedSelection reverseDo:aOneArgBlock
  4031 !
  4032 
  4033 select:aBlock
  4034     "return a new collection with all elements from the selection, for which
  4035      the argument aBlock evaluates to true.
  4036     "
  4037     |res|
  4038 
  4039     res := OrderedCollection new.
  4040     self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
  4041   ^ res
  4042 ! !
  4043 
  4044 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'!
  4045 
  4046 changed:aParameter with:oldSelection
  4047     "update the visibility staus of the current selection
  4048     "
  4049     |unselected rootView rootItem selSize|
  4050 
  4051     selSize := selection size.
  4052 
  4053     selSize == 0 ifTrue:[
  4054         selectedSuperItems := #().
  4055     ] ifFalse:[
  4056         selSize == 1 ifTrue:[
  4057             selectedSuperItems := Array with:(selection at:1).
  4058         ] ifFalse:[
  4059             rootItem := listOfItems root.
  4060 
  4061             (selection includesIdentical:rootItem) ifTrue:[
  4062                 selectedSuperItems := Array with:rootItem.
  4063             ] ifFalse:[
  4064                 selectedSuperItems := OrderedCollection new:selSize.
  4065 
  4066                 selection do:[:anItem|
  4067                     anItem parentsDetect:[:el| selection includesIdentical:el ]
  4068                                   ifNone:[ selectedSuperItems add:anItem ].
  4069                 ].
  4070             ]
  4071         ]
  4072     ].
  4073 
  4074     (     hiddenLevel == 0
  4075      and:[(rootView := listOfItems rootView) notNil
  4076      and:[rootView shown]]
  4077     ) ifTrue:[
  4078         selSize == 0 ifTrue:[
  4079             "/ must redraw the old selection unselected
  4080             self redrawUnselected:oldSelection andLock:false
  4081         ] ifFalse:[
  4082             self invalidateSelection.
  4083 
  4084             oldSelection size ~~ 0 ifTrue:[
  4085                 "/ must redraw all elements no longer in the selection
  4086                 unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
  4087                 self redrawUnselected:unselected andLock:false.
  4088             ]
  4089         ]
  4090     ].
  4091     super changed:aParameter with:oldSelection.
  4092 !
  4093 
  4094 setValue:aNewSelection 
  4095     "set the selection without notifying
  4096     "
  4097     |newSelect idx|
  4098 
  4099     newSelect := nil.
  4100 
  4101     aNewSelection notNil ifTrue:[
  4102         lockSema critical:[
  4103             aNewSelection isCollection ifFalse:[
  4104                 (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
  4105                     newSelect := selection
  4106                 ] ifFalse:[
  4107                     newSelect := Array with:aNewSelection.
  4108                 ]
  4109             ] ifTrue:[
  4110                 aNewSelection notEmpty ifTrue:[
  4111                     aNewSelection size ~~ selection size ifTrue:[
  4112                         newSelect := aNewSelection copy.
  4113                     ] ifFalse:[
  4114                         idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
  4115 
  4116                         idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
  4117                                 ifFalse:[newSelect := selection ].
  4118                     ]
  4119                 ]
  4120             ]
  4121         ].
  4122     ].
  4123     newSelect ~~ selection ifTrue:[
  4124         beforeSelectionChangedAction value.
  4125         selection := newSelect.
  4126         selection notNil ifTrue:[selection do:[:el| el makeVisible]]
  4127     ].
  4128 !
  4129 
  4130 triggerValue:aValue
  4131     "set my value & send change notifications to my dependents.
  4132      Send the change message even if the value didn't change.
  4133     "
  4134     |oldSelection|
  4135 
  4136     lockSema critical:[
  4137         oldSelection := selection.
  4138         self setValue:aValue.
  4139         self changed:#value with:oldSelection
  4140     ]
  4141 !
  4142 
  4143 value
  4144     "returns the current selection
  4145     "
  4146     ^ selection ? #()
  4147 !
  4148 
  4149 value:aValue
  4150     "change the current selection and send change notifications to my
  4151      dependents if it changed.
  4152     "
  4153     |oldSelection|
  4154 
  4155     lockSema critical:[
  4156         oldSelection := selection.
  4157         self setValue:aValue.
  4158 
  4159         oldSelection == selection ifFalse:[
  4160             self changed:#value with:oldSelection
  4161         ]
  4162     ].
  4163 ! !
  4164 
  4165 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'!
  4166 
  4167 detect:aBlock
  4168     "evaluate the argument, aBlock for each item in the selection until
  4169      the block returns true; in this case return the element which caused
  4170      the true evaluation.
  4171      If none of the evaluations returns true, an error is raised
  4172     "
  4173     ^ self detect:aBlock ifNone:[self errorNotFound]
  4174 !
  4175 
  4176 detect:aBlock ifNone:exceptionBlock
  4177     "evaluate the argument, aBlock for each item in the selection until the
  4178      block returns true; in this case return the element which caused the
  4179      true evaluation.
  4180      If none of the evaluations returns true, the result of the evaluation
  4181      of the exceptionBlock is returned
  4182     "
  4183     |cashedSelection|
  4184 
  4185     cashedSelection := selection.
  4186     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  4187   ^ cashedSelection detect:aBlock ifNone:exceptionBlock
  4188 !
  4189 
  4190 detectLast:aBlock
  4191     "evaluate the argument, aBlock for each item in the selection until
  4192      the block returns true; in this case return the element which caused
  4193      the true evaluation. The items are processed in reverse order.
  4194      If none of the evaluations returns true, an error is raised
  4195     "
  4196     ^ self detectLast:aBlock ifNone:[self errorNotFound]
  4197 !
  4198 
  4199 detectLast:aBlock ifNone:exceptionBlock
  4200     "evaluate the argument, aBlock for each item in the selection until
  4201      the block returns true; in this case return the element which caused
  4202      the true evaluation. The items are processed in reverse order.
  4203      If none of the evaluations returns true, the result of the evaluation
  4204      of the exceptionBlock is returned
  4205     "
  4206     |cashedSelection|
  4207 
  4208     cashedSelection := selection.
  4209     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  4210   ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
  4211 ! !
  4212 
  4213 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'!
  4214 
  4215 includes:anItem
  4216     "returns true if the item is in the current selection
  4217     "
  4218     |cashedSelection|
  4219 
  4220     cashedSelection := selection.
  4221     cashedSelection isNil ifTrue:[^ false].
  4222  ^  cashedSelection includesIdentical:anItem
  4223 !
  4224 
  4225 includesAll:aCollection
  4226     "return true, if all items of the collection are included in the current selection
  4227     "
  4228     |cashedSelection|
  4229 
  4230     aCollection size ~~ 0 ifTrue:[
  4231         cashedSelection := selection.
  4232         cashedSelection isNil ifTrue:[ ^ false ].
  4233 
  4234         aCollection do:[:el|
  4235             (cashedSelection includesIdentical:el) ifFalse:[^ false]
  4236         ]
  4237     ].
  4238     ^ true
  4239 !
  4240 
  4241 includesAny:aCollection
  4242     "return true, if the any item of the collection is in the current selection
  4243     "
  4244     |cashedSelection|
  4245 
  4246     aCollection notNil ifTrue:[
  4247         cashedSelection := selection.
  4248 
  4249         cashedSelection notNil ifTrue:[
  4250             aCollection do:[:el|
  4251                 (cashedSelection includesIdentical:el) ifTrue:[^ true]
  4252             ]
  4253         ]
  4254     ].
  4255     ^ false
  4256 !
  4257 
  4258 includesIdentical:anItem
  4259     "returns true if the item is in the current selection
  4260     "
  4261     ^ self includes:anItem
  4262 !
  4263 
  4264 isEmpty
  4265     "returns true if the current selection is empty
  4266     "
  4267     ^ selection size == 0
  4268 !
  4269 
  4270 isSelected:anItem
  4271     "returns true if the item is in the current selection
  4272     "
  4273     ^ self includes:anItem
  4274 !
  4275 
  4276 notEmpty
  4277     "returns true if the current selection is not empty
  4278     "
  4279     ^ selection size ~~ 0
  4280 ! !
  4281 
  4282 !ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'!
  4283 
  4284 documentation
  4285 "
  4286     Kind of HierarchicalList class which contains all the visible
  4287     ViewTreeItem's and the root, the anchor of the hierarchical list.
  4288 
  4289     [Instance variables:]
  4290         treeModel       <ViewTreeModel>         all events are delegated to
  4291         eventHook       <BlockValue>            save and resore the pre/post -EventHook
  4292 
  4293 
  4294     [author:]
  4295         Claus Atzkern
  4296 
  4297     [see also:]
  4298         HierarchicalList
  4299         ViewTreeModel
  4300         ViewTreeItem
  4301 "
  4302 ! !
  4303 
  4304 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'!
  4305 
  4306 root:theRoot
  4307     "set the root item; delegate events to my treeModel
  4308     "
  4309     |rootView|
  4310 
  4311     theRoot == root ifTrue:[^ self].
  4312 
  4313     rootView := self rootView.
  4314     super root:theRoot.
  4315 
  4316     rootView notNil ifTrue:[ |wgrp|
  4317         wgrp := rootView windowGroup.
  4318 
  4319         wgrp notNil ifTrue:[
  4320            wgrp removePreEventHook:treeModel.
  4321            wgrp removePostEventHook:self.
  4322         ].
  4323     ].
  4324 
  4325     super root:theRoot.
  4326     rootView := self rootView.
  4327 
  4328     rootView notNil ifTrue:[
  4329         "must setup a task because there might not exist a windowGroup at the moment
  4330         "
  4331         [   |wgrp|
  4332 
  4333             [rootView == self rootView] whileTrue:[
  4334                 wgrp := rootView windowGroup.
  4335                 wgrp notNil ifTrue:[
  4336                     rootView := nil.
  4337                     wgrp addPreEventHook:treeModel.
  4338                     wgrp addPostEventHook:self.
  4339                 ] ifFalse:[
  4340                     Delay waitForMilliseconds:100.
  4341                 ].
  4342             ].
  4343 
  4344         ] forkAt:(Processor userSchedulingPriority + 2).
  4345     ].
  4346     treeModel notNil ifTrue:[
  4347         treeModel targetWidgetChanged.
  4348     ].
  4349     
  4350     ^ root.
  4351 !
  4352 
  4353 rootView
  4354     "returns the widget assigned to the root or nil
  4355     "
  4356     ^ root notNil ifTrue:[root widget] ifFalse:[nil]
  4357 !
  4358 
  4359 treeModel
  4360     "returne the treeModel, a ViewTreeModel
  4361     "
  4362     ^ treeModel
  4363 ! !
  4364 
  4365 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'!
  4366 
  4367 additionalLabelForItem:anItem
  4368     "answer the additional lable for an item or nil"
  4369 
  4370     |widget l applClass applClassName key|
  4371 
  4372     widget := anItem widget.
  4373 
  4374     l := nil.
  4375     showWidgetNames == true ifTrue:[
  4376         l := '"', widget name, '"'
  4377     ].
  4378 
  4379     anItem isApplicationClass ifTrue:[
  4380         applClass := anItem applicationClass.
  4381         applClass notNil ifTrue:[   
  4382             applClassName := '[', applClass name allBold, ']'.
  4383             l := (l isNil ifTrue:[''] ifFalse:[l , ' ']) , applClassName
  4384         ].
  4385     ].
  4386 
  4387     application notNil ifTrue:[
  4388         key := application builder namedComponents keyAtValue:widget ifAbsent:nil.
  4389         key notNil ifTrue:[
  4390             l := l , ' #',key
  4391         ].
  4392     ].
  4393 
  4394     ^ l
  4395 !
  4396 
  4397 showWidgetNames
  4398     "answer true if the additional text is the widget name
  4399      otherwise the name of the application"
  4400 
  4401     ^ showWidgetNames ? true
  4402 !
  4403 
  4404 showWidgetNames:aBoolean
  4405     "set true if the additional text is the widget name
  4406      otherwise the name of the application"
  4407 
  4408     self showWidgetNames == aBoolean ifFalse:[
  4409         showWidgetNames := aBoolean.
  4410 
  4411         root notNil ifTrue:[
  4412             root recursiveAdditionalNameBehaviourChanged.
  4413             self changed.
  4414         ].
  4415     ].
  4416 ! !
  4417 
  4418 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'!
  4419 
  4420 processEvent:anEvent
  4421     "post process event
  4422     "
  4423     ^ treeModel isInTestMode not
  4424 ! !
  4425 
  4426 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'!
  4427 
  4428 on:aModel
  4429     "set the model, a ViewTreeModel
  4430     "
  4431     treeModel := aModel.
  4432     showRoot  := true.
  4433     "/ showWidgetNames := false.
  4434     showWidgetNames := true.
  4435 ! !
  4436 
  4437 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'!
  4438 
  4439 detectItemRespondsToView:aView
  4440     "returns the bottom-most item which contains the view
  4441     "
  4442     |view item topView|
  4443 
  4444     root notNil ifTrue:[
  4445         view    := aView.
  4446         topView := root widget.
  4447 
  4448         [ view notNil ] whileTrue:[
  4449             topView == view ifTrue:[^ root].
  4450             item := root recursiveDetect:[:el| el widget == view ].
  4451             item notNil ifTrue:[^ item].
  4452             view := view superView
  4453         ]
  4454     ].
  4455     ^ nil
  4456 !
  4457 
  4458 recursiveDetect:aOneOrgBlock
  4459     "recursive find the first child, for which evaluation 
  4460      of the block returns true; if none nil is returned
  4461     "
  4462     root notNil ifTrue:[
  4463         (aOneOrgBlock value:root) ifTrue:[ ^ root ].
  4464       ^ root recursiveDetect:aOneOrgBlock
  4465     ].
  4466     ^ nil
  4467 ! !
  4468 
  4469 !ViewTreeInspectorApplication class methodsFor:'documentation'!
  4470 
  4471 version
  4472     ^ '$Header$'
  4473 !
  4474 
  4475 version_CVS
  4476     ^ '$Header$'
  4477 ! !
  4478 
  4479 
  4480 ViewTreeInspectorApplication initialize!
  4481 ViewTreeInspectorApplication::ViewTreeItem initialize!