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