SelectionInListModelView subclass:#HierarchicalListView
instanceVariableNames:'imageInset imageWidth lineMask lineColor showRoot showLines
showLeftIndicators indicatorAction useDefaultIcons icons
openIndicator closeIndicator'
classVariableNames:''
poolDictionaries:''
category:'AAA'
!
!HierarchicalListView class methodsFor:'documentation'!
documentation
"
This class implements a hierarchical list view based on a
hierachical list
[Instance variables:]
textStartLeft <Integer> inset between icon and text
imageInset <Integer> inset between left side and icon
imageWidth <Integer> width of widest icon
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
[author:]
Claus Atzkern
[see also:]
ListModelView
SelectionInListModelView
HierarchicalList
HierarchicalItem
"
!
examples
"
[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]
"
! !
!HierarchicalListView class methodsFor:'resources'!
closeIndicator
"returns a little [+] bitmap"
<resource: #fileImage>
^ Icon constantNamed:#plus
ifAbsentPut:[Image fromFile:('xpmBitmaps/plus.xpm')]
!
collapsedIcon
"returns icon to indicate a collapsed entry
"
<resource: #fileImage>
^ Icon constantNamed:#directory
ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')]
!
emptyIcon
"returns icon to indicate an not extendable entry
"
<resource: #fileImage>
^ Icon constantNamed:#plainFile
ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')]
!
expandedIcon
"returns icon to indicate an extended entry
"
<resource: #fileImage>
^ Icon constantNamed:#directoryOpened
ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')]
!
openIndicator
"returns a little [-] bitmap"
<resource: #fileImage>
^ Icon constantNamed:#minus
ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')]
! !
!HierarchicalListView methodsFor:'accessing'!
list:aList
"get the status of <showRoot> from the list
"
aList notNil ifTrue:[
showRoot := aList showRoot
].
super list:aList
! !
!HierarchicalListView methodsFor:'accessing colors'!
lineColor
"get the line color
"
^ lineColor
!
lineColor:aColor
"set the line color
"
(aColor notNil and:[aColor ~= lineColor]) ifTrue:[
lineColor := aColor.
shown ifTrue:[
lineColor := lineColor on:device.
showLines ifTrue:[
self invalidate
]
]
]
! !
!HierarchicalListView methodsFor:'accessing look'!
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
]
]
!
showLeftIndicators
"show or hide the indicators for the most left items
"
^ showLeftIndicators
!
showLeftIndicators:aState
"show or hide the indicators for the most left items
"
aState ~~ showLeftIndicators ifTrue:[
showLeftIndicators := aState.
self invalidate
].
!
showLines
"returns true if lines are shown
"
^ showLines
!
showLines:aState
"show or hide lines
"
aState ~~ showLines ifTrue:[
showLines := aState.
self invalidate
].
!
useDefaultIcons
"use the default icons if no icon for an item is specified;
** default: true
"
^ useDefaultIcons
!
useDefaultIcons:aBool
"use the default icons if no icon for an item is specified;
** default: true
"
useDefaultIcons ~~ aBool ifTrue:[
useDefaultIcons := aBool.
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
"
|wasNilBefore|
wasNilBefore := indicatorAction isNil.
indicatorAction := anAction.
wasNilBefore == (anAction isNil) ifTrue:[
self invalidate
].
! !
!HierarchicalListView methodsFor:'change & update'!
lineChangedAt:aLnNr with:arg
"line changed at position; check whether line height changed
"
|item
lv "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
|
(arg == #icon or:[arg == #hierarchy]) ifFalse:[
^ super lineChangedAt:aLnNr with:arg
].
y0 := (self yVisibleOfLine:aLnNr) max:margin.
y1 := (self yVisibleOfLine:(aLnNr + 1)) min:(height - margin).
(h := y1 - y0) > 0 ifTrue:[
x0 := margin.
x1 := width - margin.
(item := list at:aLnNr ifAbsent:nil) isNil ifFalse:[
lv := item level.
x0 := self xOfFigureLevel:lv.
x1 := x0 + imageWidth.
arg == #hierarchy ifTrue:[
x0 := self xOfFigureLevel:(lv -1).
].
x0 := x0 max:margin.
x1 := x1 min:(width - margin).
x1 > x0 ifFalse:[
^ self
]
].
self redrawX:x0 y:y0 width:x1 - x0 height:h.
]
!
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'!
drawElementsFrom:start to:stop x:x0 y:y0 width:aWidth
"draw the items between start to stop without clearing the background
"
|item prevItem parent icon showIndc showIcon showText nxtPrnt
x1 "{ Class:SmallInteger }"
yTop "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
xIndc "{ Class:SmallInteger }"
xIcon "{ Class:SmallInteger }"
xText "{ Class:SmallInteger }"
widthLvl "{ Class:SmallInteger }"
insetTxt "{ Class:SmallInteger }"
offIndcX "{ Class:SmallInteger }"
offIndcY "{ Class:SmallInteger }"
offIconX "{ Class:SmallInteger }"
|
x1 := x0 + aWidth.
widthLvl := imageInset + imageWidth.
insetTxt := textStartLeft + imageWidth.
offIconX := self xOfFigureLevel:0.
showIndc := false.
indicatorAction notNil ifTrue:[
icon := openIndicator extent // 2.
offIndcX := imageWidth // 2 - widthLvl.
offIndcX := offIndcX - icon x.
offIndcY := icon y.
].
showLines ifTrue:[
self drawLinesFrom:start to:stop x:x0 y:y0 width:aWidth
].
parent := 4711. "/ to force a recompute
prevItem := 4711. "/ to force a recomputation of the level
yBot := y0.
start to:stop do:[:anIndex|
(item := list at:anIndex ifAbsent:nil) isNil ifTrue:[
^ self "/ list changed
].
yTop := yBot.
yBot := self yVisibleOfLine:(anIndex + 1).
yCtr := yTop + (yBot - yTop // 2).
(nxtPrnt := item parent) ~~ parent ifTrue:[
parent := nxtPrnt.
xIcon := prevItem == parent ifTrue:[xIcon + widthLvl]
ifFalse:[item level * widthLvl + offIconX].
xText := xIcon + insetTxt.
showIcon := xIcon < x1 and:[xText > x0].
showText := xText < x1.
indicatorAction notNil ifTrue:[
xIndc := xIcon + offIndcX.
showIndc := ( (parent notNil or:[showLeftIndicators])
and:[(xIcon > x0 and:[xIndc < x1])]
)
]
].
(showIcon and:[(icon := self figureFor:item) notNil]) ifTrue:[
icon width > imageWidth ifTrue:[
imageWidth := icon width.
StopRedrawSignal raise
].
self displayForm:icon x:xIcon y:(yCtr - (icon height // 2))
].
showText ifTrue:[
self drawLabelAt:xText y:yTop h:(yBot - yTop) index:anIndex
].
(showIndc and:[item hasChildren]) ifTrue:[
icon := item isExpanded ifTrue:[openIndicator] ifFalse:[closeIndicator].
self displayForm:icon x:xIndc y:(yCtr - offIndcY)
].
prevItem := item.
]
!
drawLinesFrom:start to:stop x:x0 y:y0 width:aWidth
"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 }"
x1 "{ 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 }"
|
x1 := x0 + aWidth.
widthLvl := imageInset + imageWidth.
offsHLnX := imageWidth // 2 + (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.
buildInArray := Array new:20.
buildInArray atAllPut:0.
showRootNot := showRoot not.
yBot := y0.
begHLnY := runHLnY := y0.
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 := item level * widthLvl + offsHLnX.
].
isFirst := parent isNil or:[(showRootNot and:[level == 2])].
endHLnX := begHLnX + widthLvl.
showVLines := begHLnX >= x0 and:[level > 1].
showHLine := x0 < endHLnX and:[x1 > begHLnX].
(showHLine and:[isFirst]) ifTrue:[
showHLine := showLeftIndicators and:[indicatorAction notNil]
]
].
showHLine ifTrue:[
self displayLineFromX:begHLnX y:yCtr toX:endHLnX y:yCtr
].
showVLines ifTrue:[
y := (parent last == item) ifTrue:[yCtr] ifFalse:[yBot].
x := begHLnX.
p2 := parent.
lv := level - 1.
self displayLineFromX:x y:runHLnY toX:x y:y.
[((p1 := p2 parent) notNil and:[(x := x - widthLvl) >= limitLvX])] whileTrue:[
(p1 last ~~ p2 and:[x <= x1]) ifTrue:[
x >= startLvX ifTrue:[
self displayLineFromX:x y:(yTop - 1) toX:x y:yBot
] ifFalse:[
buildInArray at:lv put:yBot
].
].
lv := lv - 1.
p2 := p1
]
].
prevItem := item.
runHLnY := yCtr.
].
"/
"/ draw outstanding verical lines to left
"/
x := limitLvX.
y := begHLnY.
limitLvI to:startLvI do:[:i|
(yBot := buildInArray at:i) ~~ 0 ifTrue:[
self displayLineFromX:x y:y toX:x y:yBot
].
x := x + widthLvl.
].
( start == stop
and:[(item := list at:start ifAbsent:nil) notNil
and:[item isExpanded
and:[item hasChildren]]]
) ifTrue:[
x := begHLnX + widthLvl.
(x >= x0 and:[x <= x1]) ifTrue:[
yBot := self yVisibleOfLine:(start + 1).
yCtr := y0 + (yBot - y0 // 2).
self displayLineFromX:x y:yCtr toX:x y:yBot.
]
].
self mask:nil.
!
redrawLabelFromItem:anItem atY:y h:h
"called to redraw a label caused by a selection change
"
|w "{ Class:SmallInteger }"
x "{ Class:SmallInteger }"
|
x := (self xOfStringLevel:(anItem level)) - (textStartLeft // 2).
x := x max:margin.
(w := width - x) > 0 ifTrue:[
self redrawX:x y:y width:w height:h
]
! !
!HierarchicalListView methodsFor:'event handling'!
buttonMultiPress:button x:x y:y
"handle a button multiPress event
"
|lnNr|
enabled ifTrue:[
( (button == 1 or:[button == #select])
and:[(lnNr := self indicatorLineAtX:x y:y) notNil]
) ifFalse:[
super buttonMultiPress:button x:x y:y
]
]
!
buttonPress:button x:x y:y
"handle a button press event
"
|lnNr menu item appl|
enabled ifTrue:[
((button == 2) or:[button == #menu]) ifTrue:[
( (item := self selectedElement) notNil
and:[(menu := item middleButtonMenu) notNil]
) ifTrue:[
menu isCollection ifTrue:[
menu := Menu new fromLiteralArrayEncoding:menu.
appl := self application.
appl notNil ifTrue:[
menu findGuiResourcesIn:appl.
menu receiver:appl
] ifFalse:[
menu receiver:item
]
].
^ menu startUp
].
] ifFalse:[
(lnNr := self indicatorLineAtX:x y:y) notNil ifTrue:[
(indicatorAction numArgs == 1) ifTrue:[
indicatorAction value:lnNr
] ifFalse:[
indicatorAction value
].
^ self
]
].
super buttonPress:button x:x y:y
]
!
keyPress:aKey x:x y:y
"a key was pressed - handle page-keys here
"
<resource: #keyboard( #CursorLeft #CursorRight )>
|item parent index size stop step|
(aKey == #CursorLeft or:[aKey == #CursorRight]) ifFalse:[
^ super keyPress:aKey x:x y:y
].
( enabled
and:[(size := list size) > 1
and:[(index := self selectedIndex) ~~ 0
and:[(item := list at:index ifAbsent:nil) notNil]]]
) ifTrue:[
parent := item parent.
aKey == #CursorLeft ifTrue:[step := -1. stop := 1]
ifFalse:[step := 1. stop := size].
(index + step) to:stop by:step do:[:i|
item := list at:i ifAbsent:[^ nil ].
item parent ~~ parent ifTrue:[^ self selection:i]
].
index := aKey == #CursorLeft ifTrue:[size] ifFalse:[1].
self selection:index
].
! !
!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|
image := self imageOnDevice:anImage.
icons at:aKey put:image.
imageWidth := image width max:imageWidth.
].
imageWidth := imageWidth // 2.
imageWidth odd ifTrue:[imageWidth := imageWidth + 1].
imageWidth := imageWidth * 2.
! !
!HierarchicalListView methodsFor:'initialize / release'!
initStyle
"setup viewStyle specifics
"
|cls|
super initStyle.
cls := self class.
lineMask := Form width:2 height:2 fromArray:#[16rAA 16r55].
icons := IdentityDictionary new.
icons at:#expanded ifAbsentPut:[cls expandedIcon].
icons at:#collapsed ifAbsentPut:[cls collapsedIcon].
icons at:#empty ifAbsentPut:[cls emptyIcon].
openIndicator := self class openIndicator.
closeIndicator := self class closeIndicator.
lineColor := fgColor.
highlightMode := #label.
showRoot := true.
showLeftIndicators := true.
useDefaultIcons := true.
showLines := true.
imageInset := 4.
imageWidth := 8. "/ default
! !
!HierarchicalListView methodsFor:'private'!
figureFor:anItem
"return a (bitmap) figure for an item
"
|key image w h|
"/ the item may provide an icon
"/ (it knows for itself if its open or closed)
(key := anItem icon) notNil ifTrue:[
(key isImageOrForm and:[key device == device]) ifTrue:[
^ key
].
(image := icons at:key ifAbsent:nil) notNil ifTrue:[
^ image
].
key isImageOrForm ifTrue:[
image := self imageOnDevice:key.
icons at:key put:image.
^ image
]
].
useDefaultIcons ifFalse:[^ nil].
"/ ok, item did not return an icon - use default.
anItem hasChildren ifTrue:[
key := anItem isExpanded ifTrue:[#expanded] ifFalse:[#collapsed]
] ifFalse:[
key := #empty
].
^ icons at:key
!
heightOfLineAt:aLineNr
"returns the total height for a line at an index, including
lineSpacing, the figure and the label
"
|item icon height|
item := list at:aLineNr ifAbsent:[^ 4].
height := item heightOn:self.
(icon := self figureFor:item) notNil ifTrue:[
height := (item heightOn:self) max:height.
].
^ lineSpacing + height
!
indicatorLineAtX:x y:y
"returns the lineNumber assigned to an indicator at x/y or nil
"
|lnNr item x0|
( indicatorAction isNil
or:[(lnNr := self yVisibleToLineNr:y) isNil
or:[(item := list at:lnNr ifAbsent:nil) isNil
or:[item hasChildren not]]]
) ifFalse:[
x0 := self xOfFigureLevel:(item level - 1).
(x > x0 and:[(x0 + imageWidth) > x]) ifTrue:[
^ lnNr
]
].
^ nil
!
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:[ ^ 1 ].
(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:[^ 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 }"
|
pprnt := 4711. "/ force a computation
pitem := 4712. "/ force a computation
width := 20.
deltaX := imageInset + imageWidth.
startX := self xOfStringLevel:1.
firstLine to:lastLine do:[:idx|
item := list at:idx ifAbsent:[^ 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.
width := (item widthOn:self) 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 * (imageInset + imageWidth)) + imageInset - (viewOrigin x)
!
xOfStringLevel:aLevel
"origin x where to draw the text( label )
"
^ (self xOfFigureLevel:aLevel) + imageWidth + textStartLeft
! !
!HierarchicalListView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalListView.st,v 1.1 1999-05-23 12:56:26 cg Exp $'
! !