Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Thu, 04 Feb 2010 11:31:44 +0100
changeset 2758 c61fe917957a
parent 2757 6c83d6b487b2
child 2759 d9a8fc3f0dc7
permissions -rw-r--r--
comment/format in:8 methods
changed:
#processEvent:
#selectionChanged
cg@2748
     1
"
cg@2748
     2
 COPYRIGHT (c) 2007 by eXept Software AG
cg@2748
     3
              All Rights Reserved
cg@2748
     4
cg@2748
     5
 This software is furnished under a license and may be used
cg@2748
     6
 only in accordance with the terms of that license and with the
cg@2748
     7
 inclusion of the above copyright notice.   This software may not
cg@2748
     8
 be provided or otherwise made available to, or used by, any
cg@2748
     9
 other person.  No title to or ownership of the software is
cg@2748
    10
 hereby transferred.
cg@2748
    11
"
ca@2177
    12
"{ Package: 'stx:libtool2' }"
ca@2177
    13
ca@2177
    14
"{ NameSpace: Tools }"
ca@2177
    15
cg@2744
    16
ToolApplicationModel subclass:#ViewTreeInspectorApplication
ca@2177
    17
	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
ca@2458
    18
		motionAction process followFocusChannel showNamesHolder'
ca@2177
    19
	classVariableNames:''
ca@2177
    20
	poolDictionaries:''
cg@2744
    21
	category:'Interface-Smalltalk'
ca@2177
    22
!
ca@2177
    23
ca@2177
    24
Object subclass:#MenuDesc
ca@2177
    25
	instanceVariableNames:'title value action'
ca@2177
    26
	classVariableNames:''
ca@2177
    27
	poolDictionaries:''
cg@2744
    28
	privateIn:ViewTreeInspectorApplication
ca@2177
    29
!
ca@2177
    30
cg@2744
    31
HierarchicalItem subclass:#ViewTreeItem
cg@2744
    32
	instanceVariableNames:'widget isDrawnShown exists xOffsetAdditionalName'
cg@2744
    33
	classVariableNames:'HandleExtent'
cg@2744
    34
	poolDictionaries:''
cg@2744
    35
	privateIn:ViewTreeInspectorApplication
cg@2744
    36
!
cg@2744
    37
cg@2744
    38
ValueModel subclass:#ViewTreeModel
cg@2744
    39
	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
cg@2744
    40
		inputEventAction mappedViewAction beforeSelectionChangedAction
cg@2744
    41
		icons timedUpdateTask selectOnClickHolder testModeChannel
cg@2744
    42
		hasTargetWidgetChannel'
cg@2744
    43
	classVariableNames:''
cg@2744
    44
	poolDictionaries:''
cg@2744
    45
	privateIn:ViewTreeInspectorApplication
cg@2744
    46
!
cg@2744
    47
cg@2744
    48
HierarchicalList subclass:#ItemList
cg@2744
    49
	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
cg@2744
    50
	classVariableNames:''
cg@2744
    51
	poolDictionaries:''
cg@2744
    52
	privateIn:ViewTreeInspectorApplication::ViewTreeModel
cg@2744
    53
!
cg@2744
    54
cg@2744
    55
!ViewTreeInspectorApplication class methodsFor:'documentation'!
ca@2177
    56
cg@2748
    57
copyright
cg@2748
    58
"
cg@2748
    59
 COPYRIGHT (c) 2007 by eXept Software AG
cg@2748
    60
              All Rights Reserved
cg@2748
    61
cg@2748
    62
 This software is furnished under a license and may be used
cg@2748
    63
 only in accordance with the terms of that license and with the
cg@2748
    64
 inclusion of the above copyright notice.   This software may not
cg@2748
    65
 be provided or otherwise made available to, or used by, any
cg@2748
    66
 other person.  No title to or ownership of the software is
cg@2748
    67
 hereby transferred.
cg@2748
    68
"
cg@2748
    69
!
cg@2748
    70
ca@2177
    71
documentation
ca@2177
    72
"
ca@2177
    73
     Small application showing a ViewTreeModel use.
ca@2177
    74
ca@2177
    75
     It displays a hierarchical list of a selected TopView and
ca@2177
    76
     all its contained subViews.
ca@2177
    77
     Useful to have a look at subcomponents - to see how views
ca@2177
    78
     are structured.
ca@2177
    79
ca@2177
    80
ca@2177
    81
    [Instance variables:]
ca@2177
    82
        model           <ViewTreeModel>      the used ViewTreeModel
ca@2177
    83
        clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
ca@2177
    84
        clickedPoint    <Point>              point where the motion action started from.
ca@2177
    85
        motionAction    <Action>             (oneArg-) action called durring buttonMotion.
ca@2177
    86
ca@2177
    87
ca@2177
    88
    [author:]
ca@2177
    89
        Claus Atzkern
ca@2177
    90
ca@2177
    91
    [see also:]
ca@2177
    92
        ViewTreeModel
ca@2177
    93
        ViewTreeItem
ca@2177
    94
"
ca@2177
    95
! !
ca@2177
    96
cg@2744
    97
!ViewTreeInspectorApplication class methodsFor:'initialization'!
ca@2177
    98
ca@2177
    99
initialize
ca@2177
   100
    "add myself to the launcher menu
ca@2177
   101
    "
ca@2177
   102
    self installInLauncher.
ca@2177
   103
!
ca@2177
   104
ca@2177
   105
installInLauncher
cg@2744
   106
    "add myself to the launcher menu"
cg@2744
   107
ca@2177
   108
    |menuItem icon|
ca@2177
   109
ca@2177
   110
    NewLauncher isNil ifTrue:[^ self].
cg@2744
   111
    "/ cg - disabled. the icon is too ugly.
cg@2744
   112
    ^ self.
ca@2177
   113
ca@2177
   114
    icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
ca@2177
   115
ca@2177
   116
    menuItem := MenuItem new 
cg@2744
   117
                    label: 'View Tree Inspector';
cg@2744
   118
                    value: [ ViewTreeInspectorApplication open];
ca@2177
   119
                    isButton: true;
ca@2177
   120
                    icon: icon;
ca@2177
   121
                    nameKey: #viewInspect.
ca@2177
   122
ca@2177
   123
    menuItem startGroup:#right.
ca@2177
   124
    NewLauncher addMenuItem:menuItem in:'toolbar'
ca@2177
   125
                   position:#( #before #help)
ca@2177
   126
                      space:false.
ca@2177
   127
ca@2177
   128
"
ca@2177
   129
self installInLauncher
ca@2177
   130
self removeFromLauncher
ca@2177
   131
"
ca@2177
   132
!
ca@2177
   133
ca@2177
   134
postAutoload
ca@2177
   135
    "add myself to the launcher menu
ca@2177
   136
    "
ca@2177
   137
    self installInLauncher.
ca@2177
   138
"
ca@2177
   139
self installInLauncher
ca@2177
   140
self removeFromLauncher
ca@2177
   141
"
ca@2177
   142
!
ca@2177
   143
ca@2177
   144
removeFromLauncher
ca@2177
   145
    "remove myself from the launcher menu
ca@2177
   146
    "
ca@2177
   147
    NewLauncher isNil ifTrue:[^ self].
ca@2177
   148
    NewLauncher removeUserTool:#viewInspect
ca@2177
   149
ca@2177
   150
"
ca@2177
   151
self installInLauncher
ca@2177
   152
self removeFromLauncher
ca@2177
   153
"
ca@2177
   154
!
ca@2177
   155
ca@2177
   156
unload
ca@2177
   157
    "class is about to be unloaded - remove myself from the launcher menu
ca@2177
   158
    "
ca@2177
   159
    self removeFromLauncher.
ca@2177
   160
    super unload.
ca@2177
   161
! !
ca@2177
   162
cg@2744
   163
!ViewTreeInspectorApplication class methodsFor:'image specs'!
cg@2744
   164
cg@2744
   165
pickWindowIcon
cg@2744
   166
    "This resource specification was automatically generated
cg@2744
   167
     by the ImageEditor of ST/X."
cg@2744
   168
cg@2744
   169
    "Do not manually edit this!! If it is corrupted,
cg@2744
   170
     the ImageEditor may not be able to read the specification."
cg@2744
   171
cg@2744
   172
    "
cg@2744
   173
     self pickWindowIcon inspect
cg@2744
   174
     ImageEditor openOnClass:self andSelector:#pickWindowIcon
cg@2744
   175
     Icon flushCachedIcons
cg@2744
   176
    "
cg@2744
   177
cg@2744
   178
    <resource: #image>
cg@2744
   179
cg@2744
   180
    ^Icon
cg@2744
   181
        constantNamed:'Tools::ViewTreeInspectorApplication class pickWindowIcon'
cg@2744
   182
        ifAbsentPut:[(Depth8Image new) width: 22; height: 22; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
cg@2744
   183
,;N3,;N3,;N3,;N3,;N3,;N3,;N3,3H<P38;M3P,H2@^GA(VEQHQCP0KA D<[&-%XU=WST%BN#D!!GQ$TD@(IBP\BQF)+Z6E_U4-FPCX+G1,WEA@JBP$HAT23
cg@2744
   184
,;N3,;N3,;N3,;N$():Z&IRR&1!!^,;N3,;N3,;N3,;N$)JJ^&)"T$),0W[N3,;N3,;N3,;N3,:R"'')*X%IJWK523,;N3,;N3,0@@@KN3)JJ^&)"T$"5Z,;N3
cg@2744
   185
,;N3@@B3-KL@@JJ^&)"T$)D*V[N3,;N3@KN3-KR4)JH@&)"T$)*MJE"3,;N3,0B3)JJ4&*R"@I*X%IJZ#RYV,;N3,0B3@JR"-JR"-I(@%IJV%H %U[N3,;L@
cg@2744
   186
-@B4-KR4-KR4@IRR%IJEIER3,;N3@KL@)JJ4():4&@BO#9RR!!RIS,;N3,;L@,:R"-JJ^& BT#8>O#8H"T+N3,;N3@KN$@@@@'')(@%H>O#(>AH%F3,;N3,;L@
cg@2744
   187
@JR4'' @@%IJO#8>O RIO,;N3,;N3):P@@@BX%IJO#8>O#7<"S*63,;N$():Z&IRR&IRR#8>O#8=>H"&-,;N$():Z&IRR&)"T$(>O#8>O @<)R$!!GQTD?OS$8
cg@2744
   188
MSL.I2H"H"H"H"HO,;N3,;N3,;N3,;N3,;N3,;N3,;N3,0@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 0 50 164 0 50 171 0 137 0 0 206 0 1 50 177 2 56 178 3 64 241 3 67 246 3 73 255 4 74 255 5 63 191 7 66 194 10 71 196 10 79 255 12 59 167 12 82 255 14 77 199 18 83 201 19 88 255 21 91 255 23 89 204 27 95 206 28 97 255 29 72 179 30 100 255 32 101 209 36 106 255 36 107 211 39 109 255 41 113 214 45 115 255 45 119 216 48 118 255 50 87 176 50 125 219 51 88 176 51 88 177 52 89 178 52 90 178 53 90 178 53 127 212 54 91 179 54 123 255 54 131 221 55 92 180 55 95 181 56 93 180 56 94 181 57 127 255 57 149 229 58 99 184 58 137 224 61 104 187 63 132 255 63 143 226 64 108 190 66 113 193 66 135 255 67 149 229 68 157 232 69 117 196 71 155 231 72 122 199 72 141 255 75 126 202 75 144 255 75 160 234 77 163 236 78 131 206 80 149 255 81 136 209 84 140 212 84 153 255 87 145 215 88 157 255 91 168 235 93 161 255 94 154 222 96 157 223 96 165 255 97 159 225 98 160 225 98 162 226 99 163 227 100 165 228 101 166 229 101 170 255 102 167 230 103 169 231 104 170 232 104 173 255 105 172 233 105 174 234 106 175 235 109 178 255 112 180 255 117 186 255 119 187 255 122 154 245 125 160 253 125 193 255 126 161 253 126 194 255 127 162 254 130 165 254 132 200 255 132 201 255 133 60 36 135 170 255 139 207 255 140 175 255 144 179 255 149 184 255 153 188 255 157 192 255 162 196 255 166 200 255 170 204 255 174 208 255 174 218 230 177 212 255 181 215 255 185 219 255 188 222 255 191 225 255 212 211 224 218 217 230 219 219 230 220 220 231 222 221 232 223 223 233 225 224 234 225 225 234 226 226 237 227 226 235 227 227 236 227 227 238 228 228 237 229 229 239 231 230 238 231 231 238 231 231 240 232 232 241 233 232 239 233 233 240 234 234 242 235 234 241 236 236 243 237 236 242 237 237 244 238 237 243 238 238 244 239 238 243 239 239 245 240 239 244 241 240 245 241 241 246 241 241 247 242 242 246 242 242 247 243 243 247 243 243 248 244 244 248 244 244 249 245 244 247 246 246 249 246 246 250 247 246 249 247 247 250 248 248 251 249 249 250 249 249 251 250 250 251 250 250 252 251 251 252 251 251 253 253 253 254 254 254 255 255 255 255 0 0 0]; mask:((Depth1Image new) width: 22; height: 22; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@C????????????????????????????????????????????????????????????????????????????????@@@C') ; yourself); yourself]
cg@2744
   189
! !
cg@2744
   190
cg@2744
   191
!ViewTreeInspectorApplication class methodsFor:'interface specs'!
ca@2177
   192
ca@2177
   193
windowSpec
ca@2177
   194
    "This resource specification was automatically generated
ca@2177
   195
     by the UIPainter of ST/X."
ca@2177
   196
ca@2177
   197
    "Do not manually edit this!! If it is corrupted,
ca@2177
   198
     the UIPainter may not be able to read the specification."
ca@2177
   199
ca@2177
   200
    "
cg@2757
   201
     UIPainter new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#windowSpec
cg@2757
   202
     Tools::ViewTreeInspectorApplication new openInterface:#windowSpec
cg@2757
   203
     Tools::ViewTreeInspectorApplication open
ca@2177
   204
    "
ca@2177
   205
ca@2177
   206
    <resource: #canvas>
ca@2177
   207
ca@2177
   208
    ^ 
ca@2177
   209
     #(FullSpec
ca@2177
   210
        name: windowSpec
ca@2177
   211
        window: 
ca@2177
   212
       (WindowSpec
cg@2744
   213
          label: 'View Tree Inspector'
cg@2757
   214
          name: 'View Tree Inspector'
ca@2177
   215
          min: (Point 10 10)
ca@2177
   216
          max: (Point 1024 9999)
ca@2451
   217
          bounds: (Rectangle 0 0 381 654)
ca@2177
   218
          menu: menu
ca@2177
   219
        )
ca@2177
   220
        component: 
ca@2177
   221
       (SpecCollection
ca@2177
   222
          collection: (
ca@2177
   223
           (MenuPanelSpec
ca@2177
   224
              name: 'toolbarMenu'
cg@2757
   225
              layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0)
ca@2177
   226
              menu: toolbarMenu
ca@2177
   227
              textDefault: true
ca@2177
   228
            )
ca@2177
   229
           (HierarchicalListViewSpec
ca@2177
   230
              name: 'List'
cg@2757
   231
              layout: (LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0)
ca@2177
   232
              level: 1
ca@2177
   233
              model: model
ca@2177
   234
              menu: middleButtonMenu
ca@2177
   235
              hasHorizontalScrollBar: true
ca@2177
   236
              hasVerticalScrollBar: true
ca@2177
   237
              miniScrollerHorizontal: true
ca@2177
   238
              miniScrollerVertical: false
ca@2177
   239
              listModel: listOfItems
ca@2177
   240
              multipleSelectOk: true
ca@2177
   241
              useIndex: false
ca@2177
   242
              highlightMode: label
ca@2177
   243
              showLeftIndicators: false
ca@2177
   244
              indicatorSelector: indicatorClicked:
ca@2177
   245
              useDefaultIcons: false
ca@2177
   246
              postBuildCallback: postBuildTree:
ca@2177
   247
            )
ca@2177
   248
           )
ca@2177
   249
         
ca@2177
   250
        )
ca@2177
   251
      )
ca@2177
   252
! !
ca@2177
   253
cg@2744
   254
!ViewTreeInspectorApplication class methodsFor:'menu specs'!
ca@2177
   255
ca@2177
   256
menu
ca@2177
   257
    "This resource specification was automatically generated
ca@2177
   258
     by the MenuEditor of ST/X."
ca@2177
   259
ca@2177
   260
    "Do not manually edit this!! If it is corrupted,
ca@2177
   261
     the MenuEditor may not be able to read the specification."
ca@2177
   262
ca@2177
   263
    "
ca@2454
   264
     MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
ca@2454
   265
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
ca@2177
   266
    "
ca@2177
   267
ca@2177
   268
    <resource: #menu>
ca@2177
   269
ca@2177
   270
    ^ 
ca@2177
   271
     #(Menu
ca@2177
   272
        (
ca@2177
   273
         (MenuItem
ca@2177
   274
            label: 'File'
ca@2177
   275
            translateLabel: true
ca@2177
   276
            submenu: 
ca@2177
   277
           (Menu
ca@2177
   278
              (
ca@2177
   279
               (MenuItem
ca@2177
   280
                  label: 'Pick a View'
ca@2177
   281
                  itemValue: doPickViews
ca@2177
   282
                  translateLabel: true
ca@2177
   283
                )
ca@2177
   284
               (MenuItem
ca@2455
   285
                  enabled: hasTargetWidgetChannel
ca@2177
   286
                  label: 'Release Picked View'
ca@2177
   287
                  itemValue: doUnpick
ca@2177
   288
                  translateLabel: true
ca@2177
   289
                )
ca@2177
   290
               (MenuItem
ca@2177
   291
                  label: '-'
ca@2177
   292
                )
ca@2177
   293
               (MenuItem
cg@2744
   294
                  label: 'Settings'
cg@2744
   295
                  translateLabel: true
cg@2744
   296
                  submenu: 
cg@2744
   297
                 (Menu
cg@2744
   298
                    (
cg@2744
   299
                     (MenuItem
cg@2744
   300
                        label: 'Test Mode'
cg@2744
   301
                        translateLabel: true
cg@2744
   302
                        hideMenuOnActivated: false
cg@2744
   303
                        indication: testModeChannel
cg@2744
   304
                      )
cg@2744
   305
                     (MenuItem
cg@2744
   306
                        enabled: testModeChannel
cg@2744
   307
                        label: 'Follow Focus'
cg@2744
   308
                        translateLabel: true
cg@2744
   309
                        hideMenuOnActivated: false
cg@2744
   310
                        indication: followFocusChannel
cg@2744
   311
                      )
cg@2744
   312
                     (MenuItem
cg@2744
   313
                        label: '-'
cg@2744
   314
                      )
cg@2744
   315
                     (MenuItem
cg@2744
   316
                        label: 'Select on Click'
cg@2744
   317
                        translateLabel: true
cg@2744
   318
                        hideMenuOnActivated: false
cg@2744
   319
                        indication: selectOnClickHolder
cg@2744
   320
                      )
cg@2744
   321
                     (MenuItem
cg@2744
   322
                        label: '-'
cg@2744
   323
                      )
cg@2744
   324
                     (MenuItem
cg@2744
   325
                        label: 'Show Name of Widgets'
cg@2744
   326
                        translateLabel: true
cg@2744
   327
                        hideMenuOnActivated: false
cg@2744
   328
                        indication: showNamesHolder
cg@2744
   329
                      )
cg@2744
   330
                     )
cg@2744
   331
                    nil
cg@2744
   332
                    nil
cg@2744
   333
                  )
cg@2744
   334
                )
cg@2744
   335
               (MenuItem
cg@2744
   336
                  label: '-'
cg@2744
   337
                )
cg@2744
   338
               (MenuItem
ca@2177
   339
                  label: 'Exit'
ca@2177
   340
                  itemValue: closeRequest
ca@2177
   341
                  translateLabel: true
ca@2177
   342
                )
ca@2177
   343
               )
ca@2177
   344
              nil
ca@2177
   345
              nil
ca@2177
   346
            )
ca@2177
   347
          )
ca@2177
   348
         (MenuItem
cg@2744
   349
            enabled: hasSingleSelectionHolder
cg@2744
   350
            label: 'Selection'
cg@2744
   351
            translateLabel: true
cg@2744
   352
            submenuChannel: middleButtonMenu
cg@2744
   353
          )
cg@2744
   354
         (MenuItem
cg@2744
   355
            label: 'Application'
ca@2454
   356
            translateLabel: true
ca@2454
   357
            submenu: 
ca@2454
   358
           (Menu
ca@2454
   359
              (
ca@2454
   360
               (MenuItem
cg@2744
   361
                  enabled: hasSingleSelectionHolder
cg@2744
   362
                  label: 'Browse'
cg@2744
   363
                  itemValue: doBrowse:
ca@2454
   364
                  translateLabel: true
cg@2744
   365
                  argument: application
ca@2454
   366
                )
ca@2454
   367
               (MenuItem
cg@2744
   368
                  enabled: hasSingleSelectionHolder
cg@2744
   369
                  label: 'Inspect'
cg@2744
   370
                  itemValue: doInspect:
ca@2454
   371
                  translateLabel: true
cg@2744
   372
                  argument: application
ca@2454
   373
                )
ca@2454
   374
               (MenuItem
ca@2454
   375
                  label: '-'
ca@2454
   376
                )
ca@2454
   377
               (MenuItem
cg@2744
   378
                  enabled: hasTargetWidgetChannel
cg@2744
   379
                  label: 'All Applications'
ca@2454
   380
                  translateLabel: true
cg@2744
   381
                  submenuChannel: submenuApplications:
cg@2744
   382
                )
cg@2744
   383
               )
cg@2744
   384
              nil
cg@2744
   385
              nil
cg@2744
   386
            )
cg@2744
   387
          )
cg@2744
   388
         (MenuItem
cg@2744
   389
            label: 'Widget'
cg@2744
   390
            translateLabel: true
cg@2744
   391
            submenu: 
cg@2744
   392
           (Menu
cg@2744
   393
              (
cg@2744
   394
               (MenuItem
cg@2744
   395
                  enabled: hasSingleSelectionHolder
cg@2744
   396
                  label: 'Browse'
cg@2744
   397
                  itemValue: doBrowse:
cg@2744
   398
                  translateLabel: true
cg@2744
   399
                  argument: view
cg@2744
   400
                )
cg@2744
   401
               (MenuItem
cg@2744
   402
                  enabled: hasSingleSelectionHolder
cg@2744
   403
                  label: 'Inspect'
cg@2744
   404
                  itemValue: doInspect:
cg@2744
   405
                  translateLabel: true
cg@2744
   406
                  argument: view
ca@2454
   407
                )
ca@2454
   408
               (MenuItem
ca@2454
   409
                  label: '-'
ca@2454
   410
                )
ca@2454
   411
               (MenuItem
cg@2744
   412
                  enabled: hasTargetWidgetChannel
cg@2744
   413
                  label: 'All Components'
ca@2454
   414
                  translateLabel: true
cg@2744
   415
                  startGroup: right
cg@2744
   416
                  submenuChannel: submenuComponents:
ca@2454
   417
                )
ca@2454
   418
               )
ca@2454
   419
              nil
ca@2454
   420
              nil
ca@2454
   421
            )
ca@2454
   422
          )
ca@2454
   423
         (MenuItem
cg@2744
   424
            label: 'Help'
ca@2177
   425
            translateLabel: true
cg@2744
   426
            startGroup: conditionalRight
cg@2744
   427
            submenu: 
cg@2744
   428
           (Menu
cg@2744
   429
              (
cg@2744
   430
               (MenuItem
cg@2744
   431
                  label: 'Documentation'
cg@2744
   432
                  itemValue: openDocumentation
cg@2744
   433
                  translateLabel: true
cg@2744
   434
                )
cg@2744
   435
               (MenuItem
cg@2744
   436
                  label: '-'
cg@2744
   437
                )
cg@2744
   438
               (MenuItem
cg@2744
   439
                  label: 'About this Application...'
cg@2744
   440
                  itemValue: openAboutThisApplication
cg@2744
   441
                  translateLabel: true
cg@2744
   442
                )
cg@2744
   443
               )
cg@2744
   444
              nil
cg@2744
   445
              nil
cg@2744
   446
            )
ca@2177
   447
          )
ca@2177
   448
         )
ca@2177
   449
        nil
ca@2177
   450
        nil
ca@2177
   451
      )
ca@2177
   452
!
ca@2177
   453
ca@2177
   454
middleButtonMenu
ca@2177
   455
    "This resource specification was automatically generated
ca@2177
   456
     by the MenuEditor of ST/X."
ca@2177
   457
ca@2177
   458
    "Do not manually edit this!! If it is corrupted,
ca@2177
   459
     the MenuEditor may not be able to read the specification."
ca@2177
   460
ca@2177
   461
    "
ca@2177
   462
     MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
ca@2177
   463
     (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
ca@2177
   464
    "
ca@2177
   465
ca@2177
   466
    <resource: #menu>
ca@2177
   467
ca@2177
   468
    ^ 
ca@2177
   469
     #(Menu
ca@2177
   470
        (
ca@2177
   471
         (MenuItem
ca@2177
   472
            label: 'Geometry'
ca@2177
   473
            translateLabel: true
ca@2177
   474
            submenuChannel: submenuGeometry:
ca@2177
   475
            keepLinkedMenu: true
ca@2177
   476
          )
ca@2177
   477
         (MenuItem
ca@2177
   478
            label: 'Interface'
ca@2177
   479
            translateLabel: true
ca@2177
   480
            submenuChannel: submenuInterface:
ca@2177
   481
            keepLinkedMenu: true
ca@2177
   482
          )
ca@2177
   483
         (MenuItem
ca@2177
   484
            label: 'Visibility'
ca@2177
   485
            translateLabel: true
ca@2177
   486
            submenuChannel: submenuVisibility:
ca@2177
   487
            keepLinkedMenu: true
ca@2177
   488
          )
ca@2177
   489
         (MenuItem
ca@2177
   490
            label: '-'
ca@2177
   491
          )
ca@2177
   492
         (MenuItem
ca@2177
   493
            label: 'Browse View Class'
ca@2177
   494
            itemValue: doBrowse:
ca@2177
   495
            translateLabel: true
ca@2177
   496
            argument: view
ca@2177
   497
          )
ca@2177
   498
         (MenuItem
ca@2177
   499
            label: 'Browse Model Class'
ca@2177
   500
            itemValue: doBrowse:
ca@2177
   501
            translateLabel: true
ca@2177
   502
            isVisible: hasModel
ca@2177
   503
            argument: model
ca@2177
   504
          )
ca@2177
   505
         (MenuItem
ca@2177
   506
            label: 'Browse Application Class'
ca@2177
   507
            itemValue: doBrowse:
ca@2177
   508
            translateLabel: true
ca@2177
   509
            isVisible: hasApplication
ca@2177
   510
            argument: application
ca@2177
   511
          )
ca@2177
   512
         (MenuItem
ca@2177
   513
            label: 'Browse Controller Class'
ca@2177
   514
            itemValue: doBrowse:
ca@2177
   515
            translateLabel: true
ca@2177
   516
            isVisible: hasController
ca@2177
   517
            argument: controller
ca@2177
   518
          )
ca@2177
   519
         (MenuItem
ca@2177
   520
            label: '-'
ca@2177
   521
          )
ca@2177
   522
         (MenuItem
ca@2177
   523
            label: 'Inspect View'
ca@2177
   524
            itemValue: doInspect:
ca@2177
   525
            translateLabel: true
ca@2177
   526
            argument: view
ca@2177
   527
          )
ca@2177
   528
         (MenuItem
ca@2177
   529
            label: 'Inspect Window Group'
ca@2177
   530
            itemValue: doInspect:
ca@2177
   531
            translateLabel: true
ca@2177
   532
            argument: group
ca@2177
   533
          )
ca@2177
   534
         (MenuItem
ca@2177
   535
            label: 'Inspect Model'
ca@2177
   536
            itemValue: doInspect:
ca@2177
   537
            translateLabel: true
ca@2177
   538
            isVisible: hasModel
ca@2177
   539
            argument: model
ca@2177
   540
          )
ca@2177
   541
         (MenuItem
ca@2177
   542
            label: 'Inspect Application'
ca@2177
   543
            itemValue: doInspect:
ca@2177
   544
            translateLabel: true
ca@2177
   545
            isVisible: hasApplication
ca@2177
   546
            argument: application
ca@2177
   547
          )
ca@2177
   548
         (MenuItem
ca@2177
   549
            label: 'Inspect Controller'
ca@2177
   550
            itemValue: doInspect:
ca@2177
   551
            translateLabel: true
ca@2177
   552
            isVisible: hasController
ca@2177
   553
            argument: controller
ca@2177
   554
          )
ca@2177
   555
         (MenuItem
ca@2177
   556
            label: '-'
ca@2177
   557
          )
ca@2177
   558
         (MenuItem
ca@2177
   559
            label: 'Flash'
ca@2177
   560
            itemValue: doFlash
ca@2177
   561
            translateLabel: true
ca@2177
   562
          )
ca@2177
   563
         (MenuItem
ca@2177
   564
            label: '-'
ca@2177
   565
          )
ca@2177
   566
         (MenuItem
ca@2177
   567
            label: 'Destroy'
ca@2177
   568
            itemValue: doDestroy
ca@2177
   569
            translateLabel: true
ca@2177
   570
          )
ca@2177
   571
         (MenuItem
ca@2177
   572
            label: '-'
ca@2177
   573
          )
ca@2177
   574
         (MenuItem
ca@2177
   575
            label: 'Instance Variables'
ca@2177
   576
            translateLabel: true
ca@2177
   577
            submenuChannel: submenuInspector:
ca@2177
   578
            keepLinkedMenu: true
ca@2177
   579
          )
ca@2177
   580
         (MenuItem
ca@2177
   581
            label: '='
ca@2177
   582
          )
ca@2177
   583
         (MenuItem
ca@2177
   584
            label: ''
ca@2177
   585
          )
ca@2177
   586
         (MenuItem
ca@2177
   587
            enabled: selectedComponentHasChildren
ca@2177
   588
            label: 'Applications'
ca@2177
   589
            nameKey: single
ca@2177
   590
            translateLabel: true
ca@2177
   591
            submenuChannel: submenuApplications:
ca@2177
   592
            keepLinkedMenu: true
ca@2177
   593
          )
ca@2177
   594
         (MenuItem
ca@2177
   595
            enabled: selectedComponentHasChildren
ca@2177
   596
            label: 'Components'
ca@2177
   597
            nameKey: single
ca@2177
   598
            translateLabel: true
ca@2177
   599
            submenuChannel: submenuComponents:
ca@2177
   600
            keepLinkedMenu: true
ca@2177
   601
          )
ca@2177
   602
         )
ca@2177
   603
        nil
ca@2177
   604
        nil
ca@2177
   605
      )
ca@2177
   606
!
ca@2177
   607
ca@2177
   608
toolbarMenu
ca@2177
   609
    "This resource specification was automatically generated
ca@2177
   610
     by the MenuEditor of ST/X."
ca@2177
   611
ca@2177
   612
    "Do not manually edit this!! If it is corrupted,
ca@2177
   613
     the MenuEditor may not be able to read the specification."
ca@2177
   614
ca@2177
   615
    "
cg@2757
   616
     MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#toolbarMenu
cg@2757
   617
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication toolbarMenu)) startUp
ca@2177
   618
    "
ca@2177
   619
ca@2177
   620
    <resource: #menu>
ca@2177
   621
ca@2177
   622
    ^ 
ca@2177
   623
     #(Menu
ca@2177
   624
        (
ca@2177
   625
         (MenuItem
cg@2744
   626
            label: 'Pick a View'
cg@2744
   627
            itemValue: doPickViews
cg@2744
   628
            translateLabel: false
cg@2744
   629
            isButton: true
cg@2744
   630
            hideMenuOnActivated: false
cg@2744
   631
            labelImage: (ResourceRetriever #'Tools::ViewTreeInspectorApplication' pickWindowIcon)
cg@2744
   632
          )
cg@2744
   633
         (MenuItem
cg@2757
   634
            enabled: hasTargetWidgetChannel
cg@2757
   635
            label: 'Release Picked View'
cg@2757
   636
            isButton: true
cg@2757
   637
            itemValue: doUnpick
cg@2757
   638
            translateLabel: true
cg@2757
   639
            labelImage: (ResourceRetriever ToolbarIconLibrary undoIcon)
cg@2757
   640
          )
cg@2757
   641
         (MenuItem
cg@2757
   642
            label: '-'
cg@2757
   643
          )
cg@2757
   644
         (MenuItem
ca@2454
   645
            enabled: hasSingleSelectionHolder
cg@2744
   646
            label: 'Browse Application'
ca@2454
   647
            itemValue: doBrowse:
ca@2454
   648
            translateLabel: false
cg@2744
   649
            isButton: true
cg@2744
   650
            hideMenuOnActivated: false
ca@2454
   651
            labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
ca@2454
   652
            argument: application
ca@2177
   653
          )
ca@2177
   654
         (MenuItem
ca@2454
   655
            enabled: hasSingleSelectionHolder
cg@2744
   656
            label: 'Inspect Application'
ca@2454
   657
            itemValue: doInspect:
ca@2454
   658
            translateLabel: false
cg@2744
   659
            isButton: true
cg@2744
   660
            hideMenuOnActivated: false
cg@2744
   661
            labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon)
ca@2454
   662
            argument: application
ca@2177
   663
          )
ca@2177
   664
         )
ca@2177
   665
        nil
ca@2177
   666
        nil
ca@2177
   667
      )
ca@2177
   668
! !
ca@2177
   669
cg@2747
   670
!ViewTreeInspectorApplication class methodsFor:'startup'!
cg@2747
   671
cg@2747
   672
openInPickMode
cg@2747
   673
    |app|
cg@2747
   674
cg@2747
   675
    app := self new.
cg@2747
   676
    app open.
cg@2747
   677
    app doPickViews.
cg@2747
   678
! !
cg@2747
   679
cg@2744
   680
!ViewTreeInspectorApplication methodsFor:'actions'!
ca@2177
   681
ca@2177
   682
indicatorClicked:anIndex
ca@2177
   683
    |item sensor|
ca@2177
   684
ca@2177
   685
    item := model listOfItems at:anIndex ifAbsent:nil.
ca@2177
   686
ca@2177
   687
    item notNil ifTrue:[
ca@2177
   688
        (     (sensor := self window sensor) notNil
ca@2177
   689
         and:[(sensor ctrlDown or:[sensor shiftDown])]
ca@2177
   690
        ) ifTrue:[
ca@2177
   691
            item recursiveToggleExpand
ca@2177
   692
        ] ifFalse:[
ca@2177
   693
            item toggleExpand
ca@2177
   694
        ]
ca@2177
   695
    ].
ca@2177
   696
! !
ca@2177
   697
cg@2744
   698
!ViewTreeInspectorApplication methodsFor:'aspects'!
ca@2177
   699
ca@2177
   700
followFocusChannel
ca@2455
   701
    "boolean holder, which indicates whether selection changed dependend on the focus view"
ca@2455
   702
ca@2177
   703
    ^ followFocusChannel
ca@2177
   704
!
ca@2177
   705
ca@2177
   706
hasSingleSelectionHolder
ca@2455
   707
    "boolean holder, true if one item is selected"
ca@2455
   708
ca@2177
   709
    ^ hasSingleSelectionHolder
ca@2177
   710
!
ca@2177
   711
ca@2455
   712
hasTargetWidgetChannel
ca@2455
   713
    "answer the channel which is set to true if a target widget exists"
ca@2455
   714
ca@2455
   715
    ^ model hasTargetWidgetChannel
ca@2455
   716
!
ca@2455
   717
ca@2177
   718
listOfItems
ca@2455
   719
    "returns the hierarchical list of items"
ca@2455
   720
ca@2177
   721
    ^ model listOfItems
ca@2177
   722
!
ca@2177
   723
ca@2177
   724
model
ca@2455
   725
    "returns my selection model, a ViewTreeModel"
ca@2455
   726
ca@2177
   727
    ^ model
ca@2177
   728
!
ca@2177
   729
ca@2177
   730
selectOnClickHolder
ca@2455
   731
    "boolean holder, which indicates whether the selection will change on click"
ca@2455
   732
ca@2177
   733
    ^ model selectOnClickHolder
ca@2177
   734
!
ca@2177
   735
ca@2451
   736
showNamesHolder
ca@2451
   737
    "boolean holder, which indicates whether application names or widget names
ca@2455
   738
     as additional text are shown for the items"
ca@2455
   739
ca@2451
   740
    ^ showNamesHolder
ca@2451
   741
!
ca@2451
   742
ca@2177
   743
testModeChannel
ca@2455
   744
    "answer a boolean channel which describes the behaviour how to process
ca@2455
   745
     events on the target view.
ca@2455
   746
ca@2455
   747
     false: all input events are eaten and the selection is shown on the target view.
ca@2455
   748
     true:  no  input events are eaten and no  selection is shown on the target view."
ca@2455
   749
ca@2455
   750
    ^ model testModeChannel
ca@2177
   751
! !
ca@2177
   752
cg@2744
   753
!ViewTreeInspectorApplication methodsFor:'change & update'!
ca@2177
   754
ca@2177
   755
selectionChanged
ca@2177
   756
    |info view item|
ca@2177
   757
ca@2177
   758
    item := model selectedItem.
ca@2177
   759
ca@2177
   760
    item notNil ifTrue:[ |state|
ca@2177
   761
        view := item widget.
ca@2177
   762
ca@2177
   763
        view id isNil ifTrue:[
ca@2177
   764
            state := 'no ID'.
ca@2177
   765
        ] ifFalse:[
ca@2177
   766
            view shown ifTrue:[
ca@2177
   767
                state := 'visible'.
ca@2177
   768
            ] ifFalse:[
ca@2177
   769
                state := 'invisible'
ca@2177
   770
            ].
ca@2177
   771
        ].
ca@2177
   772
        info := '%1 [%2] - %3' bindWith:(view class name)
ca@2177
   773
                                   with:(view name ? '') with:state allBold.
ca@2177
   774
ca@2177
   775
    ] ifFalse:[
ca@2177
   776
        info := ''
ca@2177
   777
    ].
ca@2177
   778
    hasSingleSelectionHolder value:(view notNil).
ca@2177
   779
!
ca@2177
   780
ca@2177
   781
update:something with:someArgument from:aModel
ca@2454
   782
    |oldSelection|
ca@2454
   783
ca@2451
   784
    aModel == showNamesHolder ifTrue:[
ca@2455
   785
        oldSelection := model selectedItem.
ca@2454
   786
        model selectedItem:nil.
ca@2451
   787
        self listOfItems showWidgetNames:(aModel value).
ca@2454
   788
        model selectedItem:oldSelection.
ca@2451
   789
        ^ self
ca@2451
   790
    ].
ca@2458
   791
ca@2458
   792
    aModel == model ifTrue:[
ca@2458
   793
        self selectionChanged.
ca@2458
   794
        ^ self
ca@2458
   795
    ].
ca@2458
   796
ca@2177
   797
    super update:something with:someArgument from:aModel.
ca@2177
   798
! !
ca@2177
   799
cg@2744
   800
!ViewTreeInspectorApplication methodsFor:'event processing'!
ca@2177
   801
ca@2177
   802
processButtonMotionEvent:ev
ca@2455
   803
    |click rootView|
ca@2177
   804
ca@2455
   805
    motionAction isNil ifTrue:[^ self].
ca@2455
   806
ca@2455
   807
    (rootView := model rootView) isNil ifTrue:[
ca@2455
   808
        clickedItem := motionAction := nil.
ca@2455
   809
        ^ self
ca@2455
   810
    ].
ca@2455
   811
ca@2455
   812
    click := rootView device
ca@2455
   813
            translatePoint:((ev x)@ (ev y))
ca@2455
   814
            fromView:(ev view)
ca@2455
   815
            toView:rootView.
ca@2455
   816
ca@2455
   817
    click = clickedPoint ifFalse:[
ca@2455
   818
        (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
ca@2455
   819
            motionAction value:click
ca@2177
   820
        ]
ca@2177
   821
    ].
ca@2177
   822
!
ca@2177
   823
ca@2177
   824
processButtonPressEvent:ev
ca@2455
   825
    |rootView sensor lastRectangle|
ca@2455
   826
ca@2455
   827
    rootView    := model rootView.
ca@2177
   828
    sensor      := model rootView sensor.
ca@2177
   829
    clickedItem := model listOfItems detectItemRespondsToView:(ev view).
ca@2177
   830
ca@2177
   831
    (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
ca@2177
   832
        clickedItem notNil ifTrue:[
ca@2177
   833
            self selectOnClickHolder value ifTrue:[
ca@2177
   834
                model toggleSelectItem:clickedItem
ca@2177
   835
            ].
ca@2177
   836
        ].
ca@2177
   837
        clickedItem := motionAction := nil.
ca@2455
   838
        ^ self
ca@2455
   839
    ].
ca@2177
   840
ca@2455
   841
    clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
ca@2455
   842
    lastRectangle := nil.
ca@2177
   843
ca@2455
   844
    motionAction :=[:p|
ca@2455
   845
        rootView    := model rootView device rootView.
ca@2455
   846
        rootView    := model rootView.
ca@2455
   847
        clickedItem := nil.
ca@2177
   848
ca@2455
   849
        rootView xoring:[
ca@2455
   850
            lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
ca@2455
   851
                                ifFalse:[ rootView clippedByChildren:false ].
ca@2455
   852
ca@2455
   853
            p isNil ifTrue:[
ca@2455
   854
                rootView clippedByChildren:true.
ca@2455
   855
                motionAction := nil.
ca@2455
   856
            ] ifFalse:[
ca@2455
   857
                lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
ca@2455
   858
                rootView displayRectangle:lastRectangle.
ca@2177
   859
            ].
ca@2455
   860
            rootView flush.
ca@2455
   861
        ].
ca@2455
   862
        lastRectangle
ca@2455
   863
    ].
ca@2177
   864
!
ca@2177
   865
ca@2177
   866
processButtonReleaseEvent:anEvent
ca@2177
   867
    |rootView rectangle newItems widget origin|
ca@2177
   868
ca@2455
   869
    (rootView := model rootView) isNil ifTrue:[
ca@2455
   870
        clickedItem := motionAction := nil.
ca@2455
   871
        ^ self
ca@2455
   872
    ].
ca@2177
   873
    motionAction isNil ifTrue:[ ^ self ].
ca@2177
   874
    clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
ca@2177
   875
ca@2455
   876
    rectangle := motionAction value:nil.
ca@2455
   877
    rectangle isNil ifTrue:[^ self].
ca@2177
   878
ca@2455
   879
    newItems := OrderedCollection new.
ca@2177
   880
ca@2455
   881
    model rootItem recursiveDo:[:anItem|
ca@2455
   882
        widget := anItem widget.
ca@2455
   883
        origin := widget originRelativeTo:rootView.
ca@2455
   884
ca@2455
   885
        (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
ca@2455
   886
            newItems add:anItem.
ca@2455
   887
        ]
ca@2177
   888
    ].
ca@2455
   889
    model value:newItems.
ca@2177
   890
!
ca@2177
   891
ca@2177
   892
processEvent:anEvent
ca@2177
   893
    |button menu|
ca@2177
   894
cg@2758
   895
    anEvent isKeyPressEvent ifTrue:[ self processKeyPressEvent:anEvent. ^ self  ].
ca@2177
   896
    anEvent isButtonEvent  ifFalse:[ ^ self ].
ca@2177
   897
ca@2177
   898
    button := anEvent button.
ca@2177
   899
ca@2177
   900
    (button == 2 or:[button == #menu]) ifTrue:[
ca@2177
   901
        motionAction isNil ifTrue:[
ca@2177
   902
            anEvent isButtonPressEvent ifTrue:[
ca@2177
   903
                self selectOnClickHolder value ifTrue:[
ca@2177
   904
                    menu := self middleButtonMenu value.
ca@2177
   905
                    menu notNil ifTrue:[
cg@2758
   906
                        menu := MenuPanel 
cg@2758
   907
                                    menu:(Menu new fromLiteralArrayEncoding:menu)
cg@2758
   908
                                    receiver:self.
ca@2177
   909
                        menu startUp.
ca@2177
   910
                    ]
ca@2177
   911
                ].
ca@2177
   912
            ].
ca@2177
   913
            clickedItem := nil.
ca@2177
   914
        ].
ca@2177
   915
        ^ self
ca@2177
   916
    ].
ca@2177
   917
cg@2758
   918
    anEvent isButtonPressEvent  ifTrue:[ self processButtonPressEvent:anEvent. ^ self ].
cg@2758
   919
    anEvent isButtonMotionEvent ifTrue:[ self processButtonMotionEvent:anEvent. ^ self ].
ca@2177
   920
ca@2177
   921
    anEvent isButtonReleaseEvent ifTrue:[
ca@2177
   922
        self selectOnClickHolder value ifTrue:[
ca@2177
   923
            self processButtonReleaseEvent:anEvent
ca@2177
   924
        ].
ca@2177
   925
    ].
ca@2177
   926
    clickedItem := motionAction := nil.
ca@2177
   927
ca@2177
   928
    anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
ca@2177
   929
        self selectOnClickHolder value ifTrue:[
ca@2177
   930
            self doInspect:#view.
ca@2177
   931
        ].
ca@2177
   932
    ].
ca@2177
   933
!
ca@2177
   934
ca@2177
   935
processKeyPressEvent:anEvent
ca@2177
   936
    |item prnt idx key max next|
ca@2177
   937
ca@2177
   938
    key := anEvent key.
ca@2177
   939
    key isSymbol ifFalse:[^ self].
ca@2177
   940
ca@2177
   941
    key == #Delete    ifTrue:[ ^ self doDestroy ].
ca@2177
   942
    key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
ca@2177
   943
ca@2177
   944
    (   key == #CursorUp
ca@2177
   945
    or:[key == #CursorDown
ca@2177
   946
    or:[key == #CursorLeft
ca@2177
   947
    or:[key == #CursorRight]]]
ca@2177
   948
    ) ifFalse:[
ca@2177
   949
        ^ self
ca@2177
   950
    ].
ca@2177
   951
    item := model selectedItem.
ca@2177
   952
ca@2177
   953
    item isNil ifTrue:[
ca@2177
   954
        ^ model selectedItem:(model first ? model rootItem)
ca@2177
   955
    ].
ca@2177
   956
ca@2177
   957
    prnt := item parent.
ca@2177
   958
    prnt isNil ifTrue:[
ca@2177
   959
        "/ is the root item
ca@2177
   960
        (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
ca@2177
   961
                                                  ifFalse:[item := item at:1 ifAbsent:item].
ca@2177
   962
cg@2758
   963
        ^ model selectedItem:item
ca@2177
   964
    ].
ca@2177
   965
    key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
ca@2177
   966
ca@2177
   967
    key == #CursorRight ifTrue:[
ca@2177
   968
        next := item at:1 ifAbsent:nil.
ca@2177
   969
        next notNil ifTrue:[ model selectedItem:next ].
cg@2758
   970
        ^ self
ca@2177
   971
    ].
ca@2177
   972
ca@2177
   973
    max := prnt size.
ca@2177
   974
ca@2177
   975
    key == #CursorUp ifTrue:[
ca@2177
   976
        idx := prnt identityIndexOf:item.
ca@2177
   977
        idx == 1 ifTrue:[idx := max + 1].
ca@2177
   978
        model selectedItem:(prnt at:idx - 1).
cg@2758
   979
        ^ self.
ca@2177
   980
    ].
ca@2177
   981
ca@2177
   982
    key == #CursorDown ifTrue:[
ca@2177
   983
        idx := prnt identityIndexOf:item.
ca@2177
   984
        idx == max ifTrue:[idx := 0].
ca@2177
   985
        model selectedItem:(prnt at:idx + 1).
cg@2758
   986
        ^ self.
ca@2177
   987
    ].
ca@2177
   988
!
ca@2177
   989
ca@2177
   990
processMappedView:aView
ca@2177
   991
    |parent anchor|
ca@2177
   992
ca@2177
   993
    parent := self listOfItems detectItemRespondsToView:aView.
ca@2177
   994
    parent isNil ifTrue:[ ^ self ].
ca@2177
   995
ca@2177
   996
    NotFoundSignal handle:[:ex|
ca@2177
   997
        "contained subvies used by spec are not yet created;
ca@2177
   998
         thus we have to wait until last used subview is build
ca@2177
   999
        "
ca@2177
  1000
        anchor := nil.
ca@2177
  1001
    ] do:[
ca@2177
  1002
        anchor := parent class buildViewsFrom:(parent widget).
ca@2177
  1003
    ].
ca@2177
  1004
    anchor notNil ifTrue:[
ca@2177
  1005
        parent updateFromChildren:anchor children.
ca@2177
  1006
    ].
ca@2177
  1007
! !
ca@2177
  1008
cg@2744
  1009
!ViewTreeInspectorApplication methodsFor:'initialization & release'!
ca@2177
  1010
ca@2177
  1011
closeDownViews
ca@2455
  1012
    "release the grapped application"
ca@2455
  1013
ca@2177
  1014
    process := nil.
ca@2177
  1015
    super closeDownViews.
ca@2177
  1016
    self doUnpick.
ca@2177
  1017
!
ca@2177
  1018
ca@2177
  1019
initialize
ca@2455
  1020
    "setup my model and channels"
ca@2455
  1021
ca@2177
  1022
    super initialize.
ca@2177
  1023
ca@2177
  1024
    hasSingleSelectionHolder := false asValue.
ca@2177
  1025
    followFocusChannel       := false asValue.
ca@2177
  1026
ca@2177
  1027
    model := ViewTreeModel new.
ca@2177
  1028
    model inputEventAction:[:ev| self processEvent:ev ].
ca@2177
  1029
    model mappedViewAction:[:vw| self processMappedView:vw ].
ca@2177
  1030
    model application:self.
ca@2458
  1031
    model addDependent:self.
ca@2458
  1032
ca@2177
  1033
ca@2451
  1034
    showNamesHolder := false asValue.
ca@2451
  1035
    showNamesHolder addDependent:self.
ca@2177
  1036
!
ca@2177
  1037
ca@2177
  1038
postBuildTree:aTree
ca@2177
  1039
    treeView := aTree scrolledView.
ca@2177
  1040
    treeView hasConstantHeight:true.
ca@2177
  1041
! !
ca@2177
  1042
cg@2744
  1043
!ViewTreeInspectorApplication methodsFor:'menu queries'!
ca@2177
  1044
ca@2177
  1045
hasApplication
ca@2455
  1046
    "returns true if the current selected view has an application"
ca@2455
  1047
ca@2177
  1048
    |view|
ca@2177
  1049
ca@2177
  1050
    view := self selectedView.
ca@2177
  1051
  ^ (view notNil and:[view application notNil])
ca@2177
  1052
!
ca@2177
  1053
ca@2177
  1054
hasController
ca@2177
  1055
    "returns true if the current selected item's view has a controller
ca@2455
  1056
     other than nil or the view itself"
ca@2455
  1057
ca@2177
  1058
    |view controller|
ca@2177
  1059
ca@2177
  1060
    view := self selectedView.
ca@2177
  1061
ca@2177
  1062
    view notNil ifTrue:[
ca@2177
  1063
        controller := view controller.
ca@2177
  1064
      ^ (controller notNil and:[controller ~~ view])
ca@2177
  1065
    ].
ca@2177
  1066
    ^ false
ca@2177
  1067
!
ca@2177
  1068
ca@2177
  1069
hasModel
ca@2455
  1070
    "returns true if the current selected view has a model"
ca@2455
  1071
ca@2177
  1072
    |view|
ca@2177
  1073
ca@2177
  1074
    view := self selectedView.
ca@2177
  1075
  ^ (view notNil and:[view model notNil])
ca@2177
  1076
! !
ca@2177
  1077
cg@2744
  1078
!ViewTreeInspectorApplication methodsFor:'menu specs'!
ca@2177
  1079
ca@2177
  1080
middleButtonMenu
ca@2455
  1081
    "returns the middleButton menu for the single selected item or nil"
ca@2455
  1082
cg@2758
  1083
    ^ [ 
cg@2758
  1084
        model selectedItem notNil 
cg@2758
  1085
            ifTrue:[self class middleButtonMenu]
cg@2758
  1086
            ifFalse:[nil]
ca@2177
  1087
      ]
ca@2177
  1088
!
ca@2177
  1089
ca@2177
  1090
submenuApplications:aMenu
ca@2177
  1091
    |applications menu item list addBlock|
ca@2177
  1092
ca@2177
  1093
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177
  1094
                                              ifFalse:[model rootItem].
ca@2177
  1095
    item isNil ifTrue:[^ nil].
ca@2177
  1096
ca@2177
  1097
    applications := IdentityDictionary new.
ca@2177
  1098
ca@2177
  1099
    addBlock := [:el| |cls ctr|
ca@2177
  1100
        cls := self resolveApplicationClassFor:el.
ca@2177
  1101
ca@2177
  1102
        cls notNil ifTrue:[
ca@2177
  1103
            ctr := applications at:cls ifAbsent:0.
ca@2177
  1104
            applications at:cls put:(ctr + 1).
ca@2177
  1105
        ].
ca@2177
  1106
    ].
ca@2177
  1107
    item recursiveDo:addBlock.
ca@2177
  1108
    addBlock value:item.
ca@2177
  1109
ca@2177
  1110
    applications isEmpty ifTrue:[^ nil ].
ca@2177
  1111
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177
  1112
ca@2177
  1113
    applications keysAndValuesDo:[:cls :ctr|
ca@2177
  1114
       list add:(MenuDesc title:(cls name)
ca@2177
  1115
                          value:(ctr printString)
ca@2177
  1116
                         action:[self doSelectNextOfApplicationClass:cls startingIn:item]
ca@2177
  1117
                 ).
ca@2177
  1118
    ].
ca@2177
  1119
ca@2177
  1120
    menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177
  1121
    menu do:[:el|
ca@2177
  1122
        el hideMenuOnActivated:false
ca@2177
  1123
    ].
ca@2177
  1124
    ^ menu
ca@2177
  1125
!
ca@2177
  1126
ca@2177
  1127
submenuComponents:aMenu
ca@2177
  1128
    |widgets list total menu item|
ca@2177
  1129
ca@2177
  1130
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177
  1131
                                              ifFalse:[model rootItem].
ca@2177
  1132
    item isNil ifTrue:[^ nil].
ca@2177
  1133
ca@2177
  1134
    widgets := IdentityDictionary new.
ca@2177
  1135
    total   := 0.
ca@2177
  1136
ca@2177
  1137
    item recursiveDo:[:el| |cls ctr|
ca@2177
  1138
        cls := el widget.
ca@2177
  1139
ca@2177
  1140
        cls notNil ifTrue:[
ca@2177
  1141
            cls := cls class.
ca@2177
  1142
            ctr := widgets at:cls ifAbsent:0.
ca@2177
  1143
            widgets at:cls put:(ctr + 1).
ca@2177
  1144
            total := total + 1.
ca@2177
  1145
        ].
ca@2177
  1146
    ].
ca@2177
  1147
    total == 0 ifTrue:[^ nil].
ca@2177
  1148
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177
  1149
ca@2177
  1150
    widgets keysAndValuesDo:[:cls :ctr|
ca@2177
  1151
        list add:(MenuDesc title:(cls name)
ca@2177
  1152
                           value:(ctr printString)
ca@2177
  1153
                          action:[self doSelectNextOfClass:cls startingIn:item]
ca@2177
  1154
                 ).
ca@2177
  1155
    ].
ca@2177
  1156
    list := list asOrderedCollection.
ca@2177
  1157
    list add:(MenuDesc separator).
ca@2177
  1158
    list add:(MenuDesc title:'Total' value:(total printString)).
ca@2177
  1159
    menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177
  1160
    menu do:[:el|
ca@2177
  1161
        el hideMenuOnActivated:false
ca@2177
  1162
    ].
ca@2177
  1163
    ^ menu
ca@2177
  1164
!
ca@2177
  1165
ca@2177
  1166
submenuGeometry:aMenu
ca@2455
  1167
    "builds and returns the geometry submenu"
ca@2455
  1168
ca@2177
  1169
    |view point inst list x y|
ca@2177
  1170
ca@2177
  1171
    view := self selectedView.
ca@2177
  1172
    view isNil ifTrue:[^ nil].
ca@2177
  1173
ca@2177
  1174
    list := OrderedCollection new.
ca@2177
  1175
ca@2177
  1176
    "/ origin
ca@2177
  1177
    point := view relativeOrigin.
ca@2177
  1178
    point isNil ifTrue:[ point := view origin ].
ca@2177
  1179
ca@2177
  1180
    x := view left.
ca@2177
  1181
    y := view top.
ca@2177
  1182
ca@2177
  1183
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177
  1184
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177
  1185
ca@2177
  1186
    list add:(MenuDesc title:'origin' value:inst).
ca@2177
  1187
ca@2177
  1188
    "/ corner
ca@2177
  1189
    point := view relativeCorner.
ca@2177
  1190
    point isNil ifTrue:[ point := view corner ].
ca@2177
  1191
ca@2177
  1192
    x := view right.
ca@2177
  1193
    y := view bottom.
ca@2177
  1194
ca@2177
  1195
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177
  1196
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177
  1197
ca@2177
  1198
    list add:(MenuDesc title:'corner' value:inst).
ca@2177
  1199
ca@2177
  1200
    "/ extent
ca@2177
  1201
    (point := view relativeExtent) isNil ifTrue:[point := view extent].
ca@2177
  1202
    list add:(MenuDesc title:'extent' value:point).
ca@2177
  1203
ca@2177
  1204
    "/ preferred extent
ca@2177
  1205
    list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
ca@2177
  1206
    list add:(MenuDesc separator).
ca@2177
  1207
ca@2177
  1208
    "/ view insets
ca@2177
  1209
    inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
ca@2177
  1210
                                         with:(view rightInset)
ca@2177
  1211
                                         with:(view topInset)
ca@2177
  1212
                                         with:(view bottomInset).
ca@2177
  1213
ca@2177
  1214
    list add:(MenuDesc title:'insets'      value:inst).
ca@2177
  1215
    list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
ca@2177
  1216
    list add:(MenuDesc title:'level'       value:(view level)).
ca@2177
  1217
    list add:(MenuDesc separator).
ca@2177
  1218
ca@2177
  1219
    (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
ca@2177
  1220
    list add:(MenuDesc title:'layout' value:inst).
ca@2177
  1221
ca@2177
  1222
    (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
ca@2177
  1223
    list add:(MenuDesc title:'transformation' value:inst).
ca@2177
  1224
ca@2177
  1225
  ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1226
!
ca@2177
  1227
ca@2177
  1228
submenuInspector:aMenu
ca@2455
  1229
    "builds and returns the inspector submenu"
ca@2455
  1230
ca@2177
  1231
    |view list n names label value|
ca@2177
  1232
ca@2177
  1233
    view := self selectedView.
ca@2177
  1234
    view isNil ifTrue:[^ nil].
ca@2177
  1235
ca@2177
  1236
    n := view class instSize.
ca@2177
  1237
    n > 0 ifFalse:[^ nil ].
ca@2177
  1238
ca@2177
  1239
    list  := OrderedCollection new:n.
ca@2177
  1240
    names := view class allInstVarNames.
ca@2177
  1241
ca@2177
  1242
    1 to:n do:[:i| |action|
ca@2177
  1243
        label := (names at:i) printString.
ca@2177
  1244
        value := view instVarAt:i.
ca@2177
  1245
        value isNil ifTrue:[
ca@2177
  1246
            value  := '------'.
ca@2177
  1247
            action := nil.
ca@2177
  1248
        ] ifFalse:[
ca@2177
  1249
            value  := value displayString contractAtEndTo:40.
ca@2177
  1250
            action := [(view instVarAt:i) inspect].
ca@2177
  1251
        ].
ca@2177
  1252
        list add:(MenuDesc title:label value:value action:action).
ca@2177
  1253
    ].
ca@2177
  1254
ca@2177
  1255
    ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1256
!
ca@2177
  1257
ca@2177
  1258
submenuInterface:aMenu
ca@2455
  1259
    "builds and returns the interface submenu"
ca@2455
  1260
ca@2177
  1261
    |view label inst value list|
ca@2177
  1262
ca@2177
  1263
    view := self selectedView.
ca@2177
  1264
    view isNil ifTrue:[^ nil].
ca@2177
  1265
ca@2177
  1266
    list := OrderedCollection new.
ca@2177
  1267
ca@2177
  1268
    inst  := view controller.
ca@2177
  1269
    value := nil.
ca@2177
  1270
ca@2177
  1271
    inst isNil ifTrue:[
ca@2177
  1272
        label := nil
ca@2177
  1273
    ] ifFalse:[
cg@2758
  1274
        inst == view ifTrue:[ 
cg@2758
  1275
            label := '== view itself' 
cg@2758
  1276
        ] ifFalse:[ 
cg@2758
  1277
            label := inst displayString.
cg@2758
  1278
            value := [view controller inspect].
cg@2758
  1279
        ].
ca@2177
  1280
    ].
ca@2177
  1281
    list add:(MenuDesc title:'controller' value:label action:value).
ca@2177
  1282
ca@2177
  1283
    inst := view delegate.
ca@2177
  1284
    inst notNil ifTrue:[
ca@2177
  1285
        list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
ca@2177
  1286
    ].
ca@2177
  1287
ca@2177
  1288
    inst := view application.
ca@2177
  1289
cg@2758
  1290
    inst notNil ifTrue:[ 
cg@2758
  1291
        |topAppl|
cg@2758
  1292
ca@2177
  1293
        list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
ca@2177
  1294
ca@2177
  1295
        topAppl := inst topApplication.
ca@2177
  1296
ca@2177
  1297
        (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
ca@2177
  1298
            list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
ca@2177
  1299
        ].
ca@2177
  1300
    ].
ca@2177
  1301
    list add:(MenuDesc separator).
ca@2177
  1302
ca@2177
  1303
    (view respondsTo:#'model:') ifTrue:[
ca@2177
  1304
        inst := model.
ca@2177
  1305
ca@2177
  1306
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1307
                  ifFalse:[ label := inst displayString.
ca@2177
  1308
                            value := [ view model inspect ].
ca@2177
  1309
                          ].
ca@2177
  1310
ca@2177
  1311
        list add:(MenuDesc title:'model' value:label action:value).
ca@2177
  1312
ca@2177
  1313
        (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
ca@2177
  1314
            view modelInterface keysAndValuesDo:[:key : val|
ca@2177
  1315
                val isNil ifTrue:[ label := nil ]
ca@2177
  1316
                         ifFalse:[ label := val displayString ].
ca@2177
  1317
ca@2177
  1318
                list add:(MenuDesc title:('      - ', key) value:label ).
ca@2177
  1319
            ]
ca@2177
  1320
        ].
ca@2177
  1321
    ].
ca@2177
  1322
ca@2177
  1323
    (view respondsTo:#enableChannel) ifTrue:[
ca@2177
  1324
        inst := view enableChannel.
ca@2177
  1325
ca@2177
  1326
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1327
                  ifFalse:[ label := inst displayString.
ca@2177
  1328
                            value := [ view enableChannel inspect ].
ca@2177
  1329
                          ].
ca@2177
  1330
ca@2177
  1331
        list add:(MenuDesc title:'enableChannel' value:label action:value).
ca@2177
  1332
    ].
ca@2177
  1333
ca@2177
  1334
    list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
ca@2177
  1335
ca@2177
  1336
    (view respondsTo:#listHolder) ifTrue:[
ca@2177
  1337
        inst := view listHolder.
ca@2177
  1338
ca@2177
  1339
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1340
                  ifFalse:[ label := inst class printString.
ca@2177
  1341
                            value := [ view listHolder inspect ].
ca@2177
  1342
                          ].
ca@2177
  1343
        list add:(MenuDesc title:'listHolder' value:label action:value).
ca@2177
  1344
    ].
ca@2177
  1345
ca@2177
  1346
    (view respondsTo:#list) ifTrue:[
ca@2177
  1347
        inst := view list.
ca@2177
  1348
ca@2177
  1349
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1350
                  ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
ca@2177
  1351
                            value := [ view list inspect ].
ca@2177
  1352
                          ].
ca@2177
  1353
ca@2177
  1354
        list add:(MenuDesc title:'list' value:label action:value).
ca@2177
  1355
    ].
ca@2177
  1356
ca@2177
  1357
    list last isSeparator ifTrue:[ list removeLast ].
ca@2177
  1358
  ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1359
!
ca@2177
  1360
ca@2177
  1361
submenuVisibility:aMenu
ca@2455
  1362
    "builds and returns the geometry submenu"
ca@2455
  1363
ca@2177
  1364
    |view list value|
ca@2177
  1365
ca@2177
  1366
    view := self selectedView.
ca@2177
  1367
    view isNil ifTrue:[^ nil].
ca@2177
  1368
ca@2177
  1369
    list := OrderedCollection new.
ca@2177
  1370
ca@2177
  1371
    list add:(MenuDesc title:'device'     value:(view device printString)).
ca@2177
  1372
    list add:(MenuDesc title:'drawableId' value:(view id)).
ca@2177
  1373
    list add:(MenuDesc title:'gcId'       value:(view gcId)).
ca@2177
  1374
ca@2177
  1375
    list add:(MenuDesc separator).
ca@2177
  1376
ca@2177
  1377
    list add:(MenuDesc title:'shown'    value:(view shown)).
ca@2177
  1378
    list add:(MenuDesc title:'realized' value:(view realized)).
ca@2177
  1379
ca@2177
  1380
    list add:(MenuDesc separator).
ca@2177
  1381
ca@2177
  1382
    list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
ca@2177
  1383
ca@2177
  1384
    (value := view visibilityChannel) isNil ifTrue:[
ca@2177
  1385
        list add:(MenuDesc title:'visibilityChannel' value:'------').
ca@2177
  1386
    ] ifFalse:[
ca@2177
  1387
        list add:(MenuDesc title:'visibilityChannel'
ca@2177
  1388
                           value:(value displayString)
ca@2177
  1389
                          action:[view visibilityChannel inspect]).
ca@2177
  1390
    ].
ca@2177
  1391
cg@2758
  1392
    ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1393
! !
ca@2177
  1394
cg@2744
  1395
!ViewTreeInspectorApplication methodsFor:'private'!
ca@2177
  1396
ca@2177
  1397
selectFocusView
ca@2177
  1398
    |rootView focusItem focusView|
ca@2177
  1399
ca@2177
  1400
    rootView := model rootView.
ca@2177
  1401
ca@2177
  1402
    (rootView notNil and:[rootView shown]) ifTrue:[
ca@2177
  1403
        focusView := rootView windowGroup focusView.
ca@2177
  1404
    ].
ca@2177
  1405
    focusView isNil ifTrue:[^ self ].
ca@2177
  1406
ca@2177
  1407
    focusItem := model selectedItem.
ca@2177
  1408
ca@2177
  1409
    (focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
ca@2177
  1410
        ^ self
ca@2177
  1411
    ].
ca@2177
  1412
    focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].
ca@2177
  1413
ca@2177
  1414
    focusItem notNil ifTrue:[
ca@2177
  1415
        model selectItem:focusItem.
ca@2177
  1416
    ].        
ca@2177
  1417
!
ca@2177
  1418
ca@2177
  1419
setRootItem:aRootItemOrNil
ca@2177
  1420
    |theProcess|
ca@2177
  1421
ca@2177
  1422
    aRootItemOrNil isNil ifTrue:[
ca@2177
  1423
        process := nil.
ca@2177
  1424
    ] ifFalse:[
ca@2177
  1425
        "/ expand tree to level 3
ca@2177
  1426
        aRootItemOrNil do:[:aRootChild|
ca@2177
  1427
            aRootChild do:[:aSubChild| aSubChild expand ].
ca@2177
  1428
            aRootChild expand.
ca@2177
  1429
        ].
ca@2177
  1430
        aRootItemOrNil expand.
ca@2177
  1431
ca@2177
  1432
        process isNil ifTrue:[
ca@2177
  1433
            theProcess := process :=
ca@2455
  1434
                Process for:[   |update testModeChannel|
ca@2177
  1435
ca@2177
  1436
                                update := false.
ca@2455
  1437
                                testModeChannel := model testModeChannel.
ca@2177
  1438
ca@2455
  1439
                                [process == theProcess] whileTrue:[
ca@2177
  1440
                                    Delay waitForSeconds:0.5.
ca@2177
  1441
ca@2177
  1442
                                    (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
ca@2455
  1443
                                        (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
ca@2177
  1444
                                            self selectFocusView.
ca@2177
  1445
                                        ].
ca@2177
  1446
                                        update ifTrue:[
ca@2177
  1447
                                            self updateShownStatus.
ca@2177
  1448
                                        ].
ca@2177
  1449
                                        update := update not.
ca@2177
  1450
                                    ].
ca@2177
  1451
                                ].
ca@2177
  1452
ca@2177
  1453
                             ] priority:8.
cg@2744
  1454
            theProcess name:'ViewTreeInspector - Follow Focus'.
ca@2177
  1455
            theProcess resume.
ca@2177
  1456
        ].
ca@2177
  1457
    ].
ca@2177
  1458
    model rootItem:aRootItemOrNil.
ca@2177
  1459
!
ca@2177
  1460
ca@2177
  1461
updateShownStatus
ca@2177
  1462
    |rootItem min max visState listIdx visY0 visY1 height damage|
ca@2177
  1463
ca@2177
  1464
    rootItem := model rootItem.
ca@2177
  1465
    (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
ca@2177
  1466
ca@2177
  1467
    max := 0.
ca@2177
  1468
    min := 9999999.
ca@2177
  1469
ca@2177
  1470
    rootItem recursiveEachVisibleItemDo:[:anItem|
ca@2177
  1471
        visState := (anItem widget shown).
ca@2177
  1472
ca@2177
  1473
        visState ~~ anItem isDrawnShown ifTrue:[
ca@2177
  1474
            anItem isDrawnShown:visState.
ca@2177
  1475
            listIdx := treeView identityIndexOf:anItem.
ca@2177
  1476
ca@2177
  1477
            listIdx > 0 ifTrue:[    
ca@2177
  1478
                max := max max:listIdx.
ca@2177
  1479
                min := min min:listIdx.
ca@2177
  1480
            ].
ca@2177
  1481
        ].
ca@2177
  1482
    ].
ca@2177
  1483
    max < min ifTrue:[^ self].
ca@2177
  1484
    max := max + 1.
ca@2177
  1485
ca@2177
  1486
    visY0  := (treeView yVisibleOfLine:min) max:0.
ca@2177
  1487
    visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
ca@2177
  1488
    height := visY1 - visY0.
ca@2177
  1489
    
ca@2177
  1490
    height > 2 ifTrue:[
ca@2177
  1491
        treeView shown ifTrue:[
ca@2177
  1492
            damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
ca@2177
  1493
            treeView invalidateDeviceRectangle:damage repairNow:false.
ca@2177
  1494
        ].
ca@2177
  1495
    ].
ca@2177
  1496
! !
ca@2177
  1497
cg@2744
  1498
!ViewTreeInspectorApplication methodsFor:'selection'!
ca@2177
  1499
ca@2177
  1500
selectedView
ca@2455
  1501
    "answer the selected view or nil"
ca@2455
  1502
ca@2177
  1503
    |item|
ca@2177
  1504
ca@2177
  1505
    item := model selectedItem.
ca@2177
  1506
    item notNil ifTrue:[ ^ item widget ].
ca@2177
  1507
  ^ nil
ca@2177
  1508
! !
ca@2177
  1509
cg@2744
  1510
!ViewTreeInspectorApplication methodsFor:'testing'!
ca@2177
  1511
ca@2177
  1512
resolveApplicationClassFor:aTreeItem
ca@2177
  1513
    aTreeItem isApplicationClass ifTrue:[
ca@2177
  1514
       ^ aTreeItem applicationClass
ca@2177
  1515
    ].
ca@2177
  1516
    ^ nil
ca@2177
  1517
!
ca@2177
  1518
ca@2177
  1519
selectedComponentHasChildren
ca@2177
  1520
    |item|
ca@2177
  1521
ca@2177
  1522
    item := model selectedItem.
ca@2177
  1523
    ^ (item notNil and:[item hasChildren])
ca@2177
  1524
! !
ca@2177
  1525
cg@2744
  1526
!ViewTreeInspectorApplication methodsFor:'user operations'!
ca@2177
  1527
ca@2177
  1528
doBrowse:what
ca@2177
  1529
    "open browser on:
ca@2177
  1530
        #view           browse class
ca@2177
  1531
        #model          browse model class
ca@2177
  1532
        #application    browse application class
ca@2177
  1533
        #controller     browse controller class
ca@2177
  1534
    "
ca@2177
  1535
    |view inst|
ca@2177
  1536
ca@2177
  1537
    view := self selectedView.
ca@2177
  1538
    view isNil ifTrue:[^ self].
ca@2177
  1539
ca@2177
  1540
             what == #view        ifTrue:[ inst := view ]
ca@2177
  1541
    ifFalse:[what == #model       ifTrue:[ inst := view model ]
ca@2177
  1542
    ifFalse:[what == #application ifTrue:[ inst := view application ]
ca@2177
  1543
    ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
ca@2177
  1544
    ifFalse:[
ca@2177
  1545
        ^ self
ca@2177
  1546
    ]]]].
ca@2177
  1547
ca@2177
  1548
    inst notNil ifTrue:[
ca@2177
  1549
        inst class browserClass openInClass:(inst class) selector:nil
ca@2177
  1550
    ].
ca@2177
  1551
!
ca@2177
  1552
ca@2177
  1553
doDestroy
ca@2455
  1554
    "destroy the current selected view"
ca@2455
  1555
ca@2177
  1556
    |item parent|
ca@2177
  1557
ca@2177
  1558
    item := model selectedItem.
ca@2177
  1559
    item isNil ifTrue:[ ^ self].
ca@2177
  1560
ca@2177
  1561
    parent := item parent.
ca@2177
  1562
ca@2177
  1563
    parent isNil ifTrue:[
ca@2177
  1564
        "/ the root
ca@2177
  1565
        model withSelectionHiddenDo:[item deleteAll].
ca@2177
  1566
      ^ self
ca@2177
  1567
    ].
ca@2177
  1568
ca@2177
  1569
    model withSelectionHiddenDo:[
ca@2177
  1570
        |idx nsel|
ca@2177
  1571
ca@2177
  1572
        idx := parent identityIndexOf:item.
ca@2177
  1573
ca@2177
  1574
        idx == parent size ifTrue:[
ca@2177
  1575
            nsel := parent at:(idx - 1) ifAbsent:parent
ca@2177
  1576
        ] ifFalse:[
ca@2177
  1577
            nsel := parent at:(idx + 1)
ca@2177
  1578
        ].
ca@2177
  1579
        model setValue:nil.
ca@2177
  1580
        item delete.
ca@2177
  1581
ca@2177
  1582
        parent isLayoutContainer ifTrue:[
ca@2177
  1583
            parent widget sizeChanged:nil
ca@2177
  1584
        ].
ca@2177
  1585
        model value:nsel.
ca@2177
  1586
    ].
ca@2177
  1587
!
ca@2177
  1588
ca@2177
  1589
doFlash
ca@2455
  1590
    "flash the selected view"
ca@2455
  1591
ca@2177
  1592
    |view|
ca@2177
  1593
ca@2177
  1594
    view := self selectedView.
ca@2177
  1595
    view isNil ifTrue:[ ^ self].
ca@2177
  1596
ca@2177
  1597
    view shown ifTrue:[
ca@2177
  1598
        model withSelectionHiddenDo:[
ca@2177
  1599
            view perform:#flash ifNotUnderstood:nil.
ca@2177
  1600
        ].
ca@2177
  1601
    ].
ca@2177
  1602
!
ca@2177
  1603
ca@2177
  1604
doInspect:what
ca@2177
  1605
    "open inspector on:
ca@2177
  1606
        #view           inspect class
ca@2177
  1607
        #group          inspect windowGroup
ca@2177
  1608
        #model          inspect model
ca@2177
  1609
        #application    inspect application
ca@2177
  1610
        #controller     inspect controller
ca@2177
  1611
    "
ca@2177
  1612
    |inst|
ca@2177
  1613
ca@2177
  1614
    inst := self selectedView.
ca@2177
  1615
    inst isNil ifTrue:[^ self].
ca@2177
  1616
ca@2177
  1617
             what == #group       ifTrue:[ inst := inst windowGroup ]
ca@2177
  1618
    ifFalse:[what == #model       ifTrue:[ inst := inst model ]
ca@2177
  1619
    ifFalse:[what == #application ifTrue:[ inst := inst application ]
ca@2177
  1620
    ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
ca@2177
  1621
ca@2177
  1622
    inst notNil ifTrue:[ inst inspect ].
ca@2177
  1623
!
ca@2177
  1624
ca@2177
  1625
doPickViews
ca@2455
  1626
    "pick a window's topView"
ca@2455
  1627
ca@2177
  1628
    |window|
ca@2177
  1629
ca@2177
  1630
    self doUnpick.
ca@2177
  1631
ca@2177
  1632
    window := Screen current viewFromUser.
ca@2177
  1633
    window isNil ifTrue:[^ self].
ca@2177
  1634
ca@2177
  1635
    window := window topView.
ca@2177
  1636
ca@2177
  1637
    (    window == Screen current rootView
ca@2177
  1638
     or:[window == self window topView]
ca@2177
  1639
    ) ifTrue:[
ca@2177
  1640
        ^ self
ca@2177
  1641
    ].
ca@2177
  1642
    self setRootItem:(ViewTreeItem buildViewsFrom:window).
ca@2177
  1643
!
ca@2177
  1644
ca@2177
  1645
doSelectNextOfApplicationClass:aClass startingIn:anItem
ca@2177
  1646
    |startItem firstFound searchNext|
ca@2177
  1647
ca@2177
  1648
    startItem  := model last.
ca@2177
  1649
    searchNext := startItem notNil.        
ca@2177
  1650
    firstFound := nil.
ca@2177
  1651
ca@2177
  1652
    anItem recursiveDo:[:el|
ca@2177
  1653
        el == startItem ifTrue:[
ca@2177
  1654
            searchNext := false
ca@2177
  1655
        ] ifFalse:[
ca@2177
  1656
            (self resolveApplicationClassFor:el) == aClass ifTrue:[
ca@2177
  1657
                searchNext ifFalse:[^ model selectItem:el].
ca@2177
  1658
ca@2177
  1659
                firstFound isNil ifTrue:[
ca@2177
  1660
                    firstFound := el
ca@2177
  1661
                ]
ca@2177
  1662
            ]
ca@2177
  1663
        ]
ca@2177
  1664
    ].
ca@2177
  1665
    firstFound notNil ifTrue:[
ca@2177
  1666
        self window beep.
ca@2177
  1667
        model selectItem:firstFound
ca@2177
  1668
    ].
ca@2177
  1669
!
ca@2177
  1670
ca@2177
  1671
doSelectNextOfClass:aClass startingIn:anItem
ca@2177
  1672
    |startItem firstFound searchNext|
ca@2177
  1673
ca@2177
  1674
    startItem  := model last.
ca@2177
  1675
    searchNext := startItem notNil.        
ca@2177
  1676
    firstFound := nil.
ca@2177
  1677
ca@2177
  1678
    anItem recursiveDo:[:el|
ca@2177
  1679
        el == startItem ifTrue:[
ca@2177
  1680
            searchNext := false
ca@2177
  1681
        ] ifFalse:[
ca@2177
  1682
            el widget class == aClass ifTrue:[
ca@2177
  1683
                searchNext ifFalse:[^ model selectItem:el].
ca@2177
  1684
ca@2177
  1685
                firstFound isNil ifTrue:[
ca@2177
  1686
                    firstFound := el
ca@2177
  1687
                ]
ca@2177
  1688
            ]
ca@2177
  1689
        ]
ca@2177
  1690
    ].
ca@2177
  1691
    firstFound notNil ifTrue:[
ca@2177
  1692
        self window beep.
ca@2177
  1693
        model selectItem:firstFound
ca@2177
  1694
    ].
ca@2177
  1695
!
ca@2177
  1696
ca@2177
  1697
doUnpick
ca@2455
  1698
    "release current picked window and contained subwindows"
ca@2455
  1699
ca@2177
  1700
    self setRootItem:nil.
cg@2744
  1701
!
cg@2744
  1702
cg@2744
  1703
openDocumentation
cg@2744
  1704
    HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR'
ca@2177
  1705
! !
ca@2177
  1706
cg@2744
  1707
!ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'!
ca@2177
  1708
ca@2177
  1709
buildFromList:aList onGC:aMenu
ca@2177
  1710
    |tabSpec menu w menuPanel|
ca@2177
  1711
ca@2177
  1712
    w := 0.
ca@2177
  1713
    aList do:[:el| w := w max:(el widthOn:aMenu) ].
ca@2177
  1714
ca@2177
  1715
    tabSpec := TabulatorSpecification new.
ca@2177
  1716
    tabSpec unit:#pixel.
ca@2177
  1717
    tabSpec positions:#(0     1.5 ).
ca@2177
  1718
    tabSpec align:#(#left #left).
ca@2177
  1719
ca@2177
  1720
    w := w + 15.
ca@2177
  1721
    tabSpec positions:(Array with:0 with:w).
ca@2177
  1722
ca@2177
  1723
    menu := Menu new.
ca@2177
  1724
ca@2177
  1725
    aList do:[:el|
ca@2177
  1726
        menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
ca@2177
  1727
    ].
ca@2177
  1728
    menuPanel := MenuPanel menu:menu.
ca@2177
  1729
    ^ menuPanel
ca@2177
  1730
! !
ca@2177
  1731
cg@2744
  1732
!ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'!
ca@2177
  1733
ca@2177
  1734
separator
ca@2177
  1735
    ^ self new
ca@2177
  1736
!
ca@2177
  1737
ca@2177
  1738
title:aTitle value:aValue
ca@2177
  1739
    ^ self title:aTitle value:aValue action:nil
ca@2177
  1740
!
ca@2177
  1741
ca@2177
  1742
title:aTitle value:aValue action:anAction
ca@2177
  1743
    ^ self new title:aTitle value:aValue action:anAction
ca@2177
  1744
! !
ca@2177
  1745
cg@2744
  1746
!ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'!
ca@2177
  1747
ca@2177
  1748
title
ca@2177
  1749
    ^ title
ca@2177
  1750
! !
ca@2177
  1751
cg@2744
  1752
!ViewTreeInspectorApplication::MenuDesc methodsFor:'building'!
ca@2177
  1753
ca@2177
  1754
asMenuItemWithTabulatorSpecification:aTabSpec
ca@2177
  1755
    |array|
ca@2177
  1756
ca@2177
  1757
    title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
ca@2177
  1758
ca@2177
  1759
    array := Array with:(title, ':') with:'------'.
ca@2177
  1760
ca@2177
  1761
    value notNil ifTrue:[
ca@2177
  1762
        array at:2 put:(value printString, ' ')
ca@2177
  1763
    ].
ca@2177
  1764
cg@2758
  1765
   ^ MenuItem 
cg@2758
  1766
        label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
cg@2758
  1767
        value:action
ca@2177
  1768
! !
ca@2177
  1769
cg@2744
  1770
!ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'!
ca@2177
  1771
ca@2177
  1772
title:aTitle value:aValue action:anAction
ca@2177
  1773
    "test for separator
ca@2177
  1774
    "
ca@2177
  1775
    title  := aTitle withoutSeparators.
ca@2177
  1776
    action := anAction.
ca@2177
  1777
ca@2177
  1778
    aValue notNil ifTrue:[
ca@2177
  1779
        value := aValue printString.
ca@2177
  1780
ca@2177
  1781
        value size > 70 ifTrue:[
ca@2177
  1782
            value := value copyFrom:1 to:70.
ca@2177
  1783
            value := value, '...'
ca@2177
  1784
        ]
ca@2177
  1785
    ].
ca@2177
  1786
! !
ca@2177
  1787
cg@2744
  1788
!ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'!
ca@2177
  1789
ca@2177
  1790
isSeparator
ca@2177
  1791
    ^ title isNil
ca@2177
  1792
!
ca@2177
  1793
ca@2177
  1794
widthOn:aGC
ca@2177
  1795
    title isNil ifTrue:[^ 5].  "/ separator
cg@2758
  1796
    ^ title widthOn:aGC
ca@2177
  1797
! !
ca@2177
  1798
cg@2744
  1799
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'!
cg@2744
  1800
cg@2744
  1801
buildViewsFrom:aView
cg@2744
  1802
    "build the items starting from a source view;
cg@2744
  1803
     returns the anhor.
cg@2744
  1804
    "
cg@2744
  1805
    |item subViews subItems|
cg@2744
  1806
cg@2744
  1807
    aView isNil ifTrue:[^ nil].
cg@2744
  1808
cg@2744
  1809
    item     := self forView:aView.
cg@2744
  1810
    subViews := aView subViews.
cg@2744
  1811
cg@2744
  1812
    subViews notEmptyOrNil ifTrue:[
cg@2744
  1813
        subItems := OrderedCollection new.
cg@2744
  1814
        subViews do:[:aSubView|
cg@2744
  1815
            subItems add:(self buildViewsFrom:aSubView).
cg@2744
  1816
        ].
cg@2744
  1817
        item children:subItems.
cg@2744
  1818
    ].
cg@2744
  1819
    ^ item
cg@2744
  1820
! !
cg@2744
  1821
cg@2744
  1822
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'!
cg@2744
  1823
cg@2744
  1824
documentation
cg@2744
  1825
"
cg@2744
  1826
    ViewTreeItems represants a pickable object within a ViewTreeModel.
cg@2744
  1827
    The class is used to build up the hierarchical tree.
cg@2744
  1828
cg@2744
  1829
    [Instance variables:]
cg@2744
  1830
        widget        <View>            the widget represented by the item
cg@2744
  1831
        spec          <UISpecification> the UISpecification or nil
cg@2744
  1832
cg@2744
  1833
    [Class variables:]
cg@2744
  1834
        HandleExtent  <Point>           keeps the extent of a handle
cg@2744
  1835
cg@2744
  1836
cg@2744
  1837
    [author:]
cg@2744
  1838
        Claus Atzkern
cg@2744
  1839
cg@2744
  1840
    [see also:]
cg@2744
  1841
        HierarchicalItem
cg@2744
  1842
        ViewTreeModel
cg@2744
  1843
"
cg@2744
  1844
!
ca@2177
  1845
ca@2177
  1846
version
ca@2177
  1847
    ^ '$Header$'
ca@2177
  1848
! !
ca@2177
  1849
cg@2744
  1850
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'!
cg@2744
  1851
cg@2744
  1852
initialize
cg@2744
  1853
    "set the extent of the Handle
cg@2744
  1854
    "
cg@2744
  1855
    HandleExtent := 6@6.
cg@2744
  1856
! !
cg@2744
  1857
cg@2744
  1858
!ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'!
cg@2744
  1859
cg@2744
  1860
forView:aView
cg@2744
  1861
    |item|
cg@2744
  1862
cg@2744
  1863
    item := self basicNew initialize.
cg@2744
  1864
    item forView:aView.
cg@2744
  1865
  ^ item
cg@2744
  1866
!
cg@2744
  1867
cg@2744
  1868
new
cg@2744
  1869
    self error:'not allowed'.
cg@2744
  1870
  ^ nil
cg@2744
  1871
!
cg@2744
  1872
cg@2744
  1873
on:aView withSpec:aSpec
cg@2744
  1874
    |item|
cg@2744
  1875
cg@2744
  1876
    item := self basicNew initialize.
cg@2744
  1877
    item on:aView withSpec:aSpec.
cg@2744
  1878
  ^ item
cg@2744
  1879
! !
cg@2744
  1880
cg@2744
  1881
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'!
cg@2744
  1882
cg@2744
  1883
applicationClass
cg@2744
  1884
    |appl|
cg@2744
  1885
cg@2744
  1886
    widget notNil ifTrue:[
cg@2744
  1887
        appl := widget application.
cg@2744
  1888
        appl notNil ifTrue:[^ appl class ].
cg@2744
  1889
    ].
cg@2744
  1890
    ^ nil
cg@2744
  1891
!
cg@2744
  1892
cg@2744
  1893
isDrawnShown
cg@2744
  1894
    "returns true if the last display operations was done during the widget was shown
cg@2744
  1895
    "
cg@2744
  1896
    ^ isDrawnShown
cg@2744
  1897
!
cg@2744
  1898
cg@2744
  1899
isDrawnShown:aBoolean
cg@2744
  1900
    isDrawnShown := aBoolean.
cg@2744
  1901
!
cg@2744
  1902
cg@2744
  1903
rootView
cg@2744
  1904
    "returns the widget assigned to the root or nil
cg@2744
  1905
    "
cg@2744
  1906
    ^ parent rootView
cg@2744
  1907
!
cg@2744
  1908
cg@2744
  1909
specClass
cg@2744
  1910
    "returns the spec-class assigned to the item
cg@2744
  1911
    "
cg@2744
  1912
    ^ widget specClass
cg@2744
  1913
!
cg@2744
  1914
cg@2744
  1915
treeModel
cg@2744
  1916
    "returns the assigned treeModel, an instance of ViewTreeModel
cg@2744
  1917
    "
cg@2744
  1918
    ^ parent treeModel
cg@2744
  1919
!
cg@2744
  1920
cg@2744
  1921
widget
cg@2744
  1922
    "returns the widget assigned to the item
cg@2744
  1923
    "
cg@2744
  1924
    ^ widget
cg@2744
  1925
! !
cg@2744
  1926
cg@2744
  1927
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'!
cg@2744
  1928
cg@2744
  1929
boundsRelativeToRoot
cg@2744
  1930
    "returns the bounds relative to the root widget
cg@2744
  1931
    "
cg@2744
  1932
    ^ self originRelativeToRoot extent:(widget extent)
cg@2744
  1933
!
cg@2744
  1934
cg@2744
  1935
cornerRelativeToRoot
cg@2744
  1936
    "returns the corner relative to the root widget
cg@2744
  1937
    "
cg@2744
  1938
    ^ self originRelativeToRoot + (widget extent)
cg@2744
  1939
!
cg@2744
  1940
cg@2744
  1941
extent
cg@2744
  1942
    "returns the extent of the widget
cg@2744
  1943
    "
cg@2744
  1944
    ^ widget extent
cg@2744
  1945
!
cg@2744
  1946
cg@2744
  1947
layoutType
cg@2744
  1948
    "returns the type of layout assigned to the wiget; nil if the
cg@2744
  1949
     superView cannot resize its sub widgets
cg@2744
  1950
    "
cg@2744
  1951
    |layout specClass superView|
cg@2744
  1952
cg@2744
  1953
    (superView := widget superView) isNil ifTrue:[
cg@2744
  1954
        ^ #Extent
cg@2744
  1955
    ].
cg@2744
  1956
        
cg@2744
  1957
    specClass := superView specClass.
cg@2744
  1958
cg@2744
  1959
    (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[
cg@2744
  1960
        ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil]
cg@2744
  1961
    ].
cg@2744
  1962
cg@2744
  1963
    (layout := widget geometryLayout) isNil ifTrue:[
cg@2744
  1964
        ^ #Extent
cg@2744
  1965
    ].
cg@2744
  1966
cg@2744
  1967
    layout isLayout ifTrue:[
cg@2744
  1968
        layout isLayoutFrame        ifTrue:[ ^ #LayoutFrame ].
cg@2744
  1969
        layout isAlignmentOrigin    ifTrue:[ ^ #AlignmentOrigin ].
cg@2744
  1970
        layout isLayoutOrigin       ifTrue:[ ^ #LayoutOrigin ].
cg@2744
  1971
    ] ifFalse:[
cg@2744
  1972
        layout isRectangle          ifTrue:[ ^ #Rectangle ].
cg@2744
  1973
        layout isPoint              ifTrue:[ ^ #Point ].
cg@2744
  1974
cg@2744
  1975
    ].
cg@2744
  1976
    Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
cg@2744
  1977
  ^ nil
cg@2744
  1978
!
cg@2744
  1979
cg@2744
  1980
originRelativeToRoot
cg@2744
  1981
    "returns the origin relative to the root widget
cg@2744
  1982
    "
cg@2744
  1983
    ^ widget originRelativeTo:(self rootView)
cg@2744
  1984
! !
cg@2744
  1985
cg@2744
  1986
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'!
cg@2744
  1987
cg@2744
  1988
children
cg@2744
  1989
    "redefined: optimize
cg@2744
  1990
    "
cg@2744
  1991
    ^ children
cg@2744
  1992
!
cg@2744
  1993
cg@2744
  1994
hasChildren
cg@2744
  1995
    |subViews list item|
cg@2744
  1996
cg@2744
  1997
    children size ~~ 0 ifTrue:[
cg@2744
  1998
        ^ true
cg@2744
  1999
    ].
cg@2744
  2000
    isExpanded := false.
cg@2744
  2001
    subViews   := widget subViews.
cg@2744
  2002
cg@2744
  2003
    subViews size == 0 ifTrue:[^ false].
cg@2744
  2004
cg@2744
  2005
    list := OrderedCollection new.
cg@2744
  2006
cg@2744
  2007
    subViews do:[:aSubView|
cg@2744
  2008
        item := self class buildViewsFrom:aSubView.
cg@2744
  2009
        item parent:self.
cg@2744
  2010
        list add:item.
cg@2744
  2011
    ].
cg@2744
  2012
    children := list.
cg@2744
  2013
    ^ true
cg@2744
  2014
!
cg@2744
  2015
cg@2744
  2016
size
cg@2744
  2017
    "redefined: returns list of children
cg@2744
  2018
    "
cg@2744
  2019
    ^ children size
cg@2744
  2020
! !
cg@2744
  2021
cg@2744
  2022
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'!
cg@2744
  2023
cg@2744
  2024
additionalLabelForItem:anItem
cg@2744
  2025
    "answer an additional item for an Item or nil"
cg@2744
  2026
cg@2744
  2027
    parent notNil ifTrue:[
cg@2744
  2028
        ^ parent additionalLabelForItem:anItem
cg@2744
  2029
    ].
cg@2744
  2030
    ^ nil
cg@2744
  2031
!
cg@2744
  2032
cg@2744
  2033
displayIcon:anIcon atX:x y:y on:aGC
cg@2744
  2034
    |x0 y0 y1 w|
cg@2744
  2035
cg@2744
  2036
    super displayIcon:anIcon atX:x y:y on:aGC.
cg@2744
  2037
cg@2744
  2038
    self exists ifFalse:[
cg@2744
  2039
        aGC paint:(Color red).
cg@2744
  2040
cg@2744
  2041
        y0 := y + 1.
cg@2744
  2042
        y1 := y + anIcon height - 2.
cg@2744
  2043
cg@2744
  2044
        x0 := x - 1.
cg@2744
  2045
        w  := anIcon width.
cg@2744
  2046
cg@2744
  2047
        2 timesRepeat:[
cg@2744
  2048
            aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1.
cg@2744
  2049
            aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0.
cg@2744
  2050
            x0 := x0 + 1.
cg@2744
  2051
        ].
cg@2744
  2052
    ].
cg@2744
  2053
!
cg@2744
  2054
cg@2744
  2055
displayOn:aGC x:x y:y h:h
cg@2744
  2056
    |labelHeight additionalName label isValidAndShown|
cg@2744
  2057
cg@2744
  2058
    label := self label.
cg@2744
  2059
    label isEmptyOrNil ifTrue:[^ self].
cg@2744
  2060
cg@2744
  2061
    widget id isNil ifTrue:[
cg@2744
  2062
        isDrawnShown := false.
cg@2744
  2063
cg@2744
  2064
        self exists ifFalse:[
cg@2744
  2065
            xOffsetAdditionalName := nil.
cg@2744
  2066
        ].
cg@2744
  2067
        isValidAndShown := false.
cg@2744
  2068
    ] ifFalse:[
cg@2744
  2069
        isValidAndShown := widget shown.
cg@2744
  2070
    ].
cg@2744
  2071
    isValidAndShown ifFalse:[
cg@2744
  2072
        label := Text string:label emphasis:#italic
cg@2744
  2073
    ].
cg@2744
  2074
cg@2744
  2075
    labelHeight := self heightOn:aGC.
cg@2744
  2076
    self displayLabel:label h:labelHeight on:aGC x:x y:y h:h.
cg@2744
  2077
cg@2744
  2078
    xOffsetAdditionalName notNil ifTrue:[
cg@2744
  2079
        additionalName := self additionalLabelForItem:self.
cg@2744
  2080
cg@2744
  2081
        additionalName notNil ifTrue:[
cg@2744
  2082
            self displayLabel:additionalName
cg@2744
  2083
                            h:labelHeight on:aGC
cg@2744
  2084
                            x:(x + xOffsetAdditionalName)
cg@2744
  2085
                            y:y
cg@2744
  2086
                            h:h.
cg@2744
  2087
        ] ifFalse:[
cg@2744
  2088
            xOffsetAdditionalName := nil.
cg@2744
  2089
        ].
cg@2744
  2090
    ].
cg@2744
  2091
!
cg@2744
  2092
cg@2744
  2093
recursiveAdditionalNameBehaviourChanged
cg@2744
  2094
    width := xOffsetAdditionalName := nil.
cg@2744
  2095
cg@2744
  2096
    children notNil ifTrue:[
cg@2744
  2097
        children do:[:each| each recursiveAdditionalNameBehaviourChanged ]
cg@2744
  2098
    ].
cg@2744
  2099
!
cg@2744
  2100
cg@2744
  2101
widthOn:aGC
cg@2744
  2102
    "return the width of the receiver, if it is to be displayed on aGC
cg@2744
  2103
    "
cg@2744
  2104
    |additionalName|
cg@2744
  2105
cg@2744
  2106
    width isNil ifTrue:[
cg@2744
  2107
        width := self widthOf:(self label) on:aGC.
cg@2744
  2108
        width := width + 2.
cg@2744
  2109
cg@2744
  2110
        additionalName := self additionalLabelForItem:self.
cg@2744
  2111
cg@2744
  2112
        additionalName notNil ifTrue:[
cg@2744
  2113
            xOffsetAdditionalName := width + 10.
cg@2744
  2114
            width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC).
cg@2744
  2115
            width := width + 2.
cg@2744
  2116
        ] ifFalse:[
cg@2744
  2117
            xOffsetAdditionalName := nil.
cg@2744
  2118
        ].
cg@2744
  2119
    ].
cg@2744
  2120
    ^ width
cg@2744
  2121
! !
cg@2744
  2122
cg@2744
  2123
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'!
cg@2744
  2124
cg@2744
  2125
handlesDo:aTwoArgAction
cg@2744
  2126
    "evaluate the two arg block on each handle; the arguments to the block is
cg@2744
  2127
     the rectangle relative to the rootView and the handle type which is
cg@2744
  2128
     set to nil if not resizeable.
cg@2744
  2129
cg@2744
  2130
     TYPES:     type    position( X - Y )
cg@2744
  2131
                -------------------------        
cg@2744
  2132
                #LT     Left   - Top
cg@2744
  2133
                #LC     Left   - Center
cg@2744
  2134
                #LB     Left   - Bottom
cg@2744
  2135
                #CT     Center - Top
cg@2744
  2136
                #CB     Center - Bottom
cg@2744
  2137
                #RT     Right  - Top
cg@2744
  2138
                #RC     Right  - Center
cg@2744
  2139
                #RB     Right  - Bottom
cg@2744
  2140
cg@2744
  2141
                nil     ** handle not pickable **
cg@2744
  2142
    "
cg@2744
  2143
    |type relOrg relCrn maxExt rootView w h
cg@2744
  2144
     xL    "{ Class:SmallInteger }"
cg@2744
  2145
     xC    "{ Class:SmallInteger }"
cg@2744
  2146
     xR    "{ Class:SmallInteger }"
cg@2744
  2147
     yT    "{ Class:SmallInteger }"
cg@2744
  2148
     yC    "{ Class:SmallInteger }"
cg@2744
  2149
     yB    "{ Class:SmallInteger }"
cg@2744
  2150
    |
cg@2744
  2151
    rootView := self rootView.
cg@2744
  2152
    relOrg   := widget originRelativeTo:rootView.
cg@2744
  2153
    relOrg isNil ifTrue:[ ^ self ].    "/ widget destroyed
cg@2744
  2154
cg@2744
  2155
    relOrg   := relOrg - (HandleExtent // 2).
cg@2744
  2156
    relCrn   := relOrg + widget extent.
cg@2744
  2157
    maxExt   := rootView extent - HandleExtent.
cg@2744
  2158
cg@2744
  2159
    xL := relOrg x max:0.
cg@2744
  2160
    xR := relCrn x min:(maxExt x).
cg@2744
  2161
    xC := xR + xL // 2.
cg@2744
  2162
cg@2744
  2163
    yT := relOrg y max:0.
cg@2744
  2164
    yB := relCrn y min:(maxExt y).
cg@2744
  2165
    yC := yB + yT // 2.
cg@2744
  2166
cg@2744
  2167
    type := self layoutType.
cg@2744
  2168
    w   := HandleExtent x.
cg@2744
  2169
    h   := HandleExtent y.
cg@2744
  2170
cg@2744
  2171
    (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[
cg@2744
  2172
        aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT.
cg@2744
  2173
        aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC.
cg@2744
  2174
        aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB.
cg@2744
  2175
        aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT.
cg@2744
  2176
        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
cg@2744
  2177
        aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT.
cg@2744
  2178
        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
cg@2744
  2179
        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
cg@2744
  2180
      ^ self
cg@2744
  2181
    ].
cg@2744
  2182
cg@2744
  2183
    aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil.
cg@2744
  2184
    aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil.
cg@2744
  2185
    aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil.
cg@2744
  2186
cg@2744
  2187
    type == #Extent ifTrue:[
cg@2744
  2188
        aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB.
cg@2744
  2189
        aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC.
cg@2744
  2190
        aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB.
cg@2744
  2191
      ^ self
cg@2744
  2192
    ].
cg@2744
  2193
    aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil.
cg@2744
  2194
!
cg@2744
  2195
cg@2744
  2196
recursiveEachVisibleItemDo:anOneArgBlock
cg@2744
  2197
    "recursive evaluate the block on each child which is visible
cg@2744
  2198
    "
cg@2744
  2199
    (isExpanded and:[children size > 0]) ifTrue:[
cg@2744
  2200
        children do:[:aChild|
cg@2744
  2201
            anOneArgBlock value:aChild.
cg@2744
  2202
            aChild recursiveEachVisibleItemDo:anOneArgBlock.
cg@2744
  2203
        ]
cg@2744
  2204
    ].
cg@2744
  2205
!
cg@2744
  2206
cg@2744
  2207
subViewsDo:aOneArgBlock
cg@2744
  2208
    "evaluate aBlock for all subviews other than InputView's   
cg@2744
  2209
    "
cg@2744
  2210
    |subViews|
cg@2744
  2211
cg@2744
  2212
    subViews := widget subViews.
cg@2744
  2213
cg@2744
  2214
    subViews notNil ifTrue:[
cg@2744
  2215
        subViews do:aOneArgBlock
cg@2744
  2216
    ].
cg@2744
  2217
! !
cg@2744
  2218
cg@2744
  2219
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'!
cg@2744
  2220
cg@2744
  2221
forView:aView
cg@2744
  2222
    widget := aView.
cg@2744
  2223
!
cg@2744
  2224
cg@2744
  2225
initialize
cg@2744
  2226
    "setup default attributes
cg@2744
  2227
    "
cg@2744
  2228
    super initialize.
cg@2744
  2229
    isDrawnShown := false.
cg@2744
  2230
    isExpanded   := false.
cg@2744
  2231
    children     := OrderedCollection new.
cg@2744
  2232
! !
cg@2744
  2233
cg@2744
  2234
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'!
cg@2744
  2235
cg@2744
  2236
delete
cg@2744
  2237
    "delete self and all contained items; the assigned views are destroyed
cg@2744
  2238
     in case of rootView, only the children are deleted
cg@2744
  2239
    "
cg@2744
  2240
    parent isHierarchicalItem ifTrue:[
cg@2744
  2241
        self criticalDo:[
cg@2744
  2242
            parent remove:self.
cg@2744
  2243
            widget destroy.
cg@2744
  2244
        ]
cg@2744
  2245
    ] ifFalse:[
cg@2744
  2246
        self deleteAll
cg@2744
  2247
    ].
cg@2744
  2248
!
cg@2744
  2249
cg@2744
  2250
deleteAll
cg@2744
  2251
    "delete all contained items; the assigned views are destroyed
cg@2744
  2252
    "
cg@2744
  2253
    children size == 0 ifTrue:[^ self].
cg@2744
  2254
cg@2744
  2255
    self criticalDo:[
cg@2744
  2256
        self nonCriticalDo:[:el| el widget destroy ].
cg@2744
  2257
        self removeAll
cg@2744
  2258
    ].
cg@2744
  2259
! !
cg@2744
  2260
cg@2744
  2261
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'!
cg@2744
  2262
cg@2744
  2263
asLayoutFrame
cg@2744
  2264
    "convert the layout of the widget to a LayoutFrame;
cg@2744
  2265
    "
cg@2744
  2266
    |extent layout newLyt lftFrc lftOff topFrc topOff|
cg@2744
  2267
cg@2744
  2268
    layout := widget geometryLayout.
cg@2744
  2269
cg@2744
  2270
    layout isNil ifTrue:[
cg@2744
  2271
        ^ widget bounds asLayout
cg@2744
  2272
    ].
cg@2744
  2273
cg@2744
  2274
    layout isLayout ifFalse:[
cg@2744
  2275
        layout isRectangle ifTrue:[
cg@2744
  2276
            ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right)
cg@2744
  2277
                           topOffset:(layout top) bottomOffset:(layout bottom)
cg@2744
  2278
        ].
cg@2744
  2279
        layout isPoint ifTrue:[
cg@2744
  2280
            extent := widget extent.
cg@2744
  2281
          ^ LayoutFrame leftOffset:(layout x)  rightOffset:(layout x + extent x)
cg@2744
  2282
                         topOffset:(layout y) bottomOffset:(layout y + extent y)
cg@2744
  2283
        ].
cg@2744
  2284
cg@2744
  2285
        Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString.
cg@2744
  2286
      ^ nil
cg@2744
  2287
    ].
cg@2744
  2288
cg@2744
  2289
    layout isLayoutFrame ifTrue:[ ^ layout copy ].    
cg@2744
  2290
cg@2744
  2291
    lftFrc := layout leftFraction.
cg@2744
  2292
    lftOff := layout leftOffset.
cg@2744
  2293
    topFrc := layout topFraction.
cg@2744
  2294
    topOff := layout topOffset.
cg@2744
  2295
    extent := widget extent.
cg@2744
  2296
cg@2744
  2297
    newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff
cg@2744
  2298
                         rightFraction:lftFrc offset:(lftOff + extent x)
cg@2744
  2299
                           topFraction:topFrc offset:topOff
cg@2744
  2300
                        bottomFraction:topFrc offset:(topOff + extent y).
cg@2744
  2301
cg@2744
  2302
    (      layout isAlignmentOrigin
cg@2744
  2303
     and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])]
cg@2744
  2304
    ) ifTrue:[
cg@2744
  2305
        |svRc prBd dlta|
cg@2744
  2306
cg@2744
  2307
        svRc := widget superView viewRectangle.
cg@2744
  2308
        prBd := widget preferredBounds.
cg@2744
  2309
cg@2744
  2310
        dlta := (  ((layout rectangleRelativeTo:svRc preferred:prBd) corner)
cg@2744
  2311
                 - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner)
cg@2744
  2312
                ) rounded.
cg@2744
  2313
cg@2744
  2314
        newLyt   leftOffset:(lftOff + dlta x).
cg@2744
  2315
        newLyt  rightOffset:(lftOff + extent x + dlta x).
cg@2744
  2316
        newLyt    topOffset:(topOff + dlta y).
cg@2744
  2317
        newLyt bottomOffset:(topOff + extent y + dlta y).
cg@2744
  2318
    ].
cg@2744
  2319
    ^ newLyt
cg@2744
  2320
!
cg@2744
  2321
cg@2744
  2322
moveLeft:l top:t
cg@2744
  2323
    "move the widget n pixele left and right
cg@2744
  2324
    "
cg@2744
  2325
    |layout|
cg@2744
  2326
cg@2744
  2327
    self isMoveable ifFalse:[ ^ self ].
cg@2744
  2328
cg@2744
  2329
    (layout := widget geometryLayout) isNil ifTrue:[
cg@2744
  2330
        "Extent"
cg@2744
  2331
        widget origin:(widget origin + (l@t)).
cg@2744
  2332
      ^ self
cg@2744
  2333
    ].
cg@2744
  2334
cg@2744
  2335
    layout := layout copy.
cg@2744
  2336
cg@2744
  2337
    layout isLayout ifTrue:[
cg@2744
  2338
        layout leftOffset:(layout leftOffset + l)
cg@2744
  2339
                topOffset:(layout topOffset  + t).
cg@2744
  2340
cg@2744
  2341
        layout isLayoutFrame ifTrue:[
cg@2744
  2342
            layout  rightOffset:(layout rightOffset  + l).
cg@2744
  2343
            layout bottomOffset:(layout bottomOffset + t).
cg@2744
  2344
        ]
cg@2744
  2345
cg@2744
  2346
    ] ifFalse:[
cg@2744
  2347
        layout isRectangle ifTrue:[
cg@2744
  2348
            layout setLeft:(layout left + l).
cg@2744
  2349
            layout  setTop:(layout top  + t).
cg@2744
  2350
        ] ifFalse:[
cg@2744
  2351
            layout isPoint ifFalse:[^ self].
cg@2744
  2352
            layout x:(layout x + l) y:(layout y + t).
cg@2744
  2353
        ]
cg@2744
  2354
    ].
cg@2744
  2355
    widget geometryLayout:layout.
cg@2744
  2356
!
cg@2744
  2357
cg@2744
  2358
resizeLeft:l top:t right:r bottom:b
cg@2744
  2359
    "resize the widget measured in pixels
cg@2744
  2360
    "
cg@2744
  2361
    |layout|
cg@2744
  2362
cg@2744
  2363
    self isResizeable ifFalse:[
cg@2744
  2364
        ^ self
cg@2744
  2365
    ].
cg@2744
  2366
cg@2744
  2367
    (layout := widget geometryLayout) isNil ifTrue:[
cg@2744
  2368
        "Extent"
cg@2744
  2369
        (r == l and:[b == t]) ifFalse:[
cg@2744
  2370
            widget extent:(widget computeExtent + ((r-l) @ (b-t))).
cg@2744
  2371
        ].
cg@2744
  2372
        ^ self
cg@2744
  2373
    ].
cg@2744
  2374
cg@2744
  2375
    layout isLayout ifTrue:[
cg@2744
  2376
        layout := layout copy.
cg@2744
  2377
cg@2744
  2378
        layout leftOffset:(layout leftOffset + l)
cg@2744
  2379
                topOffset:(layout topOffset  + t).
cg@2744
  2380
cg@2744
  2381
        layout isLayoutFrame ifTrue:[
cg@2744
  2382
            layout bottomOffset:(layout bottomOffset + b).
cg@2744
  2383
            layout  rightOffset:(layout rightOffset  + r).
cg@2744
  2384
        ]
cg@2744
  2385
    ] ifFalse:[
cg@2744
  2386
        layout isRectangle ifFalse:[^ self].
cg@2744
  2387
        layout := layout copy.
cg@2744
  2388
cg@2744
  2389
        layout left:(layout left   + l)
cg@2744
  2390
              right:(layout right  + r)
cg@2744
  2391
                top:(layout top    + t)
cg@2744
  2392
             bottom:(layout bottom + b).
cg@2744
  2393
    ].
cg@2744
  2394
    widget geometryLayout:layout.
cg@2744
  2395
! !
cg@2744
  2396
cg@2744
  2397
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'!
cg@2744
  2398
cg@2744
  2399
updateChildren
cg@2744
  2400
    |list|
cg@2744
  2401
cg@2744
  2402
    self do:[:el|
cg@2744
  2403
        el exists ifTrue:[
cg@2744
  2404
            el updateChildren.
cg@2744
  2405
        ] ifFalse:[
cg@2744
  2406
            list isNil ifTrue:[list := OrderedCollection new].
cg@2744
  2407
            list add:el.
cg@2744
  2408
        ]
cg@2744
  2409
    ].
cg@2744
  2410
    list notNil ifTrue:[
cg@2744
  2411
        list do:[:el| self remove:el ].
cg@2744
  2412
    ].
cg@2744
  2413
!
cg@2744
  2414
cg@2744
  2415
updateFromChildren:mergedList
cg@2744
  2416
    "update my children against the list of items derived from
cg@2744
  2417
     the merged list.
cg@2744
  2418
    "
cg@2744
  2419
cg@2744
  2420
    mergedList size == 0 ifTrue:[ ^ self removeAll ].
cg@2744
  2421
    children   size == 0 ifTrue:[ ^ self addAll:mergedList ].
cg@2744
  2422
cg@2744
  2423
    self criticalDo:[
cg@2744
  2424
        self nonCriticalDo:[:el| |wdg|
cg@2744
  2425
            wdg := el widget.
cg@2744
  2426
            mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ].
cg@2744
  2427
        ].
cg@2744
  2428
cg@2744
  2429
        mergedList keysAndValuesDo:[:i :el| |wdg e2|
cg@2744
  2430
            wdg := el widget.
cg@2744
  2431
cg@2744
  2432
            e2  := self at:i ifAbsent:nil.
cg@2744
  2433
cg@2744
  2434
            (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[
cg@2744
  2435
                self add:el beforeIndex:i
cg@2744
  2436
            ]
cg@2744
  2437
        ]
cg@2744
  2438
    ].
cg@2744
  2439
! !
cg@2744
  2440
cg@2744
  2441
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'!
cg@2744
  2442
cg@2744
  2443
icon
cg@2744
  2444
    "get the icon used for presentation
cg@2744
  2445
    "
cg@2744
  2446
    |specClass model|
cg@2744
  2447
cg@2744
  2448
    specClass := self specClass.
cg@2744
  2449
    specClass isNil ifTrue:[^ nil].
cg@2744
  2450
cg@2744
  2451
    model := self treeModel.
cg@2744
  2452
cg@2744
  2453
    model notNil ifTrue:[
cg@2744
  2454
        ^ model iconAt:specClass ifNonePut:[specClass icon]
cg@2744
  2455
    ].
cg@2744
  2456
    ^ specClass icon
cg@2744
  2457
!
cg@2744
  2458
cg@2744
  2459
label
cg@2744
  2460
    "get the label used for presentation
cg@2744
  2461
    "
cg@2744
  2462
    ^ self string
cg@2744
  2463
!
cg@2744
  2464
cg@2744
  2465
printOn:aStream
cg@2744
  2466
    "append a a printed representation of the item to aStream
cg@2744
  2467
    "
cg@2744
  2468
    aStream nextPutAll:(self string)
cg@2744
  2469
!
cg@2744
  2470
cg@2744
  2471
string
cg@2744
  2472
    "get the string
cg@2744
  2473
    "
cg@2744
  2474
    ^ widget class name.
cg@2744
  2475
! !
cg@2744
  2476
cg@2744
  2477
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'!
cg@2744
  2478
cg@2744
  2479
canChangeLayout
cg@2744
  2480
    "returns true if the layout of the widget can be changed and the
cg@2744
  2481
     layout is not organized by its superView
cg@2744
  2482
    "
cg@2744
  2483
    ^ self isResizeable
cg@2744
  2484
!
cg@2744
  2485
cg@2744
  2486
canResizeSubComponents
cg@2744
  2487
    "returns true if the widget can resize its sub components
cg@2744
  2488
    "
cg@2744
  2489
    |specClass|
cg@2744
  2490
cg@2744
  2491
    specClass := self specClass.
cg@2744
  2492
cg@2744
  2493
    specClass notNil ifTrue:[
cg@2744
  2494
        ^ specClass canResizeSubComponents
cg@2744
  2495
    ].
cg@2744
  2496
    ^ false
cg@2744
  2497
!
cg@2744
  2498
cg@2744
  2499
exists
cg@2744
  2500
    widget id notNil ifTrue:[^ true ].
cg@2744
  2501
cg@2744
  2502
    exists ~~ false ifTrue:[
cg@2744
  2503
        exists := false.
cg@2744
  2504
cg@2744
  2505
        widget superView notNil ifTrue:[
cg@2744
  2506
            (parent isHierarchicalItem and:[parent exists]) ifTrue:[
cg@2744
  2507
                exists := (parent widget subViews includesIdentical:widget).
cg@2744
  2508
            ].
cg@2744
  2509
        ].
cg@2744
  2510
    ].
cg@2744
  2511
    ^ exists
cg@2744
  2512
!
cg@2744
  2513
cg@2744
  2514
isApplicationClass
cg@2744
  2515
    |cls|
cg@2744
  2516
cg@2744
  2517
    cls := widget class.
cg@2744
  2518
cg@2744
  2519
    ^ (    cls == ApplicationSubView
cg@2744
  2520
        or:[cls == ApplicationWindow
cg@2744
  2521
        or:[cls == SubCanvas]]
cg@2744
  2522
      ) 
cg@2744
  2523
!
cg@2744
  2524
cg@2744
  2525
isSelected
cg@2744
  2526
    |model|
cg@2744
  2527
cg@2744
  2528
    model := self treeModel.
cg@2744
  2529
    model notNil ifTrue:[^ model isSelected:self].
cg@2744
  2530
    ^ false
cg@2744
  2531
!
cg@2744
  2532
cg@2744
  2533
supportsSubComponents
cg@2744
  2534
    "returns true if the widget supports sub components
cg@2744
  2535
    "
cg@2744
  2536
    |specClass|
cg@2744
  2537
cg@2744
  2538
    widget isScrollWrapper ifTrue:[
cg@2744
  2539
        ^ false
cg@2744
  2540
    ].
cg@2744
  2541
    specClass := self specClass.
cg@2744
  2542
cg@2744
  2543
    specClass notNil ifTrue:[
cg@2744
  2544
        ^ specClass supportsSubComponents
cg@2744
  2545
    ].
cg@2744
  2546
    ^ false
cg@2744
  2547
! !
cg@2744
  2548
cg@2744
  2549
!ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'!
cg@2744
  2550
cg@2744
  2551
isInLayoutContainer
cg@2744
  2552
    "returns true if the widget is in a layout container
cg@2744
  2553
    "
cg@2744
  2554
    |sv specClass|
cg@2744
  2555
cg@2744
  2556
    sv := widget superView.
cg@2744
  2557
cg@2744
  2558
    sv notNil ifTrue:[
cg@2744
  2559
        specClass := sv specClass.
cg@2744
  2560
cg@2744
  2561
        specClass notNil ifTrue:[
cg@2744
  2562
            ^ specClass isLayoutContainer
cg@2744
  2563
        ].
cg@2744
  2564
    ].
cg@2744
  2565
    ^ false
cg@2744
  2566
!
cg@2744
  2567
cg@2744
  2568
isLayoutContainer
cg@2744
  2569
    "answer whether corresponding view instances of the spec class can contain
cg@2744
  2570
     (and arrange) other view
cg@2744
  2571
    "
cg@2744
  2572
    |specClass|
cg@2744
  2573
cg@2744
  2574
    specClass := self specClass.
cg@2744
  2575
cg@2744
  2576
    specClass notNil ifTrue:[
cg@2744
  2577
        ^ specClass isLayoutContainer
cg@2744
  2578
    ].
cg@2744
  2579
    ^ false
cg@2744
  2580
!
cg@2744
  2581
cg@2744
  2582
isMoveable
cg@2744
  2583
    "returns true if the widget is not in a layout container
cg@2744
  2584
    "
cg@2744
  2585
    self isInLayoutContainer ifFalse:[
cg@2744
  2586
        ^ widget superView notNil
cg@2744
  2587
    ].
cg@2744
  2588
    ^ false
cg@2744
  2589
!
cg@2744
  2590
cg@2744
  2591
isResizeable
cg@2744
  2592
    "returns true if the widget is resizeable
cg@2744
  2593
    "
cg@2744
  2594
    |sv specClass|
cg@2744
  2595
cg@2744
  2596
    sv := widget superView.
cg@2744
  2597
cg@2744
  2598
    sv notNil ifTrue:[
cg@2744
  2599
        specClass := sv specClass.
cg@2744
  2600
cg@2744
  2601
        specClass notNil ifTrue:[
cg@2744
  2602
            ^ specClass canResizeSubComponents
cg@2744
  2603
        ].
cg@2744
  2604
    ].
cg@2744
  2605
    ^ false
cg@2744
  2606
! !
cg@2744
  2607
cg@2744
  2608
!ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'!
cg@2744
  2609
cg@2744
  2610
documentation
cg@2744
  2611
"
cg@2744
  2612
    Instances of ViewTreeModel can be used as model on a View and all
cg@2744
  2613
    it contained subviews for a HierarchicalListView.
cg@2744
  2614
    The model keeps two values, the hierarchical representation of the views
cg@2744
  2615
    and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
cg@2744
  2616
    It shows the selected items highlighted.
cg@2744
  2617
cg@2744
  2618
cg@2744
  2619
    [Instance variables:]
cg@2744
  2620
        lockSema            <Semaphore>         lock selection notifications and redraws
cg@2744
  2621
cg@2744
  2622
        testModeChannel     <ValueHolder>       true, than running in test mode.
cg@2744
  2623
cg@2744
  2624
        hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
cg@2744
  2625
cg@2744
  2626
        selection           <Sequence or nil>   selected items or nil
cg@2744
  2627
cg@2744
  2628
        hiddenLevel         <Integer>           internal use; redrawing the selection
cg@2744
  2629
                                                only is done if the counter is 0.
cg@2744
  2630
cg@2744
  2631
        listOfItems         <HierarchicalList>  hiearchical list build from existing items.
cg@2744
  2632
cg@2744
  2633
        selectedSuperItems  <Sequence>          list of selected super items; items selected
cg@2744
  2634
                                                but not contained in another selected item.
cg@2744
  2635
cg@2744
  2636
        inputEventAction    <Action>            called for each InputEvent
cg@2744
  2637
cg@2744
  2638
        mappedViewAction    <Action>            called for a new mapped view which
cg@2744
  2639
                                                can not be found in the current item list.
cg@2744
  2640
cg@2744
  2641
        beforeSelectionChangedAction <Action>   called before the selection changed
cg@2744
  2642
cg@2744
  2643
    [author:]
cg@2744
  2644
        Claus Atzkern
cg@2744
  2645
cg@2744
  2646
    [see also:]
cg@2744
  2647
        ViewTreeItem
cg@2744
  2648
"
cg@2744
  2649
!
cg@2744
  2650
cg@2744
  2651
examples
cg@2744
  2652
"
cg@2744
  2653
    example 1: pick any window and show views and contained views
cg@2744
  2654
                                                                                [exBegin]
cg@2744
  2655
    |top sel model panel|
cg@2744
  2656
cg@2744
  2657
    model := ViewTreeModel new.
cg@2744
  2658
    top   := StandardSystemView new; extent:440@400.
cg@2744
  2659
    sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
cg@2744
  2660
    sel bottomInset:24.
cg@2744
  2661
cg@2744
  2662
    panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
cg@2744
  2663
    panel topInset:-24.
cg@2744
  2664
    panel horizontalLayout:#fitSpace.
cg@2744
  2665
cg@2744
  2666
    Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
cg@2744
  2667
    Button label:'Pick Views' action:[  |win|
cg@2744
  2668
                                        (     (win := Screen current viewFromUser) notNil
cg@2744
  2669
                                         and:[(win := win topView) ~~ Screen current rootView
cg@2744
  2670
                                         and:[win ~~ top]]
cg@2744
  2671
                                        ) ifTrue:[
cg@2744
  2672
                                            model rootItem:(ViewTreeItem buildViewsFrom:win)
cg@2744
  2673
                                        ] ifFalse:[
cg@2744
  2674
                                            model rootItem:nil
cg@2744
  2675
                                        ]
cg@2744
  2676
                                     ] in:panel.
cg@2744
  2677
cg@2744
  2678
    sel  multipleSelectOk:true.
cg@2744
  2679
    sel              list:model listOfItems.
cg@2744
  2680
    sel             model:model.
cg@2744
  2681
    sel          useIndex:false.
cg@2744
  2682
cg@2744
  2683
    sel doubleClickAction:[:i| |el|
cg@2744
  2684
        el := model listOfItems at:i.
cg@2744
  2685
        el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
cg@2744
  2686
    ].
cg@2744
  2687
    sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
cg@2744
  2688
cg@2744
  2689
    model inputEventAction:[:anEvent| |item|
cg@2744
  2690
        anEvent isButtonEvent ifTrue:[
cg@2744
  2691
            anEvent isButtonPressEvent ifTrue:[
cg@2744
  2692
                model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
cg@2744
  2693
            ] ifFalse:[
cg@2744
  2694
                anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
cg@2744
  2695
                    (item := model selectedItem) notNil ifTrue:[item widget inspect]
cg@2744
  2696
                ]
cg@2744
  2697
            ]
cg@2744
  2698
        ]
cg@2744
  2699
    ].
cg@2744
  2700
cg@2744
  2701
    top openAndWait.
cg@2744
  2702
    [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
cg@2744
  2703
cg@2744
  2704
                                                                                [exEnd]
cg@2744
  2705
"
cg@2744
  2706
! !
cg@2744
  2707
cg@2744
  2708
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'!
cg@2744
  2709
cg@2744
  2710
application:anApplication
cg@2744
  2711
    listOfItems application:anApplication.
cg@2744
  2712
!
cg@2744
  2713
cg@2744
  2714
rootItem
cg@2744
  2715
    "get the rootItem the event viewer is established on
cg@2744
  2716
    "
cg@2744
  2717
    ^ listOfItems root
cg@2744
  2718
!
cg@2744
  2719
cg@2744
  2720
rootItem:anItem
cg@2744
  2721
    "set the rootItem the event viewer is established on
cg@2744
  2722
    "
cg@2744
  2723
    |expanded|
cg@2744
  2724
cg@2744
  2725
    timedUpdateTask := nil.
cg@2744
  2726
    self deselect.
cg@2744
  2727
cg@2744
  2728
    lockSema critical:[
cg@2744
  2729
        anItem notNil ifTrue:[ expanded := anItem isExpanded ]
cg@2744
  2730
                     ifFalse:[ expanded := false ].
cg@2744
  2731
cg@2744
  2732
        self value:nil.
cg@2744
  2733
        listOfItems root:anItem.
cg@2744
  2734
cg@2744
  2735
        anItem notNil ifTrue:[
cg@2744
  2736
            timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
cg@2744
  2737
            timedUpdateTask name:'Update'.
cg@2744
  2738
            timedUpdateTask resume.
cg@2744
  2739
        ].
cg@2744
  2740
    ].
cg@2744
  2741
cg@2744
  2742
    (expanded and:[anItem notNil]) ifTrue:[
cg@2744
  2743
        anItem expand
cg@2744
  2744
    ].
cg@2744
  2745
    ^ anItem
cg@2744
  2746
!
cg@2744
  2747
cg@2744
  2748
rootView
cg@2744
  2749
    "get the top widget the event viewer is established on, a View
cg@2744
  2750
    "
cg@2744
  2751
    ^ listOfItems rootView
cg@2744
  2752
! !
cg@2744
  2753
cg@2744
  2754
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'!
cg@2744
  2755
cg@2744
  2756
beforeSelectionChangedAction
cg@2744
  2757
    "none argument action which is called before
cg@2744
  2758
     the selection changed
cg@2744
  2759
    "
cg@2744
  2760
    ^ beforeSelectionChangedAction
cg@2744
  2761
!
cg@2744
  2762
cg@2744
  2763
beforeSelectionChangedAction:aNoneArgBlock
cg@2744
  2764
    "none argument action which is called before
cg@2744
  2765
     the selection changed
cg@2744
  2766
    "
cg@2744
  2767
    beforeSelectionChangedAction := aNoneArgBlock.
cg@2744
  2768
!
cg@2744
  2769
cg@2744
  2770
inputEventAction
cg@2744
  2771
    "called for each input event; the argument to the action is the WindowEvent
cg@2744
  2772
    "
cg@2744
  2773
    ^ inputEventAction
cg@2744
  2774
!
cg@2744
  2775
cg@2744
  2776
inputEventAction:aOneArgActionTheEvent
cg@2744
  2777
    "called for each input event; the argument to the action is the WindowEvent
cg@2744
  2778
    "
cg@2744
  2779
    inputEventAction := aOneArgActionTheEvent.
cg@2744
  2780
!
cg@2744
  2781
cg@2744
  2782
mappedViewAction
cg@2744
  2783
    "called for a new mapped view which can not be found
cg@2744
  2784
     in the current item list
cg@2744
  2785
    "
cg@2744
  2786
    ^ mappedViewAction
cg@2744
  2787
!
cg@2744
  2788
cg@2744
  2789
mappedViewAction:aOneArgBlockTheMappedView
cg@2744
  2790
    "called for a new mapped view which can not be found
cg@2744
  2791
     in the current item list
cg@2744
  2792
    "
cg@2744
  2793
    mappedViewAction := aOneArgBlockTheMappedView
cg@2744
  2794
! !
cg@2744
  2795
cg@2744
  2796
!ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'!
cg@2744
  2797
cg@2744
  2798
iconAt:aKey ifNonePut:aNoneArgBlock
cg@2744
  2799
    |icon view|
cg@2744
  2800
cg@2744
  2801
    icon := icons at:aKey ifAbsent:nil.
cg@2744
  2802
    icon notNil ifTrue:[^ icon].
cg@2744
  2803
cg@2744
  2804
    icon := aNoneArgBlock value.
cg@2744 <