HierarchicalItem.st
author Claus Gittinger <cg@exept.de>
Wed, 05 Oct 2005 14:14:10 +0200
changeset 2851 fa192ee81bb5
parent 2847 5f35597d2d49
child 2853 e852742cbd10
permissions -rw-r--r--
code cleanup
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1431
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     1
"
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     2
 COPYRIGHT (c) 1999 by eXept Software AG
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     3
              All Rights Reserved
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     4
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     5
 This software is furnished under a license and may be used
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     6
 only in accordance with the terms of that license and with the
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     8
 be provided or otherwise made available to, or used by, any
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
     9
 other person.  No title to or ownership of the software is
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    10
 hereby transferred.
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    11
"
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    12
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    13
1794
029df2e76784 *** empty log message ***
ca
parents: 1733
diff changeset
    14
"{ Package: 'stx:libwidg2' }"
029df2e76784 *** empty log message ***
ca
parents: 1733
diff changeset
    15
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
Object subclass:#HierarchicalItem
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
    17
	instanceVariableNames:'parent children isExpanded height width'
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	classVariableNames:''
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	poolDictionaries:''
1430
ae9e48cc7b9d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1409
diff changeset
    20
	category:'Views-Support'
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
HierarchicalItem subclass:#Example
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
	instanceVariableNames:'label icon'
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
	classVariableNames:'PenguinIcon'
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
	poolDictionaries:''
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
	privateIn:HierarchicalItem
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
!HierarchicalItem class methodsFor:'documentation'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
1431
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    32
copyright
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    33
"
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    34
 COPYRIGHT (c) 1999 by eXept Software AG
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    35
              All Rights Reserved
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    36
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    37
 This software is furnished under a license and may be used
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    38
 only in accordance with the terms of that license and with the
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    39
 inclusion of the above copyright notice.   This software may not
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    40
 be provided or otherwise made available to, or used by, any
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    41
 other person.  No title to or ownership of the software is
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    42
 hereby transferred.
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    43
"
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    44
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    45
!
0cc20a8f2f7c docu & copyright
Claus Gittinger <cg@exept.de>
parents: 1430
diff changeset
    46
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
documentation
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
"
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
    Hierarchical Items are mostly like Models, but the list of
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
    dependencies are kept by its HierarchicalList.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
    The class is used to build up hierarchical trees.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    52
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    53
    [Instance variables:]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    54
        parent      <Item, List or nil>         parent or my HierarchicalList.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    55
        children    <Collection or nil>         list of children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    56
        isExpanded  <Boolean>                   indicates whether the item is
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    57
                                                expanded or collapsed
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    58
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    59
    [author:]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    60
        Claus Atzkern
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    61
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    62
    [see also:]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
        HierarchicalList
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
        HierarchicalListView
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
"
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    66
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    69
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    70
!HierarchicalItem class methodsFor:'instance creation'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    71
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    72
new
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    73
    ^ (self basicNew) initialize
2314
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    74
!
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    75
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    76
parent:aParent
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    77
    |item|
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    78
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    79
    item := self new.
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    80
    item parent:aParent.
3cd113583526 *** empty log message ***
ca
parents: 2313
diff changeset
    81
  ^ item
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    84
!HierarchicalItem class methodsFor:'protocol'!
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    85
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    86
doResetExtentOnChange
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    87
    "true: the extent of the item is reset if a change
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    88
     notification is raised from the item. the default is true
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    89
    "
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    90
    ^ true
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    91
! !
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    92
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
!HierarchicalItem methodsFor:'accessing'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    94
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    95
getChildren
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    96
    "returns the children at it is; not going to the model ...
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    97
    "
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    98
    ^ children
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
    99
!
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   100
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
level
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
    "returns the level starting with 1
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
    "
2386
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   104
    |item level|
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   105
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   106
    "/ for optimization we try to suppress a block
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   107
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   108
    item  := self.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   109
2386
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   110
    (item := item parentOrModel) isNil ifTrue:[^ 0].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   111
    (item := item parentOrModel) isNil ifTrue:[^ 1].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   112
    (item := item parentOrModel) isNil ifTrue:[^ 2].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   113
    (item := item parentOrModel) isNil ifTrue:[^ 3].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   114
    (item := item parentOrModel) isNil ifTrue:[^ 4].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   115
    (item := item parentOrModel) isNil ifTrue:[^ 5].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   116
    (item := item parentOrModel) isNil ifTrue:[^ 6].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   117
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   118
    level := 7.
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   119
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   120
    [(item := item parentOrModel) notNil] whileTrue:[
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
        level := level + 1
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
    ^ level
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
parent
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
    "returns the parent or nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    ^ (parent notNil and:[parent isHierarchicalItem]) ifTrue:[parent]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
                                                     ifFalse:[nil]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
parent:aParent
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
    "set the parent (or the model if the item is the root item)
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
    parent := aParent
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
1883
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   138
!
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   139
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   140
rootItem
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   141
    "returns the root item
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   142
    "
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   143
    parent isHierarchicalItem ifTrue:[
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   144
        ^ parent rootItem
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   145
    ].
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
   146
    ^ self
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
1818
fe99c5c721e9 category changes
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   149
!HierarchicalItem methodsFor:'accessing-children'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
at:anIndex
1900
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   152
    "return the child at anIndex if valid;
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   153
     if the index is invalid, nil is returned
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
    "
1900
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   155
    ^ self at:anIndex ifAbsent:nil
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   156
!
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   157
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   158
at:anIndex ifAbsent:exceptionBlock
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   159
    "return the child at anIndex if valid; if the index is
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   160
     invalid, the result of evaluating the exceptionBlock is returned.
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   161
    "
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   162
    |list|
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   163
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   164
    (list := self children) notNil ifTrue:[
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   165
        ^ list at:anIndex ifAbsent:exceptionBlock
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   166
    ].
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   167
    ^ exceptionBlock value
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
at:anIndex put:anItem
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
    "replace a child by a new item
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
    "
2340
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   173
    |children oldItem visIndex model expFlag|
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
    anItem isNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
        ^ self removeFromIndex:anIndex toIndex:anIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
    ].
2340
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   178
    anItem parent:self.
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   179
2340
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   180
    (model := self model) isNil ifTrue:[
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   181
        ^ self children at:anIndex put:anItem
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   182
    ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   183
2340
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   184
    model criticalDo:[
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   185
        children := self children.
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   186
        oldItem  := children at:anIndex.
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   187
2340
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   188
        oldItem isExpanded ifTrue:[
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   189
            oldItem collapse
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   190
        ].
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   191
        visIndex := model identityIndexOf:oldItem.
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   192
        expFlag  := anItem isExpanded.
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   193
        anItem setExpanded:false.
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   194
2340
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   195
        children at:anIndex put:anItem.
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   196
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   197
        visIndex ~~ 0 ifTrue:[
2343
bf4bdedf0fa7 bugfix in: #at:put:
ca
parents: 2340
diff changeset
   198
            model at:visIndex put:anItem.
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   199
        ].
2340
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   200
        self changed:#redraw.
2226773397c4 bugfix in: #at:put:
ca
parents: 2315
diff changeset
   201
        expFlag ifTrue:[ anItem expand ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
    ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   203
    ^ anItem
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
children:aListOfChildren
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
    "set a new list of children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   208
    "
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   209
    self criticalDo:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   210
        self removeAll.
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   211
        self addAll:aListOfChildren beforeIndex:1
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   212
    ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   213
    ^ aListOfChildren
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
first
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
    "returns the first child
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
    ^ self at:1
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
last
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
    "returns the last child
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   225
    ^ self at:(self size)
1900
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   226
!
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   227
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   228
second
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   229
    "returns the second child
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   230
    "
27372ea0db5f implement #at:ifAbsent:
ca
parents: 1899
diff changeset
   231
    ^ self at:2
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
1818
fe99c5c721e9 category changes
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   234
!HierarchicalItem methodsFor:'accessing-hierarchy'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
collapse
2549
fb6d594099b2 checkin from browser
Stefan Vogel <sv@exept.de>
parents: 2547
diff changeset
   237
    "hide all my subitems"
fb6d594099b2 checkin from browser
Stefan Vogel <sv@exept.de>
parents: 2547
diff changeset
   238
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   239
    |visChd index|
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
    self canCollapse ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
        isExpanded := false.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   244
        self criticalDo:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   245
            (index := self listIndex) notNil ifTrue:[
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   246
                "/ do not call :#size: children will be autoloaded !!!!
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   247
                (visChd := children size) ~~ 0 ifTrue:[
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   248
                    self nonCriticalFrom:1 to:nil do:[:el|
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   249
                        visChd := visChd + el numberOfVisibleChildren
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   250
                    ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   251
                    self model itemRemoveFromIndex:(index + 1) toIndex:(index + visChd).
2201
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
   252
                ].
2549
fb6d594099b2 checkin from browser
Stefan Vogel <sv@exept.de>
parents: 2547
diff changeset
   253
                index ~~ 0 ifTrue:[self hierarchyChanged].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
            ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
        ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
    ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
2476
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   259
enforcedExpand
2724
519a2190bf15 *** empty log message ***
martin
parents: 2716
diff changeset
   260
    "expand children - even if there are no children,
2476
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   261
     the item is initially expanded (but this might be undone later,
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   262
     when we know that no children are there"
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   263
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   264
    self expand:true
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   265
!
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   266
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
expand
2476
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   268
    "expand children - but only if there are children 
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   269
     (i.e. this cannot be used before the childInfo is valid;
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   270
      aka not before the updateTask came along this item)"
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   271
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   272
    self expand:false
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   273
!
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   274
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   275
expand:enforced
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   276
    "expand children"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   277
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   278
    |index list|
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   279
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   280
    "/ test whether the item already is expanded; #canExpand could be redefined
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   281
    "/ without checking whether the node is expanded (happens already) !!
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   282
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   283
    isExpanded ifTrue:[ ^ self ].
2724
519a2190bf15 *** empty log message ***
martin
parents: 2716
diff changeset
   284
    (enforced not and:[self canExpand not]) ifTrue:[ ^ self ].
1942
cf35cdb2395e bug-fixes if lazy children creation
martin
parents: 1900
diff changeset
   285
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   286
    self criticalDo:[
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   287
        (index := self listIndex) notNil ifTrue:[
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   288
            "/ must set expand-flag to false, otherwise change notifications
2476
298ad746e52f added enforcedExpand;
Claus Gittinger <cg@exept.de>
parents: 2465
diff changeset
   289
            "/ are raised during lazy auto creation (to the list).
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   290
            isExpanded := false.
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   291
            list := self children.
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   292
            isExpanded := true.
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   293
2832
e1f6a7c48552 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   294
            list notEmptyOrNil ifTrue:[
e1f6a7c48552 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   295
                list := OrderedCollection new:64.
e1f6a7c48552 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   296
                self addVisibleChildrenTo:list.
e1f6a7c48552 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
   297
                self model itemAddAll:list beforeIndex:(index + 1).
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   298
            ].
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   299
            index ~~ 0 ifTrue:[self hierarchyChanged].
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   300
        ] ifFalse:[
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   301
            isExpanded := true
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
        ]
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   303
    ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
1409
e46f8d30a9c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1398
diff changeset
   306
makeVisible
e46f8d30a9c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1398
diff changeset
   307
    "expand all my parents
e46f8d30a9c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1398
diff changeset
   308
    "
e46f8d30a9c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1398
diff changeset
   309
    (parent notNil and:[parent isHierarchicalItem]) ifTrue:[
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   310
        self criticalDo:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   311
            parent expand.
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   312
            parent makeVisible
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   313
        ]
1409
e46f8d30a9c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1398
diff changeset
   314
    ].
e46f8d30a9c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1398
diff changeset
   315
!
e46f8d30a9c9 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1398
diff changeset
   316
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   317
recursiveCollapse
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   318
    "collapse all item and sub items
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   319
     **** must be expanded
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   320
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   321
    |visChd index|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   322
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   323
    self canCollapse ifTrue:[
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   324
        self criticalDo:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   325
            (index := self listIndex) notNil ifTrue:[
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   326
                "/ do not call :#size: children will be autoloaded !!!!
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   327
                (visChd := children size) ~~ 0 ifTrue:[
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   328
                    self nonCriticalFrom:1 to:nil do:[:el|
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   329
                        visChd := visChd + el numberOfVisibleChildren
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   330
                    ].
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   331
                ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   332
                self recursiveSetCollapsed.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   333
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   334
                visChd ~~ 0 ifTrue:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   335
                    self model itemRemoveFromIndex:(index + 1)
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   336
                                           toIndex:(index + visChd)
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   337
                ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   338
                index ~~ 0 ifTrue:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   339
                    self hierarchyChanged
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   340
                ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   341
            ] ifFalse:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   342
                self recursiveSetCollapsed
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   343
            ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   344
        ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   345
    ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   346
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   347
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   348
recursiveExpand
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   349
    "expand children and sub-children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   350
     **** must be collapsed
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   351
    "
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   352
    "/ test whether the item already is expanded; #canExpand could be redefined
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   353
    "/ without checking whether the node is expanded (happens already) !!
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   354
2846
17a1d1db69dd remove recursiveForceExpand -> make no sense
ab
parents: 2845
diff changeset
   355
    |index list|
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   356
    isExpanded ifTrue:[ ^ self ].
2845
fb807c9aa195 Add recursive force expand, to force expand of children independed
ab
parents: 2832
diff changeset
   357
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   358
    self canExpand ifFalse:[ ^ self ].
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   359
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   360
    isExpanded := true.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   361
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   362
    self criticalDo:[
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   363
        self size ~~ 0 ifTrue:[
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   364
            index := self listIndex.    "/ get the visible list index
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   365
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   366
            index isNil ifTrue:[        "/ not visible
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   367
                self nonCriticalFrom:1 to:nil do:[:el|
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   368
                    el setExpanded:true
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   369
                ].
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   370
            ] ifFalse:[
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   371
                list := OrderedCollection new:512.
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   372
                self recursiveSetExpandedAndAddToList:list.
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   373
                self model itemAddAll:list beforeIndex:(index + 1).
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   374
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   375
                index ~~ 0 ifTrue:[self hierarchyChanged]
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   376
            ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   377
        ]
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   378
    ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   379
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   380
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   381
recursiveToggleExpand
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   382
    "if the item is collapsed, the item and all its sub-items
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   383
     are expanded otherwise collapsed"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   384
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   385
    isExpanded ifTrue:[
1598
33202082065d care for uninitialized isExpanded
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   386
        self recursiveCollapse
33202082065d care for uninitialized isExpanded
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   387
    ] ifFalse:[
33202082065d care for uninitialized isExpanded
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   388
        self recursiveExpand
33202082065d care for uninitialized isExpanded
Claus Gittinger <cg@exept.de>
parents: 1571
diff changeset
   389
    ]
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   390
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   391
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   392
toggleExpand
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   393
    "if the item is collapsed, the item is expanded otherwise
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   394
     collapsed"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   395
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   396
    isExpanded ifTrue:[
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   397
        self collapse
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   398
    ] ifFalse:[
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   399
        self expand
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   400
    ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   401
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   402
1818
fe99c5c721e9 category changes
Claus Gittinger <cg@exept.de>
parents: 1804
diff changeset
   403
!HierarchicalItem methodsFor:'accessing-mvc'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   404
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   405
application
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   406
    "returns the responsible application or nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   407
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   408
    |model|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   409
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   410
    (model := self model) notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   411
        ^ model application
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   412
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   413
    ^ nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   414
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   415
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   416
applicationsDo:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   417
    "evaluate the block on each dependent application
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   418
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   419
    |model|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   420
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   421
    (model := self model) notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   422
        model applicationsDo:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   423
    ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   424
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   425
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   426
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   427
model
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   428
    "returns the hierachicalList model or nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   429
    "
2386
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   430
    |item next|
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   431
2716
c446689e8021 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2708
diff changeset
   432
    item := self. 
c446689e8021 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2708
diff changeset
   433
    [ (next := item parentOrModel) notNil ] whileTrue:[
c446689e8021 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2708
diff changeset
   434
        item := next.
c446689e8021 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 2708
diff changeset
   435
    ].
2386
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   436
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   437
    item isHierarchicalItem ifFalse:[^ item].
64b2a77c1b57 *** empty log message ***
ca
parents: 2357
diff changeset
   438
    ^ nil
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   439
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   440
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   441
!HierarchicalItem methodsFor:'adding & removing'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   442
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   443
add:aChildItem
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   444
    "add a child at end
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   445
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   446
    ^ self add:aChildItem beforeIndex:(self children size + 1).
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   447
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   448
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   449
add:aChildItem after:aChild
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   450
    "add an item after an existing item
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   451
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   452
    |index|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   453
2315
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   454
    index := self identityIndexOf:aChild.
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
   455
    index == 0 ifTrue:[ self subscriptBoundsError:index ].
2315
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   456
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   457
    self add:aChildItem beforeIndex:(index + 1).
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   458
  ^ aChildItem
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   459
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   460
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   461
add:aChildItem afterIndex:anIndex
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   462
    "add an item after an index
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   463
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   464
    ^ self add:aChildItem beforeIndex:(anIndex + 1).
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   465
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   466
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   467
add:aChildItem before:aChild
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   468
    "add an item before an existing item
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   469
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   470
    |index|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   471
2315
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   472
    index := self identityIndexOf:aChild.
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
   473
    index == 0 ifTrue:[ self subscriptBoundsError:index ].
2315
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   474
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   475
    self add:aChildItem beforeIndex:index.
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   476
  ^ aChild
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   477
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   478
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   479
add:aChildItem beforeIndex:anIndex
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   480
    "add an item before an index
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   481
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   482
    aChildItem notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   483
        self addAll:(Array with:aChildItem) beforeIndex:anIndex
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   484
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   485
    ^ aChildItem
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   486
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   487
1488
370cb752ff54 checkin from browser
tm
parents: 1486
diff changeset
   488
add:aChild sortBlock:aBlock
370cb752ff54 checkin from browser
tm
parents: 1486
diff changeset
   489
    "add a child sorted
370cb752ff54 checkin from browser
tm
parents: 1486
diff changeset
   490
    "
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   491
    self criticalDo:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   492
        self basicAdd:aChild sortBlock:aBlock
1488
370cb752ff54 checkin from browser
tm
parents: 1486
diff changeset
   493
    ].
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   494
    ^ aChild
1488
370cb752ff54 checkin from browser
tm
parents: 1486
diff changeset
   495
!
370cb752ff54 checkin from browser
tm
parents: 1486
diff changeset
   496
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   497
addAll:aList
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   498
    "add children at the end
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   499
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   500
    ^ self addAll:aList beforeIndex:(self children size + 1)
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   501
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   502
1650
9ac3cdd8572d checkin from browser
ps
parents: 1607
diff changeset
   503
addAll:aList before:aChild
9ac3cdd8572d checkin from browser
ps
parents: 1607
diff changeset
   504
    "add an item before an existing item
9ac3cdd8572d checkin from browser
ps
parents: 1607
diff changeset
   505
    "
9ac3cdd8572d checkin from browser
ps
parents: 1607
diff changeset
   506
    |index|
9ac3cdd8572d checkin from browser
ps
parents: 1607
diff changeset
   507
2315
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   508
    index := self identityIndexOf:aChild.
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
   509
    index == 0 ifTrue:[ self subscriptBoundsError:index ].
2315
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   510
d709a664a87c bug fix
ca
parents: 2314
diff changeset
   511
  ^ self addAll:aList beforeIndex:index
1650
9ac3cdd8572d checkin from browser
ps
parents: 1607
diff changeset
   512
!
9ac3cdd8572d checkin from browser
ps
parents: 1607
diff changeset
   513
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   514
addAll:aList beforeIndex:anIndex
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   515
    "add children before an index
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   516
    "
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   517
    aList size ~~ 0 ifTrue:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   518
        self criticalDo:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   519
            self basicAddAll:aList beforeIndex:anIndex
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   520
        ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   521
    ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   522
    ^ aList
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   523
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   524
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   525
addAll:aList sortBlock:aBlock
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   526
    "add children sorted
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   527
    "
2357
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   528
    aList size == 0 ifTrue:[ ^ aList ].
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   529
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   530
    aBlock isNil ifTrue:[
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   531
        self addAll:aList.
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   532
    ] ifFalse:[
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   533
        self criticalDo:[
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   534
            aList do:[:el| self basicAdd:el sortBlock:aBlock ]
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   535
        ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   536
    ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   537
    ^ aList
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   538
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   539
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   540
addAllFirst:aCollectionOfItems
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   541
    "add children at the beginning
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   542
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   543
    ^ self addAll:aCollectionOfItems beforeIndex:1
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   544
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   545
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   546
addAllLast:aCollectionOfItems
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   547
    "add children at the end
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   548
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   549
    ^ self addAll:aCollectionOfItems
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   550
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   551
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   552
addFirst:aChildItem
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   553
    "add a child at begin
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   554
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   555
    ^ self add:aChildItem beforeIndex:1.
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   556
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   557
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   558
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   559
addLast:anItem
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   560
    "add a child at end
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   561
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   562
    ^ self add:anItem
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   563
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   564
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   565
remove
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   566
    "remove the item
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   567
    "
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   568
    parent notNil ifTrue:[                                      "check whether parent exists"
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   569
        parent isHierarchicalItem ifTrue:[parent remove:self]   "parent is HierarchicalItem"
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   570
                                 ifFalse:[parent root:nil]      "parent is HierarchicalList"
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   571
    ].
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   572
    ^ self
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   573
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   574
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   575
remove:aChild
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   576
    "remove a child
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   577
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   578
    self removeIndex:(self identityIndexOf:aChild)
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   579
        
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   580
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   581
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   582
removeAll
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   583
    "remove all children
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   584
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   585
    |size|
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   586
1942
cf35cdb2395e bug-fixes if lazy children creation
martin
parents: 1900
diff changeset
   587
    (size := children size) ~~ 0 ifTrue:[
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   588
        self removeFromIndex:1 toIndex:size
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   589
    ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   590
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   591
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   592
removeAll:aList
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   593
    "remove all children in the collection
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   594
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   595
    |index|
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   596
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   597
    aList size ~~ 0 ifTrue:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   598
        self criticalDo:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   599
            aList do:[:el|
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   600
                (index := self identityIndexOf:el) ~~ 0 ifTrue:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   601
                    self removeIndex:index
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   602
                ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   603
            ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   604
        ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   605
    ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   606
    ^ aList
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   607
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   608
1899
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   609
removeFromIndex:startIndex
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   610
    "remove the children from startIndex up to end of children
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   611
    "
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   612
    ^ self removeFromIndex:startIndex toIndex:(children size)
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   613
!
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   614
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   615
removeFromIndex:startIndex toIndex:stopIndex
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   616
    "remove the children from startIndex up to and including
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   617
     the child under stopIndex.
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   618
    "
1899
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   619
    |noChildren stop|
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   620
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   621
    noChildren := children size.
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   622
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   623
    (startIndex <= stopIndex and:[startIndex <= noChildren]) ifTrue:[
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   624
        stop := stopIndex min:noChildren.
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   625
        
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   626
        self criticalDo:[
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   627
            self basicRemoveFromIndex:startIndex toIndex:stop
d7c9a9dfdbf0 bugfix in: #removeFromIndex:toIndex:
ca
parents: 1883
diff changeset
   628
        ]
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   629
    ].
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   630
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   631
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   632
removeIndex:anIndex
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   633
    "remove the child at an index
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   634
    "
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   635
    anIndex > 0 ifTrue:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   636
        self removeFromIndex:anIndex toIndex:anIndex
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   637
    ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   638
! !
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   639
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   640
!HierarchicalItem methodsFor:'basic adding & removing'!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   641
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   642
basicAdd:aChild sortBlock:aBlock
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   643
    "add a child sorted
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   644
    "
2357
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   645
    |size list|
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   646
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   647
    size := children size.
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   648
    list := Array with:aChild.
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   649
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   650
    (aBlock notNil and:[size ~~ 0]) ifTrue:[
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   651
        children keysAndValuesDo:[:i :el|
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   652
            (aBlock value:aChild value:el) ifTrue:[
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   653
                self basicAddAll:list beforeIndex:i.
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   654
                ^ aChild
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   655
            ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   656
        ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   657
    ].
2357
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   658
    self basicAddAll:list beforeIndex:(size + 1).
3fa40ed08bc6 supress change notifications for: adding sorted
ca
parents: 2343
diff changeset
   659
    ^ aChild.
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   660
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   661
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   662
basicAddAll:aList beforeIndex:anIndex
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   663
    "add children before an index
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   664
    "
1602
00fe8b9b81d6 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1601
diff changeset
   665
    |coll model notify index size|
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   666
1942
cf35cdb2395e bug-fixes if lazy children creation
martin
parents: 1900
diff changeset
   667
    size := children size.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   668
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   669
    anIndex == 1 ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   670
        notify := self
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   671
    ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   672
        anIndex > size ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   673
            anIndex > (1 + size) ifTrue:[
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
   674
                ^ self subscriptBoundsError:index
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   675
            ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   676
            notify := self at:size
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   677
        ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   678
            notify := nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   679
        ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   680
    ].
1669
443680316aac checkin from browser
ca
parents: 1650
diff changeset
   681
    children isArray ifTrue:[
443680316aac checkin from browser
ca
parents: 1650
diff changeset
   682
        children := children asOrderedCollection
443680316aac checkin from browser
ca
parents: 1650
diff changeset
   683
    ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   684
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   685
    size == 0 ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   686
        children := OrderedCollection new
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   687
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   688
    aList do:[:anItem| anItem parent:self ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   689
    children addAll:aList beforeIndex:anIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   690
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   691
    (model := self model) isNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   692
        ^ aList
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   693
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   694
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   695
    isExpanded ifFalse:[
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   696
        notify notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   697
            notify changed
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   698
        ].
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
   699
        ^ aList
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   700
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   701
    (index := self listIndex) isNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   702
        ^ aList
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   703
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   704
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   705
    children from:1 to:(anIndex - 1) do:[:anItem|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   706
        index := 1 + index + anItem numberOfVisibleChildren
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   707
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   708
    coll := OrderedCollection new.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   709
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   710
    aList do:[:anItem|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   711
        coll add:anItem.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   712
        anItem addVisibleChildrenTo:coll.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   713
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   714
    model itemAddAll:coll beforeIndex:(index + 1).
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   715
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   716
    notify notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   717
        notify changed
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   718
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   719
  ^ aList
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   720
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   721
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
   722
basicRemoveFromIndex:startIndex toIndex:stopIndex
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   723
    "remove the children from startIndex up to and including
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   724
     the child under stopIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   725
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   726
    |model notify
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   727
     index "{ Class:SmallInteger }"
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   728
     start "{ Class:SmallInteger }"
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   729
     stop  "{ Class:SmallInteger }"
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   730
     size  "{ Class:SmallInteger }"
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   731
    |
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   732
    size  := self children size.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   733
    stop  := stopIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   734
    start := startIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   735
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   736
    (stop <= size and:[start between:1 and:stop]) ifFalse:[
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
   737
        ^ self subscriptBoundsError:index
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   738
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   739
    start == 1 ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   740
        notify := self
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   741
    ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   742
        stop == size ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   743
            notify := self at:(start - 1)
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   744
        ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   745
            notify := nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   746
        ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   747
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   748
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   749
    (model := self model) notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   750
        index := model identityIndexOf:(children at:start).
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   751
        size  := stop - start + 1.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   752
    ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   753
        index := 0
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   754
    ].
1669
443680316aac checkin from browser
ca
parents: 1650
diff changeset
   755
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   756
    children from:start to:stop do:[:aChild|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   757
        index ~~ 0 ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   758
            size := size + aChild numberOfVisibleChildren
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   759
        ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   760
        aChild parent:nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   761
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   762
    children removeFromIndex:start toIndex:stop.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   763
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   764
    index ~~ 0 ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   765
        model itemRemoveFromIndex:index toIndex:(index + size - 1)
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   766
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   767
    notify notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   768
        notify changed
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   769
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   770
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   771
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   772
!HierarchicalItem methodsFor:'change & update'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   773
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
   774
changed:what with:anArgument
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   775
    "the item changed; raise change notification
1974
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   776
        #icon           icon is modified; hight and width are unchanged
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   777
        #hierarchy      collapsed/expanded; hight and width are unchanged
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   778
        #redraw         redraw but hight and width are unchanged
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   779
        .......         all others the hight and width are reset
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   780
    "
1974
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   781
    |model why|
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   782
1974
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   783
    what ~~ #redraw ifTrue:[
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   784
        (what ~~ #hierarchy and:[what ~~ #icon]) ifTrue:[
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   785
            self class doResetExtentOnChange ifTrue:[
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   786
                width := height := nil
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   787
            ].
1974
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   788
        ].
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   789
        why := what
2230
8e2b53ecd71b *** empty log message ***
ca
parents: 2206
diff changeset
   790
    ] ifFalse:[
8e2b53ecd71b *** empty log message ***
ca
parents: 2206
diff changeset
   791
        why := #redraw
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
   792
    ].
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
   793
    (model := self model) notNil ifTrue:[
1974
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   794
        model itemChanged:why with:anArgument from:self
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   795
    ].
1974
14a0093f86eb checkin from browser
ca
parents: 1966
diff changeset
   796
    super changed:why with:anArgument
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   797
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   798
2193
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   799
childrenOrderChanged
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   800
    "called if the order of the children changed by a user
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   801
     operation. Update the model and raise a change notification for
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   802
     each item which has changed its position
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   803
     triggered by the user operation !!
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   804
    "
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   805
    |model visStart list|
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   806
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   807
    self isExpanded   ifFalse:[ ^ self ].       "/ not expanded
2206
e62f6df90972 *** empty log message ***
ca
parents: 2201
diff changeset
   808
    children size > 1 ifFalse:[ ^ self ].
2193
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   809
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   810
    model := self model.
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   811
    model ifNil:[^ self].                       "/ no model
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   812
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   813
    visStart := model identityIndexOf:self.
2260
fdf2e412a42c #sort: bug fix for root and root set to unvisible
james
parents: 2252
diff changeset
   814
    visStart == 0 ifTrue:[
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   815
        model root ~~ self ifTrue:[ ^ self ].
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
   816
     "/ I'am the root but switched of by setting #showRoot to false
2260
fdf2e412a42c #sort: bug fix for root and root set to unvisible
james
parents: 2252
diff changeset
   817
    ].
2193
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   818
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   819
    self criticalDo:[
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   820
        list := OrderedCollection new.
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   821
        self addVisibleChildrenTo:list.
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   822
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   823
        list do:[:el|
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   824
            visStart := visStart + 1.
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   825
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   826
            (model at:visStart ifAbsent:el) ~~ el ifTrue:[
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   827
                model at:visStart put:el
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   828
            ].
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   829
        ]
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   830
    ].
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   831
!
41d5d33c9f78 add method to synchronize the model with the changed children order
ca
parents: 2117
diff changeset
   832
1843
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   833
fontChanged
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   834
    "called if the font has changed
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   835
    "
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   836
    width := height := nil.
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   837
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   838
    children size ~~ 0 ifTrue:[
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   839
        children do:[:el| el fontChanged ].
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   840
    ].
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   841
!
61595a6b2e37 handle font changed notification
martin
parents: 1831
diff changeset
   842
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   843
hierarchyChanged
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   844
    "hierarchy changed; optimize redrawing
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   845
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   846
    self changed:#hierarchy with:nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   847
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   848
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   849
iconChanged
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   850
    "icon changed; optimize redrawing
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   851
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   852
    self changed:#icon with:nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   853
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   854
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   855
!HierarchicalItem methodsFor:'enumerating'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   856
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   857
collect:aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   858
    "for each child in the receiver, evaluate the argument, aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   859
     and return a new collection with the results
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   860
    "
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   861
    |coll|
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   862
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   863
    coll := OrderedCollection new.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   864
    self do:[:el| coll add:(aBlock value:el) ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   865
  ^ coll
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   866
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   867
2465
a282c734a816 +contains:
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   868
contains:aBlock
a282c734a816 +contains:
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   869
    "return true if aBlock returns true for any of the receivers items"
a282c734a816 +contains:
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   870
a282c734a816 +contains:
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   871
    self do:[:el | (aBlock value:el) ifTrue:[^ true] ].
a282c734a816 +contains:
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   872
    ^ false
a282c734a816 +contains:
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   873
!
a282c734a816 +contains:
Claus Gittinger <cg@exept.de>
parents: 2386
diff changeset
   874
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   875
do:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   876
    "evaluate a block on each child
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   877
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   878
    ^ self from:1 do:aOneArgBlock
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   879
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   880
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   881
from:startIndex do:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   882
    "evaluate a block on each child starting with the
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   883
     child at startIndex to the end.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   884
    "
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   885
    ^ self from:startIndex to:nil do:aOneArgBlock
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   886
!
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   887
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   888
from:startIndex reverseDo:aOneArgBlock
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   889
    "evaluate a block on each child starting at end to the startIndex
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   890
    "
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   891
    ^ self from:startIndex to:nil reverseDo:aOneArgBlock
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   892
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   893
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   894
from:startIndex to:endIndex do:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   895
    "evaluate a block on each child starting with the
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   896
     child at startIndex to the endIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   897
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   898
    |res|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   899
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   900
    self size < startIndex ifTrue:[^ nil].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   901
    res := nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   902
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   903
    self criticalDo:[
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   904
        res := self nonCriticalFrom:startIndex to:endIndex do:aOneArgBlock
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   905
    ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   906
    ^ res
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   907
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   908
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   909
from:startIndex to:endIndex reverseDo:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   910
    "evaluate a block on each child starting with the
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   911
     child at endIndex to the startIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   912
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   913
    |res|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   914
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   915
    self size < startIndex ifTrue:[^ nil].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   916
    res := nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   917
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   918
    self criticalDo:[
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   919
        res := self nonCriticalFrom:startIndex to:endIndex reverseDo:aOneArgBlock
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   920
    ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   921
    ^ res
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   922
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   923
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   924
keysAndValuesDo:aTwoArgBlock
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   925
    "evaluate the argument, aBlock for every child,
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   926
     passing both index and element as arguments.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   927
    "
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   928
    |key res|
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   929
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   930
    key := 1.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   931
    res := nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   932
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   933
    self do:[:el|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   934
        res := el value:key value:el.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   935
        key := key + 1.
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   936
    ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   937
    ^ res
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   938
!
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   939
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   940
keysAndValuesReverseDo:aTwoArgBlock
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   941
    "evaluate the argument, aBlock in reverse order for every
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   942
     child, passing both index and element as arguments.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   943
    "
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   944
    |res|
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   945
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   946
    self size == 0 ifTrue:[^ nil].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   947
    res := nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   948
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   949
    self criticalDo:[
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   950
        res := self nonCriticalKeysAndValuesReverseDo:aTwoArgBlock
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   951
    ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   952
    ^ res
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   953
!
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
   954
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   955
recursiveCollect:aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   956
    "for each child in the receiver, evaluate the argument, aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   957
     and return a new collection with the results
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   958
    "
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   959
    |coll|
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   960
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   961
    coll := OrderedCollection new.
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   962
    self recursiveDo:[:el| coll add:(aBlock value:el) ].
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   963
  ^ coll
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   964
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   965
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   966
recursiveDo:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   967
    "evaluate a block on each item and all the sub-items
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   968
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   969
    self do:[:aChild|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   970
        aOneArgBlock value:aChild.
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   971
        aChild nonCriticalRecursiveDo:aOneArgBlock
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   972
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   973
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   974
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   975
recursiveReverseDo:aOneArgBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   976
    "evaluate a block on each item and all the sub-items;
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   977
     proccesing children in reverse direction
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   978
    "
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   979
    self reverseDo:[:aChild|
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
   980
        aChild nonCriticalRecursiveReverseDo:aOneArgBlock.
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   981
        aOneArgBlock value:aChild.
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   982
    ].
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   983
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   984
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   985
recursiveSelect:aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   986
    "return a new collection with all children and subChildren from the receiver, for which
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   987
     the argument aBlock evaluates to true.
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   988
    "
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   989
    |coll|
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   990
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   991
    coll := OrderedCollection new.
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   992
    self recursiveDo:[:el| (aBlock value:el) ifTrue:[coll add:el] ].
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
   993
  ^ coll
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   994
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
   995
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   996
reverseDo:aOneArgBlock
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   997
    "evaluate a block on each child in reverse direction
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   998
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
   999
    ^ self from:1 reverseDo:aOneArgBlock
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1000
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1001
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1002
select:aBlock
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1003
    "return a new collection with all items from the receiver, for which
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1004
     the argument aBlock evaluates to true.
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1005
    "
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1006
    |coll|
1831
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1007
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1008
    coll := OrderedCollection new.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1009
    self do:[:el| (aBlock value:el) ifTrue:[coll add:el] ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1010
  ^ coll
1876
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1011
!
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1012
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1013
withAllDo:aOneArgBlock
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1014
    "evaluate the block on each item and subitem including self
1876
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1015
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1016
    aOneArgBlock value:self.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1017
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1018
    self do:[:el|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1019
        aOneArgBlock value:el.
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1020
        el nonCriticalRecursiveDo:aOneArgBlock.
1883
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
  1021
    ].
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
  1022
! !
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1023
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1024
!HierarchicalItem methodsFor:'enumerating parents'!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1025
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1026
parentsDetect:aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1027
    "find the first parent, for which evaluation of the block returns
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1028
     true; if none does so, report an error
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1029
    "
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1030
    ^ self parentsDetect:aBlock ifNone:[self errorNotFound]
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1031
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1032
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1033
parentsDetect:aBlock ifNone:anExceptionBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1034
    "find the first parent, for which evaluation of the block returns
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1035
     true; if none does so, return the evaluation of anExceptionBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1036
    "
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1037
    |prnt|
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1038
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1039
    prnt := self.
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1040
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1041
    self criticalDo:[
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1042
        [(prnt := prnt parent) notNil and:[prnt isHierarchicalItem]] whileTrue:[
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1043
            (aBlock value:prnt) ifTrue:[^ prnt]
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1044
        ]
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1045
    ].
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1046
    ^ anExceptionBlock value
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1047
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1048
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1049
parentsDo:aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1050
    "evaluate a block on each parent
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1051
    "
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1052
    |prnt|
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1053
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1054
    prnt := self.
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1055
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1056
    self criticalDo:[
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1057
        [(prnt := prnt parent) notNil and:[prnt isHierarchicalItem]] whileTrue:[
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1058
            aBlock value:prnt
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1059
        ]
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1060
    ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1061
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1062
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1063
!HierarchicalItem methodsFor:'initialization'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1064
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1065
initialize
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1066
    isExpanded := false
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1067
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1068
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1069
!HierarchicalItem methodsFor:'private'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1070
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1071
addVisibleChildrenTo:aList
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1072
    "add all visible children and sub-children to the list"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1073
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1074
    isExpanded ifFalse:[^ self].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1075
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1076
    self nonCriticalFrom:1 to:nil do:[:el|
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1077
        aList add:el.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1078
        el addVisibleChildrenTo:aList.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1079
    ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1080
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1081
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1082
criticalDo:aBlock
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1083
    |model|
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1084
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1085
    (model := self model) notNil ifTrue:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1086
        model recursionLock critical:aBlock
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1087
    ] ifFalse:[
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1088
        aBlock value
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1089
    ]
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1090
!
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1091
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1092
listIndex
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1093
    "returns the visible index or nil; for a none visible root
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1094
     0 is returned
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1095
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1096
    |index model|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1097
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1098
    (model := self model) notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1099
        index := model identityIndexOf:self.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1100
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1101
        (index ~~ 0 or:[parent == model]) ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1102
            ^ index
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1103
        ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1104
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1105
    ^ nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1106
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1107
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1108
numberOfVisibleChildren
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1109
    "returns number of all visible children including subchildren"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1110
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1111
    |size|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1112
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1113
    isExpanded ifFalse:[^ 0].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1114
    size := 0.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1115
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1116
    self nonCriticalFrom:1 to:nil do:[:el|
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1117
        size := 1 + size + el numberOfVisibleChildren
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1118
    ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1119
    ^ size
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1120
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1121
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1122
parentOrModel
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1123
    "returns the parent without checking for item or model
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1124
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1125
    ^ parent
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1126
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1127
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1128
setExpanded:aBoolean
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1129
    "set expanded flag without any computation or notification"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1130
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1131
    isExpanded := aBoolean
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1132
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1133
2493
8b70a26f1694 method category rename
Claus Gittinger <cg@exept.de>
parents: 2486
diff changeset
  1134
!HierarchicalItem methodsFor:'private-displaying'!
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1135
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1136
displayLabel:aLabel h:lH on:aGC x:x y:y h:h 
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1137
    "display the label at x@y
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1138
    "
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
  1139
    |y0|
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1140
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1141
    lH ~~ 0 ifTrue:[
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1142
        y0 := y - (lH + 1 - h // 2).
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1143
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
  1144
        y0 := y0 + (aLabel ascentOn:aGC).
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
  1145
        (aLabel isString not
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
  1146
        or:[(aLabel includes:(Character cr)) not]) ifTrue:[
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1147
            ^ aLabel displayOn:aGC x:x y:y0
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1148
        ].
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1149
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1150
        aLabel asCollectionOfLines do:[:el|
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1151
            el displayOn:aGC x:x y:y0.
2484
92f9e42980ab correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 2476
diff changeset
  1152
            y0 := y0 + (el heightOn:aGC)
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1153
        ]
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1154
    ].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1155
!
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1156
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1157
heightOf:aLabel on:aGC
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1158
    "returns the height of the label or 0
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1159
    "
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1160
    |h|
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1161
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1162
    aLabel isSequenceable ifFalse:[
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1163
        ^ aLabel notNil ifTrue:[aLabel heightOn:aGC] ifFalse:[0]
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1164
    ].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1165
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1166
    aLabel isString ifFalse:[
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1167
        h := 0.
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1168
        aLabel do:[:el|h := h max:(self heightOf:el on:aGC)].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1169
      ^ h
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1170
    ].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1171
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1172
    h := 1 + (aLabel occurrencesOf:(Character cr)).
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1173
    ^ h * (aGC font height)
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1174
!
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1175
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1176
widthOf:aLabel on:aGC
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1177
    "returns the height of the label or 0
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1178
    "
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1179
    |w|
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1180
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1181
    aLabel isSequenceable ifFalse:[
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1182
        ^ aLabel notNil ifTrue:[aLabel widthOn:aGC] ifFalse:[0]
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1183
    ].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1184
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1185
    aLabel isString ifFalse:[
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1186
        w := -5.
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1187
        aLabel do:[:el|w := w + 5 + (self widthOf:el on:aGC)].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1188
      ^ w
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1189
    ].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1190
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1191
    (aLabel indexOf:(Character cr)) == 0 ifTrue:[
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1192
        ^ aLabel widthOn:aGC
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1193
    ].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1194
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1195
    w := 0.
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1196
    aLabel asCollectionOfLines do:[:el|w := w max:(el widthOn:aGC)].
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1197
  ^ w
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1198
! !
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1199
2493
8b70a26f1694 method category rename
Claus Gittinger <cg@exept.de>
parents: 2486
diff changeset
  1200
!HierarchicalItem methodsFor:'private-enumerating'!
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1201
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1202
nonCriticalDo:aOneArgBlock
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1203
    "evaluate a block noncritical on each child.
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1204
    "
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1205
    ^ self nonCriticalFrom:1 to:nil do:aOneArgBlock
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1206
!
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1207
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1208
nonCriticalFrom:startIndex to:endIndex do:aOneArgBlock
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1209
    "evaluate a block noncritical on each child starting with the
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1210
     child at startIndex to the endIndex (if nil to end of list).
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1211
    "
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1212
    |list size resp|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1213
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1214
    list := self children.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1215
    size := list size.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1216
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1217
    startIndex > size ifTrue:[^ nil].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1218
    resp := nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1219
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1220
    endIndex notNil ifTrue:[
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1221
        size := size min:endIndex
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1222
    ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1223
    startIndex to:size do:[:i| |item|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1224
        item := list at:i ifAbsent:nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1225
        item isNil ifTrue:[^ resp].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1226
        resp := aOneArgBlock value:item.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1227
    ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1228
    ^ resp
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1229
!
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1230
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1231
nonCriticalFrom:startIndex to:endIndex reverseDo:aOneArgBlock
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1232
    "evaluate a block non critical on each child starting with the
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1233
     child at endIndex (if nil to end of list) to startIndex.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1234
    "
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1235
    |list size resp|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1236
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1237
    list := self children.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1238
    size := list size.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1239
    resp := nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1240
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1241
    endIndex notNil ifTrue:[
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1242
        size := size min:endIndex
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1243
    ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1244
    size to:startIndex by:-1 do:[:i| |item|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1245
        item := list at:i ifAbsent:nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1246
        item isNil ifTrue:[^ resp].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1247
        resp := aOneArgBlock value:item.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1248
    ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1249
    ^ resp
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1250
!
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1251
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1252
nonCriticalKeysAndValuesReverseDo:aOneArgBlock
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1253
    "evaluate the argument, aBlock in reverse order for every
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1254
     child, passing both index and element as arguments.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1255
    "
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1256
    |list size resp|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1257
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1258
    list := self children.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1259
    size := list size.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1260
    resp := nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1261
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1262
    size to:1 by:-1 do:[:i| |item|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1263
        item := list at:i ifAbsent:nil.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1264
        item isNil ifTrue:[^ resp].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1265
        resp := aOneArgBlock value:i value:item.
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1266
    ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1267
    ^ resp
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1268
!
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1269
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1270
nonCriticalRecursiveDo:anOneArgBlock
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1271
    "evaluate the block non critical on each item and all the sub-items
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1272
    "
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1273
    self nonCriticalFrom:1 to:nil do:[:aChild|
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1274
        anOneArgBlock value:aChild.
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1275
        aChild nonCriticalRecursiveDo:anOneArgBlock
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1276
    ].
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1277
!
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1278
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1279
nonCriticalRecursiveReverseDo:anOneArgBlock
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1280
    "evaluate the block non critical on each item and all the sub-items;
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1281
     proccesing children in reverse direction
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1282
    "
2117
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1283
    self nonCriticalFrom:1 to:nil reverseDo:[:aChild|
61d68e3e5bdc methods rename (cg)
tm
parents: 2081
diff changeset
  1284
        aChild nonCriticalRecursiveReverseDo:anOneArgBlock.
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1285
        anOneArgBlock value:aChild.
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1286
    ].
2294
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1287
!
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1288
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1289
nonCriticalRecursiveSort:aSortBlock
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1290
    "evaluate a block noncritical on each child.
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1291
    "
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1292
    |unsorted sorted|
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1293
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1294
    unsorted := children.
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1295
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1296
    unsorted size ~~ 0 ifTrue:[
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1297
        sorted := unsorted sort:aSortBlock.
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1298
        sorted do:[:el| el nonCriticalRecursiveSort:aSortBlock ].
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1299
        children := sorted.
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1300
    ].
2008
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1301
! !
916175defb9e add none critical blocks for recursive operations (optimize)
ca
parents: 1974
diff changeset
  1302
2493
8b70a26f1694 method category rename
Claus Gittinger <cg@exept.de>
parents: 2486
diff changeset
  1303
!HierarchicalItem methodsFor:'private-hierarchy'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1304
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1305
recursiveSetCollapsed
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1306
    "collapse all children and sub-children without notifications"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1307
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1308
    isExpanded := false.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1309
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1310
    "/ do not call #size: children will be autoloaded !!!!
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1311
    children size ~~ 0 ifTrue:[
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1312
        self nonCriticalFrom:1 to:nil do:[:el| el canRecursiveCollapse ifTrue:[el recursiveSetCollapsed]].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1313
    ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1314
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1315
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1316
recursiveSetExpandedAndAddToList:aList
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1317
    "expand all children and sub-children without notifications;
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1318
     add children to list"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1319
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1320
    isExpanded := true.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1321
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1322
    self do:[:eachChild|
2601
27b91c77ce7b bug fix during recursive expand of children
ca
parents: 2549
diff changeset
  1323
        aList add:eachChild.
27b91c77ce7b bug fix during recursive expand of children
ca
parents: 2549
diff changeset
  1324
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1325
        eachChild canRecursiveExpand ifTrue:[
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1326
            eachChild recursiveSetExpandedAndAddToList:aList.
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1327
        ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1328
    ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1329
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1330
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1331
!HierarchicalItem methodsFor:'protocol-accessing'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1332
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1333
children
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1334
    "returns a list of children
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1335
     *** to optimize: redefine by subClass
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1336
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1337
    |model|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1338
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1339
    children isNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1340
        (model := self model) notNil ifTrue:[
1486
5b520551b2ef checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1431
diff changeset
  1341
            children := model childrenFor:self
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1342
        ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1343
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1344
    ^ children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1345
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1346
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1347
icon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1348
    "returns the icon or nil;
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1349
     *** to optimize:redefine by subClass
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1350
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1351
    |model|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1352
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1353
    (model := self model) notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1354
        ^ model iconFor:self
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1355
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1356
    ^ nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1357
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1358
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1359
label
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1360
    "returns the label displayed on aGC;
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1361
     *** to optimize:redefine by subClass
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1362
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1363
    |model|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1364
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1365
    (model := self model) notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1366
        ^ model labelFor:self
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1367
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1368
    ^ nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1369
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1370
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1371
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1372
middleButtonMenu
2602
8aec4c5fbf5b comment
Claus Gittinger <cg@exept.de>
parents: 2601
diff changeset
  1373
    "returns the items middleButtonMenu or nil if no menu is defined.
8aec4c5fbf5b comment
Claus Gittinger <cg@exept.de>
parents: 2601
diff changeset
  1374
     If nil is returned, the view is asked for a menu.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1375
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1376
    |model|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1377
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1378
    (model := self model) notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1379
        ^ model middleButtonMenuFor:self
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1380
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1381
    ^ nil
1831
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1382
!
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1383
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1384
recursiveSortChildren:aSortBlock
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1385
    |children|
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1386
2832
e1f6a7c48552 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2781
diff changeset
  1387
    (children := self children) notEmptyOrNil ifTrue:[
1831
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1388
        self criticalDo:[
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1389
            children sort:aSortBlock.
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1390
            children do:[:aChild| aChild recursiveSortChildren:aSortBlock ]
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1391
        ]
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1392
    ].
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1393
!
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1394
8efa00e1247a sort stuff; height fix when label changes
Claus Gittinger <cg@exept.de>
parents: 1818
diff changeset
  1395
sortChildren:aSortBlock
2708
f3efc17bcbce Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 2602
diff changeset
  1396
    "sort the children inplace using the 2-arg block sortBlock for comparison"
f3efc17bcbce Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 2602
diff changeset
  1397
f3efc17bcbce Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 2602
diff changeset
  1398
    <resource: #obsolete>
f3efc17bcbce Mark obsolete methods
Stefan Vogel <sv@exept.de>
parents: 2602
diff changeset
  1399
    self obsoleteMethodWarning:'use #sort:'.
2252
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1400
    self sort:aSortBlock.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1401
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1402
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1403
!HierarchicalItem methodsFor:'protocol-displaying'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1404
1532
56e0fafc4349 change display protocol for item
Claus Gittinger <cg@exept.de>
parents: 1489
diff changeset
  1405
displayOn:aGC x:x y:y h:h
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1406
    "draw the receiver in the graphicsContext, aGC.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1407
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1408
    |label
1398
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1409
     x0 "{ Class:SmallInteger }"
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1410
    |
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1411
    (label := self label) isNil ifTrue:[^ self].
1398
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1412
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1413
    (label isSequenceable and:[label isString not]) ifFalse:[
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1414
        ^ self displayLabel:label h:(self heightOn:aGC) on:aGC x:x y:y h:h
1398
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1415
    ].
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1416
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1417
    x0 := x.
1398
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1418
    label do:[:el|
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1419
        el notNil ifTrue:[
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1420
            self displayLabel:el h:(self heightOf:el on:aGC) on:aGC x:x0 y:y h:h.
1398
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1421
            x0 := x0 + 5 + (el widthOn:aGC).
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1422
        ].
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1423
    ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1424
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1425
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1426
heightOn:aGC
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1427
    "return the width of the receiver, if it is to be displayed on aGC
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1428
    "
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1429
    height isNil ifTrue:[
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1430
        height := self heightOf:(self label) on:aGC
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1431
    ].
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1432
    ^ height
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1433
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1434
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1435
widthOn:aGC
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1436
    "return the width of the receiver, if it is to be displayed on aGC
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1437
    "
1606
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1438
    width isNil ifTrue:[
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1439
        width := self widthOf:(self label) on:aGC
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1440
    ].
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1441
    ^ width
b46b9ec4b5d8 cache height and width
ca
parents: 1602
diff changeset
  1442
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1443
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1444
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1445
!HierarchicalItem methodsFor:'protocol-event processing'!
2313
6e91bdaac5bc delegate buttonPress event to the item
ca
parents: 2305
diff changeset
  1446
6e91bdaac5bc delegate buttonPress event to the item
ca
parents: 2305
diff changeset
  1447
processButtonPress:button x:x y:y
6e91bdaac5bc delegate buttonPress event to the item
ca
parents: 2305
diff changeset
  1448
    "a mouse button was pressed in my label.
2519
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1449
     Return true, if the event is eaten (ignored by the gc).
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1450
     On default false is returned (should be handled by the gc).
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1451
    "
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1452
    ^ false
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1453
!
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1454
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1455
processButtonPress:button x:x y:y on:aGC
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1456
    "a mouse button was pressed in my label.
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1457
     Return true, if the event is eaten (ignored by the gc).
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1458
     On default false is returned (should be handled by the gc).
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1459
    "
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1460
    ^ self processButtonPress:button x:x y:y
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1461
!
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1462
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1463
processButtonPressOnIcon:button on:aGC
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1464
    "a mouse button was pressed in my icon.
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1465
     Return true, if the event is eaten (ignored by the gc).
f043b9204ce7 process button events from hierarchical tree widget
james
parents: 2493
diff changeset
  1466
     On default false is returned (should be handled by the gc).
2313
6e91bdaac5bc delegate buttonPress event to the item
ca
parents: 2305
diff changeset
  1467
    "
6e91bdaac5bc delegate buttonPress event to the item
ca
parents: 2305
diff changeset
  1468
    ^ false
6e91bdaac5bc delegate buttonPress event to the item
ca
parents: 2305
diff changeset
  1469
! !
6e91bdaac5bc delegate buttonPress event to the item
ca
parents: 2305
diff changeset
  1470
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1471
!HierarchicalItem methodsFor:'protocol-monitoring'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1472
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1473
monitoringCycle
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1474
    "called all 'n' seconds by the model, if the monitoring
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1475
     cycle is enabled. The item can perform some checks, ..
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1476
     **** can be redefined by subclass to perform some actions
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1477
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1478
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1479
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1480
!HierarchicalItem methodsFor:'protocol-queries'!
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1481
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1482
canCollapse
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1483
    "called before collapsing the item; can be redefined
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1484
     by subclass to omit the collapse operation"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1485
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1486
    ^ isExpanded
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1487
!
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1488
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1489
canExpand
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1490
    "called before expanding the item; can be redefined
2549
fb6d594099b2 checkin from browser
Stefan Vogel <sv@exept.de>
parents: 2547
diff changeset
  1491
     by subclass to omit the expand operation"
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1492
2549
fb6d594099b2 checkin from browser
Stefan Vogel <sv@exept.de>
parents: 2547
diff changeset
  1493
    ^ self hasChildren
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1494
!
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1495
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1496
canRecursiveCollapse
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1497
    "called before collapsing the item; can be redefined
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1498
     by subclass to omit the collapse operation "
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1499
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1500
    ^ self canCollapse
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1501
!
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1502
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1503
canRecursiveExpand
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1504
    "called before expanding the item; can be redefined
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1505
     by subclass to omit the collapse operation"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1506
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1507
    ^ self canExpand
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1508
!
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1509
1571
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1510
drawHorizontalLineUpToText
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1511
    "draw the horizizontal line for the selected item up to the text
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1512
     or on default to the start of the the vertical line; only used by
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1513
     the hierarchical view
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1514
    "
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1515
    ^ false
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1516
!
a230fb988d3e support configuration of length of vertical line
ca
parents: 1540
diff changeset
  1517
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1518
hasChildren
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1519
    "checks whether the item has children; 
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1520
     the list needs not to be loaded yet( example. FileDirectory ).
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1521
     *** to optimize: redefine in subClass
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1522
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1523
    ^ self children size ~~ 0
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1524
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1525
2201
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
  1526
hasIndicator
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
  1527
    "on default the indicator is drawn if the item
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
  1528
     has children
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
  1529
    "
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
  1530
    ^ self hasChildren
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
  1531
!
aa74fa6137a5 make indicator dependent on hasIndicator and not hasChildren
ca
parents: 2193
diff changeset
  1532
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1533
isSelectable
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1534
    "returns true if the item is selectable otherwise false
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1535
    "
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1536
    ^ true
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1537
!
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1538
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1539
string
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1540
    "access the printable string used for steping through a list
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1541
     searching for an entry starting with a character.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1542
     *** to optimize:redefine by subClass
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1543
    "
1398
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1544
    |label|
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1545
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1546
    (label := self label) notNil ifTrue:[
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1547
        label isString      ifTrue:[ ^ label string ].
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1548
        label isImageOrForm ifTrue:[ ^ nil ].
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1549
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1550
        label isSequenceable ifFalse:[
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1551
            ^ label perform:#string ifNotUnderstood:nil
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1552
        ].
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1553
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1554
        label do:[:el||s|
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1555
            (el notNil and:[el isImageOrForm not]) ifTrue:[
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1556
                s := el perform:#string ifNotUnderstood:nil.
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1557
                s notNil ifTrue:[^ s].
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1558
            ]
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1559
        ]
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1560
    ].
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1561
    ^ nil
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1562
        
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1563
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1564
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1565
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1566
!HierarchicalItem methodsFor:'queries'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1567
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1568
isChildOf:anItem
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1569
    "returns true if the item is a child of anItem
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1570
    "
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1571
    |item|
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1572
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1573
    item := self.
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1574
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1575
    [anItem ~~ item] whileTrue:[
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1576
        ((item := item parent) notNil and:[item isHierarchicalItem]) ifFalse:[
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1577
            ^ false
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1578
        ]
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1579
    ].
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1580
    ^ true
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1581
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1582
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1583
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1584
isCollapsed
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1585
    "returns true if the item is collapsed"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1586
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1587
    ^ isExpanded not
2305
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1588
!
a31516be9bd1 *** empty log message ***
ca
parents: 2294
diff changeset
  1589
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1590
isExpanded
2547
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1591
    "returns true if the item is expanded"
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1592
1b75a2c2be7c Hooks for recursive expand
Stefan Vogel <sv@exept.de>
parents: 2519
diff changeset
  1593
    ^ isExpanded 
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1594
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1595
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1596
isHierarchicalItem
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1597
    "used to decide if the parent is a hierarchical item
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1598
     or the model
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1599
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1600
    ^ true
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1601
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1602
2033
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1603
isRealChildOf:anItem
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1604
    "returns true if the item is a child of anItem
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1605
    "
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1606
    |item|
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1607
    item := self parent.
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1608
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1609
    [item notNil] whileTrue:[
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1610
        item == anItem ifTrue:[^ true].
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1611
        item := item parent.
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1612
    ].
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1613
    ^ false
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1614
!
abe5de512c81 checkin from browser
martin
parents: 2029
diff changeset
  1615
1876
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1616
isRootItem
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1617
    "returns true if the item is the root item
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1618
    "
1883
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
  1619
    ^ parent isHierarchicalItem not
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
  1620
!
1876
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1621
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1622
size
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1623
    "return the number of children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1624
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1625
    ^ self children size
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1626
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1627
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1628
!HierarchicalItem methodsFor:'searching'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1629
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1630
detect:aOneArgBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1631
    "find the first child, for which evaluation of the block returns
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1632
     true; if none does so, report an error
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1633
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1634
    ^ self detect:aOneArgBlock ifNone:[self errorNotFound]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1635
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1636
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1637
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1638
detect:anOneArgBlock ifNone:anExceptionBlock
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1639
    "find the first child, for which evaluation of the block returns
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1640
     true; if none does so, return the evaluation of anExceptionBlock
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1641
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1642
    self do:[:el| (anOneArgBlock value:el) ifTrue:[^ el] ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1643
  ^ anExceptionBlock value
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1644
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1645
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1646
detectLast:aOneArgBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1647
    "find the last child, for which evaluation of the block returns
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1648
     true; if none does so, an exception is raised
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1649
    "
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1650
    ^ self detectLast:aOneArgBlock ifNone:[self errorNotFound]
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1651
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1652
!
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1653
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1654
detectLast:anOneArgBlock ifNone:anExceptionBlock
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1655
    "find the last child, for which evaluation of the block returns
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1656
     true; if none does so, return the evaluation of anExceptionBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1657
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1658
    self reverseDo:[:el| (anOneArgBlock value:el) ifTrue:[^ el] ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1659
  ^ anExceptionBlock value
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1660
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1661
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1662
findFirst:anOneArgBlock
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1663
    "find the first child, for which evaluation of the argument, aOneArgBlock
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1664
     returns true; return its index or 0 if none detected.
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1665
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1666
    self keysAndValuesDo:[:i :el| (anOneArgBlock value:el) ifTrue:[^ i] ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1667
  ^ 0
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1668
!
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1669
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1670
findLast:anOneArgBlock
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1671
    "find the last child, for which evaluation of the argument, aOneArgBlock
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1672
     returns true; return its index or 0 if none detected.
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1673
    "
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1674
    self keysAndValuesReverseDo:[:i :el| (anOneArgBlock value:el) ifTrue:[^ i] ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1675
  ^ 0
1966
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1676
!
ed61dfa648b5 add new enumerating/seraching functionality
ca
parents: 1965
diff changeset
  1677
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1678
identityIndexOf:aChild
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1679
    "return the index of aChild or 0 if not found. Compare using ==
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1680
    "
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1681
    ^ self identityIndexOf:aChild startingAt:1
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1682
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1683
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1684
identityIndexOf:aChild startingAt:startIndex
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1685
    "return the index of aChild, starting search at startIndex.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1686
     Compare using ==; return 0 if not found
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1687
    "
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1688
    |index|
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1689
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1690
    index := startIndex.
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1691
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1692
    self from:startIndex do:[:el|
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1693
        el == aChild ifTrue:[^ index ].
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1694
        index := index + 1.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1695
    ].
2081
409ed8b04ae2 *** empty log message ***
ca
parents: 2033
diff changeset
  1696
    ^ 0
1489
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1697
!
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1698
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1699
recursiveDetect:aOneArgBlock
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1700
    "recursive find the first child, for which evaluation 
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1701
     of the block returns true; if none nil is returned
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1702
    "
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1703
    self recursiveDo:[:aChild|
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1704
        (aOneArgBlock value:aChild) ifTrue:[^ aChild]
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1705
    ].
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1706
    ^ nil
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1707
!
1489
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1708
1804
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1709
recursiveDetectLast:aBlock
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1710
    "find the last child, for which evaluation of the block returns
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1711
     true; if none does so, nil id returned
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1712
    "
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1713
    self recursiveReverseDo:[:aChild|
91896c0dfd4a add new features
ca
parents: 1794
diff changeset
  1714
        (aBlock value:aChild) ifTrue:[^ aChild].
1489
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1715
    ].
d4c9639f7786 checkin from browser
tm
parents: 1488
diff changeset
  1716
    ^ nil
1876
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1717
!
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1718
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1719
withAllDetect:aOneArgBlock
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1720
    "recursive find the first item including self, for which evaluation
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1721
     of the block returns true; if none nil is returned
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1722
    "
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1723
    (aOneArgBlock value:self) ifTrue:[^ self].
d9ec853e7843 add more messages
ca
parents: 1843
diff changeset
  1724
1883
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
  1725
    ^ self recursiveDetect:aOneArgBlock
7da039ab6677 added: access-methode for rootItem
tm
parents: 1876
diff changeset
  1726
! !
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1727
2486
d0c3806e68a6 category change
Claus Gittinger <cg@exept.de>
parents: 2484
diff changeset
  1728
!HierarchicalItem methodsFor:'sorting & reordering'!
2252
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1729
2294
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1730
recursiveSort:aSortBlock
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1731
    "recursive sort the children inplace using the 2-arg block sortBlock for comparison
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1732
    "
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1733
    self criticalDo:[
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1734
        children size ~~ 0 ifTrue:[
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1735
            self nonCriticalRecursiveSort:aSortBlock.
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1736
            self childrenOrderChanged.
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1737
        ]
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1738
    ].
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1739
!
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1740
2252
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1741
sort:aSortBlock
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1742
    "sort the children inplace using the 2-arg block sortBlock for comparison
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1743
    "
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1744
    |unsorted|
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1745
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1746
    self criticalDo:[
2294
7f45237a518c recursive sort children
ca
parents: 2260
diff changeset
  1747
        unsorted := children.
2252
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1748
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1749
        unsorted size ~~ 0 ifTrue:[
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1750
            children := unsorted sort:aSortBlock.
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1751
            self childrenOrderChanged.
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1752
        ]
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1753
    ].
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1754
! !
ebcefc9af592 add #sort:
ca
parents: 2230
diff changeset
  1755
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1756
!HierarchicalItem::Example class methodsFor:'instance creation'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1757
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1758
labeled:aLabel
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1759
    ^ self new setLabel:aLabel
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1760
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1761
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1762
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1763
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1764
labeled:aLabel icon:anIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1765
    ^ self new setLabel:aLabel icon:anIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1766
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1767
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1768
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1769
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1770
!HierarchicalItem::Example class methodsFor:'resources'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1771
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1772
iconForLevel:aLevel
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1773
    "returns an icon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1774
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1775
    aLevel == 2 ifTrue:[ ^ ResourceSelectionBrowser iconPrivateClass ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1776
    aLevel == 3 ifTrue:[ ^ ResourceSelectionBrowser iconClass ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1777
    aLevel == 4 ifTrue:[ ^ ResourceSelectionBrowser iconCategory ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1778
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1779
  ^ nil
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1780
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1781
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1782
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1783
penguinIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1784
    PenguinIcon isNil ifTrue:[
1794
029df2e76784 *** empty log message ***
ca
parents: 1733
diff changeset
  1785
        PenguinIcon := Smalltalk imageFromFileNamed:'xpmBitmaps/misc_logos/linux_penguin.xpm'
029df2e76784 *** empty log message ***
ca
parents: 1733
diff changeset
  1786
                                 inPackage:'stx:goodies'
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1787
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1788
    ^ PenguinIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1789
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1790
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1791
!HierarchicalItem::Example methodsFor:'accessing'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1792
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1793
children
2781
062d03cf175e *** empty log message ***
ca
parents: 2724
diff changeset
  1794
    |lvl lbl txt image img icon|
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1795
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1796
    children notNil ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1797
        ^ children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1798
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1799
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1800
    (lvl := self level) == 5 ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1801
        children := #().
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1802
      ^ children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1803
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1804
    icon     := self class iconForLevel:(lvl + 1).
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1805
    children := OrderedCollection new.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1806
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1807
    lvl < 4 ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1808
        txt := (lvl + 1) printString, ' ['.
2781
062d03cf175e *** empty log message ***
ca
parents: 2724
diff changeset
  1809
        img := Icon saveIcon.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1810
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1811
        1 to:5 do:[:i|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1812
            (i == 2 or:[i == 3]) ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1813
                lbl := img
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1814
            ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1815
                i == 4 ifTrue:[
1540
3fab5658652a support carrige return in labels
Claus Gittinger <cg@exept.de>
parents: 1539
diff changeset
  1816
                    lbl := Array with:(self class penguinIcon)
1733
67c144581e63 add critical semaphore (RecursionLock)
ca
parents: 1669
diff changeset
  1817
                                 with:('penguin#and#text' replaceAll:$# with:(Character cr)).
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1818
                ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1819
                    lbl := txt, (i printString), ']'
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1820
                ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1821
            ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1822
            children add:(self class labeled:lbl icon:icon)
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1823
        ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1824
    ] ifFalse:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1825
        image := ResourceSelectionBrowser iconPrivateClass.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1826
        txt   := LabelAndIcon icon:image string:'Text'.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1827
        img   := Icon copyIcon.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1828
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1829
        1 to:5 do:[:i|
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1830
            lbl := i odd ifTrue:[txt] ifFalse:[img].
1398
590a0d3a5ff4 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1390
diff changeset
  1831
            lbl := Array with:lbl with:'test' with:img.
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1832
            children add:(self class labeled:lbl icon:icon).
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1833
        ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1834
    ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1835
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1836
    children do:[:aChild| aChild parent:self ].
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1837
  ^ children
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1838
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1839
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1840
icon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1841
    "returns the icon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1842
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1843
    ^ icon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1844
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1845
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1846
icon:anIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1847
    "set the icon; if icon changed, a notification
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1848
     is raised.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1849
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1850
    icon ~= anIcon ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1851
        icon := anIcon.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1852
        self iconChanged
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1853
    ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1854
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1855
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1856
label
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1857
    "returns the label
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1858
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1859
    ^ label
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1860
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1861
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1862
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1863
label:aLabel
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1864
    "set the label; if label changed, a notification
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1865
     is raised.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1866
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1867
    label ~= aLabel ifTrue:[
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1868
        label := aLabel.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1869
        self changed.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1870
    ]
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1871
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1872
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1873
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1874
setIcon:anIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1875
    "set the icon without any change notification
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1876
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1877
    icon := anIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1878
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1879
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1880
setLabel:aLabel
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1881
    "set the label without any change notification
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1882
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1883
    label := aLabel
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1884
!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1885
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1886
setLabel:aLabel icon:anIcon
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1887
    "set the label and icon without any change notification
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1888
    "
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1889
    label := aLabel.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1890
    icon  := anIcon.
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1891
! !
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1892
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1893
!HierarchicalItem class methodsFor:'documentation'!
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1894
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1895
version
2851
fa192ee81bb5 code cleanup
Claus Gittinger <cg@exept.de>
parents: 2847
diff changeset
  1896
    ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalItem.st,v 1.72 2005-10-05 12:14:10 cg Exp $'
1390
62dc950b9140 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1897
! !