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