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