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