"
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 lineMask lineColor showRoot showLines
showLeftIndicators indicatorAction useDefaultIcons icons
openIndicator closeIndicator alignTextRight alignTextRightX
maxWidthOfText minLineHeight levelOfLastItem expandOnSelect
autoScrollHorizontal'
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
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
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 miniScroller: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 miniScroller: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]
"
! !
!HierarchicalListView class methodsFor:'resources'!
closeIndicator
"returns a little [+] bitmap"
<resource: #fileImage>
^ Icon constantNamed:#plus
ifAbsentPut:[Smalltalk imageFromFileNamed:'plus.xpm' forClass:self]
!
collapsedIcon
"returns icon to indicate a collapsed entry
"
<resource: #fileImage>
^ Icon constantNamed:#directory
ifAbsentPut:[Smalltalk imageFromFileNamed:'dir.xpm' forClass:self]
!
emptyIcon
"returns icon to indicate an not extendable entry
"
<resource: #fileImage>
^ Icon constantNamed:#plainFile
ifAbsentPut:[Smalltalk imageFromFileNamed:'file_plain.xpm' forClass:self]
!
expandedIcon
"returns icon to indicate an extended entry
"
<resource: #fileImage>
^ Icon constantNamed:#directoryOpened
ifAbsentPut:[Smalltalk imageFromFileNamed:'dir_open.xpm' forClass:self]
!
openIndicator
"returns a little [-] bitmap"
<resource: #fileImage>
^ Icon constantNamed:#minus
ifAbsentPut:[Smalltalk imageFromFileNamed:'minus.xpm' forClass:self]
! !
!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:[
(list notNil and:[(root := list root) notNil]) ifTrue:[
root fontChanged
].
super font:aFont
].
!
list:aList
"get the status of <showRoot> from the list
"
aList notNil ifTrue:[
showRoot := aList showRoot
].
super list:aList
!
parentToChildInset
"returns the computed inset between parent / child
"
^ imageInset + imageWidth
! !
!HierarchicalListView methodsFor:'accessing-behavior'!
autoScrollHorizontal
"true, than automatically scroll horizontal upto the text label
of the current selected line.
"
^ 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 > self parentToChildInset 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 imageOnDevice: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 imageOnDevice:anImage) notNil ifTrue:[
icons at:aKey put:image
] ifFalse:[
icons removeKey:aKey ifAbsent:nil
]
]
!
showLeftIndicators
"show or hide the indicators for the most left items
"
^ showLeftIndicators
!
showLeftIndicators:aBoolean
"show or hide the indicators for the most left items
"
aBoolean ~~ showLeftIndicators ifTrue:[
showLeftIndicators := aBoolean.
shown ifTrue:[ self invalidate ].
].
!
showLines
"returns true if lines are shown
"
^ showLines
!
showLines:aBoolean
"show or hide lines
"
aBoolean ~~ showLines ifTrue:[
showLines := aBoolean.
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
"if the action is not nil, indicators are shown and a click on the indicator
will evaluate the action with none or one argument, the index into the list
"
^ indicatorAction
!
indicatorAction:anAction
"if the action is not nil, indicators are shown and a click on the indicator
will evaluate the action with none or one argument, the index into the list
"
|maxLevel contentsChgSize|
(indicatorAction isNil) == (anAction isNil) ifTrue:[
indicatorAction := anAction.
^ self
].
(widthOfContents isNil or:[list size == 0]) ifTrue:[
indicatorAction := anAction.
self invalidate.
^ self
].
"/ must recompute width of contents
maxLevel := 0.
list do:[:el| maxLevel := maxLevel max:(el level) ].
contentsChgSize := self xOfFigureLevel:maxLevel.
indicatorAction := anAction.
contentsChgSize := (self xOfFigureLevel:maxLevel) - contentsChgSize.
widthOfContents := widthOfContents + contentsChgSize.
self invalidate.
contentsChgSize ~~ 0 ifTrue:[ self contentsChanged ].
! !
!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|
indicatorAction isNil ifTrue:[^ self].
item := list at:aLnNr ifAbsent:nil.
item isNil ifTrue:[^ self].
item hasIndicator ifFalse:[^ self].
expanded := item isExpanded.
indicatorAction valueWithOptionalArgument:aLnNr.
(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) - margin.
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
lv "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
yB "{ Class:SmallInteger }"
|
(arg == #icon or:[arg == #hierarchy]) ifFalse:[
item := list at:aLnNr ifAbsent:nil.
item isNil ifTrue:[^ self].
super lineChangedAt:aLnNr with:arg.
(arg ~~ #redraw and:[widthOfContents notNil]) ifTrue:[
x0 := (self xOfStringLevel:(item level))
+ (item widthOn:self)
+ (viewOrigin x).
x0 > widthOfContents ifTrue:[
widthOfContents := x0.
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].
x0 := margin.
x1 := width - margin.
(item := list at:aLnNr ifAbsent:nil) isNil ifFalse:[
lv := item level.
x1 := (self xOfStringLevel:lv) - (textStartLeft // 2).
arg == #hierarchy ifTrue:[ lv := lv - 1 ].
x0 := (self xOfFigureLevel:lv) max:margin.
x1 := x1 min:(width - margin).
x1 > x0 ifFalse:[^ self]
].
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 := list last.
levelOfLastItem := item level.
( shown
and:[showLines
and:[firstAddedIndex > 1
and:[nLines ~~ 0
and:[(item := list at:firstAddedIndex ifAbsent:nil) notNil
and:[(level := item level) > 1]]]]]
) ifFalse:[
^ self.
].
xLft := (self xOfFigureLevel:(level - 1)) + (imageWidth // 2) - 1.
(xLft > margin and:[xLft < (width - margin)]) ifFalse:[
^ self
].
start := firstAddedIndex - 1.
start to:1 by:-1 do:[:i| |el|
el := list 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:3 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 := list size.
searchLevel := levelOfLastItem.
listSize == 0 ifTrue:[ levelOfLastItem := 1 ]
ifFalse:[ levelOfLastItem := list last level ].
(shown and:[showLines and:[listSize ~~ 0 and:[aStart > listSize]]]) ifTrue:[
index := list 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
!
update:what with:aPara from:chgObj
"get the status of <showRoot> from the list
"
chgObj == list ifTrue:[
showRoot ~~ list showRoot ifTrue:[
showRoot := list showRoot.
self invalidate.
]
].
super update:what with:aPara from:chgObj
! !
!HierarchicalListView methodsFor:'drawing basics'!
displayElement:anItem x:x y:y h:h
"draw a label at x/y; fg/bg colors are already set
"
anItem displayOn:self x:x y:y h:h
!
drawElementsFrom:start to:stop x:xLeft y:yT w:w
"draw the items between start to stop without clearing the background
"
|item prevItem parent icon showIndc showIcon showText nxtPrnt iconHeight
iconExtent
yTop "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
xIndc "{ Class:SmallInteger }"
xIcon "{ Class:SmallInteger }"
xText "{ Class:SmallInteger }"
xDeltaIT "{ Class:SmallInteger }"
xL "{ Class:SmallInteger }"
xR "{ Class:SmallInteger }"
height "{ Class:SmallInteger }"
widthLvl "{ Class:SmallInteger }"
insetTxt "{ Class:SmallInteger }"
offIndcX "{ Class:SmallInteger }"
offIndcY "{ Class:SmallInteger }"
offIconX "{ Class:SmallInteger }"
iconWidth "{ Class:SmallInteger }"
iconRgtX "{ Class:SmallInteger }"
|
widthLvl := self parentToChildInset.
insetTxt := textStartLeft + imageWidth.
xL := xLeft.
xR := xL + w.
alignTextRight ifTrue:[
xText := alignTextRightX - (viewOrigin x).
showText := xText < xR.
].
offIconX := self xOfFigureLevel:0.
showIndc := false.
indicatorAction notNil ifTrue:[
offIndcX := offIndcY := 0.
openIndicator notNil ifTrue:[
iconExtent := openIndicator extent // 2.
offIndcX := imageWidth // 2 - widthLvl.
offIndcX := offIndcX - iconExtent x.
offIndcY := iconExtent y.
]
].
showLines ifTrue:[
self drawLinesFrom:start to:stop x:xL y:yT toX:xR
].
parent := 4711. "/ to force a recompute
prevItem := 4711. "/ to force a recomputation of the level
yBot := yT.
xIcon := offIconX.
start to:stop do:[:anIndex|
(item := list at:anIndex ifAbsent:nil) isNil ifTrue:[
^ self "/ list changed
].
yTop := yBot.
yBot := self yVisibleOfLine:(anIndex + 1).
height := yBot - yTop.
yCtr := yTop + (height // 2).
(nxtPrnt := item parent) ~~ parent ifTrue:[
parent := nxtPrnt.
xIcon := prevItem == parent ifTrue:[xIcon + widthLvl]
ifFalse:[item level * widthLvl + offIconX].
alignTextRight ifFalse:[
xText := xIcon + insetTxt.
showText := xText < xR.
].
showIcon := xIcon < xR and:[xText > xL].
indicatorAction notNil ifTrue:[
xIndc := xIcon + offIndcX.
(xIcon > xL and:[xIndc < xR]) ifTrue:[
showIndc := parent notNil or:[showLeftIndicators]
] ifFalse:[
showIndc := false
]
]
].
(showIcon and:[(icon := self figureFor:item) notNil]) ifTrue:[
iconWidth := icon width.
iconHeight := icon height.
iconRgtX := xIcon + iconWidth.
xDeltaIT := xText - textStartLeft - iconRgtX.
xDeltaIT < 0 ifTrue:[
alignTextRightX := alignTextRightX - xDeltaIT.
widthOfContents notNil ifTrue:[
alignTextRight ifFalse:[ |old|
iconWidth := iconWidth + 1 // 2 * 2.
widthLvl := (iconWidth - imageWidth) max:2.
imageWidth := imageWidth + widthLvl.
list criticalDo:[
xL := 1.
list do:[:el| xL := xL max:(el level) ].
list showRoot ifFalse:[ xL := xL - 1 ].
widthOfContents := widthOfContents + (xL * widthLvl)
].
] ifTrue:[
widthOfContents := alignTextRightX + maxWidthOfText
].
widthLvl := self xOfStringLevel:(item level).
xText := item widthOn:self.
xText > maxWidthOfText ifTrue:[ maxWidthOfText := xText ].
widthOfContents := (widthLvl + xText) max:widthOfContents.
].
(constantHeight notNil and:[ iconHeight >= constantHeight ]) ifTrue:[
constantHeight := iconHeight + lineSpacing.
self recomputeHeightOfContents.
].
self contentsChanged.
StopRedrawSignal raise
].
iconRgtX > xL ifTrue:[
(constantHeight notNil and:[ iconHeight >= constantHeight ]) ifTrue:[
constantHeight := iconHeight + lineSpacing.
self recomputeHeightOfContents.
self contentsChanged.
StopRedrawSignal raise
].
icon displayOn:self x:xIcon y:(yCtr - (iconHeight // 2))
]
].
showText ifTrue:[
self drawLabelAt:anIndex x:xText y:yTop h:height
].
(showIndc and:[item hasIndicator]) ifTrue:[
icon := item isExpanded ifTrue:[openIndicator] ifFalse:[closeIndicator].
icon notNil ifTrue:[
icon displayOn:self x:xIndc y:(yCtr - offIndcY)
]
].
prevItem := item.
]
!
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 nxtPrnt
showRootNot isFirst buildInArray
x "{ Class:SmallInteger }"
xText "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
yTop "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
begHLnY "{ Class:SmallInteger }"
runHLnY "{ Class:SmallInteger }"
begHLnX "{ Class:SmallInteger }"
endHLnX "{ Class:SmallInteger }"
widthLvl "{ Class:SmallInteger }"
offsHLnX "{ Class:SmallInteger }"
level "{ Class:SmallInteger }"
startLvI "{ Class:SmallInteger }"
startLvX "{ Class:SmallInteger }"
limitLvI "{ Class:SmallInteger }"
limitLvX "{ Class:SmallInteger }"
imgHWdt "{ Class:SmallInteger }"
minXVLine "{ Class:SmallInteger }"
|
imgHWdt := imageWidth // 2.
widthLvl := self parentToChildInset.
offsHLnX := imgHWdt + (self xOfFigureLevel:-1).
parent := 4711. "/ to force a recompute
prevItem := 4711. "/ to force a recomputation of the level
self setMaskOrigin:(self viewOrigin + (0 @ 1) \\ (lineMask extent)).
self paint:lineColor on:bgColor.
self mask:lineMask.
startLvI := self smallestLevelBetween:start and:stop.
startLvX := self xOfFigureLevel:startLvI.
limitLvI := 2.
limitLvX := limitLvI * widthLvl + offsHLnX.
showRoot ifFalse:[
minXVLine := (self xOfFigureLevel:2) - 2. "/ tolerance
] ifTrue:[
minXVLine := 0
].
showRootNot := showRoot not.
yBot := yT.
begHLnY := runHLnY := yT.
endHLnX := limitLvX.
level := 1.
alignTextRight ifTrue:[
xText := alignTextRightX - (viewOrigin x) - textStartLeft.
].
start to:stop do:[:anIndex|
(item := list at:anIndex ifAbsent:nil) isNil ifTrue:[
^ self mask:nil "/ list changed
].
yTop := yBot.
yBot := self yVisibleOfLine:(anIndex + 1).
yCtr := yTop + (yBot - yTop // 2).
anIndex == 1 ifTrue:[ begHLnY := runHLnY := yCtr ].
(nxtPrnt := item parent) ~~ parent ifTrue:[
parent := nxtPrnt.
prevItem == parent ifTrue:[
level := level + 1.
begHLnX := endHLnX.
] ifFalse:[
level := item level.
begHLnX := level * widthLvl + offsHLnX.
].
isFirst := parent isNil or:[(showRootNot and:[level == 2])].
endHLnX := begHLnX + widthLvl.
showVLines := begHLnX >= xL and:[level > 1].
alignTextRight ifFalse:[
xText := endHLnX + (widthLvl // 2).
].
showHLine := (xL < xText and:[xR > begHLnX]).
(showHLine and:[isFirst]) ifTrue:[
showHLine := showLeftIndicators and:[indicatorAction notNil]
]
].
showHLine ifTrue:[
item drawHorizontalLineUpToText ifTrue:[
p1 := xText
] ifFalse:[
item hasChildren ifTrue:[
p1 := endHLnX.
] ifFalse:[
(showRoot not and:[item parent isRootItem]) ifTrue:[
p1 := xL - 1 "/ do not draw the horizontal line
] ifFalse:[
p1 := begHLnX + imgHWdt
]
]
].
xL < p1 ifTrue:[
self displayLineFromX:begHLnX y:yCtr toX:p1 y:yCtr
]
].
showVLines ifTrue:[
y := (parent last == item) ifTrue:[yCtr] ifFalse:[yBot].
x := begHLnX.
p2 := parent.
lv := level - 1.
x >= minXVLine ifTrue:[
self displayLineFromX:x y:runHLnY toX:x y:y.
].
[((p1 := p2 parent) notNil and:[(x := x - widthLvl) >= limitLvX])] whileTrue:[
(p1 last ~~ p2 and:[x <= xR]) ifTrue:[
x >= startLvX ifTrue:[
x >= minXVLine ifTrue:[
self displayLineFromX:x y:(yTop - 1) toX:x y:yBot
]
] ifFalse:[
buildInArray isNil ifTrue:[buildInArray := Array new:startLvI].
buildInArray at:lv put:yBot
].
].
lv := lv - 1.
p2 := p1
]
].
prevItem := item.
runHLnY := yCtr.
].
"/
"/ draw outstanding verical lines to left
"/
x := minXVLine max:xL.
(item isExpanded and:[item hasChildren]) ifTrue:[
(endHLnX >= x and:[endHLnX <= xR]) ifTrue:[
self displayLineFromX:endHLnX y:yCtr toX:endHLnX y:yBot.
]
].
buildInArray notNil ifTrue:[
x := limitLvX.
y := begHLnY.
limitLvI to:startLvI do:[:i|
|yB|
(yB := buildInArray at:i) notNil ifTrue:[
x >= minXVLine ifTrue:[
self displayLineFromX:x y:y toX:x y:yB
]
].
x := x + widthLvl.
]
].
self mask:nil.
! !
!HierarchicalListView methodsFor:'event handling'!
buttonPress:button x:x y:y
"handle a button press event
"
|line item x0 y0|
enabled ifFalse:[^ self].
line := self yVisibleToLineNr:y.
line notNil ifTrue:[
item := list at:line ifAbsent:nil.
item notNil ifTrue:[
x0 := self xOfStringLevel:(item level).
x >= x0 ifTrue:[
y0 := self yVisibleOfLine:line.
(item processButtonPress:button x:(x - x0) y:(y - y0)) == true ifTrue:[
^ self
].
].
]
] ifFalse:[
item := nil
].
(button == 1 or:[button == #select]) ifTrue:[
(item notNil and:[indicatorAction notNil and:[item hasIndicator]]) ifTrue:[
x0 := self xOfFigureLevel:(item level - 1).
(x > x0 and:[(x0 + imageWidth) > x]) 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 := list 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 index|
enabled ifFalse:[^ self].
index := self selectedIndex.
aKey == Character space ifTrue:[
index ~~ 0 ifTrue:[
^ self indicatorPressedAt:index
]
].
((aKey == #CursorRight) or:[(aKey == #CursorLeft)]) ifTrue:[
index ~~ 0 ifTrue:[
item := list at:index ifAbsent:nil.
item notNil ifTrue:[
(aKey == #CursorLeft) == (item isExpanded) ifTrue:[
^ self indicatorPressedAt:index
] ifFalse:[
aKey == #CursorLeft ifTrue:[
self selectElement:item parent ifAbsent:[].
^ self.
] ifFalse:[
" select the childrens first item on CursorLeft
if there are any"
item hasChildren ifTrue:[
self selection:(index + 1)
].
^ self.
].
].
]
]
].
^ super keyPress:aKey x:x y:y
! !
!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|
super fetchResources.
lineMask := lineMask onDevice:device.
lineColor := lineColor onDevice:device.
openIndicator := self imageOnDevice:openIndicator.
closeIndicator := self imageOnDevice:closeIndicator.
imageWidth := 4.
icons keysAndValuesDo:[:aKey :anImage|
anImage isNil ifTrue:[
('HierachicalListView [warning]: missing image: ' , aKey) errorPrintCR.
] ifFalse:[
image := self imageOnDevice:anImage.
icons at:aKey put:image.
imageWidth := image width max:imageWidth.
]
].
imageWidth := imageWidth + 1 // 2 * 2.
alignTextRightX := imageWidth + 20 max:alignTextRightX.
! !
!HierarchicalListView methodsFor:'initialize / release'!
initStyle
"setup viewStyle specifics
"
|cls|
super initStyle.
cls := self class.
lineMask := Form width:2 height:2 fromArray:#[16rAA 16r55].
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 := 8. "/ default
alignTextRight := false.
alignTextRightX := 8.
maxWidthOfText := 0.
expandOnSelect := styleSheet at:#'selection.expandOnSelect' default:false.
autoScrollHorizontal := true.
!
initialize
super initialize.
levelOfLastItem := 1.
! !
!HierarchicalListView methodsFor:'private'!
figureFor:anItem
"return a (bitmap) figure for an item
"
|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 imageOnDevice: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 imageOnDevice:(self class emptyIcon) ]
].
anItem isExpanded ifTrue:[
^ icons at:#expanded ifAbsentPut:[ self imageOnDevice:(self class expandedIcon) ].
].
^ icons at:#collapsed ifAbsentPut:[ self imageOnDevice:(self class collapsedIcon) ].
!
heightOfItem:anItem
"returns the height of an item excluding lineSpacing ...
"
|image height|
height := anItem heightOn:self.
image := self figureFor: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 max:minLineHeight
!
smallestLevelBetween:start and:stop
"returns the smallest level between a range
"
|prevItem currParent nextParent item
lvl "{ Class:SmallInteger }"
min "{ Class:SmallInteger }"
beg "{ Class:SmallInteger }"
|
prevItem := list 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 := list 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
"return the width of the longest line in pixels
"
|nprnt pprnt pitem item
textX "{ Class: SmallInteger }"
level "{ Class: SmallInteger }"
width "{ Class: SmallInteger }"
deltaX "{ Class: SmallInteger }"
startX "{ Class: SmallInteger }"
itemW "{ Class: SmallInteger }"
|
width := 20.
alignTextRight ifTrue:[
firstLine to:lastLine do:[:idx|
item := list at:idx ifAbsent:nil.
item isNil ifTrue:[
maxWidthOfText := maxWidthOfText max:width.
^ alignTextRightX + width
].
width := (item widthOn:self) max:width.
].
maxWidthOfText := maxWidthOfText max:width.
^ alignTextRightX + width
].
pprnt := 4711. "/ force a computation
pitem := 4712. "/ force a computation
deltaX := self parentToChildInset.
startX := self xOfStringLevel:1.
startX := startX + (viewOrigin x).
textX := 0.
level := 1.
firstLine to:lastLine do:[:idx|
item := list at:idx ifAbsent:nil.
item isNil ifTrue:[^ width + startX].
(nprnt := item parent) ~~ pprnt ifTrue:[
(pprnt := nprnt) == pitem ifTrue:[
level := level + 1.
textX := textX + deltaX.
] ifFalse:[
level := item level.
textX := level - 1 * deltaX.
]
].
pitem := item.
itemW := item widthOn:self.
maxWidthOfText := maxWidthOfText max:itemW.
width := (itemW + textX) max:width
].
^ width + startX.
!
xOfFigureLevel:aLevel
"origin x where to draw the icon
"
|l "{ Class:SmallInteger }"|
l := showRoot ifTrue:[aLevel] ifFalse:[aLevel - 1].
indicatorAction isNil ifTrue:[
l := l - 1
] ifFalse:[
showLeftIndicators ifFalse:[
l := l - 1
]
].
^ (l * (self parentToChildInset)) + imageInset - (viewOrigin x)
!
xOfStringLevel:aLevel
"origin x where to draw the text( label )
"
alignTextRight ifTrue:[
^ alignTextRightX - (viewOrigin x)
].
^ (self xOfFigureLevel:aLevel) + imageWidth + textStartLeft
!
xVisibleOfItem:anItem
"returns the visible x of the labeled text
"
^ self xOfStringLevel:(anItem level)
! !
!HierarchicalListView methodsFor:'scrolling'!
computeViewOriginXat:aLnrNr
"compute the visible viewOrigin x for the item at a line
"
|item xLft xRgt lvWidth level vwOrgX xInset|
aLnrNr == 1 ifTrue:[^ 0].
vwOrgX := viewOrigin x.
alignTextRight ifTrue:[ ^ vwOrgX ].
item := list at:aLnrNr ifAbsent:nil.
item isNil ifTrue:[ ^ vwOrgX ].
level := item level.
level <= 2 ifTrue:[^ 0 ].
xLft := self xOfFigureLevel:(level - 1).
lvWidth := self parentToChildInset.
xRgt := (self xOfStringLevel:level) + (item widthOn:self).
xLft > lvWidth negated ifTrue:[
xRgt < width ifTrue:[^ vwOrgX]
].
xInset := ((width - (xRgt - xLft) // 2) // lvWidth * lvWidth) max:0.
vwOrgX := xLft + vwOrgX - xInset - margin.
vwOrgX < lvWidth ifTrue:[^ 0 ].
^ vwOrgX
!
makeLineVisible:aLnrNr
"scroll to make the selection line visible
"
|newY item y0 newX|
(shown and:[aLnrNr notNil]) ifFalse:[^ self].
aLnrNr <= 1 ifTrue:[
aLnrNr == 1 ifTrue:[ self scrollTo:(0 @ 0) ].
^ self
].
item := list at:aLnrNr ifAbsent:nil.
item isNil ifTrue:[^ self].
y0 := self yVisibleOfLine:aLnrNr.
( y0 < margin
or:[(y0 + (item heightOn:self)) > (height - margin)]
) ifTrue:[
newY := ((self yAbsoluteOfLine:aLnrNr) - (height // 2)) max:0.
] ifFalse:[
newY := viewOrigin y.
].
newX := viewOrigin x.
(autoScrollHorizontal or:[newX ~~ 0]) ifTrue:[
newX := self computeViewOriginXat:aLnrNr
].
self scrollTo:(newX @ newY).
!
makeSelectionVisible
"scroll to make the selection line visible
"
shown ifTrue:[
self makeLineVisible:(self firstInSelection).
].
! !
!HierarchicalListView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalListView.st,v 1.60 2002-10-18 09:08:05 ca Exp $'
! !