Tools__ViewTreeModel.st
author Claus Gittinger <cg@exept.de>
Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570 4e663bc64364
parent 2457 04459d76932e
permissions -rw-r--r--
changed #requestPackage
ca@2176
     1
"{ Package: 'stx:libtool2' }"
ca@2176
     2
ca@2176
     3
"{ NameSpace: Tools }"
ca@2176
     4
ca@2176
     5
ValueModel subclass:#ViewTreeModel
ca@2176
     6
	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
ca@2176
     7
		inputEventAction mappedViewAction beforeSelectionChangedAction
ca@2457
     8
		icons timedUpdateTask selectOnClickHolder testModeChannel
ca@2457
     9
		hasTargetWidgetChannel'
ca@2176
    10
	classVariableNames:''
ca@2176
    11
	poolDictionaries:''
ca@2176
    12
	category:'A-Views-Support'
ca@2176
    13
!
ca@2176
    14
ca@2176
    15
HierarchicalList subclass:#ItemList
ca@2453
    16
	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
ca@2176
    17
	classVariableNames:''
ca@2176
    18
	poolDictionaries:''
ca@2176
    19
	privateIn:ViewTreeModel
ca@2176
    20
!
ca@2176
    21
ca@2176
    22
!ViewTreeModel class methodsFor:'documentation'!
ca@2176
    23
ca@2176
    24
documentation
ca@2176
    25
"
ca@2176
    26
    Instances of ViewTreeModel can be used as model on a View and all
ca@2176
    27
    it contained subviews for a HierarchicalListView.
ca@2176
    28
    The model keeps two values, the hierarchical representation of the views
ca@2176
    29
    and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
ca@2176
    30
    It shows the selected items highlighted.
ca@2176
    31
ca@2176
    32
ca@2176
    33
    [Instance variables:]
ca@2176
    34
        lockSema            <Semaphore>         lock selection notifications and redraws
ca@2176
    35
ca@2457
    36
        testModeChannel     <ValueHolder>       true, than running in test mode.
ca@2457
    37
ca@2457
    38
        hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
ca@2176
    39
ca@2176
    40
        selection           <Sequence or nil>   selected items or nil
ca@2176
    41
ca@2176
    42
        hiddenLevel         <Integer>           internal use; redrawing the selection
ca@2176
    43
                                                only is done if the counter is 0.
ca@2176
    44
ca@2176
    45
        listOfItems         <HierarchicalList>  hiearchical list build from existing items.
ca@2176
    46
ca@2176
    47
        selectedSuperItems  <Sequence>          list of selected super items; items selected
ca@2176
    48
                                                but not contained in another selected item.
ca@2176
    49
ca@2176
    50
        inputEventAction    <Action>            called for each InputEvent
ca@2176
    51
ca@2176
    52
        mappedViewAction    <Action>            called for a new mapped view which
ca@2176
    53
                                                can not be found in the current item list.
ca@2176
    54
ca@2176
    55
        beforeSelectionChangedAction <Action>   called before the selection changed
ca@2176
    56
ca@2176
    57
    [author:]
ca@2176
    58
        Claus Atzkern
ca@2176
    59
ca@2176
    60
    [see also:]
ca@2176
    61
        ViewTreeItem
ca@2176
    62
"
ca@2176
    63
!
ca@2176
    64
ca@2176
    65
examples
ca@2176
    66
"
ca@2176
    67
    example 1: pick any window and show views and contained views
ca@2176
    68
                                                                                [exBegin]
ca@2176
    69
    |top sel model panel|
ca@2176
    70
ca@2176
    71
    model := ViewTreeModel new.
ca@2176
    72
    top   := StandardSystemView new; extent:440@400.
ca@2176
    73
    sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
ca@2176
    74
    sel bottomInset:24.
ca@2176
    75
ca@2176
    76
    panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
ca@2176
    77
    panel topInset:-24.
ca@2176
    78
    panel horizontalLayout:#fitSpace.
ca@2176
    79
ca@2176
    80
    Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
ca@2176
    81
    Button label:'Pick Views' action:[  |win|
ca@2176
    82
                                        (     (win := Screen current viewFromUser) notNil
ca@2176
    83
                                         and:[(win := win topView) ~~ Screen current rootView
ca@2176
    84
                                         and:[win ~~ top]]
ca@2176
    85
                                        ) ifTrue:[
ca@2176
    86
                                            model rootItem:(ViewTreeItem buildViewsFrom:win)
ca@2176
    87
                                        ] ifFalse:[
ca@2176
    88
                                            model rootItem:nil
ca@2176
    89
                                        ]
ca@2176
    90
                                     ] in:panel.
ca@2176
    91
ca@2176
    92
    sel  multipleSelectOk:true.
ca@2176
    93
    sel              list:model listOfItems.
ca@2176
    94
    sel             model:model.
ca@2176
    95
    sel          useIndex:false.
ca@2176
    96
ca@2176
    97
    sel doubleClickAction:[:i| |el|
ca@2176
    98
        el := model listOfItems at:i.
ca@2176
    99
        el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
ca@2176
   100
    ].
ca@2176
   101
    sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
ca@2176
   102
ca@2176
   103
    model inputEventAction:[:anEvent| |item|
ca@2176
   104
        anEvent isButtonEvent ifTrue:[
ca@2176
   105
            anEvent isButtonPressEvent ifTrue:[
ca@2176
   106
                model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
ca@2176
   107
            ] ifFalse:[
ca@2176
   108
                anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
ca@2176
   109
                    (item := model selectedItem) notNil ifTrue:[item widget inspect]
ca@2176
   110
                ]
ca@2176
   111
            ]
ca@2176
   112
        ]
ca@2176
   113
    ].
ca@2176
   114
ca@2176
   115
    top openAndWait.
ca@2176
   116
    [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
ca@2176
   117
ca@2176
   118
                                                                                [exEnd]
ca@2176
   119
"
ca@2176
   120
! !
ca@2176
   121
ca@2176
   122
!ViewTreeModel methodsFor:'accessing'!
ca@2176
   123
ca@2176
   124
application:anApplication
ca@2176
   125
    listOfItems application:anApplication.
ca@2176
   126
!
ca@2176
   127
ca@2176
   128
rootItem
ca@2176
   129
    "get the rootItem the event viewer is established on
ca@2176
   130
    "
ca@2176
   131
    ^ listOfItems root
ca@2176
   132
!
ca@2176
   133
ca@2176
   134
rootItem:anItem
ca@2176
   135
    "set the rootItem the event viewer is established on
ca@2176
   136
    "
ca@2176
   137
    |expanded|
ca@2176
   138
ca@2176
   139
    timedUpdateTask := nil.
ca@2457
   140
    self deselect.
ca@2176
   141
ca@2176
   142
    lockSema critical:[
ca@2176
   143
        anItem notNil ifTrue:[ expanded := anItem isExpanded ]
ca@2176
   144
                     ifFalse:[ expanded := false ].
ca@2176
   145
ca@2176
   146
        self value:nil.
ca@2176
   147
        listOfItems root:anItem.
ca@2176
   148
ca@2176
   149
        anItem notNil ifTrue:[
ca@2176
   150
            timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
ca@2176
   151
            timedUpdateTask name:'Update'.
ca@2176
   152
            timedUpdateTask resume.
ca@2176
   153
        ].
ca@2176
   154
    ].
ca@2176
   155
ca@2176
   156
    (expanded and:[anItem notNil]) ifTrue:[
ca@2176
   157
        anItem expand
ca@2176
   158
    ].
ca@2176
   159
    ^ anItem
ca@2176
   160
!
ca@2176
   161
ca@2176
   162
rootView
ca@2176
   163
    "get the top widget the event viewer is established on, a View
ca@2176
   164
    "
ca@2176
   165
    ^ listOfItems rootView
ca@2176
   166
! !
ca@2176
   167
ca@2176
   168
!ViewTreeModel methodsFor:'accessing actions'!
ca@2176
   169
ca@2176
   170
beforeSelectionChangedAction
ca@2176
   171
    "none argument action which is called before
ca@2176
   172
     the selection changed
ca@2176
   173
    "
ca@2176
   174
    ^ beforeSelectionChangedAction
ca@2176
   175
!
ca@2176
   176
ca@2176
   177
beforeSelectionChangedAction:aNoneArgBlock
ca@2176
   178
    "none argument action which is called before
ca@2176
   179
     the selection changed
ca@2176
   180
    "
ca@2176
   181
    beforeSelectionChangedAction := aNoneArgBlock.
ca@2176
   182
!
ca@2176
   183
ca@2176
   184
inputEventAction
ca@2176
   185
    "called for each input event; the argument to the action is the WindowEvent
ca@2176
   186
    "
ca@2176
   187
    ^ inputEventAction
ca@2176
   188
!
ca@2176
   189
ca@2176
   190
inputEventAction:aOneArgActionTheEvent
ca@2176
   191
    "called for each input event; the argument to the action is the WindowEvent
ca@2176
   192
    "
ca@2176
   193
    inputEventAction := aOneArgActionTheEvent.
ca@2176
   194
!
ca@2176
   195
ca@2176
   196
mappedViewAction
ca@2176
   197
    "called for a new mapped view which can not be found
ca@2176
   198
     in the current item list
ca@2176
   199
    "
ca@2176
   200
    ^ mappedViewAction
ca@2176
   201
!
ca@2176
   202
ca@2176
   203
mappedViewAction:aOneArgBlockTheMappedView
ca@2176
   204
    "called for a new mapped view which can not be found
ca@2176
   205
     in the current item list
ca@2176
   206
    "
ca@2176
   207
    mappedViewAction := aOneArgBlockTheMappedView
ca@2176
   208
! !
ca@2176
   209
ca@2176
   210
!ViewTreeModel methodsFor:'accessing look'!
ca@2176
   211
ca@2176
   212
iconAt:aKey ifNonePut:aNoneArgBlock
ca@2176
   213
    |icon view|
ca@2176
   214
ca@2176
   215
    icon := icons at:aKey ifAbsent:nil.
ca@2176
   216
    icon notNil ifTrue:[^ icon].
ca@2176
   217
ca@2176
   218
    icon := aNoneArgBlock value.
ca@2176
   219
    icon isNil ifTrue:[^ nil].
ca@2176
   220
ca@2176
   221
    view := self rootView.
ca@2176
   222
    view isNil ifTrue:[^ icon].
ca@2176
   223
ca@2176
   224
    icon := icon copy onDevice:(view device).
ca@2176
   225
    icon isImage ifTrue:[
ca@2176
   226
        icon clearMaskedPixels.
ca@2176
   227
    ].
ca@2176
   228
    icons at:aKey put:icon.
ca@2176
   229
    ^ icon
ca@2176
   230
! !
ca@2176
   231
ca@2176
   232
!ViewTreeModel methodsFor:'accessing visibility'!
ca@2176
   233
ca@2176
   234
signalHiddenLevel
ca@2176
   235
    "show the selection if signaled; increments hiddenLevel
ca@2176
   236
     see: #waitHiddenLevel
ca@2176
   237
    "
ca@2176
   238
    (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
ca@2176
   239
        hiddenLevel := 0.
ca@2176
   240
        self invalidateSelection.
ca@2176
   241
    ].
ca@2176
   242
!
ca@2176
   243
ca@2176
   244
waitHiddenLevel
ca@2176
   245
    "hide the selection until signaled; increments hiddenLevel
ca@2176
   246
     see: #signalHiddenLevel
ca@2176
   247
    "
ca@2176
   248
    self redrawUnselected:selection andLock:true
ca@2176
   249
!
ca@2176
   250
ca@2176
   251
withSelectionHiddenDo:aNoneArgumentBlock
ca@2176
   252
    "apply block with selection hidden
ca@2176
   253
    "
ca@2176
   254
ca@2176
   255
    [   self waitHiddenLevel.
ca@2176
   256
ca@2176
   257
        aNoneArgumentBlock value
ca@2176
   258
ca@2176
   259
    ] valueNowOrOnUnwindDo:[
ca@2176
   260
        self signalHiddenLevel.
ca@2176
   261
    ].
ca@2176
   262
! !
ca@2176
   263
ca@2457
   264
!ViewTreeModel methodsFor:'aspects'!
ca@2457
   265
ca@2457
   266
hasTargetWidgetChannel
ca@2457
   267
    "answer the channel which is set to true if a target widget exists"
ca@2457
   268
ca@2457
   269
    ^ hasTargetWidgetChannel
ca@2457
   270
!
ca@2457
   271
ca@2457
   272
listOfItems
ca@2457
   273
    "hiearchical list build from existing items"
ca@2457
   274
ca@2457
   275
    ^ listOfItems
ca@2457
   276
!
ca@2457
   277
ca@2457
   278
selectOnClickHolder
ca@2457
   279
    "boolean holder, which indicates whether the selection will change on click
ca@2457
   280
    "
ca@2457
   281
    ^ selectOnClickHolder
ca@2457
   282
!
ca@2457
   283
ca@2457
   284
testModeChannel
ca@2457
   285
    "answer a boolean channel which describes the behaviour how to process
ca@2457
   286
     events on the target view.
ca@2457
   287
ca@2457
   288
     false: all input events are eaten and the selection is shown on the target view.
ca@2457
   289
     true:  no  input events are eaten and no  selection is shown on the target view."
ca@2457
   290
ca@2457
   291
    ^ testModeChannel
ca@2457
   292
! !
ca@2457
   293
ca@2176
   294
!ViewTreeModel methodsFor:'change & update'!
ca@2176
   295
ca@2457
   296
targetWidgetChanged
ca@2457
   297
    hasTargetWidgetChannel value:(self rootItem notNil).
ca@2457
   298
!
ca@2457
   299
ca@2176
   300
timedUpdateTaskCycle
ca@2176
   301
    |view myTaskId|
ca@2176
   302
ca@2176
   303
    myTaskId := timedUpdateTask.
ca@2176
   304
ca@2176
   305
    listOfItems root notNil ifTrue:[
ca@2176
   306
        view := listOfItems root widget.
ca@2176
   307
    ].
ca@2176
   308
ca@2176
   309
    [ view notNil ] whileTrue:[
ca@2176
   310
        Delay waitForSeconds:0.5.
ca@2176
   311
        
ca@2176
   312
        (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
ca@2176
   313
            view := nil.
ca@2176
   314
        ] ifTrue:[
ca@2176
   315
            (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
ca@2176
   316
                view sensor pushUserEvent:#updateChildren for:self.
ca@2176
   317
            ].
ca@2176
   318
        ].
ca@2176
   319
    ].
ca@2176
   320
    timedUpdateTask == myTaskId ifTrue:[
ca@2176
   321
        timedUpdateTask := nil.
ca@2176
   322
        listOfItems root:nil.
ca@2176
   323
    ].
ca@2176
   324
!
ca@2176
   325
ca@2457
   326
update:something with:someArgument from:aModel
ca@2457
   327
ca@2457
   328
    aModel == testModeChannel ifTrue:[
ca@2457
   329
        (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
ca@2457
   330
            testModeChannel value ifTrue:[
ca@2457
   331
                self redrawUnselected:selection andLock:false checkTestMode:false.
ca@2457
   332
            ] ifFalse:[
ca@2457
   333
                self invalidateSelection.
ca@2457
   334
            ].
ca@2457
   335
        ].
ca@2457
   336
        ^ self
ca@2457
   337
    ].
ca@2457
   338
    super update:something with:someArgument from:aModel.
ca@2457
   339
!
ca@2457
   340
ca@2176
   341
updateChildren
ca@2176
   342
    |rootItem|
ca@2176
   343
ca@2176
   344
    rootItem := listOfItems root.
ca@2176
   345
    rootItem isNil ifTrue:[^ self].
ca@2176
   346
ca@2176
   347
    rootItem exists ifFalse:[
ca@2176
   348
        listOfItems root:nil.
ca@2176
   349
    ] ifTrue:[
ca@2176
   350
        rootItem updateChildren.
ca@2176
   351
    ].
ca@2176
   352
! !
ca@2176
   353
ca@2176
   354
!ViewTreeModel methodsFor:'event processing'!
ca@2176
   355
ca@2176
   356
processEvent:anEvent
ca@2176
   357
    "catch and process all WindowEvents for the rootComponent and its contained
ca@2176
   358
     widgets; redraw selection in case of damage ....
ca@2176
   359
    "
ca@2457
   360
    |evView item rootView testMode|
ca@2176
   361
ca@2176
   362
    evView := anEvent view.
ca@2176
   363
    evView isNil ifTrue:[
ca@2176
   364
        (anEvent isMessageSendEvent and:[anEvent receiver == self]) ifFalse:[
ca@2176
   365
            ^ false
ca@2176
   366
        ].
ca@2176
   367
        anEvent value.
ca@2176
   368
        ^ true.
ca@2176
   369
    ].
ca@2176
   370
    rootView := listOfItems rootView.
ca@2176
   371
    rootView isNil ifTrue:[ ^ false ].
ca@2176
   372
ca@2176
   373
    anEvent isConfigureEvent ifTrue:[
ca@2176
   374
        hiddenLevel == 0 ifTrue:[
ca@2176
   375
            self redrawUnselected:selection andLock:false.
ca@2176
   376
        ].
ca@2176
   377
        ^ false
ca@2176
   378
    ].
ca@2176
   379
ca@2176
   380
    "/ check whether view is contained within the rootView
ca@2176
   381
    (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
ca@2176
   382
        ^ false
ca@2176
   383
    ].
ca@2176
   384
ca@2176
   385
    anEvent isInputEvent ifFalse:[
ca@2176
   386
        anEvent isDamage ifTrue:[
ca@2176
   387
            hiddenLevel == 0 ifTrue:[self invalidateSelection].
ca@2176
   388
            ^ false
ca@2176
   389
        ].
ca@2176
   390
ca@2176
   391
        anEvent isMapEvent ifTrue:[
ca@2176
   392
            mappedViewAction notNil ifTrue:[
ca@2176
   393
                item := listOfItems recursiveDetect:[:el| el widget == evView].
ca@2176
   394
                item isNil ifTrue:[ mappedViewAction value:evView ]
ca@2176
   395
            ].
ca@2176
   396
            ^ false
ca@2176
   397
        ].
ca@2176
   398
ca@2176
   399
        anEvent type == #terminate ifTrue:[
ca@2176
   400
            item := listOfItems recursiveDetect:[:el| el widget == evView].
ca@2176
   401
            item notNil ifTrue:[ self processTerminateForItem:item ].
ca@2176
   402
            ^ false
ca@2176
   403
        ].
ca@2176
   404
        ^ false
ca@2176
   405
    ].
ca@2457
   406
    testMode := testModeChannel value.
ca@2457
   407
ca@2176
   408
    anEvent isFocusEvent ifTrue:[
ca@2176
   409
        evView == rootView ifTrue:[
ca@2176
   410
            self invalidateSelection
ca@2176
   411
        ].
ca@2176
   412
        ^ testMode not.
ca@2176
   413
    ].
ca@2176
   414
    anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
ca@2176
   415
ca@2176
   416
    testMode ifFalse:[
ca@2176
   417
        inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
ca@2176
   418
    ] ifTrue:[
ca@2176
   419
        anEvent isButtonPressEvent ifTrue:[
ca@2176
   420
            selectOnClickHolder value ifTrue:[
ca@2176
   421
                self selectItem:(listOfItems detectItemRespondsToView:evView).
ca@2176
   422
            ].
ca@2176
   423
        ]
ca@2176
   424
    ].
ca@2176
   425
ca@2176
   426
    (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
ca@2176
   427
        hiddenLevel := 1.
ca@2176
   428
        self signalHiddenLevel.
ca@2176
   429
    ].
ca@2176
   430
ca@2176
   431
    ^ testMode not
ca@2176
   432
!
ca@2176
   433
ca@2176
   434
processTerminateForItem:anItem
ca@2176
   435
    "received terminate for an item
ca@2176
   436
    "
ca@2176
   437
    anItem remove.
ca@2176
   438
! !
ca@2176
   439
ca@2176
   440
!ViewTreeModel methodsFor:'initialization'!
ca@2176
   441
ca@2176
   442
initialize
ca@2176
   443
    "setup the default attributes
ca@2176
   444
    "
ca@2176
   445
    super initialize.
ca@2176
   446
ca@2457
   447
    hiddenLevel           := 0.
ca@2457
   448
    lockSema              := RecursionLock new.
ca@2457
   449
    listOfItems           := ItemList new on:self.
ca@2457
   450
    selectedSuperItems    := #().
ca@2457
   451
    icons                 := IdentityDictionary new.
ca@2457
   452
ca@2457
   453
    hasTargetWidgetChannel := false asValue.
ca@2457
   454
    selectOnClickHolder    := true asValue.
ca@2457
   455
ca@2457
   456
    testModeChannel := false asValue.
ca@2457
   457
    testModeChannel addDependent:self.
ca@2176
   458
! !
ca@2176
   459
ca@2176
   460
!ViewTreeModel methodsFor:'private selection'!
ca@2176
   461
ca@2176
   462
invalidateSelection
ca@2176
   463
    "invalidate the current selection
ca@2176
   464
    "
ca@2176
   465
    |topView|
ca@2176
   466
ca@2457
   467
    testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
ca@2176
   468
ca@2176
   469
    (     hiddenLevel == 0
ca@2176
   470
     and:[selection notNil
ca@2176
   471
     and:[(topView := listOfItems rootView) notNil
ca@2176
   472
     and:[topView shown]]]
ca@2176
   473
    ) ifTrue:[
ca@2176
   474
        topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
ca@2176
   475
    ]
ca@2176
   476
!
ca@2176
   477
ca@2176
   478
recursiveRepair:theDamages startIn:aView relativeTo:aRootView
ca@2176
   479
    "repair all views and contained views, which intersects the damage.
ca@2176
   480
     !!!! all damages repaired are removed from the list of damages !!!!
ca@2176
   481
    "
ca@2176
   482
    |color relOrg damage subViews repaired
ca@2176
   483
     bwWidth    "{ Class:SmallInteger }"
ca@2176
   484
     x          "{ Class:SmallInteger }"
ca@2176
   485
     y          "{ Class:SmallInteger }"
ca@2176
   486
     w          "{ Class:SmallInteger }"
ca@2176
   487
     h          "{ Class:SmallInteger }"
ca@2176
   488
     relOrgX    "{ Class:SmallInteger }"
ca@2176
   489
     relOrgY    "{ Class:SmallInteger }"
ca@2176
   490
     width      "{ Class:SmallInteger }"
ca@2176
   491
     height     "{ Class:SmallInteger }"
ca@2176
   492
     size       "{ Class:SmallInteger }"
ca@2176
   493
    |
ca@2176
   494
    (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
ca@2176
   495
ca@2176
   496
    subViews := aView subViews.
ca@2176
   497
ca@2176
   498
    subViews size ~~ 0 ifTrue:[
ca@2176
   499
        subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
ca@2176
   500
        theDamages isEmpty ifTrue:[ ^ self ].
ca@2176
   501
    ].
ca@2176
   502
ca@2176
   503
    relOrg  := aView originRelativeTo:aRootView.
ca@2176
   504
    bwWidth := aView borderWidth.
ca@2176
   505
    size    := theDamages size.
ca@2176
   506
ca@2176
   507
    "/ compute relative origin starting from border left@top
ca@2176
   508
    relOrgX := relOrg x - bwWidth.
ca@2176
   509
    relOrgY := relOrg y - bwWidth.
ca@2176
   510
    width   := aView width  + bwWidth + bwWidth.
ca@2176
   511
    height  := aView height + bwWidth + bwWidth.
ca@2176
   512
ca@2176
   513
    size to:1 by:-1 do:[:anIndex|
ca@2176
   514
        repaired := damage := theDamages at:anIndex.
ca@2176
   515
ca@2176
   516
        "/ compute the rectangle into the view
ca@2176
   517
        y := damage top  - relOrgY.
ca@2176
   518
        x := damage left - relOrgX.
ca@2176
   519
        w := damage width.
ca@2176
   520
        h := damage height.
ca@2176
   521
ca@2176
   522
        x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
ca@2176
   523
        y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
ca@2176
   524
        x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
ca@2176
   525
        y + h > height ifTrue:[ h := height - y.    repaired := nil ].
ca@2176
   526
ca@2176
   527
        (w > 0 and:[h > 0]) ifTrue:[
ca@2176
   528
            bwWidth ~~ 0 ifTrue:[
ca@2176
   529
                color isNil ifTrue:[
ca@2176
   530
                    "/ must force redraw of border
ca@2176
   531
                    color := aView borderColor.
ca@2176
   532
                    aView borderColor:(Color colorId:1).
ca@2176
   533
                    aView borderColor:color.
ca@2176
   534
                ].
ca@2176
   535
                w := w - bwWidth.
ca@2176
   536
                h := h - bwWidth.
ca@2176
   537
ca@2176
   538
                (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
ca@2176
   539
                (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
ca@2176
   540
ca@2176
   541
                h > 0 ifFalse:[w := 0].         "/ later testing on width only
ca@2176
   542
            ].
ca@2176
   543
ca@2176
   544
            w > 0 ifTrue:[
ca@2176
   545
                aView clearRectangleX:x y:y width:w height:h.
ca@2176
   546
                aView exposeX:x y:y width:w height:h
ca@2176
   547
            ].
ca@2176
   548
            repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
ca@2176
   549
        ]
ca@2176
   550
    ].
ca@2176
   551
!
ca@2176
   552
ca@2176
   553
redrawSelection
ca@2176
   554
    "redraw all items selected
ca@2176
   555
    "
ca@2176
   556
    |topView size|
ca@2176
   557
ca@2457
   558
    testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
ca@2176
   559
ca@2176
   560
    (     hiddenLevel == 0
ca@2176
   561
     and:[(size := selection size) > 0
ca@2176
   562
     and:[(topView := listOfItems rootView) notNil
ca@2176
   563
     and:[topView shown
ca@2176
   564
     and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
ca@2176
   565
    ) ifFalse:[
ca@2176
   566
        ^ self
ca@2176
   567
    ].
ca@2176
   568
ca@2176
   569
    lockSema critical:[
ca@2457
   570
        |list|
ca@2176
   571
ca@2457
   572
        list := selection.
ca@2176
   573
ca@2457
   574
        list size > 0 ifTrue:[
ca@2457
   575
            topView paint:(Color black).
ca@2457
   576
            topView clippedByChildren:false.
ca@2176
   577
ca@2457
   578
            list keysAndValuesReverseDo:[:anIndex :anItem|
ca@2457
   579
                (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
ca@2457
   580
ca@2457
   581
                anItem handlesDo:[:aRect :what|
ca@2457
   582
                    what isNil ifTrue:[topView displayRectangle:aRect]
ca@2457
   583
                              ifFalse:[topView    fillRectangle:aRect]
ca@2457
   584
                ]
ca@2457
   585
            ].
ca@2457
   586
            topView clippedByChildren:true.
ca@2176
   587
        ].
ca@2176
   588
    ].
ca@2176
   589
!
ca@2176
   590
ca@2176
   591
redrawUnselected:aList andLock:doLock
ca@2176
   592
    "redraw all items unselected; if doLock is true, the hiddenLevel
ca@2176
   593
     is incremented and thus the select mechanism is locked.
ca@2176
   594
    "
ca@2457
   595
    self redrawUnselected:aList andLock:doLock checkTestMode:true.
ca@2457
   596
!
ca@2457
   597
ca@2457
   598
redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
ca@2457
   599
    "redraw all items unselected; if doLock is true, the hiddenLevel
ca@2457
   600
     is incremented and thus the select mechanism is locked.
ca@2457
   601
    "
ca@2176
   602
    |rootView damages subViews x y w h|
ca@2176
   603
ca@2176
   604
    doLock ifTrue:[
ca@2176
   605
        hiddenLevel := hiddenLevel + 1.
ca@2176
   606
        hiddenLevel ~~ 1 ifTrue:[^ self].
ca@2176
   607
    ] ifFalse:[
ca@2176
   608
        hiddenLevel ~~ 0 ifTrue:[^ self].
ca@2176
   609
    ].
ca@2457
   610
    checkTestMode ifTrue:[
ca@2457
   611
        testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
ca@2457
   612
    ].
ca@2176
   613
ca@2176
   614
    (     aList size ~~ 0
ca@2176
   615
     and:[(rootView := listOfItems rootView) notNil
ca@2176
   616
     and:[rootView shown]]
ca@2176
   617
    ) ifFalse:[
ca@2176
   618
        ^ self
ca@2176
   619
    ].
ca@2176
   620
ca@2176
   621
    lockSema critical:[
ca@2176
   622
        damages := OrderedCollection new:(8 * aList size).
ca@2176
   623
ca@2176
   624
        aList do:[:item|
ca@2176
   625
            item handlesDo:[:handle :what|
ca@2176
   626
                damages reverseDo:[:el|
ca@2176
   627
                    (el intersects:handle) ifTrue:[
ca@2176
   628
                        damages removeIdentical:el.
ca@2176
   629
ca@2176
   630
                        handle left:(handle left   min:el left)
ca@2176
   631
                              right:(handle right  max:el right)
ca@2176
   632
                                top:(handle top    min:el top)
ca@2176
   633
                             bottom:(handle bottom max:el bottom)
ca@2176
   634
                    ]
ca@2176
   635
                ].                        
ca@2176
   636
                damages add:handle
ca@2176
   637
            ]
ca@2176
   638
        ].
ca@2176
   639
ca@2176
   640
        damages do:[:el|
ca@2176
   641
            x := el left.
ca@2176
   642
            y := el top.
ca@2176
   643
            w := el width.
ca@2176
   644
            h := el height.
ca@2176
   645
ca@2176
   646
            rootView clearRectangleX:x y:y width:w height:h.
ca@2176
   647
            rootView         exposeX:x y:y width:w height:h.
ca@2176
   648
        ].
ca@2176
   649
ca@2176
   650
        (subViews := rootView subViews) notNil ifTrue:[
ca@2176
   651
            subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
ca@2176
   652
        ].
ca@2176
   653
    ].
ca@2176
   654
! !
ca@2176
   655
ca@2457
   656
!ViewTreeModel methodsFor:'queries'!
ca@2457
   657
ca@2457
   658
isInTestMode
ca@2457
   659
    "answer false, all input events are eaten and the selection is shown on the target view.
ca@2457
   660
     answer true,  no  input events are eaten and no  selection is shown on the target view."
ca@2457
   661
ca@2457
   662
    ^ testModeChannel value
ca@2457
   663
! !
ca@2457
   664
ca@2176
   665
!ViewTreeModel methodsFor:'selection accessing'!
ca@2176
   666
ca@2176
   667
at:anIndex
ca@2176
   668
    "returns the selected item at an index or nil
ca@2176
   669
    "
ca@2176
   670
    selection notNil ifTrue:[
ca@2176
   671
        ^ selection at:anIndex ifAbsent:nil
ca@2176
   672
    ].
ca@2176
   673
    ^ nil
ca@2176
   674
!
ca@2176
   675
ca@2176
   676
at:anIndex ifAbsent:aBlock
ca@2176
   677
    "returns the selected item at an index or the result of the block
ca@2176
   678
    "
ca@2176
   679
    selection notNil ifTrue:[
ca@2176
   680
        ^ selection at:anIndex ifAbsent:aBlock
ca@2176
   681
    ].
ca@2176
   682
    ^ aBlock value
ca@2176
   683
!
ca@2176
   684
ca@2176
   685
first
ca@2176
   686
    "returns the first selected item or nil
ca@2176
   687
    "
ca@2176
   688
    ^ self at:1
ca@2176
   689
!
ca@2176
   690
ca@2176
   691
last
ca@2176
   692
    "returns the last selected item or nil
ca@2176
   693
    "
ca@2176
   694
    ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
ca@2176
   695
!
ca@2176
   696
ca@2176
   697
selectedItem
ca@2176
   698
    "returns the single selected item or nil (size ~~ 1 nil is returned)
ca@2176
   699
    "
ca@2176
   700
    ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
ca@2176
   701
!
ca@2176
   702
ca@2176
   703
selectedSuperItems
ca@2176
   704
    "returs the list of selected superItems; items selected
ca@2176
   705
     but not contained in another selected item.
ca@2176
   706
    "
ca@2176
   707
    ^ selectedSuperItems
ca@2176
   708
!
ca@2176
   709
ca@2176
   710
size
ca@2176
   711
    "returns the number of items selected
ca@2176
   712
    "
ca@2176
   713
    ^ selection size
ca@2176
   714
! !
ca@2176
   715
ca@2176
   716
!ViewTreeModel methodsFor:'selection adding & removing'!
ca@2176
   717
ca@2176
   718
add:item
ca@2176
   719
    "add an item to the current selection
ca@2176
   720
    "
ca@2176
   721
    |newSelect|
ca@2176
   722
ca@2176
   723
    item isNil ifTrue:[^ item].
ca@2176
   724
ca@2176
   725
    lockSema critical:[
ca@2176
   726
        selection isNil ifTrue:[
ca@2176
   727
            newSelect := Array with:item.
ca@2176
   728
        ] ifFalse:[
ca@2176
   729
            (self includes:item) ifFalse:[
ca@2176
   730
                newSelect := selection copyWith:item
ca@2176
   731
            ]
ca@2176
   732
        ].
ca@2176
   733
ca@2176
   734
        newSelect size ~~ selection size ifTrue:[
ca@2176
   735
            item makeVisible.
ca@2176
   736
            self value:newSelect
ca@2176
   737
        ]
ca@2176
   738
    ].
ca@2176
   739
    ^ item
ca@2176
   740
!
ca@2176
   741
ca@2176
   742
addAll:aCollectionOfItems
ca@2176
   743
    "add a collection of items to the current selection
ca@2176
   744
    "
ca@2176
   745
    |newSelect|
ca@2176
   746
ca@2176
   747
    aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
ca@2176
   748
ca@2176
   749
    lockSema critical:[
ca@2176
   750
        selection isNil ifTrue:[
ca@2176
   751
            newSelect := Array withAll:aCollectionOfItems.
ca@2176
   752
        ] ifFalse:[
ca@2176
   753
            newSelect := OrderedCollection withAll:selection.
ca@2176
   754
ca@2176
   755
            aCollectionOfItems do:[:el|
ca@2176
   756
                (selection includesIdentical:el) ifFalse:[newSelect add:el]
ca@2176
   757
            ].
ca@2176
   758
        ].
ca@2176
   759
        self value:newSelect.
ca@2176
   760
    ].
ca@2176
   761
    ^ aCollectionOfItems
ca@2176
   762
!
ca@2176
   763
ca@2176
   764
deselect
ca@2176
   765
    "clear the selection
ca@2176
   766
    "
ca@2176
   767
    self value:nil.
ca@2176
   768
!
ca@2176
   769
ca@2176
   770
remove:item
ca@2176
   771
    "remove the item from the current selection
ca@2176
   772
    "
ca@2176
   773
    |newSelect|
ca@2176
   774
ca@2176
   775
    item isNil ifTrue:[^ nil].
ca@2176
   776
ca@2176
   777
    lockSema critical:[
ca@2176
   778
        (selection notNil and:[selection includesIdentical:item]) ifTrue:[
ca@2176
   779
            selection size == 1 ifTrue:[ newSelect := nil ]
ca@2176
   780
                               ifFalse:[ newSelect := selection copyWithout:item ].
ca@2176
   781
ca@2176
   782
            self value:newSelect
ca@2176
   783
        ].
ca@2176
   784
    ].
ca@2176
   785
    ^ item
ca@2176
   786
!
ca@2176
   787
ca@2176
   788
removeAll
ca@2176
   789
    "clear the selection
ca@2176
   790
    "
ca@2176
   791
    self deselect.
ca@2176
   792
!
ca@2176
   793
ca@2176
   794
removeAll:loItems
ca@2176
   795
    "remove all items of the collection from the current selection
ca@2176
   796
    "
ca@2176
   797
    |newSelect|
ca@2176
   798
ca@2176
   799
    selection   isNil ifTrue:[ ^ loItems ].
ca@2176
   800
    loItems size == 0 ifTrue:[ ^ loItems ].
ca@2176
   801
ca@2176
   802
    lockSema critical:[
ca@2176
   803
        selection notNil ifTrue:[
ca@2176
   804
            newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
ca@2176
   805
            self value:newSelect.
ca@2176
   806
        ]
ca@2176
   807
    ].
ca@2176
   808
    ^ loItems
ca@2176
   809
!
ca@2176
   810
ca@2176
   811
selectAll
ca@2176
   812
    "select all items
ca@2176
   813
    "
ca@2176
   814
    |root newSelection|
ca@2176
   815
ca@2176
   816
    root := listOfItems root.
ca@2176
   817
ca@2176
   818
    root isNil ifTrue:[
ca@2176
   819
        newSelection := nil
ca@2176
   820
    ] ifFalse:[
ca@2176
   821
        newSelection := OrderedCollection new.
ca@2176
   822
        root recursiveDo:[:el| newSelection add:el ].
ca@2176
   823
    ].
ca@2176
   824
    self value:newSelection.
ca@2176
   825
!
ca@2176
   826
ca@2176
   827
selectItem:anItem
ca@2176
   828
    "set the current selection to the item
ca@2176
   829
    "
ca@2176
   830
    self value:anItem
ca@2176
   831
!
ca@2176
   832
ca@2176
   833
selectRootItem
ca@2176
   834
    "set the current selection to the root item
ca@2176
   835
    "
ca@2176
   836
    self value:(self rootItem).
ca@2176
   837
!
ca@2176
   838
ca@2176
   839
selectedItem:anItem
ca@2176
   840
    "set the current selection to the item
ca@2176
   841
    "
ca@2176
   842
    self selectItem:anItem.
ca@2176
   843
!
ca@2176
   844
ca@2176
   845
toggleSelectItem:anItem
ca@2176
   846
    "toggle selection-state of the item; add or remove the item from the
ca@2176
   847
     current selection.
ca@2176
   848
    "
ca@2176
   849
    anItem notNil ifTrue:[
ca@2176
   850
        (self includes:anItem) ifTrue:[self remove:anItem]
ca@2176
   851
                              ifFalse:[self add:anItem]
ca@2176
   852
    ].
ca@2176
   853
    ^ anItem
ca@2176
   854
! !
ca@2176
   855
ca@2176
   856
!ViewTreeModel methodsFor:'selection enumerating'!
ca@2176
   857
ca@2176
   858
collect:aBlock
ca@2176
   859
    "for each element in the selection, evaluate the argument, aBlock
ca@2176
   860
     and return a new collection with the results
ca@2176
   861
    "
ca@2176
   862
    |res|
ca@2176
   863
ca@2176
   864
    res := OrderedCollection new.
ca@2176
   865
    self do:[:el| res add:(aBlock value:el)].
ca@2176
   866
  ^ res
ca@2176
   867
!
ca@2176
   868
ca@2176
   869
do:aOneArgBlock
ca@2176
   870
    "evaluate the argument, aBlock for each item in the selection
ca@2176
   871
    "
ca@2176
   872
    |cashedSelection|
ca@2176
   873
ca@2176
   874
    cashedSelection := selection.
ca@2176
   875
    cashedSelection isNil ifTrue:[^ nil].
ca@2176
   876
  ^ cashedSelection do:aOneArgBlock
ca@2176
   877
!
ca@2176
   878
ca@2176
   879
from:start do:aOneArgBlock
ca@2176
   880
    "evaluate the argument, aBlock for the items starting at index start
ca@2176
   881
    "
ca@2176
   882
    |cashedSelection|
ca@2176
   883
ca@2176
   884
    cashedSelection := selection.
ca@2176
   885
    cashedSelection isNil ifTrue:[^ nil].
ca@2176
   886
  ^ cashedSelection from:start do:aOneArgBlock
ca@2176
   887
!
ca@2176
   888
ca@2176
   889
from:start to:stop do:aOneArgBlock
ca@2176
   890
    "evaluate the argument, aBlock for the items with index start to
ca@2176
   891
     stop in the selection.
ca@2176
   892
    "
ca@2176
   893
    |cashedSelection|
ca@2176
   894
ca@2176
   895
    cashedSelection := selection.
ca@2176
   896
    cashedSelection isNil ifTrue:[^ nil].
ca@2176
   897
  ^ cashedSelection from:start to:stop do:aOneArgBlock
ca@2176
   898
!
ca@2176
   899
ca@2176
   900
reverseDo:aOneArgBlock
ca@2176
   901
    "evaluate the argument, aBlock for each item in the selection
ca@2176
   902
    "
ca@2176
   903
    |cashedSelection|
ca@2176
   904
ca@2176
   905
    cashedSelection := selection.
ca@2176
   906
    cashedSelection isNil ifTrue:[^ nil].
ca@2176
   907
  ^ cashedSelection reverseDo:aOneArgBlock
ca@2176
   908
!
ca@2176
   909
ca@2176
   910
select:aBlock
ca@2176
   911
    "return a new collection with all elements from the selection, for which
ca@2176
   912
     the argument aBlock evaluates to true.
ca@2176
   913
    "
ca@2176
   914
    |res|
ca@2176
   915
ca@2176
   916
    res := OrderedCollection new.
ca@2176
   917
    self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
ca@2176
   918
  ^ res
ca@2176
   919
! !
ca@2176
   920
ca@2176
   921
!ViewTreeModel methodsFor:'selection protocol'!
ca@2176
   922
ca@2176
   923
changed:aParameter with:oldSelection
ca@2176
   924
    "update the visibility staus of the current selection
ca@2176
   925
    "
ca@2176
   926
    |unselected rootView rootItem selSize|
ca@2176
   927
ca@2176
   928
    selSize := selection size.
ca@2176
   929
ca@2176
   930
    selSize == 0 ifTrue:[
ca@2176
   931
        selectedSuperItems := #().
ca@2176
   932
    ] ifFalse:[
ca@2176
   933
        selSize == 1 ifTrue:[
ca@2176
   934
            selectedSuperItems := Array with:(selection at:1).
ca@2176
   935
        ] ifFalse:[
ca@2176
   936
            rootItem := listOfItems root.
ca@2176
   937
ca@2176
   938
            (selection includesIdentical:rootItem) ifTrue:[
ca@2176
   939
                selectedSuperItems := Array with:rootItem.
ca@2176
   940
            ] ifFalse:[
ca@2176
   941
                selectedSuperItems := OrderedCollection new:selSize.
ca@2176
   942
ca@2176
   943
                selection do:[:anItem|
ca@2176
   944
                    anItem parentsDetect:[:el| selection includesIdentical:el ]
ca@2176
   945
                                  ifNone:[ selectedSuperItems add:anItem ].
ca@2176
   946
                ].
ca@2176
   947
            ]
ca@2176
   948
        ]
ca@2176
   949
    ].
ca@2176
   950
ca@2176
   951
    (     hiddenLevel == 0
ca@2176
   952
     and:[(rootView := listOfItems rootView) notNil
ca@2176
   953
     and:[rootView shown]]
ca@2176
   954
    ) ifTrue:[
ca@2176
   955
        selSize == 0 ifTrue:[
ca@2176
   956
            "/ must redraw the old selection unselected
ca@2176
   957
            self redrawUnselected:oldSelection andLock:false
ca@2176
   958
        ] ifFalse:[
ca@2176
   959
            self invalidateSelection.
ca@2176
   960
ca@2176
   961
            oldSelection size ~~ 0 ifTrue:[
ca@2176
   962
                "/ must redraw all elements no longer in the selection
ca@2176
   963
                unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
ca@2176
   964
                self redrawUnselected:unselected andLock:false.
ca@2176
   965
            ]
ca@2176
   966
        ]
ca@2176
   967
    ].
ca@2176
   968
    super changed:aParameter with:oldSelection.
ca@2176
   969
!
ca@2176
   970
ca@2176
   971
setValue:aNewSelection 
ca@2176
   972
    "set the selection without notifying
ca@2176
   973
    "
ca@2176
   974
    |newSelect idx|
ca@2176
   975
ca@2176
   976
    newSelect := nil.
ca@2176
   977
ca@2176
   978
    aNewSelection notNil ifTrue:[
ca@2176
   979
        lockSema critical:[
ca@2176
   980
            aNewSelection isCollection ifFalse:[
ca@2176
   981
                (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
ca@2176
   982
                    newSelect := selection
ca@2176
   983
                ] ifFalse:[
ca@2176
   984
                    newSelect := Array with:aNewSelection.
ca@2176
   985
                ]
ca@2176
   986
            ] ifTrue:[
ca@2176
   987
                aNewSelection notEmpty ifTrue:[
ca@2176
   988
                    aNewSelection size ~~ selection size ifTrue:[
ca@2176
   989
                        newSelect := aNewSelection copy.
ca@2176
   990
                    ] ifFalse:[
ca@2176
   991
                        idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
ca@2176
   992
ca@2176
   993
                        idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
ca@2176
   994
                                ifFalse:[newSelect := selection ].
ca@2176
   995
                    ]
ca@2176
   996
                ]
ca@2176
   997
            ]
ca@2176
   998
        ].
ca@2176
   999
    ].
ca@2176
  1000
    newSelect ~~ selection ifTrue:[
ca@2176
  1001
        beforeSelectionChangedAction value.
ca@2176
  1002
        selection := newSelect.
ca@2176
  1003
        selection notNil ifTrue:[selection do:[:el| el makeVisible]]
ca@2176
  1004
    ].
ca@2176
  1005
!
ca@2176
  1006
ca@2176
  1007
triggerValue:aValue
ca@2176
  1008
    "set my value & send change notifications to my dependents.
ca@2176
  1009
     Send the change message even if the value didn't change.
ca@2176
  1010
    "
ca@2176
  1011
    |oldSelection|
ca@2176
  1012
ca@2176
  1013
    lockSema critical:[
ca@2176
  1014
        oldSelection := selection.
ca@2176
  1015
        self setValue:aValue.
ca@2176
  1016
        self changed:#value with:oldSelection
ca@2176
  1017
    ]
ca@2176
  1018
!
ca@2176
  1019
ca@2176
  1020
value
ca@2176
  1021
    "returns the current selection
ca@2176
  1022
    "
ca@2176
  1023
    ^ selection ? #()
ca@2176
  1024
!
ca@2176
  1025
ca@2176
  1026
value:aValue
ca@2176
  1027
    "change the current selection and send change notifications to my
ca@2176
  1028
     dependents if it changed.
ca@2176
  1029
    "
ca@2176
  1030
    |oldSelection|
ca@2176
  1031
ca@2176
  1032
    lockSema critical:[
ca@2176
  1033
        oldSelection := selection.
ca@2176
  1034
        self setValue:aValue.
ca@2176
  1035
ca@2176
  1036
        oldSelection == selection ifFalse:[
ca@2176
  1037
            self changed:#value with:oldSelection
ca@2176
  1038
        ]
ca@2176
  1039
    ].
ca@2176
  1040
! !
ca@2176
  1041
ca@2176
  1042
!ViewTreeModel methodsFor:'selection searching'!
ca@2176
  1043
ca@2176
  1044
detect:aBlock
ca@2176
  1045
    "evaluate the argument, aBlock for each item in the selection until
ca@2176
  1046
     the block returns true; in this case return the element which caused
ca@2176
  1047
     the true evaluation.
ca@2176
  1048
     If none of the evaluations returns true, an error is raised
ca@2176
  1049
    "
ca@2176
  1050
    ^ self detect:aBlock ifNone:[self errorNotFound]
ca@2176
  1051
!
ca@2176
  1052
ca@2176
  1053
detect:aBlock ifNone:exceptionBlock
ca@2176
  1054
    "evaluate the argument, aBlock for each item in the selection until the
ca@2176
  1055
     block returns true; in this case return the element which caused the
ca@2176
  1056
     true evaluation.
ca@2176
  1057
     If none of the evaluations returns true, the result of the evaluation
ca@2176
  1058
     of the exceptionBlock is returned
ca@2176
  1059
    "
ca@2176
  1060
    |cashedSelection|
ca@2176
  1061
ca@2176
  1062
    cashedSelection := selection.
ca@2176
  1063
    cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
ca@2176
  1064
  ^ cashedSelection detect:aBlock ifNone:exceptionBlock
ca@2176
  1065
!
ca@2176
  1066
ca@2176
  1067
detectLast:aBlock
ca@2176
  1068
    "evaluate the argument, aBlock for each item in the selection until
ca@2176
  1069
     the block returns true; in this case return the element which caused
ca@2176
  1070
     the true evaluation. The items are processed in reverse order.
ca@2176
  1071
     If none of the evaluations returns true, an error is raised
ca@2176
  1072
    "
ca@2176
  1073
    ^ self detectLast:aBlock ifNone:[self errorNotFound]
ca@2176
  1074
!
ca@2176
  1075
ca@2176
  1076
detectLast:aBlock ifNone:exceptionBlock
ca@2176
  1077
    "evaluate the argument, aBlock for each item in the selection until
ca@2176
  1078
     the block returns true; in this case return the element which caused
ca@2176
  1079
     the true evaluation. The items are processed in reverse order.
ca@2176
  1080
     If none of the evaluations returns true, the result of the evaluation
ca@2176
  1081
     of the exceptionBlock is returned
ca@2176
  1082
    "
ca@2176
  1083
    |cashedSelection|
ca@2176
  1084
ca@2176
  1085
    cashedSelection := selection.
ca@2176
  1086
    cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
ca@2176
  1087
  ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
ca@2176
  1088
! !
ca@2176
  1089
ca@2176
  1090
!ViewTreeModel methodsFor:'selection testing'!
ca@2176
  1091
ca@2176
  1092
includes:anItem
ca@2176
  1093
    "returns true if the item is in the current selection
ca@2176
  1094
    "
ca@2176
  1095
    |cashedSelection|
ca@2176
  1096
ca@2176
  1097
    cashedSelection := selection.
ca@2176
  1098
    cashedSelection isNil ifTrue:[^ false].
ca@2176
  1099
 ^  cashedSelection includesIdentical:anItem
ca@2176
  1100
!
ca@2176
  1101
ca@2176
  1102
includesAll:aCollection
ca@2176
  1103
    "return true, if all items of the collection are included in the current selection
ca@2176
  1104
    "
ca@2176
  1105
    |cashedSelection|
ca@2176
  1106
ca@2176
  1107
    aCollection size ~~ 0 ifTrue:[
ca@2176
  1108
        cashedSelection := selection.
ca@2176
  1109
        cashedSelection isNil ifTrue:[ ^ false ].
ca@2176
  1110
ca@2176
  1111
        aCollection do:[:el|
ca@2176
  1112
            (cashedSelection includesIdentical:el) ifFalse:[^ false]
ca@2176
  1113
        ]
ca@2176
  1114
    ].
ca@2176
  1115
    ^ true
ca@2176
  1116
!
ca@2176
  1117
ca@2176
  1118
includesAny:aCollection
ca@2176
  1119
    "return true, if the any item of the collection is in the current selection
ca@2176
  1120
    "
ca@2176
  1121
    |cashedSelection|
ca@2176
  1122
ca@2176
  1123
    aCollection notNil ifTrue:[
ca@2176
  1124
        cashedSelection := selection.
ca@2176
  1125
ca@2176
  1126
        cashedSelection notNil ifTrue:[
ca@2176
  1127
            aCollection do:[:el|
ca@2176
  1128
                (cashedSelection includesIdentical:el) ifTrue:[^ true]
ca@2176
  1129
            ]
ca@2176
  1130
        ]
ca@2176
  1131
    ].
ca@2176
  1132
    ^ false
ca@2176
  1133
!
ca@2176
  1134
ca@2176
  1135
includesIdentical:anItem
ca@2176
  1136
    "returns true if the item is in the current selection
ca@2176
  1137
    "
ca@2176
  1138
    ^ self includes:anItem
ca@2176
  1139
!
ca@2176
  1140
ca@2176
  1141
isEmpty
ca@2176
  1142
    "returns true if the current selection is empty
ca@2176
  1143
    "
ca@2176
  1144
    ^ selection size == 0
ca@2176
  1145
!
ca@2176
  1146
ca@2176
  1147
isSelected:anItem
ca@2176
  1148
    "returns true if the item is in the current selection
ca@2176
  1149
    "
ca@2176
  1150
    ^ self includes:anItem
ca@2176
  1151
!
ca@2176
  1152
ca@2176
  1153
notEmpty
ca@2176
  1154
    "returns true if the current selection is not empty
ca@2176
  1155
    "
ca@2176
  1156
    ^ selection size ~~ 0
ca@2176
  1157
! !
ca@2176
  1158
ca@2176
  1159
!ViewTreeModel::ItemList class methodsFor:'documentation'!
ca@2176
  1160
ca@2176
  1161
documentation
ca@2176
  1162
"
ca@2176
  1163
    Kind of HierarchicalList class which contains all the visible
ca@2176
  1164
    ViewTreeItem's and the root, the anchor of the hierarchical list.
ca@2176
  1165
ca@2176
  1166
    [Instance variables:]
ca@2176
  1167
        treeModel       <ViewTreeModel>         all events are delegated to
ca@2176
  1168
        eventHook       <BlockValue>            save and resore the pre/post -EventHook
ca@2176
  1169
ca@2176
  1170
ca@2176
  1171
    [author:]
ca@2176
  1172
        Claus Atzkern
ca@2176
  1173
ca@2176
  1174
    [see also:]
ca@2176
  1175
        HierarchicalList
ca@2176
  1176
        ViewTreeModel
ca@2176
  1177
        ViewTreeItem
ca@2176
  1178
"
ca@2176
  1179
! !
ca@2176
  1180
ca@2176
  1181
!ViewTreeModel::ItemList methodsFor:'accessing'!
ca@2176
  1182
ca@2176
  1183
root:theRoot
ca@2176
  1184
    "set the root item; delegate events to my treeModel
ca@2176
  1185
    "
ca@2176
  1186
    |rootView|
ca@2176
  1187
ca@2176
  1188
    theRoot == root ifTrue:[^ self].
ca@2176
  1189
ca@2176
  1190
    rootView := self rootView.
ca@2176
  1191
    super root:theRoot.
ca@2176
  1192
ca@2176
  1193
    rootView notNil ifTrue:[ |wgrp|
ca@2176
  1194
        wgrp := rootView windowGroup.
ca@2176
  1195
ca@2176
  1196
        wgrp notNil ifTrue:[
ca@2176
  1197
           wgrp removePreEventHook:treeModel.
ca@2176
  1198
           wgrp removePostEventHook:self.
ca@2176
  1199
        ].
ca@2176
  1200
    ].
ca@2176
  1201
ca@2176
  1202
    super root:theRoot.
ca@2176
  1203
    rootView := self rootView.
ca@2176
  1204
ca@2176
  1205
    rootView notNil ifTrue:[
ca@2176
  1206
        "must setup a task because there might not exist a windowGroup at the moment
ca@2176
  1207
        "
ca@2176
  1208
        [   |wgrp|
ca@2176
  1209
ca@2176
  1210
            [rootView == self rootView] whileTrue:[
ca@2176
  1211
                wgrp := rootView windowGroup.
ca@2176
  1212
                wgrp notNil ifTrue:[
ca@2176
  1213
                    rootView := nil.
ca@2176
  1214
                    wgrp addPreEventHook:treeModel.
ca@2176
  1215
                    wgrp addPostEventHook:self.
ca@2176
  1216
                ] ifFalse:[
ca@2176
  1217
                    Delay waitForMilliseconds:100.
ca@2176
  1218
                ].
ca@2176
  1219
            ].
ca@2176
  1220
ca@2176
  1221
        ] forkAt:(Processor userSchedulingPriority + 2).
ca@2176
  1222
    ].
ca@2457
  1223
    treeModel notNil ifTrue:[
ca@2457
  1224
        treeModel targetWidgetChanged.
ca@2457
  1225
    ].
ca@2457
  1226
    
ca@2176
  1227
    ^ root.
ca@2176
  1228
!
ca@2176
  1229
ca@2176
  1230
rootView
ca@2176
  1231
    "returns the widget assigned to the root or nil
ca@2176
  1232
    "
ca@2176
  1233
    ^ root notNil ifTrue:[root widget] ifFalse:[nil]
ca@2176
  1234
!
ca@2176
  1235
ca@2176
  1236
treeModel
ca@2176
  1237
    "returne the treeModel, a ViewTreeModel
ca@2176
  1238
    "
ca@2176
  1239
    ^ treeModel
ca@2176
  1240
! !
ca@2176
  1241
ca@2453
  1242
!ViewTreeModel::ItemList methodsFor:'accessing look'!
ca@2453
  1243
ca@2453
  1244
additionalLabelForItem:anItem
ca@2453
  1245
    "answer the additional lable for an item or nil"
ca@2453
  1246
ca@2453
  1247
    |applClass|
ca@2453
  1248
ca@2453
  1249
    showWidgetNames == true ifTrue:[
ca@2453
  1250
        ^ '[', anItem widget name, ']'
ca@2453
  1251
    ].
ca@2453
  1252
ca@2453
  1253
    anItem isApplicationClass ifTrue:[
ca@2453
  1254
        applClass := anItem applicationClass.
ca@2453
  1255
ca@2453
  1256
        applClass notNil ifTrue:[
ca@2453
  1257
            ^ ('[', applClass name, ']')
ca@2453
  1258
        ].
ca@2453
  1259
    ].
ca@2453
  1260
    ^ nil
ca@2453
  1261
!
ca@2453
  1262
ca@2453
  1263
showWidgetNames
ca@2453
  1264
    "answer true if the additional text is the widget name
ca@2453
  1265
     otherwise the name of the application"
ca@2453
  1266
ca@2453
  1267
    ^ showWidgetNames ? false
ca@2453
  1268
!
ca@2453
  1269
ca@2453
  1270
showWidgetNames:aBoolean
ca@2453
  1271
    "set true if the additional text is the widget name
ca@2453
  1272
     otherwise the name of the application"
ca@2453
  1273
ca@2453
  1274
    self showWidgetNames == aBoolean ifFalse:[
ca@2453
  1275
        showWidgetNames := aBoolean.
ca@2453
  1276
ca@2453
  1277
        root notNil ifTrue:[
ca@2453
  1278
            root recursiveAdditionalNameBehaviourChanged.
ca@2453
  1279
            self changed.
ca@2453
  1280
        ].
ca@2453
  1281
    ].
ca@2453
  1282
! !
ca@2453
  1283
ca@2176
  1284
!ViewTreeModel::ItemList methodsFor:'event processing'!
ca@2176
  1285
ca@2176
  1286
processEvent:anEvent
ca@2176
  1287
    "post process event
ca@2176
  1288
    "
ca@2457
  1289
    ^ treeModel isInTestMode not
ca@2176
  1290
! !
ca@2176
  1291
ca@2176
  1292
!ViewTreeModel::ItemList methodsFor:'instance creation'!
ca@2176
  1293
ca@2176
  1294
on:aModel
ca@2176
  1295
    "set the model, a ViewTreeModel
ca@2176
  1296
    "
ca@2176
  1297
    treeModel := aModel.
ca@2176
  1298
    showRoot  := true.
ca@2453
  1299
    showWidgetNames := false.
ca@2176
  1300
! !
ca@2176
  1301
ca@2176
  1302
!ViewTreeModel::ItemList methodsFor:'searching'!
ca@2176
  1303
ca@2176
  1304
detectItemRespondsToView:aView
ca@2176
  1305
    "returns the bottom-most item which contains the view
ca@2176
  1306
    "
ca@2176
  1307
    |view item topView|
ca@2176
  1308
ca@2176
  1309
    root notNil ifTrue:[
ca@2176
  1310
        view    := aView.
ca@2176
  1311
        topView := root widget.
ca@2176
  1312
ca@2176
  1313
        [ view notNil ] whileTrue:[
ca@2176
  1314
            topView == view ifTrue:[^ root].
ca@2176
  1315
            item := root recursiveDetect:[:el| el widget == view ].
ca@2176
  1316
            item notNil ifTrue:[^ item].
ca@2176
  1317
            view := view superView
ca@2176
  1318
        ]
ca@2176
  1319
    ].
ca@2176
  1320
    ^ nil
ca@2176
  1321
!
ca@2176
  1322
ca@2176
  1323
recursiveDetect:aOneOrgBlock
ca@2176
  1324
    "recursive find the first child, for which evaluation 
ca@2176
  1325
     of the block returns true; if none nil is returned
ca@2176
  1326
    "
ca@2176
  1327
    root notNil ifTrue:[
ca@2176
  1328
        (aOneOrgBlock value:root) ifTrue:[ ^ root ].
ca@2176
  1329
      ^ root recursiveDetect:aOneOrgBlock
ca@2176
  1330
    ].
ca@2176
  1331
    ^ nil
ca@2176
  1332
! !
ca@2176
  1333
ca@2176
  1334
!ViewTreeModel class methodsFor:'documentation'!
ca@2176
  1335
ca@2176
  1336
version
ca@2176
  1337
    ^ '$Header$'
ca@2176
  1338
! !