Tools__ViewTreeApplication.st
author Claus Gittinger <cg@exept.de>
Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570 4e663bc64364
parent 2458 64d8f3c973b3
child 2744 5bee95e91ffd
permissions -rw-r--r--
changed #requestPackage
ca@2177
     1
"{ Package: 'stx:libtool2' }"
ca@2177
     2
ca@2177
     3
"{ NameSpace: Tools }"
ca@2177
     4
ca@2177
     5
ApplicationModel subclass:#ViewTreeApplication
ca@2177
     6
	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint
ca@2458
     7
		motionAction process followFocusChannel showNamesHolder'
ca@2177
     8
	classVariableNames:''
ca@2177
     9
	poolDictionaries:''
ca@2177
    10
	category:'A-Views-Support'
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:''
ca@2177
    17
	privateIn:ViewTreeApplication
ca@2177
    18
!
ca@2177
    19
ca@2177
    20
!ViewTreeApplication class methodsFor:'documentation'!
ca@2177
    21
ca@2177
    22
documentation
ca@2177
    23
"
ca@2177
    24
     Small application showing a ViewTreeModel use.
ca@2177
    25
ca@2177
    26
     It displays a hierarchical list of a selected TopView and
ca@2177
    27
     all its contained subViews.
ca@2177
    28
     Useful to have a look at subcomponents - to see how views
ca@2177
    29
     are structured.
ca@2177
    30
ca@2177
    31
ca@2177
    32
    [Instance variables:]
ca@2177
    33
        model           <ViewTreeModel>      the used ViewTreeModel
ca@2177
    34
        clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)
ca@2177
    35
        clickedPoint    <Point>              point where the motion action started from.
ca@2177
    36
        motionAction    <Action>             (oneArg-) action called durring buttonMotion.
ca@2177
    37
ca@2177
    38
ca@2177
    39
    [author:]
ca@2177
    40
        Claus Atzkern
ca@2177
    41
ca@2177
    42
    [see also:]
ca@2177
    43
        ViewTreeModel
ca@2177
    44
        ViewTreeItem
ca@2177
    45
"
ca@2177
    46
! !
ca@2177
    47
ca@2177
    48
!ViewTreeApplication class methodsFor:'initialization'!
ca@2177
    49
ca@2177
    50
initialize
ca@2177
    51
    "add myself to the launcher menu
ca@2177
    52
    "
ca@2177
    53
    self installInLauncher.
ca@2177
    54
!
ca@2177
    55
ca@2177
    56
installInLauncher
ca@2177
    57
    "add myself to the launcher menu
ca@2177
    58
    "
ca@2177
    59
    |menuItem icon|
ca@2177
    60
ca@2177
    61
    NewLauncher isNil ifTrue:[^ self].
ca@2177
    62
ca@2177
    63
    icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.
ca@2177
    64
ca@2177
    65
    menuItem := MenuItem new 
ca@2177
    66
                    label: 'View Inspector';
ca@2177
    67
                    value: [ ViewTreeApplication open];
ca@2177
    68
                    isButton: true;
ca@2177
    69
                    icon: icon;
ca@2177
    70
                    nameKey: #viewInspect.
ca@2177
    71
ca@2177
    72
    menuItem startGroup:#right.
ca@2177
    73
    NewLauncher addMenuItem:menuItem in:'toolbar'
ca@2177
    74
                   position:#( #before #help)
ca@2177
    75
                      space:false.
ca@2177
    76
ca@2177
    77
"
ca@2177
    78
self installInLauncher
ca@2177
    79
self removeFromLauncher
ca@2177
    80
"
ca@2177
    81
!
ca@2177
    82
ca@2177
    83
postAutoload
ca@2177
    84
    "add myself to the launcher menu
ca@2177
    85
    "
ca@2177
    86
    self installInLauncher.
ca@2177
    87
"
ca@2177
    88
self installInLauncher
ca@2177
    89
self removeFromLauncher
ca@2177
    90
"
ca@2177
    91
!
ca@2177
    92
ca@2177
    93
removeFromLauncher
ca@2177
    94
    "remove myself from the launcher menu
ca@2177
    95
    "
ca@2177
    96
    NewLauncher isNil ifTrue:[^ self].
ca@2177
    97
    NewLauncher removeUserTool:#viewInspect
ca@2177
    98
ca@2177
    99
"
ca@2177
   100
self installInLauncher
ca@2177
   101
self removeFromLauncher
ca@2177
   102
"
ca@2177
   103
!
ca@2177
   104
ca@2177
   105
unload
ca@2177
   106
    "class is about to be unloaded - remove myself from the launcher menu
ca@2177
   107
    "
ca@2177
   108
    self removeFromLauncher.
ca@2177
   109
    super unload.
ca@2177
   110
! !
ca@2177
   111
ca@2177
   112
!ViewTreeApplication class methodsFor:'interface specs'!
ca@2177
   113
ca@2177
   114
windowSpec
ca@2177
   115
    "This resource specification was automatically generated
ca@2177
   116
     by the UIPainter of ST/X."
ca@2177
   117
ca@2177
   118
    "Do not manually edit this!! If it is corrupted,
ca@2177
   119
     the UIPainter may not be able to read the specification."
ca@2177
   120
ca@2177
   121
    "
ca@2451
   122
     UIPainter new openOnClass:Tools::ViewTreeApplication andSelector:#windowSpec
ca@2451
   123
     Tools::ViewTreeApplication new openInterface:#windowSpec
ca@2451
   124
     Tools::ViewTreeApplication open
ca@2177
   125
    "
ca@2177
   126
ca@2177
   127
    <resource: #canvas>
ca@2177
   128
ca@2177
   129
    ^ 
ca@2177
   130
     #(FullSpec
ca@2177
   131
        name: windowSpec
ca@2177
   132
        window: 
ca@2177
   133
       (WindowSpec
ca@2177
   134
          label: 'ViewTreeInspector'
ca@2177
   135
          name: 'ViewTreeInspector'
ca@2177
   136
          min: (Point 10 10)
ca@2177
   137
          max: (Point 1024 9999)
ca@2451
   138
          bounds: (Rectangle 0 0 381 654)
ca@2177
   139
          menu: menu
ca@2177
   140
        )
ca@2177
   141
        component: 
ca@2177
   142
       (SpecCollection
ca@2177
   143
          collection: (
ca@2177
   144
           (MenuPanelSpec
ca@2177
   145
              name: 'toolbarMenu'
ca@2177
   146
              layout: (LayoutFrame 0 0.0 0 0 0 1.0 32 0)
ca@2177
   147
              menu: toolbarMenu
ca@2177
   148
              textDefault: true
ca@2177
   149
            )
ca@2177
   150
           (HierarchicalListViewSpec
ca@2177
   151
              name: 'List'
ca@2458
   152
              layout: (LayoutFrame 0 0.0 32 0.0 0 1.0 0 1.0)
ca@2177
   153
              level: 1
ca@2177
   154
              model: model
ca@2177
   155
              menu: middleButtonMenu
ca@2177
   156
              hasHorizontalScrollBar: true
ca@2177
   157
              hasVerticalScrollBar: true
ca@2177
   158
              miniScrollerHorizontal: true
ca@2177
   159
              miniScrollerVertical: false
ca@2177
   160
              listModel: listOfItems
ca@2177
   161
              multipleSelectOk: true
ca@2177
   162
              useIndex: false
ca@2177
   163
              highlightMode: label
ca@2177
   164
              showLeftIndicators: false
ca@2177
   165
              indicatorSelector: indicatorClicked:
ca@2177
   166
              useDefaultIcons: false
ca@2177
   167
              postBuildCallback: postBuildTree:
ca@2177
   168
            )
ca@2177
   169
           )
ca@2177
   170
         
ca@2177
   171
        )
ca@2177
   172
      )
ca@2177
   173
! !
ca@2177
   174
ca@2177
   175
!ViewTreeApplication class methodsFor:'menu specs'!
ca@2177
   176
ca@2177
   177
menu
ca@2177
   178
    "This resource specification was automatically generated
ca@2177
   179
     by the MenuEditor of ST/X."
ca@2177
   180
ca@2177
   181
    "Do not manually edit this!! If it is corrupted,
ca@2177
   182
     the MenuEditor may not be able to read the specification."
ca@2177
   183
ca@2177
   184
    "
ca@2454
   185
     MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#menu
ca@2454
   186
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication menu)) startUp
ca@2177
   187
    "
ca@2177
   188
ca@2177
   189
    <resource: #menu>
ca@2177
   190
ca@2177
   191
    ^ 
ca@2177
   192
     #(Menu
ca@2177
   193
        (
ca@2177
   194
         (MenuItem
ca@2177
   195
            label: 'File'
ca@2177
   196
            translateLabel: true
ca@2177
   197
            submenu: 
ca@2177
   198
           (Menu
ca@2177
   199
              (
ca@2177
   200
               (MenuItem
ca@2177
   201
                  label: 'Pick a View'
ca@2177
   202
                  itemValue: doPickViews
ca@2177
   203
                  translateLabel: true
ca@2177
   204
                )
ca@2177
   205
               (MenuItem
ca@2455
   206
                  enabled: hasTargetWidgetChannel
ca@2177
   207
                  label: 'Release Picked View'
ca@2177
   208
                  itemValue: doUnpick
ca@2177
   209
                  translateLabel: true
ca@2177
   210
                )
ca@2177
   211
               (MenuItem
ca@2177
   212
                  label: '-'
ca@2177
   213
                )
ca@2177
   214
               (MenuItem
ca@2177
   215
                  label: 'Exit'
ca@2177
   216
                  itemValue: closeRequest
ca@2177
   217
                  translateLabel: true
ca@2177
   218
                )
ca@2177
   219
               )
ca@2177
   220
              nil
ca@2177
   221
              nil
ca@2177
   222
            )
ca@2177
   223
          )
ca@2177
   224
         (MenuItem
ca@2454
   225
            label: 'Settings'
ca@2454
   226
            translateLabel: true
ca@2454
   227
            submenu: 
ca@2454
   228
           (Menu
ca@2454
   229
              (
ca@2454
   230
               (MenuItem
ca@2454
   231
                  label: 'Test Mode'
ca@2454
   232
                  translateLabel: true
ca@2454
   233
                  hideMenuOnActivated: false
ca@2454
   234
                  indication: testModeChannel
ca@2454
   235
                )
ca@2454
   236
               (MenuItem
ca@2454
   237
                  enabled: testModeChannel
ca@2454
   238
                  label: 'Follow Focus'
ca@2454
   239
                  translateLabel: true
ca@2454
   240
                  hideMenuOnActivated: false
ca@2454
   241
                  indication: followFocusChannel
ca@2454
   242
                )
ca@2454
   243
               (MenuItem
ca@2454
   244
                  label: '-'
ca@2454
   245
                )
ca@2454
   246
               (MenuItem
ca@2454
   247
                  label: 'Select on Click'
ca@2454
   248
                  translateLabel: true
ca@2454
   249
                  hideMenuOnActivated: false
ca@2454
   250
                  indication: selectOnClickHolder
ca@2454
   251
                )
ca@2454
   252
               (MenuItem
ca@2454
   253
                  label: '-'
ca@2454
   254
                )
ca@2454
   255
               (MenuItem
ca@2454
   256
                  label: 'Show Name of Widgets'
ca@2454
   257
                  translateLabel: true
ca@2454
   258
                  hideMenuOnActivated: false
ca@2454
   259
                  indication: showNamesHolder
ca@2454
   260
                )
ca@2454
   261
               )
ca@2454
   262
              nil
ca@2454
   263
              nil
ca@2454
   264
            )
ca@2454
   265
          )
ca@2454
   266
         (MenuItem
ca@2177
   267
            label: ''
ca@2177
   268
          )
ca@2177
   269
         (MenuItem
ca@2177
   270
            enabled: hasSingleSelectionHolder
ca@2177
   271
            label: 'Menu'
ca@2177
   272
            translateLabel: true
ca@2177
   273
            submenuChannel: middleButtonMenu
ca@2177
   274
          )
ca@2177
   275
         (MenuItem
ca@2455
   276
            enabled: hasTargetWidgetChannel
ca@2177
   277
            label: 'Components'
ca@2177
   278
            translateLabel: true
ca@2177
   279
            startGroup: right
ca@2177
   280
            submenuChannel: submenuComponents:
ca@2177
   281
          )
ca@2177
   282
         (MenuItem
ca@2455
   283
            enabled: hasTargetWidgetChannel
ca@2177
   284
            label: 'Applications'
ca@2177
   285
            translateLabel: true
ca@2177
   286
            submenuChannel: submenuApplications:
ca@2177
   287
          )
ca@2177
   288
         )
ca@2177
   289
        nil
ca@2177
   290
        nil
ca@2177
   291
      )
ca@2177
   292
!
ca@2177
   293
ca@2177
   294
middleButtonMenu
ca@2177
   295
    "This resource specification was automatically generated
ca@2177
   296
     by the MenuEditor of ST/X."
ca@2177
   297
ca@2177
   298
    "Do not manually edit this!! If it is corrupted,
ca@2177
   299
     the MenuEditor may not be able to read the specification."
ca@2177
   300
ca@2177
   301
    "
ca@2177
   302
     MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu
ca@2177
   303
     (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp
ca@2177
   304
    "
ca@2177
   305
ca@2177
   306
    <resource: #menu>
ca@2177
   307
ca@2177
   308
    ^ 
ca@2177
   309
     #(Menu
ca@2177
   310
        (
ca@2177
   311
         (MenuItem
ca@2177
   312
            label: 'Geometry'
ca@2177
   313
            translateLabel: true
ca@2177
   314
            submenuChannel: submenuGeometry:
ca@2177
   315
            keepLinkedMenu: true
ca@2177
   316
          )
ca@2177
   317
         (MenuItem
ca@2177
   318
            label: 'Interface'
ca@2177
   319
            translateLabel: true
ca@2177
   320
            submenuChannel: submenuInterface:
ca@2177
   321
            keepLinkedMenu: true
ca@2177
   322
          )
ca@2177
   323
         (MenuItem
ca@2177
   324
            label: 'Visibility'
ca@2177
   325
            translateLabel: true
ca@2177
   326
            submenuChannel: submenuVisibility:
ca@2177
   327
            keepLinkedMenu: true
ca@2177
   328
          )
ca@2177
   329
         (MenuItem
ca@2177
   330
            label: '-'
ca@2177
   331
          )
ca@2177
   332
         (MenuItem
ca@2177
   333
            label: 'Browse View Class'
ca@2177
   334
            itemValue: doBrowse:
ca@2177
   335
            translateLabel: true
ca@2177
   336
            argument: view
ca@2177
   337
          )
ca@2177
   338
         (MenuItem
ca@2177
   339
            label: 'Browse Model Class'
ca@2177
   340
            itemValue: doBrowse:
ca@2177
   341
            translateLabel: true
ca@2177
   342
            isVisible: hasModel
ca@2177
   343
            argument: model
ca@2177
   344
          )
ca@2177
   345
         (MenuItem
ca@2177
   346
            label: 'Browse Application Class'
ca@2177
   347
            itemValue: doBrowse:
ca@2177
   348
            translateLabel: true
ca@2177
   349
            isVisible: hasApplication
ca@2177
   350
            argument: application
ca@2177
   351
          )
ca@2177
   352
         (MenuItem
ca@2177
   353
            label: 'Browse Controller Class'
ca@2177
   354
            itemValue: doBrowse:
ca@2177
   355
            translateLabel: true
ca@2177
   356
            isVisible: hasController
ca@2177
   357
            argument: controller
ca@2177
   358
          )
ca@2177
   359
         (MenuItem
ca@2177
   360
            label: '-'
ca@2177
   361
          )
ca@2177
   362
         (MenuItem
ca@2177
   363
            label: 'Inspect View'
ca@2177
   364
            itemValue: doInspect:
ca@2177
   365
            translateLabel: true
ca@2177
   366
            argument: view
ca@2177
   367
          )
ca@2177
   368
         (MenuItem
ca@2177
   369
            label: 'Inspect Window Group'
ca@2177
   370
            itemValue: doInspect:
ca@2177
   371
            translateLabel: true
ca@2177
   372
            argument: group
ca@2177
   373
          )
ca@2177
   374
         (MenuItem
ca@2177
   375
            label: 'Inspect Model'
ca@2177
   376
            itemValue: doInspect:
ca@2177
   377
            translateLabel: true
ca@2177
   378
            isVisible: hasModel
ca@2177
   379
            argument: model
ca@2177
   380
          )
ca@2177
   381
         (MenuItem
ca@2177
   382
            label: 'Inspect Application'
ca@2177
   383
            itemValue: doInspect:
ca@2177
   384
            translateLabel: true
ca@2177
   385
            isVisible: hasApplication
ca@2177
   386
            argument: application
ca@2177
   387
          )
ca@2177
   388
         (MenuItem
ca@2177
   389
            label: 'Inspect Controller'
ca@2177
   390
            itemValue: doInspect:
ca@2177
   391
            translateLabel: true
ca@2177
   392
            isVisible: hasController
ca@2177
   393
            argument: controller
ca@2177
   394
          )
ca@2177
   395
         (MenuItem
ca@2177
   396
            label: '-'
ca@2177
   397
          )
ca@2177
   398
         (MenuItem
ca@2177
   399
            label: 'Flash'
ca@2177
   400
            itemValue: doFlash
ca@2177
   401
            translateLabel: true
ca@2177
   402
          )
ca@2177
   403
         (MenuItem
ca@2177
   404
            label: '-'
ca@2177
   405
          )
ca@2177
   406
         (MenuItem
ca@2177
   407
            label: 'Destroy'
ca@2177
   408
            itemValue: doDestroy
ca@2177
   409
            translateLabel: true
ca@2177
   410
          )
ca@2177
   411
         (MenuItem
ca@2177
   412
            label: '-'
ca@2177
   413
          )
ca@2177
   414
         (MenuItem
ca@2177
   415
            label: 'Instance Variables'
ca@2177
   416
            translateLabel: true
ca@2177
   417
            submenuChannel: submenuInspector:
ca@2177
   418
            keepLinkedMenu: true
ca@2177
   419
          )
ca@2177
   420
         (MenuItem
ca@2177
   421
            label: '='
ca@2177
   422
          )
ca@2177
   423
         (MenuItem
ca@2177
   424
            label: ''
ca@2177
   425
          )
ca@2177
   426
         (MenuItem
ca@2177
   427
            enabled: selectedComponentHasChildren
ca@2177
   428
            label: 'Applications'
ca@2177
   429
            nameKey: single
ca@2177
   430
            translateLabel: true
ca@2177
   431
            submenuChannel: submenuApplications:
ca@2177
   432
            keepLinkedMenu: true
ca@2177
   433
          )
ca@2177
   434
         (MenuItem
ca@2177
   435
            enabled: selectedComponentHasChildren
ca@2177
   436
            label: 'Components'
ca@2177
   437
            nameKey: single
ca@2177
   438
            translateLabel: true
ca@2177
   439
            submenuChannel: submenuComponents:
ca@2177
   440
            keepLinkedMenu: true
ca@2177
   441
          )
ca@2177
   442
         )
ca@2177
   443
        nil
ca@2177
   444
        nil
ca@2177
   445
      )
ca@2177
   446
!
ca@2177
   447
ca@2177
   448
toolbarMenu
ca@2177
   449
    "This resource specification was automatically generated
ca@2177
   450
     by the MenuEditor of ST/X."
ca@2177
   451
ca@2177
   452
    "Do not manually edit this!! If it is corrupted,
ca@2177
   453
     the MenuEditor may not be able to read the specification."
ca@2177
   454
ca@2177
   455
    "
ca@2451
   456
     MenuEditor new openOnClass:Tools::ViewTreeApplication andSelector:#toolbarMenu
ca@2451
   457
     (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeApplication toolbarMenu)) startUp
ca@2177
   458
    "
ca@2177
   459
ca@2177
   460
    <resource: #menu>
ca@2177
   461
ca@2177
   462
    ^ 
ca@2177
   463
     #(Menu
ca@2177
   464
        (
ca@2177
   465
         (MenuItem
ca@2454
   466
            enabled: hasSingleSelectionHolder
ca@2454
   467
            label: 'Application'
ca@2454
   468
            itemValue: doBrowse:
ca@2454
   469
            translateLabel: false
ca@2454
   470
            labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
ca@2454
   471
            argument: application
ca@2177
   472
          )
ca@2177
   473
         (MenuItem
ca@2454
   474
            enabled: hasSingleSelectionHolder
ca@2454
   475
            label: 'Application'
ca@2454
   476
            itemValue: doInspect:
ca@2454
   477
            translateLabel: false
ca@2454
   478
            labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Application')
ca@2454
   479
            argument: application
ca@2177
   480
          )
ca@2177
   481
         (MenuItem
ca@2455
   482
            label: ''
ca@2177
   483
          )
ca@2451
   484
         (MenuItem
ca@2454
   485
            enabled: hasSingleSelectionHolder
ca@2454
   486
            label: 'Widget'
ca@2454
   487
            itemValue: doBrowse:
ca@2454
   488
            translateLabel: false
ca@2454
   489
            labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2)
ca@2454
   490
            argument: view
ca@2454
   491
          )
ca@2454
   492
         (MenuItem
ca@2454
   493
            enabled: hasSingleSelectionHolder
ca@2454
   494
            label: 'Widget'
ca@2454
   495
            itemValue: doInspect:
ca@2451
   496
            translateLabel: true
ca@2454
   497
            labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon 'Widget')
ca@2454
   498
            argument: view
ca@2451
   499
          )
ca@2177
   500
         )
ca@2177
   501
        nil
ca@2177
   502
        nil
ca@2177
   503
      )
ca@2177
   504
! !
ca@2177
   505
ca@2177
   506
!ViewTreeApplication methodsFor:'actions'!
ca@2177
   507
ca@2177
   508
indicatorClicked:anIndex
ca@2177
   509
    |item sensor|
ca@2177
   510
ca@2177
   511
    item := model listOfItems at:anIndex ifAbsent:nil.
ca@2177
   512
ca@2177
   513
    item notNil ifTrue:[
ca@2177
   514
        (     (sensor := self window sensor) notNil
ca@2177
   515
         and:[(sensor ctrlDown or:[sensor shiftDown])]
ca@2177
   516
        ) ifTrue:[
ca@2177
   517
            item recursiveToggleExpand
ca@2177
   518
        ] ifFalse:[
ca@2177
   519
            item toggleExpand
ca@2177
   520
        ]
ca@2177
   521
    ].
ca@2177
   522
! !
ca@2177
   523
ca@2177
   524
!ViewTreeApplication methodsFor:'aspects'!
ca@2177
   525
ca@2177
   526
followFocusChannel
ca@2455
   527
    "boolean holder, which indicates whether selection changed dependend on the focus view"
ca@2455
   528
ca@2177
   529
    ^ followFocusChannel
ca@2177
   530
!
ca@2177
   531
ca@2177
   532
hasSingleSelectionHolder
ca@2455
   533
    "boolean holder, true if one item is selected"
ca@2455
   534
ca@2177
   535
    ^ hasSingleSelectionHolder
ca@2177
   536
!
ca@2177
   537
ca@2455
   538
hasTargetWidgetChannel
ca@2455
   539
    "answer the channel which is set to true if a target widget exists"
ca@2455
   540
ca@2455
   541
    ^ model hasTargetWidgetChannel
ca@2455
   542
!
ca@2455
   543
ca@2177
   544
listOfItems
ca@2455
   545
    "returns the hierarchical list of items"
ca@2455
   546
ca@2177
   547
    ^ model listOfItems
ca@2177
   548
!
ca@2177
   549
ca@2177
   550
model
ca@2455
   551
    "returns my selection model, a ViewTreeModel"
ca@2455
   552
ca@2177
   553
    ^ model
ca@2177
   554
!
ca@2177
   555
ca@2177
   556
selectOnClickHolder
ca@2455
   557
    "boolean holder, which indicates whether the selection will change on click"
ca@2455
   558
ca@2177
   559
    ^ model selectOnClickHolder
ca@2177
   560
!
ca@2177
   561
ca@2451
   562
showNamesHolder
ca@2451
   563
    "boolean holder, which indicates whether application names or widget names
ca@2455
   564
     as additional text are shown for the items"
ca@2455
   565
ca@2451
   566
    ^ showNamesHolder
ca@2451
   567
!
ca@2451
   568
ca@2177
   569
testModeChannel
ca@2455
   570
    "answer a boolean channel which describes the behaviour how to process
ca@2455
   571
     events on the target view.
ca@2455
   572
ca@2455
   573
     false: all input events are eaten and the selection is shown on the target view.
ca@2455
   574
     true:  no  input events are eaten and no  selection is shown on the target view."
ca@2455
   575
ca@2455
   576
    ^ model testModeChannel
ca@2177
   577
! !
ca@2177
   578
ca@2177
   579
!ViewTreeApplication methodsFor:'change & update'!
ca@2177
   580
ca@2177
   581
selectionChanged
ca@2455
   582
    "called if the selection changed"
ca@2455
   583
ca@2177
   584
    |info view item|
ca@2177
   585
ca@2177
   586
    item := model selectedItem.
ca@2177
   587
ca@2177
   588
    item notNil ifTrue:[ |state|
ca@2177
   589
        view := item widget.
ca@2177
   590
ca@2177
   591
        view id isNil ifTrue:[
ca@2177
   592
            state := 'no ID'.
ca@2177
   593
        ] ifFalse:[
ca@2177
   594
            view shown ifTrue:[
ca@2177
   595
                state := 'visible'.
ca@2177
   596
            ] ifFalse:[
ca@2177
   597
                state := 'invisible'
ca@2177
   598
            ].
ca@2177
   599
        ].
ca@2177
   600
        info := '%1 [%2] - %3' bindWith:(view class name)
ca@2177
   601
                                   with:(view name ? '') with:state allBold.
ca@2177
   602
ca@2177
   603
    ] ifFalse:[
ca@2177
   604
        info := ''
ca@2177
   605
    ].
ca@2177
   606
    hasSingleSelectionHolder value:(view notNil).
ca@2177
   607
!
ca@2177
   608
ca@2177
   609
update:something with:someArgument from:aModel
ca@2454
   610
    |oldSelection|
ca@2454
   611
ca@2451
   612
    aModel == showNamesHolder ifTrue:[
ca@2455
   613
        oldSelection := model selectedItem.
ca@2454
   614
        model selectedItem:nil.
ca@2451
   615
        self listOfItems showWidgetNames:(aModel value).
ca@2454
   616
        model selectedItem:oldSelection.
ca@2451
   617
        ^ self
ca@2451
   618
    ].
ca@2458
   619
ca@2458
   620
    aModel == model ifTrue:[
ca@2458
   621
        self selectionChanged.
ca@2458
   622
        ^ self
ca@2458
   623
    ].
ca@2458
   624
ca@2177
   625
    super update:something with:someArgument from:aModel.
ca@2177
   626
! !
ca@2177
   627
ca@2177
   628
!ViewTreeApplication methodsFor:'event processing'!
ca@2177
   629
ca@2177
   630
processButtonMotionEvent:ev
ca@2455
   631
    "handle a button motion event"
ca@2177
   632
ca@2455
   633
    |click rootView|
ca@2177
   634
ca@2455
   635
    motionAction isNil ifTrue:[^ self].
ca@2455
   636
ca@2455
   637
    (rootView := model rootView) isNil ifTrue:[
ca@2455
   638
        clickedItem := motionAction := nil.
ca@2455
   639
        ^ self
ca@2455
   640
    ].
ca@2455
   641
ca@2455
   642
    click := rootView device
ca@2455
   643
            translatePoint:((ev x)@ (ev y))
ca@2455
   644
            fromView:(ev view)
ca@2455
   645
            toView:rootView.
ca@2455
   646
ca@2455
   647
    click = clickedPoint ifFalse:[
ca@2455
   648
        (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[
ca@2455
   649
            motionAction value:click
ca@2177
   650
        ]
ca@2177
   651
    ].
ca@2177
   652
!
ca@2177
   653
ca@2177
   654
processButtonPressEvent:ev
ca@2455
   655
    "handle a buttopn press event"
ca@2177
   656
ca@2455
   657
    |rootView sensor lastRectangle|
ca@2455
   658
ca@2455
   659
    rootView    := model rootView.
ca@2177
   660
    sensor      := model rootView sensor.
ca@2177
   661
    clickedItem := model listOfItems detectItemRespondsToView:(ev view).
ca@2177
   662
ca@2177
   663
    (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
ca@2177
   664
        clickedItem notNil ifTrue:[
ca@2177
   665
            self selectOnClickHolder value ifTrue:[
ca@2177
   666
                model toggleSelectItem:clickedItem
ca@2177
   667
            ].
ca@2177
   668
        ].
ca@2177
   669
        clickedItem := motionAction := nil.
ca@2455
   670
        ^ self
ca@2455
   671
    ].
ca@2177
   672
ca@2455
   673
    clickedPoint := rootView device translatePoint:((ev x)@ (ev y))  fromView:(ev view) toView:rootView.
ca@2455
   674
    lastRectangle := nil.
ca@2177
   675
ca@2455
   676
    motionAction :=[:p|
ca@2455
   677
        rootView    := model rootView device rootView.
ca@2455
   678
        rootView    := model rootView.
ca@2455
   679
        clickedItem := nil.
ca@2177
   680
ca@2455
   681
        rootView xoring:[
ca@2455
   682
            lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]
ca@2455
   683
                                ifFalse:[ rootView clippedByChildren:false ].
ca@2455
   684
ca@2455
   685
            p isNil ifTrue:[
ca@2455
   686
                rootView clippedByChildren:true.
ca@2455
   687
                motionAction := nil.
ca@2455
   688
            ] ifFalse:[
ca@2455
   689
                lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).
ca@2455
   690
                rootView displayRectangle:lastRectangle.
ca@2177
   691
            ].
ca@2455
   692
            rootView flush.
ca@2455
   693
        ].
ca@2455
   694
        lastRectangle
ca@2455
   695
    ].
ca@2177
   696
!
ca@2177
   697
ca@2177
   698
processButtonReleaseEvent:anEvent
ca@2455
   699
    "handle a button release event"
ca@2455
   700
ca@2177
   701
    |rootView rectangle newItems widget origin|
ca@2177
   702
ca@2455
   703
    (rootView := model rootView) isNil ifTrue:[
ca@2455
   704
        clickedItem := motionAction := nil.
ca@2455
   705
        ^ self
ca@2455
   706
    ].
ca@2177
   707
    motionAction isNil ifTrue:[ ^ self ].
ca@2177
   708
    clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].
ca@2177
   709
ca@2455
   710
    rectangle := motionAction value:nil.
ca@2455
   711
    rectangle isNil ifTrue:[^ self].
ca@2177
   712
ca@2455
   713
    newItems := OrderedCollection new.
ca@2177
   714
ca@2455
   715
    model rootItem recursiveDo:[:anItem|
ca@2455
   716
        widget := anItem widget.
ca@2455
   717
        origin := widget originRelativeTo:rootView.
ca@2455
   718
ca@2455
   719
        (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[
ca@2455
   720
            newItems add:anItem.
ca@2455
   721
        ]
ca@2177
   722
    ].
ca@2455
   723
    model value:newItems.
ca@2177
   724
!
ca@2177
   725
ca@2177
   726
processEvent:anEvent
ca@2455
   727
    "process an event"
ca@2455
   728
ca@2177
   729
    |button menu|
ca@2177
   730
ca@2177
   731
    anEvent isKeyPressEvent ifTrue:[ ^ self processKeyPressEvent:anEvent ].
ca@2177
   732
    anEvent isButtonEvent  ifFalse:[ ^ self ].
ca@2177
   733
ca@2177
   734
    button := anEvent button.
ca@2177
   735
ca@2177
   736
    (button == 2 or:[button == #menu]) ifTrue:[
ca@2177
   737
        motionAction isNil ifTrue:[
ca@2177
   738
            anEvent isButtonPressEvent ifTrue:[
ca@2177
   739
                self selectOnClickHolder value ifTrue:[
ca@2177
   740
                    menu := self middleButtonMenu value.
ca@2177
   741
                    menu notNil ifTrue:[
ca@2177
   742
                        menu := MenuPanel menu:(Menu new fromLiteralArrayEncoding:menu)
ca@2177
   743
                                      receiver:self.
ca@2177
   744
                        menu startUp.
ca@2177
   745
                    ]
ca@2177
   746
                ].
ca@2177
   747
            ].
ca@2177
   748
            clickedItem := nil.
ca@2177
   749
        ].
ca@2177
   750
        ^ self
ca@2177
   751
    ].
ca@2177
   752
ca@2177
   753
    anEvent isButtonPressEvent  ifTrue:[ ^ self processButtonPressEvent:anEvent  ].
ca@2177
   754
    anEvent isButtonMotionEvent ifTrue:[ ^ self processButtonMotionEvent:anEvent ].
ca@2177
   755
ca@2177
   756
    anEvent isButtonReleaseEvent ifTrue:[
ca@2177
   757
        self selectOnClickHolder value ifTrue:[
ca@2177
   758
            self processButtonReleaseEvent:anEvent
ca@2177
   759
        ].
ca@2177
   760
    ].
ca@2177
   761
    clickedItem := motionAction := nil.
ca@2177
   762
ca@2177
   763
    anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
ca@2177
   764
        self selectOnClickHolder value ifTrue:[
ca@2177
   765
            self doInspect:#view.
ca@2177
   766
        ].
ca@2177
   767
    ].
ca@2177
   768
!
ca@2177
   769
ca@2177
   770
processKeyPressEvent:anEvent
ca@2455
   771
    "process an key press event"
ca@2455
   772
ca@2177
   773
    |item prnt idx key max next|
ca@2177
   774
ca@2177
   775
    key := anEvent key.
ca@2177
   776
    key isSymbol ifFalse:[^ self].
ca@2177
   777
ca@2177
   778
    key == #Delete    ifTrue:[ ^ self doDestroy ].
ca@2177
   779
    key == #InspectIt ifTrue:[ ^ self doInspect:#view ].
ca@2177
   780
ca@2177
   781
    (   key == #CursorUp
ca@2177
   782
    or:[key == #CursorDown
ca@2177
   783
    or:[key == #CursorLeft
ca@2177
   784
    or:[key == #CursorRight]]]
ca@2177
   785
    ) ifFalse:[
ca@2177
   786
        ^ self
ca@2177
   787
    ].
ca@2177
   788
    item := model selectedItem.
ca@2177
   789
ca@2177
   790
    item isNil ifTrue:[
ca@2177
   791
        ^ model selectedItem:(model first ? model rootItem)
ca@2177
   792
    ].
ca@2177
   793
ca@2177
   794
    prnt := item parent.
ca@2177
   795
    prnt isNil ifTrue:[
ca@2177
   796
        "/ is the root item
ca@2177
   797
        (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]
ca@2177
   798
                                                  ifFalse:[item := item at:1 ifAbsent:item].
ca@2177
   799
ca@2177
   800
      ^ model selectedItem:item
ca@2177
   801
    ].
ca@2177
   802
    key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].
ca@2177
   803
ca@2177
   804
    key == #CursorRight ifTrue:[
ca@2177
   805
        next := item at:1 ifAbsent:nil.
ca@2177
   806
        next notNil ifTrue:[ model selectedItem:next ].
ca@2177
   807
      ^ self
ca@2177
   808
    ].
ca@2177
   809
ca@2177
   810
    max := prnt size.
ca@2177
   811
ca@2177
   812
    key == #CursorUp ifTrue:[
ca@2177
   813
        idx := prnt identityIndexOf:item.
ca@2177
   814
        idx == 1 ifTrue:[idx := max + 1].
ca@2177
   815
        model selectedItem:(prnt at:idx - 1).
ca@2177
   816
      ^ self.
ca@2177
   817
    ].
ca@2177
   818
ca@2177
   819
    key == #CursorDown ifTrue:[
ca@2177
   820
        idx := prnt identityIndexOf:item.
ca@2177
   821
        idx == max ifTrue:[idx := 0].
ca@2177
   822
        model selectedItem:(prnt at:idx + 1).
ca@2177
   823
      ^ self.
ca@2177
   824
    ].
ca@2177
   825
!
ca@2177
   826
ca@2177
   827
processMappedView:aView
ca@2455
   828
    "process a mapped event"
ca@2455
   829
ca@2177
   830
    |parent anchor|
ca@2177
   831
ca@2177
   832
    parent := self listOfItems detectItemRespondsToView:aView.
ca@2177
   833
    parent isNil ifTrue:[ ^ self ].
ca@2177
   834
ca@2177
   835
    NotFoundSignal handle:[:ex|
ca@2177
   836
        "contained subvies used by spec are not yet created;
ca@2177
   837
         thus we have to wait until last used subview is build
ca@2177
   838
        "
ca@2177
   839
        anchor := nil.
ca@2177
   840
    ] do:[
ca@2177
   841
        anchor := parent class buildViewsFrom:(parent widget).
ca@2177
   842
    ].
ca@2177
   843
    anchor notNil ifTrue:[
ca@2177
   844
        parent updateFromChildren:anchor children.
ca@2177
   845
    ].
ca@2177
   846
! !
ca@2177
   847
ca@2177
   848
!ViewTreeApplication methodsFor:'initialization & release'!
ca@2177
   849
ca@2177
   850
closeDownViews
ca@2455
   851
    "release the grapped application"
ca@2455
   852
ca@2177
   853
    process := nil.
ca@2177
   854
    super closeDownViews.
ca@2177
   855
    self doUnpick.
ca@2177
   856
!
ca@2177
   857
ca@2177
   858
initialize
ca@2455
   859
    "setup my model and channels"
ca@2455
   860
ca@2177
   861
    super initialize.
ca@2177
   862
ca@2177
   863
    hasSingleSelectionHolder := false asValue.
ca@2177
   864
    followFocusChannel       := false asValue.
ca@2177
   865
ca@2177
   866
    model := ViewTreeModel new.
ca@2177
   867
    model inputEventAction:[:ev| self processEvent:ev ].
ca@2177
   868
    model mappedViewAction:[:vw| self processMappedView:vw ].
ca@2177
   869
    model application:self.
ca@2458
   870
    model addDependent:self.
ca@2458
   871
ca@2177
   872
ca@2451
   873
    showNamesHolder := false asValue.
ca@2451
   874
    showNamesHolder addDependent:self.
ca@2177
   875
!
ca@2177
   876
ca@2177
   877
postBuildTree:aTree
ca@2177
   878
    treeView := aTree scrolledView.
ca@2177
   879
    treeView hasConstantHeight:true.
ca@2177
   880
! !
ca@2177
   881
ca@2177
   882
!ViewTreeApplication methodsFor:'menu queries'!
ca@2177
   883
ca@2177
   884
hasApplication
ca@2455
   885
    "returns true if the current selected view has an application"
ca@2455
   886
ca@2177
   887
    |view|
ca@2177
   888
ca@2177
   889
    view := self selectedView.
ca@2177
   890
  ^ (view notNil and:[view application notNil])
ca@2177
   891
!
ca@2177
   892
ca@2177
   893
hasController
ca@2177
   894
    "returns true if the current selected item's view has a controller
ca@2455
   895
     other than nil or the view itself"
ca@2455
   896
ca@2177
   897
    |view controller|
ca@2177
   898
ca@2177
   899
    view := self selectedView.
ca@2177
   900
ca@2177
   901
    view notNil ifTrue:[
ca@2177
   902
        controller := view controller.
ca@2177
   903
      ^ (controller notNil and:[controller ~~ view])
ca@2177
   904
    ].
ca@2177
   905
    ^ false
ca@2177
   906
!
ca@2177
   907
ca@2177
   908
hasModel
ca@2455
   909
    "returns true if the current selected view has a model"
ca@2455
   910
ca@2177
   911
    |view|
ca@2177
   912
ca@2177
   913
    view := self selectedView.
ca@2177
   914
  ^ (view notNil and:[view model notNil])
ca@2177
   915
! !
ca@2177
   916
ca@2177
   917
!ViewTreeApplication methodsFor:'menu specs'!
ca@2177
   918
ca@2177
   919
middleButtonMenu
ca@2455
   920
    "returns the middleButton menu for the single selected item or nil"
ca@2455
   921
ca@2177
   922
    ^ [ model selectedItem notNil ifTrue:[self class middleButtonMenu]
ca@2177
   923
                                 ifFalse:[nil]
ca@2177
   924
      ]
ca@2177
   925
!
ca@2177
   926
ca@2177
   927
submenuApplications:aMenu
ca@2177
   928
    |applications menu item list addBlock|
ca@2177
   929
ca@2177
   930
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177
   931
                                              ifFalse:[model rootItem].
ca@2177
   932
    item isNil ifTrue:[^ nil].
ca@2177
   933
ca@2177
   934
    applications := IdentityDictionary new.
ca@2177
   935
ca@2177
   936
    addBlock := [:el| |cls ctr|
ca@2177
   937
        cls := self resolveApplicationClassFor:el.
ca@2177
   938
ca@2177
   939
        cls notNil ifTrue:[
ca@2177
   940
            ctr := applications at:cls ifAbsent:0.
ca@2177
   941
            applications at:cls put:(ctr + 1).
ca@2177
   942
        ].
ca@2177
   943
    ].
ca@2177
   944
    item recursiveDo:addBlock.
ca@2177
   945
    addBlock value:item.
ca@2177
   946
ca@2177
   947
    applications isEmpty ifTrue:[^ nil ].
ca@2177
   948
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177
   949
ca@2177
   950
    applications keysAndValuesDo:[:cls :ctr|
ca@2177
   951
       list add:(MenuDesc title:(cls name)
ca@2177
   952
                          value:(ctr printString)
ca@2177
   953
                         action:[self doSelectNextOfApplicationClass:cls startingIn:item]
ca@2177
   954
                 ).
ca@2177
   955
    ].
ca@2177
   956
ca@2177
   957
    menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177
   958
    menu do:[:el|
ca@2177
   959
        el hideMenuOnActivated:false
ca@2177
   960
    ].
ca@2177
   961
    ^ menu
ca@2177
   962
!
ca@2177
   963
ca@2177
   964
submenuComponents:aMenu
ca@2177
   965
    |widgets list total menu item|
ca@2177
   966
ca@2177
   967
    item := aMenu selection nameKey == #single ifTrue:[model selectedItem]
ca@2177
   968
                                              ifFalse:[model rootItem].
ca@2177
   969
    item isNil ifTrue:[^ nil].
ca@2177
   970
ca@2177
   971
    widgets := IdentityDictionary new.
ca@2177
   972
    total   := 0.
ca@2177
   973
ca@2177
   974
    item recursiveDo:[:el| |cls ctr|
ca@2177
   975
        cls := el widget.
ca@2177
   976
ca@2177
   977
        cls notNil ifTrue:[
ca@2177
   978
            cls := cls class.
ca@2177
   979
            ctr := widgets at:cls ifAbsent:0.
ca@2177
   980
            widgets at:cls put:(ctr + 1).
ca@2177
   981
            total := total + 1.
ca@2177
   982
        ].
ca@2177
   983
    ].
ca@2177
   984
    total == 0 ifTrue:[^ nil].
ca@2177
   985
    list := SortedCollection sortBlock:[:a :b| a title < b title ].
ca@2177
   986
ca@2177
   987
    widgets keysAndValuesDo:[:cls :ctr|
ca@2177
   988
        list add:(MenuDesc title:(cls name)
ca@2177
   989
                           value:(ctr printString)
ca@2177
   990
                          action:[self doSelectNextOfClass:cls startingIn:item]
ca@2177
   991
                 ).
ca@2177
   992
    ].
ca@2177
   993
    list := list asOrderedCollection.
ca@2177
   994
    list add:(MenuDesc separator).
ca@2177
   995
    list add:(MenuDesc title:'Total' value:(total printString)).
ca@2177
   996
    menu := MenuDesc buildFromList:list onGC:aMenu.
ca@2177
   997
    menu do:[:el|
ca@2177
   998
        el hideMenuOnActivated:false
ca@2177
   999
    ].
ca@2177
  1000
    ^ menu
ca@2177
  1001
!
ca@2177
  1002
ca@2177
  1003
submenuGeometry:aMenu
ca@2455
  1004
    "builds and returns the geometry submenu"
ca@2455
  1005
ca@2177
  1006
    |view point inst list x y|
ca@2177
  1007
ca@2177
  1008
    view := self selectedView.
ca@2177
  1009
    view isNil ifTrue:[^ nil].
ca@2177
  1010
ca@2177
  1011
    list := OrderedCollection new.
ca@2177
  1012
ca@2177
  1013
    "/ origin
ca@2177
  1014
    point := view relativeOrigin.
ca@2177
  1015
    point isNil ifTrue:[ point := view origin ].
ca@2177
  1016
ca@2177
  1017
    x := view left.
ca@2177
  1018
    y := view top.
ca@2177
  1019
ca@2177
  1020
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177
  1021
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177
  1022
ca@2177
  1023
    list add:(MenuDesc title:'origin' value:inst).
ca@2177
  1024
ca@2177
  1025
    "/ corner
ca@2177
  1026
    point := view relativeCorner.
ca@2177
  1027
    point isNil ifTrue:[ point := view corner ].
ca@2177
  1028
ca@2177
  1029
    x := view right.
ca@2177
  1030
    y := view bottom.
ca@2177
  1031
ca@2177
  1032
    (x == point x and:[y == point y]) ifTrue:[ inst := point ]
ca@2177
  1033
                                     ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].
ca@2177
  1034
ca@2177
  1035
    list add:(MenuDesc title:'corner' value:inst).
ca@2177
  1036
ca@2177
  1037
    "/ extent
ca@2177
  1038
    (point := view relativeExtent) isNil ifTrue:[point := view extent].
ca@2177
  1039
    list add:(MenuDesc title:'extent' value:point).
ca@2177
  1040
ca@2177
  1041
    "/ preferred extent
ca@2177
  1042
    list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).
ca@2177
  1043
    list add:(MenuDesc separator).
ca@2177
  1044
ca@2177
  1045
    "/ view insets
ca@2177
  1046
    inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)
ca@2177
  1047
                                         with:(view rightInset)
ca@2177
  1048
                                         with:(view topInset)
ca@2177
  1049
                                         with:(view bottomInset).
ca@2177
  1050
ca@2177
  1051
    list add:(MenuDesc title:'insets'      value:inst).
ca@2177
  1052
    list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).
ca@2177
  1053
    list add:(MenuDesc title:'level'       value:(view level)).
ca@2177
  1054
    list add:(MenuDesc separator).
ca@2177
  1055
ca@2177
  1056
    (inst := view layout) notNil ifTrue:[ inst := inst displayString ].
ca@2177
  1057
    list add:(MenuDesc title:'layout' value:inst).
ca@2177
  1058
ca@2177
  1059
    (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].
ca@2177
  1060
    list add:(MenuDesc title:'transformation' value:inst).
ca@2177
  1061
ca@2177
  1062
  ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1063
!
ca@2177
  1064
ca@2177
  1065
submenuInspector:aMenu
ca@2455
  1066
    "builds and returns the inspector submenu"
ca@2455
  1067
ca@2177
  1068
    |view list n names label value|
ca@2177
  1069
ca@2177
  1070
    view := self selectedView.
ca@2177
  1071
    view isNil ifTrue:[^ nil].
ca@2177
  1072
ca@2177
  1073
    n := view class instSize.
ca@2177
  1074
    n > 0 ifFalse:[^ nil ].
ca@2177
  1075
ca@2177
  1076
    list  := OrderedCollection new:n.
ca@2177
  1077
    names := view class allInstVarNames.
ca@2177
  1078
ca@2177
  1079
    1 to:n do:[:i| |action|
ca@2177
  1080
        label := (names at:i) printString.
ca@2177
  1081
        value := view instVarAt:i.
ca@2177
  1082
        value isNil ifTrue:[
ca@2177
  1083
            value  := '------'.
ca@2177
  1084
            action := nil.
ca@2177
  1085
        ] ifFalse:[
ca@2177
  1086
            value  := value displayString contractAtEndTo:40.
ca@2177
  1087
            action := [(view instVarAt:i) inspect].
ca@2177
  1088
        ].
ca@2177
  1089
        list add:(MenuDesc title:label value:value action:action).
ca@2177
  1090
    ].
ca@2177
  1091
ca@2177
  1092
    ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1093
!
ca@2177
  1094
ca@2177
  1095
submenuInterface:aMenu
ca@2455
  1096
    "builds and returns the interface submenu"
ca@2455
  1097
ca@2177
  1098
    |view label inst value list|
ca@2177
  1099
ca@2177
  1100
    view := self selectedView.
ca@2177
  1101
    view isNil ifTrue:[^ nil].
ca@2177
  1102
ca@2177
  1103
    list := OrderedCollection new.
ca@2177
  1104
ca@2177
  1105
    inst  := view controller.
ca@2177
  1106
    value := nil.
ca@2177
  1107
ca@2177
  1108
    inst isNil ifTrue:[
ca@2177
  1109
        label := nil
ca@2177
  1110
    ] ifFalse:[
ca@2177
  1111
        inst == view ifTrue:[ label := '== view itself' ]
ca@2177
  1112
                    ifFalse:[ label := inst displayString.
ca@2177
  1113
                              value := [view controller inspect].
ca@2177
  1114
                            ].
ca@2177
  1115
    ].
ca@2177
  1116
    list add:(MenuDesc title:'controller' value:label action:value).
ca@2177
  1117
ca@2177
  1118
    inst := view delegate.
ca@2177
  1119
    inst notNil ifTrue:[
ca@2177
  1120
        list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).
ca@2177
  1121
    ].
ca@2177
  1122
ca@2177
  1123
    inst := view application.
ca@2177
  1124
ca@2177
  1125
    inst notNil ifTrue:[ |topAppl|
ca@2177
  1126
        list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).
ca@2177
  1127
ca@2177
  1128
        topAppl := inst topApplication.
ca@2177
  1129
ca@2177
  1130
        (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[
ca@2177
  1131
            list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).
ca@2177
  1132
        ].
ca@2177
  1133
    ].
ca@2177
  1134
    list add:(MenuDesc separator).
ca@2177
  1135
ca@2177
  1136
    (view respondsTo:#'model:') ifTrue:[
ca@2177
  1137
        inst := model.
ca@2177
  1138
ca@2177
  1139
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1140
                  ifFalse:[ label := inst displayString.
ca@2177
  1141
                            value := [ view model inspect ].
ca@2177
  1142
                          ].
ca@2177
  1143
ca@2177
  1144
        list add:(MenuDesc title:'model' value:label action:value).
ca@2177
  1145
ca@2177
  1146
        (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[
ca@2177
  1147
            view modelInterface keysAndValuesDo:[:key : val|
ca@2177
  1148
                val isNil ifTrue:[ label := nil ]
ca@2177
  1149
                         ifFalse:[ label := val displayString ].
ca@2177
  1150
ca@2177
  1151
                list add:(MenuDesc title:('      - ', key) value:label ).
ca@2177
  1152
            ]
ca@2177
  1153
        ].
ca@2177
  1154
    ].
ca@2177
  1155
ca@2177
  1156
    (view respondsTo:#enableChannel) ifTrue:[
ca@2177
  1157
        inst := view enableChannel.
ca@2177
  1158
ca@2177
  1159
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1160
                  ifFalse:[ label := inst displayString.
ca@2177
  1161
                            value := [ view enableChannel inspect ].
ca@2177
  1162
                          ].
ca@2177
  1163
ca@2177
  1164
        list add:(MenuDesc title:'enableChannel' value:label action:value).
ca@2177
  1165
    ].
ca@2177
  1166
ca@2177
  1167
    list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].
ca@2177
  1168
ca@2177
  1169
    (view respondsTo:#listHolder) ifTrue:[
ca@2177
  1170
        inst := view listHolder.
ca@2177
  1171
ca@2177
  1172
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1173
                  ifFalse:[ label := inst class printString.
ca@2177
  1174
                            value := [ view listHolder inspect ].
ca@2177
  1175
                          ].
ca@2177
  1176
        list add:(MenuDesc title:'listHolder' value:label action:value).
ca@2177
  1177
    ].
ca@2177
  1178
ca@2177
  1179
    (view respondsTo:#list) ifTrue:[
ca@2177
  1180
        inst := view list.
ca@2177
  1181
ca@2177
  1182
        inst isNil ifTrue:[ label := value := nil ]
ca@2177
  1183
                  ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).
ca@2177
  1184
                            value := [ view list inspect ].
ca@2177
  1185
                          ].
ca@2177
  1186
ca@2177
  1187
        list add:(MenuDesc title:'list' value:label action:value).
ca@2177
  1188
    ].
ca@2177
  1189
ca@2177
  1190
    list last isSeparator ifTrue:[ list removeLast ].
ca@2177
  1191
  ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1192
!
ca@2177
  1193
ca@2177
  1194
submenuVisibility:aMenu
ca@2455
  1195
    "builds and returns the geometry submenu"
ca@2455
  1196
ca@2177
  1197
    |view list value|
ca@2177
  1198
ca@2177
  1199
    view := self selectedView.
ca@2177
  1200
    view isNil ifTrue:[^ nil].
ca@2177
  1201
ca@2177
  1202
    list := OrderedCollection new.
ca@2177
  1203
ca@2177
  1204
    list add:(MenuDesc title:'device'     value:(view device printString)).
ca@2177
  1205
    list add:(MenuDesc title:'drawableId' value:(view id)).
ca@2177
  1206
    list add:(MenuDesc title:'gcId'       value:(view gcId)).
ca@2177
  1207
ca@2177
  1208
    list add:(MenuDesc separator).
ca@2177
  1209
ca@2177
  1210
    list add:(MenuDesc title:'shown'    value:(view shown)).
ca@2177
  1211
    list add:(MenuDesc title:'realized' value:(view realized)).
ca@2177
  1212
ca@2177
  1213
    list add:(MenuDesc separator).
ca@2177
  1214
ca@2177
  1215
    list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)).
ca@2177
  1216
ca@2177
  1217
    (value := view visibilityChannel) isNil ifTrue:[
ca@2177
  1218
        list add:(MenuDesc title:'visibilityChannel' value:'------').
ca@2177
  1219
    ] ifFalse:[
ca@2177
  1220
        list add:(MenuDesc title:'visibilityChannel'
ca@2177
  1221
                           value:(value displayString)
ca@2177
  1222
                          action:[view visibilityChannel inspect]).
ca@2177
  1223
    ].
ca@2177
  1224
ca@2177
  1225
        
ca@2177
  1226
  ^ MenuDesc buildFromList:list onGC:aMenu
ca@2177
  1227
! !
ca@2177
  1228
ca@2177
  1229
!ViewTreeApplication methodsFor:'private'!
ca@2177
  1230
ca@2177
  1231
selectFocusView
ca@2177
  1232
    |rootView focusItem focusView|
ca@2177
  1233
ca@2177
  1234
    rootView := model rootView.
ca@2177
  1235
ca@2177
  1236
    (rootView notNil and:[rootView shown]) ifTrue:[
ca@2177
  1237
        focusView := rootView windowGroup focusView.
ca@2177
  1238
    ].
ca@2177
  1239
    focusView isNil ifTrue:[^ self ].
ca@2177
  1240
ca@2177
  1241
    focusItem := model selectedItem.
ca@2177
  1242
ca@2177
  1243
    (focusItem notNil and:[focusItem widget == focusView]) ifTrue:[
ca@2177
  1244
        ^ self
ca@2177
  1245
    ].
ca@2177
  1246
    focusItem := model listOfItems recursiveDetect:[:el| el widget == focusView ].
ca@2177
  1247
ca@2177
  1248
    focusItem notNil ifTrue:[
ca@2177
  1249
        model selectItem:focusItem.
ca@2177
  1250
    ].        
ca@2177
  1251
!
ca@2177
  1252
ca@2177
  1253
setRootItem:aRootItemOrNil
ca@2177
  1254
    |theProcess|
ca@2177
  1255
ca@2177
  1256
    aRootItemOrNil isNil ifTrue:[
ca@2177
  1257
        process := nil.
ca@2177
  1258
    ] ifFalse:[
ca@2177
  1259
        "/ expand tree to level 3
ca@2177
  1260
        aRootItemOrNil do:[:aRootChild|
ca@2177
  1261
            aRootChild do:[:aSubChild| aSubChild expand ].
ca@2177
  1262
            aRootChild expand.
ca@2177
  1263
        ].
ca@2177
  1264
        aRootItemOrNil expand.
ca@2177
  1265
ca@2177
  1266
        process isNil ifTrue:[
ca@2177
  1267
            theProcess := process :=
ca@2455
  1268
                Process for:[   |update testModeChannel|
ca@2177
  1269
ca@2177
  1270
                                update := false.
ca@2455
  1271
                                testModeChannel := model testModeChannel.
ca@2177
  1272
ca@2455
  1273
                                [process == theProcess] whileTrue:[
ca@2177
  1274
                                    Delay waitForSeconds:0.5.
ca@2177
  1275
ca@2177
  1276
                                    (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[
ca@2455
  1277
                                        (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[
ca@2177
  1278
                                            self selectFocusView.
ca@2177
  1279
                                        ].
ca@2177
  1280
                                        update ifTrue:[
ca@2177
  1281
                                            self updateShownStatus.
ca@2177
  1282
                                        ].
ca@2177
  1283
                                        update := update not.
ca@2177
  1284
                                    ].
ca@2177
  1285
                                ].
ca@2177
  1286
ca@2177
  1287
                             ] priority:8.
ca@2177
  1288
            theProcess name:'ViewTreeApplication::Follow Focus'.
ca@2177
  1289
            theProcess resume.
ca@2177
  1290
        ].
ca@2177
  1291
    ].
ca@2177
  1292
    model rootItem:aRootItemOrNil.
ca@2177
  1293
!
ca@2177
  1294
ca@2177
  1295
updateShownStatus
ca@2177
  1296
    |rootItem min max visState listIdx visY0 visY1 height damage|
ca@2177
  1297
ca@2177
  1298
    rootItem := model rootItem.
ca@2177
  1299
    (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self].
ca@2177
  1300
ca@2177
  1301
    max := 0.
ca@2177
  1302
    min := 9999999.
ca@2177
  1303
ca@2177
  1304
    rootItem recursiveEachVisibleItemDo:[:anItem|
ca@2177
  1305
        visState := (anItem widget shown).
ca@2177
  1306
ca@2177
  1307
        visState ~~ anItem isDrawnShown ifTrue:[
ca@2177
  1308
            anItem isDrawnShown:visState.
ca@2177
  1309
            listIdx := treeView identityIndexOf:anItem.
ca@2177
  1310
ca@2177
  1311
            listIdx > 0 ifTrue:[    
ca@2177
  1312
                max := max max:listIdx.
ca@2177
  1313
                min := min min:listIdx.
ca@2177
  1314
            ].
ca@2177
  1315
        ].
ca@2177
  1316
    ].
ca@2177
  1317
    max < min ifTrue:[^ self].
ca@2177
  1318
    max := max + 1.
ca@2177
  1319
ca@2177
  1320
    visY0  := (treeView yVisibleOfLine:min) max:0.
ca@2177
  1321
    visY1  := (treeView yVisibleOfLine:max) min:(treeView height).
ca@2177
  1322
    height := visY1 - visY0.
ca@2177
  1323
    
ca@2177
  1324
    height > 2 ifTrue:[
ca@2177
  1325
        treeView shown ifTrue:[
ca@2177
  1326
            damage := Rectangle left:0 top:visY0 width:(treeView width) height:height.
ca@2177
  1327
            treeView invalidateDeviceRectangle:damage repairNow:false.
ca@2177
  1328
        ].
ca@2177
  1329
    ].
ca@2177
  1330
! !
ca@2177
  1331
ca@2177
  1332
!ViewTreeApplication methodsFor:'selection'!
ca@2177
  1333
ca@2177
  1334
selectedView
ca@2455
  1335
    "answer the selected view or nil"
ca@2455
  1336
ca@2177
  1337
    |item|
ca@2177
  1338
ca@2177
  1339
    item := model selectedItem.
ca@2177
  1340
    item notNil ifTrue:[ ^ item widget ].
ca@2177
  1341
  ^ nil
ca@2177
  1342
! !
ca@2177
  1343
ca@2177
  1344
!ViewTreeApplication methodsFor:'testing'!
ca@2177
  1345
ca@2177
  1346
resolveApplicationClassFor:aTreeItem
ca@2177
  1347
    aTreeItem isApplicationClass ifTrue:[
ca@2177
  1348
       ^ aTreeItem applicationClass
ca@2177
  1349
    ].
ca@2177
  1350
    ^ nil
ca@2177
  1351
!
ca@2177
  1352
ca@2177
  1353
selectedComponentHasChildren
ca@2177
  1354
    |item|
ca@2177
  1355
ca@2177
  1356
    item := model selectedItem.
ca@2177
  1357
    ^ (item notNil and:[item hasChildren])
ca@2177
  1358
! !
ca@2177
  1359
ca@2177
  1360
!ViewTreeApplication methodsFor:'user operations'!
ca@2177
  1361
ca@2177
  1362
doBrowse:what
ca@2177
  1363
    "open browser on:
ca@2177
  1364
        #view           browse class
ca@2177
  1365
        #model          browse model class
ca@2177
  1366
        #application    browse application class
ca@2177
  1367
        #controller     browse controller class
ca@2177
  1368
    "
ca@2177
  1369
    |view inst|
ca@2177
  1370
ca@2177
  1371
    view := self selectedView.
ca@2177
  1372
    view isNil ifTrue:[^ self].
ca@2177
  1373
ca@2177
  1374
             what == #view        ifTrue:[ inst := view ]
ca@2177
  1375
    ifFalse:[what == #model       ifTrue:[ inst := view model ]
ca@2177
  1376
    ifFalse:[what == #application ifTrue:[ inst := view application ]
ca@2177
  1377
    ifFalse:[what == #controller  ifTrue:[ inst := view controller ]
ca@2177
  1378
    ifFalse:[
ca@2177
  1379
        ^ self
ca@2177
  1380
    ]]]].
ca@2177
  1381
ca@2177
  1382
    inst notNil ifTrue:[
ca@2177
  1383
        inst class browserClass openInClass:(inst class) selector:nil
ca@2177
  1384
    ].
ca@2177
  1385
!
ca@2177
  1386
ca@2177
  1387
doDestroy
ca@2455
  1388
    "destroy the current selected view"
ca@2455
  1389
ca@2177
  1390
    |item parent|
ca@2177
  1391
ca@2177
  1392
    item := model selectedItem.
ca@2177
  1393
    item isNil ifTrue:[ ^ self].
ca@2177
  1394
ca@2177
  1395
    parent := item parent.
ca@2177
  1396
ca@2177
  1397
    parent isNil ifTrue:[
ca@2177
  1398
        "/ the root
ca@2177
  1399
        model withSelectionHiddenDo:[item deleteAll].
ca@2177
  1400
      ^ self
ca@2177
  1401
    ].
ca@2177
  1402
ca@2177
  1403
    model withSelectionHiddenDo:[
ca@2177
  1404
        |idx nsel|
ca@2177
  1405
ca@2177
  1406
        idx := parent identityIndexOf:item.
ca@2177
  1407
ca@2177
  1408
        idx == parent size ifTrue:[
ca@2177
  1409
            nsel := parent at:(idx - 1) ifAbsent:parent
ca@2177
  1410
        ] ifFalse:[
ca@2177
  1411
            nsel := parent at:(idx + 1)
ca@2177
  1412
        ].
ca@2177
  1413
        model setValue:nil.
ca@2177
  1414
        item delete.
ca@2177
  1415
ca@2177
  1416
        parent isLayoutContainer ifTrue:[
ca@2177
  1417
            parent widget sizeChanged:nil
ca@2177
  1418
        ].
ca@2177
  1419
        model value:nsel.
ca@2177
  1420
    ].
ca@2177
  1421
!
ca@2177
  1422
ca@2177
  1423
doFlash
ca@2455
  1424
    "flash the selected view"
ca@2455
  1425
ca@2177
  1426
    |view|
ca@2177
  1427
ca@2177
  1428
    view := self selectedView.
ca@2177
  1429
    view isNil ifTrue:[ ^ self].
ca@2177
  1430
ca@2177
  1431
    view shown ifTrue:[
ca@2177
  1432
        model withSelectionHiddenDo:[
ca@2177
  1433
            view perform:#flash ifNotUnderstood:nil.
ca@2177
  1434
        ].
ca@2177
  1435
    ].
ca@2177
  1436
!
ca@2177
  1437
ca@2177
  1438
doInspect:what
ca@2177
  1439
    "open inspector on:
ca@2177
  1440
        #view           inspect class
ca@2177
  1441
        #group          inspect windowGroup
ca@2177
  1442
        #model          inspect model
ca@2177
  1443
        #application    inspect application
ca@2177
  1444
        #controller     inspect controller
ca@2177
  1445
    "
ca@2177
  1446
    |inst|
ca@2177
  1447
ca@2177
  1448
    inst := self selectedView.
ca@2177
  1449
    inst isNil ifTrue:[^ self].
ca@2177
  1450
ca@2177
  1451
             what == #group       ifTrue:[ inst := inst windowGroup ]
ca@2177
  1452
    ifFalse:[what == #model       ifTrue:[ inst := inst model ]
ca@2177
  1453
    ifFalse:[what == #application ifTrue:[ inst := inst application ]
ca@2177
  1454
    ifFalse:[what == #controller  ifTrue:[ inst := inst controller  ]]]].
ca@2177
  1455
ca@2177
  1456
    inst notNil ifTrue:[ inst inspect ].
ca@2177
  1457
!
ca@2177
  1458
ca@2177
  1459
doPickViews
ca@2455
  1460
    "pick a window's topView"
ca@2455
  1461
ca@2177
  1462
    |window|
ca@2177
  1463
ca@2177
  1464
    self doUnpick.
ca@2177
  1465
ca@2177
  1466
    window := Screen current viewFromUser.
ca@2177
  1467
    window isNil ifTrue:[^ self].
ca@2177
  1468
ca@2177
  1469
    window := window topView.
ca@2177
  1470
ca@2177
  1471
    (    window == Screen current rootView
ca@2177
  1472
     or:[window == self window topView]
ca@2177
  1473
    ) ifTrue:[
ca@2177
  1474
        ^ self
ca@2177
  1475
    ].
ca@2177
  1476
    self setRootItem:(ViewTreeItem buildViewsFrom:window).
ca@2177
  1477
!
ca@2177
  1478
ca@2177
  1479
doSelectNextOfApplicationClass:aClass startingIn:anItem
ca@2177
  1480
    |startItem firstFound searchNext|
ca@2177
  1481
ca@2177
  1482
    startItem  := model last.
ca@2177
  1483
    searchNext := startItem notNil.        
ca@2177
  1484
    firstFound := nil.
ca@2177
  1485
ca@2177
  1486
    anItem recursiveDo:[:el|
ca@2177
  1487
        el == startItem ifTrue:[
ca@2177
  1488
            searchNext := false
ca@2177
  1489
        ] ifFalse:[
ca@2177
  1490
            (self resolveApplicationClassFor:el) == aClass ifTrue:[
ca@2177
  1491
                searchNext ifFalse:[^ model selectItem:el].
ca@2177
  1492
ca@2177
  1493
                firstFound isNil ifTrue:[
ca@2177
  1494
                    firstFound := el
ca@2177
  1495
                ]
ca@2177
  1496
            ]
ca@2177
  1497
        ]
ca@2177
  1498
    ].
ca@2177
  1499
    firstFound notNil ifTrue:[
ca@2177
  1500
        self window beep.
ca@2177
  1501
        model selectItem:firstFound
ca@2177
  1502
    ].
ca@2177
  1503
!
ca@2177
  1504
ca@2177
  1505
doSelectNextOfClass:aClass startingIn:anItem
ca@2177
  1506
    |startItem firstFound searchNext|
ca@2177
  1507
ca@2177
  1508
    startItem  := model last.
ca@2177
  1509
    searchNext := startItem notNil.        
ca@2177
  1510
    firstFound := nil.
ca@2177
  1511
ca@2177
  1512
    anItem recursiveDo:[:el|
ca@2177
  1513
        el == startItem ifTrue:[
ca@2177
  1514
            searchNext := false
ca@2177
  1515
        ] ifFalse:[
ca@2177
  1516
            el widget class == aClass ifTrue:[
ca@2177
  1517
                searchNext ifFalse:[^ model selectItem:el].
ca@2177
  1518
ca@2177
  1519
                firstFound isNil ifTrue:[
ca@2177
  1520
                    firstFound := el
ca@2177
  1521
                ]
ca@2177
  1522
            ]
ca@2177
  1523
        ]
ca@2177
  1524
    ].
ca@2177
  1525
    firstFound notNil ifTrue:[
ca@2177
  1526
        self window beep.
ca@2177
  1527
        model selectItem:firstFound
ca@2177
  1528
    ].
ca@2177
  1529
!
ca@2177
  1530
ca@2177
  1531
doUnpick
ca@2455
  1532
    "release current picked window and contained subwindows"
ca@2455
  1533
ca@2177
  1534
    self setRootItem:nil.
ca@2177
  1535
! !
ca@2177
  1536
ca@2177
  1537
!ViewTreeApplication::MenuDesc class methodsFor:'building'!
ca@2177
  1538
ca@2177
  1539
buildFromList:aList onGC:aMenu
ca@2177
  1540
    |tabSpec menu w menuPanel|
ca@2177
  1541
ca@2177
  1542
    w := 0.
ca@2177
  1543
    aList do:[:el| w := w max:(el widthOn:aMenu) ].
ca@2177
  1544
ca@2177
  1545
    tabSpec := TabulatorSpecification new.
ca@2177
  1546
    tabSpec unit:#pixel.
ca@2177
  1547
    tabSpec positions:#(0     1.5 ).
ca@2177
  1548
    tabSpec align:#(#left #left).
ca@2177
  1549
ca@2177
  1550
    w := w + 15.
ca@2177
  1551
    tabSpec positions:(Array with:0 with:w).
ca@2177
  1552
ca@2177
  1553
    menu := Menu new.
ca@2177
  1554
ca@2177
  1555
    aList do:[:el|
ca@2177
  1556
        menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec).
ca@2177
  1557
    ].
ca@2177
  1558
    menuPanel := MenuPanel menu:menu.
ca@2177
  1559
    ^ menuPanel
ca@2177
  1560
! !
ca@2177
  1561
ca@2177
  1562
!ViewTreeApplication::MenuDesc class methodsFor:'instance creation'!
ca@2177
  1563
ca@2177
  1564
separator
ca@2177
  1565
    ^ self new
ca@2177
  1566
!
ca@2177
  1567
ca@2177
  1568
title:aTitle value:aValue
ca@2177
  1569
    ^ self title:aTitle value:aValue action:nil
ca@2177
  1570
!
ca@2177
  1571
ca@2177
  1572
title:aTitle value:aValue action:anAction
ca@2177
  1573
    ^ self new title:aTitle value:aValue action:anAction
ca@2177
  1574
! !
ca@2177
  1575
ca@2177
  1576
!ViewTreeApplication::MenuDesc methodsFor:'accessing'!
ca@2177
  1577
ca@2177
  1578
title
ca@2177
  1579
    ^ title
ca@2177
  1580
! !
ca@2177
  1581
ca@2177
  1582
!ViewTreeApplication::MenuDesc methodsFor:'building'!
ca@2177
  1583
ca@2177
  1584
asMenuItemWithTabulatorSpecification:aTabSpec
ca@2177
  1585
    |array|
ca@2177
  1586
ca@2177
  1587
    title isNil ifTrue:[ ^ MenuItem label:value ].     "/ separator
ca@2177
  1588
ca@2177
  1589
    array := Array with:(title, ':') with:'------'.
ca@2177
  1590
ca@2177
  1591
    value notNil ifTrue:[
ca@2177
  1592
        array at:2 put:(value printString, ' ')
ca@2177
  1593
    ].
ca@2177
  1594
ca@2177
  1595
  ^ MenuItem label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec)
ca@2177
  1596
             value:action
ca@2177
  1597
! !
ca@2177
  1598
ca@2177
  1599
!ViewTreeApplication::MenuDesc methodsFor:'instance creation'!
ca@2177
  1600
ca@2177
  1601
title:aTitle value:aValue action:anAction
ca@2177
  1602
    "test for separator
ca@2177
  1603
    "
ca@2177
  1604
    title  := aTitle withoutSeparators.
ca@2177
  1605
    action := anAction.
ca@2177
  1606
ca@2177
  1607
    aValue notNil ifTrue:[
ca@2177
  1608
        value := aValue printString.
ca@2177
  1609
ca@2177
  1610
        value size > 70 ifTrue:[
ca@2177
  1611
            value := value copyFrom:1 to:70.
ca@2177
  1612
            value := value, '...'
ca@2177
  1613
        ]
ca@2177
  1614
    ].
ca@2177
  1615
! !
ca@2177
  1616
ca@2177
  1617
!ViewTreeApplication::MenuDesc methodsFor:'queries'!
ca@2177
  1618
ca@2177
  1619
isSeparator
ca@2177
  1620
    ^ title isNil
ca@2177
  1621
!
ca@2177
  1622
ca@2177
  1623
widthOn:aGC
ca@2177
  1624
    title isNil ifTrue:[^ 5].  "/ separator
ca@2177
  1625
  ^ title widthOn:aGC
ca@2177
  1626
! !
ca@2177
  1627
ca@2177
  1628
!ViewTreeApplication class methodsFor:'documentation'!
ca@2177
  1629
ca@2177
  1630
version
ca@2177
  1631
    ^ '$Header$'
ca@2177
  1632
! !
ca@2177
  1633
ca@2177
  1634
ViewTreeApplication initialize!