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