Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Wed, 16 Aug 2017 13:52:20 +0200
changeset 3456 4d4297bad4fa
parent 3453 01e6b207c1b4
child 3457 3f3ea99e8af5
permissions -rw-r--r--
#FEATURE by cg
class: Tools::ViewTreeInspectorApplication
also show menus

added:
#selectedMenuItem
#submenuMenuItemInterface:
comment/format in: #selectionChanged
changed:
#doRedraw
#middleButtonMenu
#updateShownStatus

class: Tools::ViewTreeInspectorApplication class
added: #middleButtonMenuForMenuItems

class: Tools::ViewTreeInspectorApplication::ViewTreeItem
class definition
added:
#forMenuItem:
#menuItem
#parent:
comment/format in:
#icon
#specClass
changed:
#displayOn:x:y:h:isHighlightedAsSelected:
#exists
#handlesDo:
#hasChildren
#string

class: Tools::ViewTreeInspectorApplication::ViewTreeItem class
added:
#buildMenuItemsFrom:
#forMenuItem:
comment/format in: #forView:
changed: #buildViewsFrom:

class: Tools::ViewTreeInspectorApplication::ViewTreeModel
changed: #path

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