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