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