"
COPYRIGHT (c) 1999 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libwidg2' }"
SelectionInListModelView subclass:#HierarchicalListView
instanceVariableNames:'imageInset imageWidth lineColor showRoot showLines
useDefaultIcons icons openIndicator closeIndicator alignTextRight
alignTextRightX maxWidthOfText minLineHeight levelOfLastItem
expandOnSelect autoScrollHorizontal showIndicators
showLeftIndicators indicatorAction'
classVariableNames:''
poolDictionaries:''
category:'Views-Trees'
!
!HierarchicalListView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1999 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
This class implements a hierarchical list view based on a
hierachical list.
It provides functionality similar to SelectionInTreeView, but optimizes
redraws, and operates directly upon the model (in contrast to
SelectionInTreeView, which generates a list internally).
[Instance variables:]
textStartLeft <Integer> inset between icon and text
imageInset <Integer> inset between left side and icon
imageWidth <Integer> width of widest icon
minLineHeight <Integer> minimum required line height
including open/close indication ...
lineMask <Form> line mask
lineColor <Color> line color
showRoot <Boolean> root element is shown or hidden
derives from the hierachical list.
showLines <Boolean> show or hide lines
showIndicators <Boolean> show or hide indicators
useDefaultIcons <Boolean> use the default icons if no icon
for an item is specified
icons <IdentityDictionary> list of registered icons;
identifier := <key> value := <icon>
showLeftIndicators <Boolean> show or hide indicator for most left items
indicatorAction <Block> action evaluated if indicator is pressed (0/1/2 arguments)
openIndicator <Icon, Image or Form> expanded indicator
closeIndicator <Icon, Image or Form> collapsed indicator
alignTextRight <Boolean> enable disable of align the text right
icon text
icon text of child
should be set after creation of the widget!!
alignTextRightX <Integer> left x position of aligned right text
maxWidthOfText <Integer> keeps the maximum width of a text label
levelOfLastItem <Integer> keeps the level of the last item;
in case of a delete last items from list
we know were to redraw lines from
autoScrollHorizontal <Boolean> true, than automatically scroll horizontal upto
the text label of the current selected line.
expandOnSelect <Boolean> true, than the item selected by a buttonPress
event will be immediately expanded.
[author:]
Claus Atzkern
[see also:]
ListModelView
SelectionInListModelView
HierarchicalList
HierarchicalItem
"
!
examples
"
show a hierarchical list
[exBegin]
|top sel list item|
list := HierarchicalList new.
item := HierarchicalItem::Example labeled:'Root Item'.
item expand.
list showRoot:false.
list root:item.
top := StandardSystemView new; extent:300@300.
sel := ScrollableView for:HierarchicalListView miniScrollerH:true
origin:0.0@0.0 corner:1.0@1.0 in:top.
sel list:list.
sel multipleSelectOk:true.
sel doubleClickAction:[:i| (list at:i) toggleExpand ].
sel indicatorAction:[:i| (list at:i) toggleExpand ].
top open.
[exEnd]
show a hierarchical list; open an editor on reselect a
line with label is a string.
[exBegin]
|top sel list item|
list := HierarchicalList new.
item := HierarchicalItem::Example labeled:'Root Item'.
item expand.
list showRoot:false.
list root:item.
top := StandardSystemView new; extent:300@300.
sel := ScrollableView for:HierarchicalListView miniScrollerH:true
origin:0.0@0.0 corner:1.0@1.0 in:top.
sel list:list.
sel openEditorAction:[:ln :aGC| |field item|
item := list at:ln.
item label isString ifFalse:[
field := nil
] ifTrue:[
field := EditField new.
field level:0.
field acceptOnLostFocus:true.
field acceptAction:[:x| item label:(field contents) ].
field font:(aGC font).
field contents:(item label).
].
field
].
sel multipleSelectOk:true.
sel doubleClickAction:[:i| (list at:i) toggleExpand ].
sel indicatorAction:[:i| (list at:i) toggleExpand ].
top open.
[exEnd]
[exBegin]
|top sel list item|
list := HierarchicalList new.
item := HierarchicalItem::Example labeled:'Root Item'.
item expand.
list showRoot:false.
list root:item.
top := StandardSystemView new; extent:300@300.
sel := ScrollableView for:HierarchicalListView miniScrollerH:true
origin:0.0@0.0 corner:1.0@1.0 in:top.
sel list:list.
sel multipleSelectOk:true.
sel alignTextRight:true.
sel doubleClickAction:[:i| (list at:i) toggleExpand ].
sel indicatorAction:[:i| (list at:i) toggleExpand ].
top open.
[exBegin]
"
!
test
|top sel list item|
list := HierarchicalList new.
item := HierarchicalItem::Example labeled:'Root Item'.
item expand.
list showRoot:false.
list root:item.
top := StandardSystemView new; extent:300@300.
sel := ScrollableView for:HierarchicalListView miniScrollerH:true
origin:0.0@0.0 corner:1.0@1.0 in:top.
sel useDefaultIcons:false.
sel list:list.
sel multipleSelectOk:true.
sel showLines:false.
sel doubleClickAction:[:i| (list at:i) toggleExpand ].
sel indicatorAction:[:i| (list at:i) toggleExpand ].
top open.
! !
!HierarchicalListView class methodsFor:'resources'!
closeIndicator
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self closeIndicator inspect
ImageEditor openOnClass:self andSelector:#closeIndicator
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'HierarchicalListView class closeIndicator'
ifAbsentPut:[(Depth2Image new) width: 9; height: 9; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUU@Z*)@Z")@Z")@X@I-Z")@Z")KZ*)@UUU;') ; colorMapFromArray:#[0 0 0 128 128 128 255 255 255]; yourself]
!
collapsedIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self collapsedIcon inspect
ImageEditor openOnClass:self andSelector:#collapsedIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'HierarchicalListView class collapsedIcon'
ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@UP@@@@@@@@EUUUPAUUUT@UUUU@EUUUPAUUUT@UUUU@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 0]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@O@A>@O?<??3??O?<??3??O?<??0@@@@@@@@b') ; yourself); yourself]
!
emptyIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self emptyIcon inspect
ImageEditor openOnClass:self andSelector:#emptyIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'HierarchicalListView class emptyIcon'
ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@EUTP@AUUE@@UUP@@EUUU@AUUUP@UUUT@EUUU@AUUUP@UUUT@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@O?@?>C?<O?8??#?>O?8??#?>O?8?? @@@@@@@@b') ; yourself); yourself]
!
expandedIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self expandedIcon inspect
ImageEditor openOnClass:self andSelector:#expandedIcon
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'HierarchicalListView class expandedIcon'
ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@UP@@@UU@@@EUUUPA@@@@@R*** B***(@***(@****@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 179 179 179 255 255 0]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@O@A>@O?<??3???????;??/?<??0@@@@@@@@b') ; yourself); yourself]
!
openIndicator
"This resource specification was automatically generated
by the ImageEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the ImageEditor may not be able to read the specification."
"
self openIndicator inspect
ImageEditor openOnClass:self andSelector:#openIndicator
Icon flushCachedIcons
"
<resource: #image>
^Icon
constantNamed:#'HierarchicalListView class openIndicator'
ifAbsentPut:[(Depth2Image new) width: 9; height: 9; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUU@Z*)@Z*)(Z*)HX@I@Z*)@Z*)@Z*)@UUU.') ; colorMapFromArray:#[0 0 0 128 128 128 255 255 255]; yourself]
! !
!HierarchicalListView methodsFor:'accessing'!
font:aFont
"set a new font; if the font changed, all my items
has to clear their cashed width and height
"
|root|
(aFont isNil or:[aFont = font]) ifFalse:[
root := self root.
root notNil ifTrue:[ root fontChanged ].
super font:aFont
].
!
list:aList
"test whether the list is not a hierarchical item and
retrieve the showRoot attribute from the list
"
aList notNil ifTrue:[
aList isHierarchicalItem ifTrue:[
self list root:aList.
aList expand.
^ self
].
showRoot := aList showRoot.
].
super list:aList
!
newDefaultList
"creates and returns a new default list class, on default a HierarchicalList
"
|list|
list := HierarchicalList new.
list showRoot:(showRoot ? true).
^ list
!
root
"returns the anchor of the list or nil
"
^ self list root
! !
!HierarchicalListView methodsFor:'accessing-behavior'!
autoScrollHorizontal
"true, than automatically scroll horizontal upto the text label
of the current selected line.
"
autoScrollHorizontal == true ifTrue:[
^ renderer autoScrollHorizontal
].
^ false
!
autoScrollHorizontal:aBoolean
"true, than automatically scroll horizontal upto the text label
of the current selected line.
"
autoScrollHorizontal := aBoolean.
!
expandOnSelect
"true, than the item selected by a buttonPress event will
be immediately expanded.
"
^ expandOnSelect
!
expandOnSelect:aBoolean
"true, than the item selected by a buttonPress event will
be immediately expanded.
"
expandOnSelect := aBoolean.
! !
!HierarchicalListView methodsFor:'accessing-colors'!
lineColor
"get the color of the horizontal and vertical lines
"
^ lineColor
!
lineColor:aColor
"set the color of the horizontal and vertical lines
"
(aColor notNil and:[aColor ~= lineColor]) ifTrue:[
lineColor := aColor.
shown ifTrue:[
lineColor := lineColor onDevice:device.
showLines ifTrue:[ self invalidate ]
]
].
! !
!HierarchicalListView methodsFor:'accessing-look'!
alignTextRight
"align the text right
"
^ alignTextRight
!
alignTextRight:aBool
"align the text right
"
alignTextRight := aBool ? false.
!
alignTextRightX
"returns the minimum used text inset, if text is aligned right.
"
^ alignTextRightX
!
alignTextRightX:aNumber
"set the minimum used text inset, if text is aligned right.
"
aNumber > 0 ifTrue:[
alignTextRightX := aNumber.
(alignTextRight and:[widthOfContents notNil]) ifTrue:[
widthOfContents := alignTextRightX + maxWidthOfText.
shown ifTrue:[
self invalidate.
self contentsChanged.
]
]
].
!
iconAt:aKey ifAbsentPut:aBlock
"return the icon stored under a key; if not present,the
result of the block if not nil is stored under the key
and returned.
"
|icon|
icon := icons at:aKey ifAbsent:nil.
icon notNil ifTrue:[^ icon].
icon := aBlock value.
icon isNil ifTrue:[^ nil].
realized ifTrue:[
icon := self imageOnMyDevice:icon
].
icons at:aKey put:icon.
^ icon
!
registerKeysAndIcons:aDictionary
"register icons by key and value derived from a directory
"
|image|
(aDictionary isNil or:[aDictionary isEmpty]) ifTrue:[
^ self
].
aDictionary keysAndValuesDo:[:aKey :anImage|
(image := self imageOnMyDevice:anImage) notNil ifTrue:[
icons at:aKey put:image
] ifFalse:[
icons removeKey:aKey ifAbsent:nil
]
]
!
showIndicators
"returns true if indicators are shown
"
^ showIndicators
!
showIndicators:aBoolean
"true if indicators are shown
"
showIndicators ~~ aBoolean ifTrue:[
showIndicators := aBoolean.
shown ifTrue:[ self invalidate ].
].
!
showLeftIndicators
"show or hide the indicators for the most left items
"
^ showLeftIndicators
!
showLeftIndicators:aBoolean
"show or hide the indicators for the most left items
"
|oldInset newInset|
aBoolean == showLeftIndicators ifTrue:[ ^ self ].
(widthOfContents isNil or:[self size == 0]) ifTrue:[
showLeftIndicators := aBoolean.
^ self
].
oldInset := self xVisibleOfIconAtLevel:3.
showLeftIndicators := aBoolean.
newInset := self xVisibleOfIconAtLevel:3.
newInset ~~ oldInset ifTrue:[
widthOfContents := widthOfContents + (newInset - oldInset).
].
shown ifTrue:[
self invalidate
].
newInset ~~ oldInset ifTrue:[
self contentsChanged
].
!
showLines
"returns true if lines are shown
"
^ showLines
!
showLines:aBoolean
"show or hide lines
"
aBoolean ~~ showLines ifTrue:[
showLines := aBoolean.
shown ifTrue:[ self invalidate ].
].
!
showRoot
"true if the root is shown
"
^ showRoot
!
showRoot:aBoolean
"true if the root is shown
"
showRoot ~~ aBoolean ifTrue:[
showRoot := aBoolean.
self list showRoot:showRoot.
shown ifTrue:[ self invalidate ]
].
!
useDefaultIcons
"use the default icons if no icon for an item is specified;
** default: true
"
^ useDefaultIcons
!
useDefaultIcons:aBoolean
"use the default icons if no icon for an item is specified;
** default: true
"
useDefaultIcons ~~ aBoolean ifTrue:[
useDefaultIcons := aBoolean.
shown ifTrue:[ self invalidate ].
]
! !
!HierarchicalListView methodsFor:'actions'!
indicatorAction
"the action evaluated if an indicator is pressed; otherwise
if indicators are shown a default action is performed (toggle expand item).
The arguments to the block are:
- no argument
- 1 argument index
- 2 argument index, self
"
^ indicatorAction
!
indicatorAction:anAction
"the action evaluated if an indicator is pressed; otherwise
if indicators are shown a default action is performed (toggle expand item).
The arguments to the block are:
- no argument
- 1 argument index
- 2 argument index, self
"
indicatorAction := anAction.
! !
!HierarchicalListView methodsFor:'change & update'!
indicatorPressedAt:aLnNr
"handle indicator pressed action;
if the item changed expanded, we try to show all
new visible children
"
|item expanded availY usedY vwOrgX vwOrgY idx|
showIndicators ifFalse:[^ self].
item := self at:aLnNr ifAbsent:nil.
item isNil ifTrue:[^ self].
item hasIndicator ifFalse:[^ self].
expanded := item isExpanded.
indicatorAction notNil ifTrue:[
indicatorAction valueWithOptionalArgument:aLnNr and:self.
] ifFalse:[ |sensor|
sensor := self sensor.
(sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
item recursiveToggleExpand
] ifFalse:[
item toggleExpand
].
].
(expanded or:[item isExpanded not]) ifTrue:[^ self].
"/ compute the index of last child assigned to item
idx := item numberOfVisibleChildren. "/ no visible children
idx == 0 ifTrue:[^ self].
idx := aLnNr + idx.
vwOrgY := viewOrigin y.
availY := (self yVisibleOfLine:aLnNr) - (self yVisibleOfLine:1).
availY > margin ifTrue:[
usedY := (self yVisibleOfLine:(idx + 1)) - (height - margin - margin).
usedY > 1 ifTrue:[
vwOrgY := vwOrgY + (usedY min:availY).
].
].
vwOrgX := self computeViewOriginXat:aLnNr.
self scrollTo:(vwOrgX @ vwOrgY).
!
lineChangedAt:aLnNr with:arg
"line changed at position; check whether line height changed
"
|item
level "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
yB "{ Class:SmallInteger }"
|
item := self at:aLnNr ifAbsent:nil.
item isNil ifTrue:[^ self].
(arg == #icon or:[arg == #hierarchy]) ifFalse:[
super lineChangedAt:aLnNr with:arg.
(arg ~~ #redraw and:[widthOfContents notNil]) ifTrue:[
x0 := (self xVisibleOfTextAtLevel:(item level))
+ (renderer widthFor:item)
+ (viewOrigin x).
x0 > widthOfContents ifTrue:[
widthOfContents := x0.
self contentsChanged.
]
].
^ self
].
level := item level.
(alignTextRight and:[arg == #hierarchy]) ifTrue:[
"/ must test whether alignTextRightX is enough
(item isExpanded and:[item hasChildren]) ifTrue:[
x0 := self xVisibleOfIconAtLevel:(level + 2).
alignTextRightX < x0 ifTrue:[
alignTextRightX := x0.
shown ifTrue:[ self invalidate ].
widthOfContents notNil ifTrue:[
widthOfContents := alignTextRightX + maxWidthOfText.
self contentsChanged.
].
^ self.
]
]
].
shown ifFalse:[^ self].
yB := height - margin.
y0 := (self yVisibleOfLine:aLnNr) max:margin.
y0 < yB ifFalse:[ ^ self ].
y1 := (self yVisibleOfLine:(aLnNr + 1)) min:yB.
y1 > y0 ifFalse:[^ self].
x1 := (self xVisibleOfTextAtLevel:level) - 1.
x1 > margin ifFalse:[^ self].
x0 := (self xVisibleOfIndicatorAtLevel:level) max:margin.
x1 := x1 min:(width - margin).
x0 < x1 ifTrue:[
self invalidate:(Rectangle left:x0 top:y0 width:(x1 - x0) height:(y1 - y0))
repairNow:false.
].
!
listChangedInsert:firstAddedIndex nItems:nLines
"must draw vertical lines above the added items
"
|item level yTop yBot xLft start maxY|
super listChangedInsert:firstAddedIndex nItems:nLines.
item := self last.
levelOfLastItem := item level.
( shown
and:[showLines
and:[firstAddedIndex > 1
and:[nLines ~~ 0
and:[(item := self at:firstAddedIndex ifAbsent:nil) notNil
and:[(level := item level) > 1]]]]]
) ifFalse:[
^ self.
].
xLft := self xVisibleOfVerticalLineAt:level.
(xLft > margin and:[xLft < (width - margin)]) ifFalse:[
^ self
].
start := firstAddedIndex - 1.
start to:1 by:-1 do:[:i| |el|
el := self at:i.
el level <= level ifTrue:[
i == start ifTrue:[^ self].
yTop := (self yVisibleOfLine:i + 1) max:margin.
maxY := height - margin.
yTop < maxY ifTrue:[
yBot := (self yVisibleOfLine:firstAddedIndex) - 1 min:maxY.
self invalidate:(Rectangle left:xLft top:yTop width:2 height:(yBot - yTop))
].
^ self
]
].
!
listChangedRemove:aStart toIndex:aStop
"test whether last items are deleted;
than we have to redraw lines because of different levels
"
|listSize index y0 searchLevel|
listSize := self size.
searchLevel := levelOfLastItem.
listSize == 0 ifTrue:[ levelOfLastItem := 1 ]
ifFalse:[ levelOfLastItem := self last level ].
(shown and:[showLines and:[listSize ~~ 0 and:[aStart > listSize]]]) ifTrue:[
index := self findLast:[:el| el level <= searchLevel ].
(index ~~ 0 and:[index < listSize]) ifTrue:[
y0 := (self yVisibleOfLine:index) max:margin.
self invalidateX:0 y:y0 width:width height:(height - margin - y0).
]
].
^ super listChangedRemove:aStart toIndex:aStop
!
updateFromList:what with:aPara
"get the status of <showRoot> from the list
"
|newState|
newState := self list showRoot.
showRoot ~~ newState ifTrue:[
showRoot := newState.
self invalidate.
].
super updateFromList:what with:aPara.
! !
!HierarchicalListView methodsFor:'drawing basics'!
drawElementsFrom:start to:stop x:xLeft y:yT w:w
"draw the items between start to stop without clearing the background
"
|item prevParent icon showIndc showIcon showText
yTop "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
level "{ Class:SmallInteger }"
xIndc "{ Class:SmallInteger }"
xIcon "{ Class:SmallInteger }"
xText "{ Class:SmallInteger }"
xL "{ Class:SmallInteger }"
xR "{ Class:SmallInteger }"
height "{ Class:SmallInteger }"
offIndcY "{ Class:SmallInteger }"
|
xL := xLeft.
xR := xL + w.
showIndicators ifTrue:[
offIndcY := openIndicator width // 2.
].
showLines ifTrue:[
self drawLinesFrom:start to:stop x:xL y:yT toX:xR
].
prevParent := #NIL. "/ to force a recompute
yBot := yT.
showIndc := false.
start to:stop do:[:anIndex|
(item := self at:anIndex ifAbsent:nil) isNil ifTrue:[
^ self "/ list changed
].
yTop := yBot.
yBot := self yVisibleOfLine:(anIndex + 1).
height := yBot - yTop.
yCtr := yTop + (height // 2).
item parent ~~ prevParent ifTrue:[
prevParent := item parent.
level := item level.
xIcon := self xVisibleOfIconAtLevel:level.
xText := self xVisibleOfTextAtLevel:level.
showText := (xText < xR).
showIcon := (xIcon < xR and:[xText > xL]).
showIndicators ifTrue:[
xIndc := self xVisibleOfIndicatorAtLevel:level.
showIndc := (xIcon > xL and:[xIndc < xR]).
showIndc ifTrue:[
showIndc := prevParent notNil or:[showLeftIndicators]
]
]
].
(showIcon and:[(icon := self validateDrawableIconFor:item) notNil]) ifTrue:[
(xIcon + icon width) > xL ifTrue:[
icon displayOn:self x:xIcon y:(yCtr - (icon height // 2))
]
].
showText ifTrue:[
self drawLabelAt:anIndex x:xText y:yTop h:height
].
(showIndc and:[item hasIndicator]) ifTrue:[
item isExpanded ifTrue:[icon := openIndicator ]
ifFalse:[icon := closeIndicator].
icon displayOn:self x:xIndc y:(yCtr - offIndcY)
].
].
!
drawLinesFrom:start to:stop x:xL y:yT toX:xR
"draw the lines between start to stop without clearing the background
"
|item prevItem parent p1 p2 showVLines showHLine lv buildInArray showLeftIdc
x "{ Class:SmallInteger }"
xText "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
yTop "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
begHLnY "{ Class:SmallInteger }"
runHLnY "{ Class:SmallInteger }"
lftVrtX "{ Class:SmallInteger }"
rgtVrtX "{ Class:SmallInteger }"
level "{ Class:SmallInteger }"
minVertLevel "{ Class:SmallInteger }"
minHorzLevel "{ Class:SmallInteger }"
smallestLevel "{ Class:SmallInteger }"
|
parent := prevItem := 4711. "/ to force a recompute
self setMaskOrigin:(self viewOrigin + (0 @ 1) \\ (lineMask extent)).
self paint:lineColor on:bgColor.
self mask:lineMask.
smallestLevel := self smallestLevelBetween:start and:stop.
minVertLevel := 2.
showLeftIndicators ifTrue:[
showLeftIdc := showIndicators.
showRoot ifFalse:[ minVertLevel := 3 ]
] ifFalse:[
showLeftIdc := false.
].
showRoot ifFalse:[ minHorzLevel := 2 ]
ifTrue:[ minHorzLevel := 1 ].
showLeftIdc ifFalse:[
minHorzLevel := minHorzLevel + 1.
].
yBot := begHLnY := runHLnY := yT.
level := 1.
start to:stop do:[:anIndex|
(item := self at:anIndex ifAbsent:nil) isNil ifTrue:[
^ self mask:nil "/ list changed
].
yTop := yBot.
yBot := self yVisibleOfLine:(anIndex + 1).
yCtr := yTop + (yBot - yTop // 2).
item parent ~~ parent ifTrue:[
anIndex == 1 ifTrue:[ begHLnY := runHLnY := yCtr ].
parent := item parent.
prevItem == parent ifTrue:[
level := level + 1.
lftVrtX := rgtVrtX.
] ifFalse:[
level := item level.
lftVrtX := self xVisibleOfVerticalLineAt:level.
].
showVLines := (level >= minVertLevel and:[lftVrtX >= xL]).
rgtVrtX := self xVisibleOfVerticalLineAt:level + 1.
level >= minHorzLevel ifTrue:[
xText := (self xVisibleOfTextAtLevel:level) - textStartLeft.
showHLine := (xL < xText and:[xR > lftVrtX]).
] ifFalse:[
showHLine := false
].
].
showHLine ifTrue:[
( level ~~ 2
or:[showRoot or:[(showLeftIdc and:[item hasIndicator])]]
) ifTrue:[
item drawHorizontalLineUpToText ifTrue:[ x := xText ]
ifFalse:[ x := rgtVrtX ].
self displayLineFromX:lftVrtX y:yCtr toX:x y:yCtr.
].
].
anIndex == start ifTrue:[
(item isExpanded and:[item hasChildren]) ifTrue:[
self displayLineFromX:rgtVrtX y:yCtr toX:rgtVrtX y:yBot.
]
].
showVLines ifTrue:[
parent last == item ifTrue:[ y := yCtr ]
ifFalse:[ y := yBot ].
x := lftVrtX.
p2 := parent.
lv := level - 1.
level >= smallestLevel ifTrue:[
self displayLineFromX:x y:runHLnY toX:x y:y.
].
[ (p2 notNil and:[lv >= minVertLevel]) ] whileTrue:[
p1 := p2 parent.
p1 notNil ifTrue:[
x := self xVisibleOfVerticalLineAt:lv.
x < xL ifTrue:[
p1 := nil.
] ifFalse:[
p1 last ~~ p2 ifTrue:[
lv >= smallestLevel ifTrue:[
self displayLineFromX:x y:(yTop - 1) toX:x y:yBot
] ifFalse:[
buildInArray isNil ifTrue:[buildInArray := Array new:smallestLevel].
buildInArray at:lv put:yBot
]
].
].
].
p2 := p1.
lv := lv - 1.
].
].
prevItem := item.
runHLnY := yCtr.
].
buildInArray notNil ifTrue:[
y := begHLnY.
2 to:smallestLevel do:[:i| |u yB|
(yB := buildInArray at:i) notNil ifTrue:[
x := self xVisibleOfVerticalLineAt:i.
x >= xL ifTrue:[
self displayLineFromX:x y:y toX:x y:yB
]
].
]
].
self mask:nil.
!
validateDrawableIconFor:anItem
"returns the icon to be drawn for an item or nil
test the extent of the icopn; on error an exception is raised
"
|width needMore icon maxLevel startOfText oldX newX|
icon := self iconFor:anItem.
icon isNil ifTrue:[^ nil].
width := icon width.
(constantHeight notNil and:[icon height > constantHeight]) ifTrue:[
constantHeight := icon height + lineSpacing.
self recomputeHeightOfContents.
width <= imageWidth ifTrue:[
self contentsChanged.
StopRedrawSignal raiseRequest
].
] ifFalse:[
width <= imageWidth ifTrue:[ ^ icon ].
].
maxLevel := 1.
self list criticalDo:[
self list do:[:el| maxLevel := maxLevel max:(el level) ].
].
needMore := (width - imageWidth) max:2.
oldX := self xVisibleOfIconAtLevel:(maxLevel + 1).
imageWidth := imageWidth + needMore.
newX := self xVisibleOfIconAtLevel:(maxLevel + 1).
alignTextRightX := alignTextRightX max:newX.
widthOfContents notNil ifTrue:[
alignTextRight ifTrue:[
widthOfContents := alignTextRightX + maxWidthOfText
] ifFalse:[
widthOfContents := widthOfContents + (newX - oldX)
].
width := renderer widthFor:anItem.
startOfText := self xVisibleOfTextAtLevel:(anItem level).
widthOfContents := widthOfContents max:(startOfText + width).
width > maxWidthOfText ifTrue:[
maxWidthOfText := width
].
].
self contentsChanged.
StopRedrawSignal raiseRequest.
^ icon
! !
!HierarchicalListView methodsFor:'event handling'!
buttonPress:button x:x y:y
"handle a button press event
"
|line item x0 y0|
enabled ifFalse:[^ self].
self closeEditor.
line := self yVisibleToLineNr:y.
line notNil ifTrue:[
item := self at:line ifAbsent:nil.
item notNil ifTrue:[
x0 := self xVisibleOfIconAtLevel:(item level).
x >= x0 ifTrue:[
x0 := self xVisibleOfTextAtLevel:(item level).
y0 := self yVisibleOfLine:line.
x >= x0 ifTrue:[
(item processButtonPress:button x:(x - x0) y:(y - y0) on:self) == true ifTrue:[
^ self
]
] ifFalse:[
(item processButtonPressOnIcon:button on:self) == true ifTrue:[
^ self
]
]
].
]
] ifFalse:[
item := nil
].
showIndicators ifTrue:[
(button == 1 or:[button == #select]) ifTrue:[
(item notNil and:[item hasIndicator]) ifTrue:[
x0 := self xVisibleOfIndicatorAtLevel:(item level).
(x between:x0 and:(x0 + openIndicator width)) ifTrue:[
self indicatorPressedAt:line.
^ self
].
].
].
].
super buttonPress:button x:x y:y.
!
buttonPressOrReleaseAtLine:aLnNr x:x y:y
"handle a button press or release at a line
"
|oldIdx newIdx newItem|
oldIdx := self selectedIndex.
super buttonPressOrReleaseAtLine:aLnNr x:x y:y.
newIdx := self selectedIndex.
(newIdx ~~ oldIdx and:[newIdx ~~ 0]) ifTrue:[
expandOnSelect ifTrue:[
newItem := self at:newIdx ifAbsent:nil.
newItem isNil ifTrue:[^ self].
newItem expand
].
self makeLineVisible:newIdx.
].
!
keyPress:aKey x:x y:y
"a key was pressed - handle page-keys here
"
<resource: #keyboard( #CursorLeft #CursorRight )>
|item lineNr isCursorLeft|
enabled ifFalse:[^ self].
( aKey == Character space
or:[aKey == #CursorRight
or:[aKey == #CursorLeft]]
) ifFalse:[
super keyPress:aKey x:x y:y.
^ self
].
lineNr := self cursorLine.
lineNr ~~ 0 ifTrue:[
item := cursorItem
] ifFalse:[
lineNr := self selectedIndex.
lineNr == 0 ifTrue:[^ self].
item := self at:lineNr ifAbsent:nil.
item isNil ifTrue:[^ self].
].
aKey == Character space ifTrue:[
item toggleExpand.
^ self
].
isCursorLeft := aKey == #CursorLeft.
item isExpanded == isCursorLeft ifTrue:[
item toggleExpand.
^ self
].
isCursorLeft ifTrue:[
(item := item parent) isNil ifTrue:[^ self].
lineNr := self identityIndexOf:item.
] ifFalse:[
item hasChildren ifFalse:[^ self].
lineNr := lineNr + 1.
].
item := self at:lineNr ifAbsent:nil.
item isNil ifTrue:[^ self].
(self canSelectIndex:lineNr forAdd:false) ifTrue:[
self selection:lineNr
].
! !
!HierarchicalListView methodsFor:'fetch resources'!
fetchResources
"fetch device colors and ..., to avoid reallocation at redraw time;
*** called after a create or snapin to fetch all device resources
"
|image defaultWidth|
super fetchResources.
lineColor := lineColor onDevice:device.
openIndicator := self imageOnMyDevice:openIndicator.
closeIndicator := self imageOnMyDevice:closeIndicator.
defaultWidth := imageWidth.
icons keysAndValuesDo:[:aKey :anImage|
anImage isNil ifTrue:[
('HierachicalListView [warning]: missing image: ' , aKey) errorPrintCR.
] ifFalse:[
image := self imageOnMyDevice:anImage.
icons at:aKey put:image.
imageWidth := image width max:imageWidth.
]
].
imageWidth := (imageWidth + 1 // 2 * 2) max:defaultWidth.
alignTextRightX := imageWidth + 20 max:alignTextRightX.
! !
!HierarchicalListView methodsFor:'initialization & release'!
initStyle
"setup viewStyle specifics
"
|cls|
super initStyle.
cls := self class.
icons := Dictionary new.
openIndicator := self class openIndicator.
closeIndicator := self class closeIndicator.
minLineHeight := (openIndicator height) max:(closeIndicator height).
lineColor := fgColor.
highlightMode := #label.
showRoot := true.
showLeftIndicators := true.
useDefaultIcons := true.
showLines := true.
imageInset := 4.
imageWidth := 0.
alignTextRight := false.
alignTextRightX := 8.
maxWidthOfText := 0.
highlightEnterItem := styleSheet at:#'selection.highlightEnterItem' default:false.
expandOnSelect := styleSheet at:#'selection.expandOnSelect' default:false.
autoScrollHorizontal := true.
!
initialize
super initialize.
levelOfLastItem := 1.
self showIndicators:true.
! !
!HierarchicalListView methodsFor:'private'!
iconFor:anItem
"returns an icon or image for the item or nil if the item
provides no image and #useDefaultIcons is switched off.
"
|iconOrKey image|
"/ get the icon or access key from the item
iconOrKey := anItem icon.
iconOrKey notNil ifTrue:[
iconOrKey isImageOrForm ifTrue:[
"/ got an image; have to register the image on my device
iconOrKey device == device ifTrue:[
^ iconOrKey
].
^ icons at:iconOrKey ifAbsentPut:[ self imageOnMyDevice:iconOrKey ].
].
image := icons at:iconOrKey ifAbsent:nil.
image notNil ifTrue:[ ^ image ].
].
"/ test whether a default image should be returned
useDefaultIcons ifFalse:[
^ nil
].
anItem hasChildren ifFalse:[
^ icons at:#empty ifAbsentPut:[ self imageOnMyDevice:(self class emptyIcon) ]
].
anItem isExpanded ifTrue:[
^ icons at:#expanded ifAbsentPut:[ self imageOnMyDevice:(self class expandedIcon) ].
].
^ icons at:#collapsed ifAbsentPut:[ self imageOnMyDevice:(self class collapsedIcon) ].
!
lineHeightFor:anItem
"returns the computed line height for an item
"
|image height|
height := renderer heightFor:anItem.
image := self iconFor:anItem.
image notNil ifTrue:[
height := image height max:height.
].
hasConstantHeight ifTrue:[
icons size ~~ 0 ifTrue:[
icons do:[:anIcon| height := anIcon height max:height ]
] ifFalse:[
image isNil ifTrue:[ height := height max:16 ]
]
].
height := height + lineSpacing.
^ height max:minLineHeight
!
smallestLevelBetween:start and:stop
"returns the smallest level of all items in a range
"
|prevItem currParent nextParent item
lvl "{ Class:SmallInteger }"
min "{ Class:SmallInteger }"
beg "{ Class:SmallInteger }"
|
prevItem := self at:start ifAbsent:nil.
(prevItem isNil or:[(currParent := prevItem parent) isNil]) ifTrue:[
^ 1
].
(min := prevItem level) == 2 ifTrue:[
^ min
].
beg := start + 1.
beg to:stop do:[:i|
item := self at:i ifAbsent:nil.
item isNil ifTrue:[^ min].
(nextParent := item parent) == currParent ifFalse:[
(currParent := nextParent) == prevItem ifFalse:[
(lvl := item level) == 2 ifTrue:[
^ 2
].
min := min min:lvl
]
].
prevItem := item
].
^ min
!
widthOfWidestLineBetween:firstLine and:lastLine
"returns the width of the longest line in pixels in a range
"
|parent item textX level width widthOfLabel|
width := renderer widthOfWidestLineBetween:firstLine and:lastLine.
width notNil ifTrue:[^ width].
width := 20.
alignTextRight ifTrue:[
parent := nil.
level := 1.
firstLine to:lastLine do:[:idx|
item := self at:idx ifAbsent:nil.
item notNil ifTrue:[
width := (renderer widthFor:item) max:width.
item parent ~~ parent ifTrue:[
level := item level max:level.
parent := item parent.
].
].
].
maxWidthOfText := maxWidthOfText max:width.
textX := self xVisibleOfIconAtLevel:(level + 1).
alignTextRightX < textX ifTrue:[
alignTextRightX := textX.
shown ifTrue:[ self invalidate].
].
^ alignTextRightX + width
].
parent := 4711. "/ force a computation
firstLine to:lastLine do:[:idx|
item := self at:idx ifAbsent:nil.
item notNil ifTrue:[
item parent ~~ parent ifTrue:[
textX := self xVisibleOfTextAtLevel:(item level).
parent := item parent.
].
widthOfLabel := renderer widthFor:item.
maxWidthOfText := maxWidthOfText max:widthOfLabel.
width := widthOfLabel + textX max:width
].
].
^ width + viewOrigin x.
!
xVisibleOfIconAtLevel:aLevel
"returns the visible origin x of the icon at a level.
"
|x|
x := self xVisibleOfVerticalLineAt:aLevel.
(showRoot and:[aLevel == 1]) ifTrue:[
showLeftIndicators ifFalse:[
^ x - (imageWidth // 2)
].
].
^ x + (openIndicator width // 2) + imageInset
!
xVisibleOfIndicatorAtLevel:aLevel
"returns the visible origin x of the vertical line at a level.
"
|x|
x := self xVisibleOfVerticalLineAt:aLevel.
x := x - (openIndicator width // 2).
^ x
!
xVisibleOfItem:anItem
"returns the visible origin x of the item's label.
"
^ self xVisibleOfTextAtLevel:(anItem level)
!
xVisibleOfTextAtLevel:aLevel
"returns the visible origin x of the text label at a level.
"
alignTextRight ifTrue:[
^ alignTextRightX - (viewOrigin x)
].
^ (self xVisibleOfIconAtLevel:aLevel) + imageWidth + textStartLeft
!
xVisibleOfVerticalLineAt:aLevel
"returns the visible origin x of the vertical line assigned to a level.
"
|xOffset opWidth2 igWidth2 firstLevel|
opWidth2 := openIndicator width // 2.
igWidth2 := imageWidth // 2.
xOffset := igWidth2 + opWidth2 + imageInset.
showRoot ifTrue:[ firstLevel := 1 ]
ifFalse:[ firstLevel := 2 ].
showLeftIndicators ifTrue:[
aLevel < firstLevel ifTrue:[
xOffset := opWidth2 - (firstLevel * xOffset)
] ifFalse:[
xOffset := opWidth2 + (aLevel - firstLevel * xOffset)
]
] ifFalse:[
aLevel < 2 ifTrue:[
xOffset := igWidth2 - (aLevel - firstLevel * xOffset)
] ifFalse:[
xOffset := igWidth2 + (aLevel - firstLevel - 1 * xOffset)
].
].
"/ 2 := a left margin
^ xOffset + 2 - (viewOrigin x)
! !
!HierarchicalListView methodsFor:'scrolling'!
computeViewOriginXat:aLnrNr
"returns the viewOrigin x to make the item at a line visisble
"
|item xLft xRgt level vwOrgX useX|
vwOrgX := viewOrigin x.
renderer autoScrollHorizontal ifFalse:[^ vwOrgX ].
alignTextRight ifTrue:[ ^ vwOrgX ].
aLnrNr == 1 ifTrue:[ ^ 0 ].
item := self at:aLnrNr ifAbsent:nil.
item isNil ifTrue:[ ^ vwOrgX ].
level := item level.
level == 1 ifTrue:[ ^ 0 ]. "/ is root item
level == 2 ifTrue:[ "/ parent is root
(showRoot and:[showLeftIndicators]) ifFalse:[ ^ 0 ].
].
xLft := self xVisibleOfIconAtLevel:(level - 1).
xLft > 0 ifFalse:[ ^ vwOrgX + xLft max:0 ].
xRgt := (self xVisibleOfTextAtLevel:level) + (renderer widthFor:item).
useX := xRgt - width.
useX > 0 ifFalse:[ ^ vwOrgX ].
useX := useX + 16 min:xLft.
^ vwOrgX + useX.
!
makeLineVisible:aLnrNr
"make the line horizontal and vertical visible
"
|newY item y0 newX|
alignTextRight ifTrue:[^ self].
(shown and:[aLnrNr notNil]) ifFalse:[^ self].
aLnrNr <= 1 ifTrue:[
aLnrNr == 1 ifTrue:[
newX := self computeViewOriginXat:1.
self scrollTo:(newX @ 0).
].
^ self
].
item := self at:aLnrNr ifAbsent:nil.
item isNil ifTrue:[^ self].
y0 := self yVisibleOfLine:aLnrNr.
( y0 < margin
or:[(y0 + (renderer heightFor:item)) > (height - margin)]
) ifTrue:[
newY := ((self yAbsoluteOfLine:aLnrNr) - (height // 2)) max:0.
] ifFalse:[
newY := viewOrigin y.
].
newX := viewOrigin x.
(self autoScrollHorizontal or:[newX ~~ 0]) ifTrue:[
newX := self computeViewOriginXat:aLnrNr
].
self scrollTo:(newX @ newY).
! !
!HierarchicalListView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalListView.st,v 1.90 2004-02-20 11:36:40 ca Exp $'
! !