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