"
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 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]
"
! !
!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]; 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:[
(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 xVisibleOfIconAtLevel:maxLevel.
indicatorAction := anAction.
contentsChgSize := (self xVisibleOfIconAtLevel: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
level "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
yB "{ Class:SmallInteger }"
|
item := list 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))
+ (item widthOn:self)
+ (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].
arg == #hierarchy ifTrue:[ level := level - 1 ].
x0 := (self xVisibleOfIconAtLevel: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 := 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 xVisibleOfIconAtLevel:(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 extent
yTop "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
xIndc "{ Class:SmallInteger }"
xIcon "{ Class:SmallInteger }"
xText "{ 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 }"
|
widthLvl := self parentToChildInset.
insetTxt := textStartLeft + imageWidth.
xL := xLeft.
xR := xL + w.
alignTextRight ifTrue:[
xText := alignTextRightX - (viewOrigin x).
showText := xText < xR.
].
offIconX := self xVisibleOfIconAtLevel:0.
showIndc := false.
indicatorAction notNil ifTrue:[
offIndcX := offIndcY := 0.
openIndicator notNil ifTrue:[
extent := openIndicator extent // 2.
offIndcX := imageWidth // 2 - widthLvl.
offIndcX := offIndcX - extent x.
offIndcY := extent 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.
showIndc := (xIcon > xL and:[xIndc < xR]).
showIndc ifTrue:[
showIndc := parent 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)
].
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 xVisibleOfIconAtLevel:-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 xVisibleOfIconAtLevel:startLvI.
limitLvI := 2.
limitLvX := limitLvI * widthLvl + offsHLnX.
showRoot ifFalse:[
minXVLine := (self xVisibleOfIconAtLevel: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.
!
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|
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 raise
].
] ifFalse:[
width <= imageWidth ifTrue:[ ^ icon ].
].
needMore := width - imageWidth max:2.
imageWidth := imageWidth + needMore.
maxLevel := 1.
list criticalDo:[
list do:[:el| maxLevel := maxLevel max:(el level) ].
].
alignTextRightX := alignTextRightX max:(self xVisibleOfIconAtLevel:(maxLevel + 1)).
widthOfContents notNil ifTrue:[
alignTextRight ifTrue:[
widthOfContents := alignTextRightX + maxWidthOfText
] ifFalse:[
list showRoot ifFalse:[ maxLevel := maxLevel - 1 ].
widthOfContents := widthOfContents + (maxLevel * needMore)
].
width := anItem widthOn:self.
startOfText := self xVisibleOfTextAtLevel:(anItem level).
widthOfContents := widthOfContents max:(startOfText + width).
width > maxWidthOfText ifTrue:[
maxWidthOfText := width
].
].
self contentsChanged.
StopRedrawSignal raise.
^ icon
! !
!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 xVisibleOfTextAtLevel:(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 xVisibleOfIconAtLevel:(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 defaultWidth|
super fetchResources.
lineMask := lineMask onDevice:device.
lineColor := lineColor onDevice:device.
openIndicator := self imageOnDevice:openIndicator.
closeIndicator := self imageOnDevice:closeIndicator.
defaultWidth := imageWidth.
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) max:defaultWidth.
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 := 16. "/ default
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.
! !
!HierarchicalListView methodsFor:'private'!
heightOfItem:anItem
"returns the height of an item excluding lineSpacing ...
"
|image height|
height := anItem heightOn:self.
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 max:minLineHeight
!
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 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) ].
!
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 := 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
"returns the width of the longest line in pixels in a range
"
|nprnt pprnt pitem item
textX "{ Class: SmallInteger }"
level "{ Class: SmallInteger }"
width "{ Class: SmallInteger }"
deltaX "{ Class: SmallInteger }"
startX "{ Class: SmallInteger }"
itemW "{ Class: SmallInteger }"
|
width := 20.
level := 1.
pprnt := 4711. "/ force a computation
deltaX := self parentToChildInset.
alignTextRight ifTrue:[
firstLine to:lastLine do:[:idx|
item := list at:idx ifAbsent:nil.
item notNil ifTrue:[
width := (item widthOn:self) max:width.
nprnt := item parent.
nprnt ~~ pprnt ifTrue:[
level := item level max:level.
pprnt := nprnt.
].
].
].
maxWidthOfText := maxWidthOfText max:width.
startX := self xVisibleOfIconAtLevel:(level + 1).
alignTextRightX < startX ifTrue:[
shown ifTrue:[ self invalidate].
alignTextRightX := startX
].
^ alignTextRightX + width
].
pitem := 4712. "/ force a computation
startX := (self xVisibleOfTextAtLevel:1) + (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.
!
xVisibleOfIconAtLevel:aLevel
"returns the visible origin x of the icon at a level.
"
|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)
!
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
! !
!HierarchicalListView methodsFor:'scrolling'!
computeViewOriginXat:aLnrNr
"returns the viewOrigin x to make the item at a line visisble
"
|item xLft xRgt lvWidth level vwOrgX xInset|
alignTextRight ifTrue:[^ viewOrigin x ].
aLnrNr == 1 ifTrue:[^ 0].
vwOrgX := viewOrigin x.
item := list at:aLnrNr ifAbsent:nil.
item isNil ifTrue:[ ^ vwOrgX ].
level := item level.
level <= 2 ifTrue:[^ 0 ].
xLft := self xVisibleOfIconAtLevel:(level - 1).
lvWidth := self parentToChildInset.
xRgt := (self xVisibleOfTextAtLevel: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
"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:[ 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
"make the firts line in the selection horizontal and vertical visible
"
shown ifTrue:[
self makeLineVisible:(self firstInSelection).
].
! !
!HierarchicalListView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalListView.st,v 1.67 2002-10-28 09:56:50 ca Exp $'
! !