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