"
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.
"
SelectionInListModelView subclass:#HierarchicalListView
instanceVariableNames:'imageInset imageWidth lineMask lineColor showRoot showLines
showLeftIndicators indicatorAction useDefaultIcons icons
openIndicator closeIndicator'
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
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 invalidateX: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'!
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:xL y:yT w:w
"draw the items between start to stop without clearing the background
"
|item prevItem parent icon showIndc showIcon showText nxtPrnt
yTop "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
xIndc "{ Class:SmallInteger }"
xIcon "{ Class:SmallInteger }"
xText "{ Class:SmallInteger }"
xR "{ Class:SmallInteger }"
height "{ Class:SmallInteger }"
widthLvl "{ Class:SmallInteger }"
insetTxt "{ Class:SmallInteger }"
offIndcX "{ Class:SmallInteger }"
offIndcY "{ Class:SmallInteger }"
offIconX "{ Class:SmallInteger }"
|
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.
].
xR := xL + w.
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.
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].
xText := xIcon + insetTxt.
showIcon := xIcon < xR and:[xText > xL].
showText := xText < xR.
indicatorAction notNil ifTrue:[
xIndc := xIcon + offIndcX.
showIndc := ( (parent notNil or:[showLeftIndicators])
and:[(xIcon > xL and:[xIndc < xR])]
)
]
].
(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:anIndex x:xText y:yTop h:height
].
(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: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 }"
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 }"
|
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 := yT.
begHLnY := runHLnY := yT.
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 >= xL and:[level > 1].
showHLine := xL < endHLnX and:[xR > 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 <= xR]) 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 >= xL and:[x <= xR]) ifTrue:[
yBot := self yVisibleOfLine:(start + 1).
yCtr := yT + (yBot - yT // 2).
self displayLineFromX:x y:yCtr toX:x y:yBot.
]
].
self mask:nil.
! !
!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 isNil ifTrue:[^ 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:nil.
item isNil ifTrue:[^ 4].
height := item heightOn:self.
(icon := self figureFor:item) notNil ifTrue:[
height := (icon 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: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 }"
|
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: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.
width := ((item widthOn:self) + 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 * (imageInset + imageWidth)) + imageInset - (viewOrigin x)
!
xOfStringLevel:aLevel
"origin x where to draw the text( label )
"
^ (self xOfFigureLevel:aLevel) + imageWidth + textStartLeft
!
xVisibleOfItem:anItem
"returns the visible x of the labeled text
"
^ self xOfStringLevel:(anItem level)
! !
!HierarchicalListView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalListView.st,v 1.12 1999-09-29 05:02:19 ca Exp $'
! !