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