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