"
COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
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.
"
SelectionInListView subclass:#SelectionInTreeView
instanceVariableNames:'validateDoubleClickBlock selectionHolder rootHolder imageWidth
showLines listOfNodes imageInset textInset labelOffsetY lineMask
lineColor computeResources showRoot showDirectoryIndicator
closeIndicator openIndicator showDirectoryIndicatorForRoot
imageOpened imageClosed imageItem discardMotionEvents
registeredImages supportsExpandAll'
classVariableNames:''
poolDictionaries:''
category:'Views-Text'
!
!SelectionInTreeView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
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
"
somewhat like a SelectionInListView; but specialized for hierarchical (i.e. tree-like)
lists and adds the functions to show/hide subtrees.
Requires SelectionInTree as model and TreeItem (or compatible) list entries.
This class obsoletes SelectionInTreeView, which is no longer
maintained but kept for backward compatibility.
[see also:]
SelectionInTree
TreeItem
SelectionInTreeView
SelectionInListView
FileSelectionTree
[author:]
Claus Atzkern
"
!
examples
"
shows the tree of smalltalk classes:
[exBegin]
|top sel|
top := StandardSystemView new; extent:300@300.
sel := SelectionInTreeView new.
sel root:(TreeItem newAsTreeFromSmalltalkClass:Object).
sel action:[:nr | Transcript show:'selected:'; showCR:nr].
top add:(ScrollableView forView:sel) in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
top open.
[exEnd]
same, including nil-subclasses (i.e. really all classes):
[exBegin]
|top sel|
top := StandardSystemView new; extent:300@300.
sel := SelectionInTreeView new.
sel root:(TreeItem newAsTreeFromSmalltalkClass:nil).
sel action:[:nr | Transcript show:'selected:'; showCR:nr].
sel lineColor:(Color red).
top add:(ScrollableView forView:sel) in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
top open.
[exEnd]
shows the tree of smalltalk classes; show directory indication and no
lines.
[exBegin]
|top sel|
top := StandardSystemView new; extent:300@300.
sel := SelectionInTreeView new.
sel showLines:false.
sel showDirectoryIndicator:true.
sel root:(TreeItem newAsTreeFromSmalltalkClass:Object).
sel action:[:nr | Transcript show:'selected:'; showCR:nr].
top add:(ScrollableView forView:sel) in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
top open.
[exEnd]
"
! !
!SelectionInTreeView class methodsFor:'constants'!
minImageInset
"returns minimum inset from directory indication to image
"
^ 6
! !
!SelectionInTreeView class methodsFor:'resources'!
closeIndicator
<resource: #fileImage>
^ Icon
constantNamed:#plus
ifAbsentPut:[Image fromFile:('xpmBitmaps/plus.xpm')]
!
imageClosed
<resource: #fileImage>
^ Icon
constantNamed:#directory
ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')]
!
imageItem
<resource: #fileImage>
^ Icon
constantNamed:#plainFile
ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')]
!
imageOpened
<resource: #fileImage>
^ Icon
constantNamed:#directoryOpened
ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')]
!
openIndicator
<resource: #fileImage>
^ Icon
constantNamed:#minus
ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')]
! !
!SelectionInTreeView methodsFor:'accessing'!
lineColor
"returns user configured line color or nil
"
^ lineColor
!
lineColor:aColor
"returns user configured line color or nil
"
|col|
col := aColor = fgColor ifTrue:[nil] ifFalse:[aColor].
col = lineColor ifFalse:[
lineColor := col.
shown ifTrue:[
lineColor notNil ifTrue:[lineColor := lineColor on:device].
self invalidate
]
]
!
nodeAtIndex:anIndex
"returns node at an index or nil
"
(anIndex notNil and:[anIndex between:1 and:listOfNodes size]) ifTrue:[
^ listOfNodes at:anIndex
].
^ nil
!
root
"gets the root of the model; the first item into list.
"
^ self nodeAtIndex:1
!
root:aRoot
"sets the root of the model; the first item into list.
"
aRoot notNil ifTrue:[aRoot expand].
model root:aRoot
!
textInset
"get the left inset of the text label
"
^ textInset
!
textInset:anInset
"set the left inset of the text label
"
anInset ~~ textInset ifTrue:[
anInset >= 0 ifTrue:[
textInset := anInset.
self invalidate
] ifFalse:[
self error
]
].
! !
!SelectionInTreeView methodsFor:'accessing-behavior'!
showDirectoryIndicator
"returns true if directories has an open/closed indicator
"
^ showDirectoryIndicator
!
showDirectoryIndicator:aState
"set or clear open/closed indicator for directories
"
"show or hide lines
"
aState ~~ showDirectoryIndicator ifTrue:[
showDirectoryIndicator := aState.
self recomputeDirectoryIndicator.
self invalidate
].
!
showDirectoryIndicatorForRoot
"returns true if root directory has an open/closed indicator if
the common showDirectoryIndicator is enabled
"
^ showDirectoryIndicatorForRoot
!
showDirectoryIndicatorForRoot:aState
"true if root directory has an open/closed indicator if
the common showDirectoryIndicator is enabled
"
aState ~~ showDirectoryIndicator ifTrue:[
showDirectoryIndicatorForRoot := aState.
self recomputeDirectoryIndicator.
self invalidate
].
!
showLines
"returns true if lines are shown
"
^ showLines
!
showLines:aState
"show or hide lines
"
aState ~~ showLines ifTrue:[
showLines := aState.
self invalidate
].
!
showRoot
"list with or without root
"
^ showRoot
!
showRoot:aState
"list with or without root
"
showRoot ~~ aState ifTrue:[
model showRoot:(showRoot := aState)
].
!
supportsExpandAll
^ supportsExpandAll
!
supportsExpandAll:aBool
supportsExpandAll := aBool
!
validateDoubleClickBlock
"set the conditionBlock; this block is evaluated before a doubleClick action
on a node will be performed. In case of returning false, the doubleClick will
not be handled.
"
^ validateDoubleClickBlock
!
validateDoubleClickBlock:aOneArgBlock
"set the conditionBlock; this block is evaluated before a doubleClick action
on a node will be performed. In case of returning false, the doubleClick will
not be handled.
"
validateDoubleClickBlock := aOneArgBlock
! !
!SelectionInTreeView methodsFor:'accessing-channels'!
rootHolder
"get the holder which keeps the hierarchical list entry or nil
"
^ rootHolder
!
rootHolder:aValueHolder
"set the holder which keeps the hierarchical list entry or nil
"
rootHolder notNil ifTrue:[
rootHolder removeDependent:self
].
(rootHolder := aValueHolder) notNil ifTrue:[
rootHolder addDependent:self.
self rootFromModel.
].
!
selectionHolder
"get the holder which keeps a list of selected items or nil
"
^ selectionHolder
!
selectionHolder:aHolder
"set the holder which keeps a list of selected items or nil
"
selectionHolder notNil ifTrue:[
selectionHolder removeDependent:self
].
(selectionHolder := aHolder) notNil ifTrue:[
selectionHolder addDependent:self.
self selectionFromModel
].
! !
!SelectionInTreeView methodsFor:'accessing-images'!
imageClosed
"return the value of the instance variable 'imageClosed' (automatically generated)"
^ imageClosed
"Created: 3.7.1997 / 12:34:31 / cg"
!
imageItem
"return the value of the instance variable 'imageItem' (automatically generated)"
^ imageItem
"Created: 3.7.1997 / 12:34:34 / cg"
!
imageOnDevice:anImage
"associate iamge to device and clear pixel mask (in case of realized);
returns the new image.
"
|img|
img := anImage onDevice:device.
realized ifTrue:[
img := img clearMaskedPixels
].
^ img
!
imageOpened
"return the value of the instance variable 'imageOpened' (automatically generated)"
^ imageOpened
"Created: 3.7.1997 / 12:34:28 / cg"
! !
!SelectionInTreeView methodsFor:'change & update'!
update:something with:aParameter from:aModel
"one of my models changed its value
"
|idx|
aModel == rootHolder ifTrue:[
^ self rootFromModel
].
aModel == selectionHolder ifTrue:[
^ self selectionFromModel
].
aModel == model ifTrue:[
something == #list ifTrue:[
^ self getListFromModel
]
] ifFalse:[
(aModel isKindOf:TreeItem) ifTrue:[
(something == #size or:[something == #children]) ifTrue:[
model recomputeList.
^ self
].
(idx := self indexOfNode:aModel) ~~ 0 ifTrue:[
something == #value ifTrue:[
list at:idx put:(aModel name).
self redrawLine:idx.
^ self
].
something == #indication ifTrue:[
self redrawIndicatorLine:idx.
^ self
].
].
^ self
]
].
^ super update:something with:aParameter from:aModel.
! !
!SelectionInTreeView methodsFor:'drawing'!
drawLine:line atX:atX inVisible:visLineNr with:fg and:bg
self drawFromVisibleLine:visLineNr to:visLineNr with:fg and:bg
!
drawLine:line fromX:x inVisible:visLineNr with:fg and:bg
self drawFromVisibleLine:visLineNr to:visLineNr with:fg and:bg
!
drawLine:line inVisible:visLineNr with:fg and:bg
self drawFromVisibleLine:visLineNr to:visLineNr with:fg and:bg
!
drawVisibleLine:visLineNr col:col with:fg and:bg
self drawFromVisibleLine:visLineNr to:visLineNr with:fg and:bg
!
drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
self drawFromVisibleLine:visLineNr to:visLineNr with:fg and:bg
!
drawVisibleLine:visLineNr from:startCol with:fg and:bg
self drawFromVisibleLine:visLineNr to:visLineNr with:fg and:bg
! !
!SelectionInTreeView methodsFor:'drawing basics'!
drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
"redraw a visible line range with clearing the background
"
|y0 y1 sz|
shown ifTrue:[
y0 := self yOfVisibleLine:startVisLineNr.
y0 := y0 - 1.
sz := endVisLineNr - startVisLineNr + 1.
y1 := sz * fontHeight.
"/ clear rectangle line and set background color
self paint:bg.
self fillRectangleX:0 y:y0 width:width height:y1.
(y1 := self visibleLineToAbsoluteLine:startVisLineNr) notNil ifTrue:[
self redrawLinesX:0 y:y0 toX:width start:y1 stop:(y1 + sz)
]
]
!
drawLabelIndex:anIndex atX:x y:yCenter
"draw text label at x and y centered
"
|lbl|
(lbl := (listOfNodes at:anIndex) name) notNil ifTrue:[
self displayOpaqueString:lbl x:x y:(yCenter + labelOffsetY).
]
!
redrawIndicatorLine:aLineNr
"redraw the directory indicator for a line
"
|node ext img visLn
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
lv "{ Class:SmallInteger }"
dX "{ Class:SmallInteger }"
|
( shown
and:[showDirectoryIndicator
and:[(visLn := self listLineToVisibleLine:aLineNr) notNil]]
) ifFalse:[
^ self
].
node := listOfNodes at:aLineNr.
((lv := node level) ~~ 1 or:[showDirectoryIndicatorForRoot]) ifFalse:[
^ self
].
(x := imageWidth // 2) odd ifTrue:[x := x + 1].
x := (self xOfFigureLevel:(lv - 1)) + x.
"/ draw directory indicator
img := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
ext := img extent // 2.
dX := ext x.
(x + dX > 0 and:[(x := x - dX) < (width - margin)]) ifTrue:[
(self isInSelection:aLineNr) ifTrue:[ self paint:hilightFgColor on:hilightBgColor ]
ifFalse:[ self paint:fgColor on:bgColor ].
y := (self yOfVisibleLine:visLn) + (fontHeight // 2) - 1.
self displayForm:img x:x y:(y - ext y)
].
!
redrawLinesX:x0 y:y0 toX:x1 start:start stop:stop
"redraw from line to line without clearing the background
"
|node image extent isSelected defLineColor rnode prnt
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
level "{ Class:SmallInteger }"
yTop "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
yCtr "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
end "{ Class:SmallInteger }"
index "{ Class:SmallInteger }"
xCross "{ Class:SmallInteger }"
xFig "{ Class:SmallInteger }"
xStr "{ Class:SmallInteger }"
dyLvl "{ Class:SmallInteger }"
soVDt "{ Class:SmallInteger }"
soVLn "{ Class:SmallInteger }"
lv "{ Class:SmallInteger }"
figWidthDiv2 "{ Class:SmallInteger }"
|
size := listOfNodes size.
index := start.
end := stop min:size.
level := -1. "/ to force evaluation of #ifFalse in loop
soVDt := 0.
yTop := y0.
yCtr := yTop - (fontHeight // 2).
dyLvl := imageInset + imageWidth.
figWidthDiv2 := imageWidth // 2.
figWidthDiv2 odd ifTrue:[figWidthDiv2 := figWidthDiv2 + 1].
showLines ifTrue:[
soVDt := (figWidthDiv2 + (self xOfFigureLevel:1)) - dyLvl - dyLvl.
self setMaskOrigin:(self viewOrigin + (0 @ 1) \\ (lineMask extent)).
defLineColor := lineColor ? fgColor.
].
[index <= end] whileTrue:[
node := listOfNodes at:index.
yBot := yTop + fontHeight.
yCtr := yCtr + fontHeight.
(lv := node level) == level ifFalse:[
xFig := self xOfFigureLevel:lv.
xStr := self xOfStringLevel:lv.
xCross := xFig - dyLvl + figWidthDiv2.
level := lv.
soVLn := lv * dyLvl + soVDt.
].
(isSelected := self isInSelection:index) ifTrue:[
self paint:hilightFgColor on:hilightBgColor
].
showLines ifTrue:[
isSelected ifFalse:[
self paint:defLineColor on:bgColor
].
self mask:lineMask.
xCross < x1 ifTrue:[
( ((x := xFig + figWidthDiv2) between:x0 and:x1)
and:[node isCollapsable
and:[node children notEmpty]]
) ifTrue:[
self displayLineFromX:x y:yCtr toX:x y:yBot
].
"/ vertical line from previous to current form
(xCross >= x0 and:[level ~~ 1]) ifTrue:[
prnt := node parent children.
prnt isEmpty ifTrue:[ ^ self ]. "/ error occured
lv := prnt last == node ifTrue:[yCtr] ifFalse:[yBot].
self displayLineFromX:xCross y:yTop - 1 toX:xCross y:lv
].
"/ horizontal line from previous to current form
( xFig > x0
and:[(level ~~ 1
or:[showDirectoryIndicatorForRoot and:[showDirectoryIndicator]])]
) ifTrue:[
self displayLineFromX:xCross y:yCtr toX:xFig y:yCtr
]
].
"/ draw all vertical lines to left side
(xCross >= x0 and:[(rnode := node parent) notNil]) ifTrue:[
x := soVLn.
y := yTop - 1.
[((prnt := rnode parent) notNil and:[(x := x - dyLvl) >= x0])] whileTrue:[
(prnt children last ~~ rnode and:[x <= x1]) ifTrue:[
self displayLineFromX:x y:y toX:x y:yBot
].
rnode := prnt
]
].
self mask:nil.
].
isSelected ifFalse:[
self paint:fgColor on:bgColor
].
"/ draw image
(image := self figureFor:node) notNil ifTrue:[
(xFig < x1 and:[xStr > x0]) ifTrue:[
self displayForm:image x:xFig y:(yCtr - (image height // 2))
]
].
"/ draw text label
xStr < x1 ifTrue:[
self drawLabelIndex:index atX:xStr y:yCtr .
].
"/ draw directory indicator
(showDirectoryIndicator and:[node showIndicator]) ifTrue:[
(level ~~ 1 or:[showDirectoryIndicatorForRoot]) ifTrue:[
image := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
extent := image extent // 2.
x := extent x.
(xCross + x > x0 and:[(x := xCross - x) < x1]) ifTrue:[
self displayForm:image x:x y:(yCtr - extent y)
]
]
].
"/ setup next line
index := index + 1.
yTop := yBot.
]
!
redrawSelFrameForYs:aList fromX:x0 toX:x1
"redraw selection frames for each line starting at an absolute
y derived from the argument a list.
"
|
spc "{ Class: SmallInteger }"
dY "{ Class: SmallInteger }"
w "{ Class: SmallInteger }"
y "{ Class: SmallInteger }"
x "{ Class: SmallInteger }"
|
aList size == 0 ifTrue:[ ^ self ].
strikeOut ifTrue:[
y := fontHeight // 2.
self paint:bgColor.
aList do:[:sY| self displayLineFromX:x0 y:(sY + y) toX:x1 y:(sY + y) ].
^ self
].
spc := lineSpacing // 2.
hilightFrameColor notNil ifTrue:[
hilightLevel == 0 ifTrue:[
dY := fontHeight - 1.
self paint:hilightFrameColor.
aList do:[:sY|
y := sY - spc. self displayLineFromX:x0 y:y toX:x1 y:y.
y := y + dY. self displayLineFromX:x0 y:y toX:x1 y:y.
]
]
] ifFalse:[
hilightStyle == #motif ifTrue:[
dY := fontHeight - spc - 2.
self paint:bgColor.
aList do:[:sY|
y := sY - spc + 1. self displayLineFromX:x0 y:y toX:x1 y:y.
y := sY + dY. self displayLineFromX:x0 y:y toX:x1 y:y.
]
]
].
hilightLevel ~~ 0 ifTrue:[
"/ draw edge
w := ((width - (2 * margin)) max:(self widthOfContents)) + leftOffset.
x := margin - leftOffset.
aList do:[:sY|
self drawEdgesForX:x y:(sY - spc) width:w height:fontHeight level:hilightLevel.
]
]
! !
!SelectionInTreeView methodsFor:'enumerating'!
detectNode:aOneArgBlock
"evaluate the argument, aBlock for each node in the list until
the block returns true; in this case return the node which caused
the true evaluation. If none node is detected, nil is returned.
"
^ listOfNodes detect:aOneArgBlock ifNone:nil
!
selectedNodesDo:aOneArgBlock
"evaluate the block on each node selected
"
self selectionDo:[:i| aOneArgBlock value:(listOfNodes at:i) ]
! !
!SelectionInTreeView methodsFor:'event handling'!
buttonMotion:buttonMask x:x y:y
"mouse-move while button was pressed - handle selection changes"
discardMotionEvents ifFalse:[
super buttonMotion:buttonMask x:x y:y
]
!
buttonMultiPress:button x:x y:y
(self indicatiorLineForButton:button atX:x y:y) == 0 ifTrue:[
^ super buttonMultiPress:button x:x y:y
].
"/ discard doubleClick on indicator
!
buttonPress:button x:x y:y
"check for indicator
"
|expand node lineNr isExpandable|
lineNr := self indicatiorLineForButton:button atX:x y:y.
lineNr == 0 ifTrue:[
^ super buttonPress:button x:x y:y
].
node := listOfNodes at:lineNr.
node hasChildren ifFalse:[ "/ no children exists
^ super buttonPress:button x:x y:y
].
discardMotionEvents := true.
dragIsActive := false.
clickPosition := nil.
self hasSelection ifTrue:[
(selectConditionBlock isNil or:[selectConditionBlock value:lineNr]) ifTrue:[
self selection:lineNr
] ifFalse:[
self selection:nil
]
].
isExpandable := node isExpandable.
self isCtrlMetaAltOrShiftPressed ifFalse:[
^ self nodeAt:lineNr expand:isExpandable
].
isExpandable ifTrue:[
supportsExpandAll ifFalse:[
^ self nodeAt:lineNr expand:isExpandable
].
node expandAll
] ifFalse:[
(node hasExpandedChildren) ifTrue:[
node hasChildrenWithSubChildren ifFalse:[
^ self nodeAt:lineNr expand:isExpandable
].
node collapseAllChildren
] ifFalse:[
supportsExpandAll ifFalse:[
^ self nodeAt:lineNr expand:isExpandable
].
node expandAllChildren
]
].
node children isEmpty ifTrue:[
"/ no children; redraw selected line (image might change)
self redrawLine:lineNr.
] ifFalse:[
"/ with children; update list and redraw to end.
self recomputeListFromNodeAt:lineNr
]
!
buttonRelease:button x:x y:y
"stop any autoscroll"
discardMotionEvents ifTrue:[
clickPosition := nil.
discardMotionEvents := false.
].
super buttonRelease:button x:x y:y
!
doubleClicked
"handle a double click; collapse or expand selected entry
in case of having children
"
|node|
(node := self selectedNode) notNil ifTrue:[
( validateDoubleClickBlock isNil
or:[(validateDoubleClickBlock value:node) ~~ false]
) ifTrue:[
self selectedNodeExpand:(node isExpandable).
super doubleClicked
]
]
!
indicatiorLineForButton:aButton atX:x y:y
"returns linenumber assigned to indicator at x/y or 0
"
|nr x0 node|
( enabled
and:[showDirectoryIndicator
and:[aButton == 1 or:[aButton == #select]]]
) ifTrue:[
nr := self visibleLineToListLine:(self visibleLineOfY:y).
nr notNil ifTrue:[
node := listOfNodes at:nr.
node hasChildren ifTrue:[
x0 := self xOfFigureLevel:(node level - 1).
(x > x0 and:[(x0 + imageWidth) > x and:[node children notEmpty]]) ifTrue:[
^ nr
]
]
]
].
^ 0
!
isCtrlMetaAltOrShiftPressed
"returns true if CTRL, META, ALT or SHIFT is pressed
"
|sensor|
(sensor := self sensor) notNil ifTrue:[
^ ( sensor ctrlDown
or:[sensor altDown
or:[sensor shiftDown
or:[sensor metaDown]]]
)
].
^ false
!
key:key select:index x:x y:y
"select an entry by a keyboard action. This is treated like a doubleClick
on that entry.
Add on: In case that the entry is not selectable, scroll to the entry
"
(enabled and:[keyActionStyle notNil]) ifFalse:[
^ self
].
(selectConditionBlock isNil or:[selectConditionBlock value:index]) ifTrue:[
^ super key:key select:index x:x y:y
].
keyActionStyle == #pass ifTrue:[
^ self
].
self gotoLine:index
!
keyPress:key x:x y:y
"handle keyboard input"
<resource: #keyboard ( #CursorLeft #CursorRight ) >
|idx node inc end|
enabled ifFalse:[
^ self
].
(key == #CursorLeft or:[key == #CursorRight]) ifTrue:[
(idx := self selectedIndex) == 0 ifTrue:[ ^ self ].
(key == #CursorLeft) ifTrue:[ inc := -1. end := 0 ]
ifFalse:[ inc := 1. end := 1 + listOfNodes size ].
[(idx := idx + inc) ~~ end] whileTrue:[
node := listOfNodes at:idx.
node hasChildren ifTrue:[
^ self key:key select:idx x:x y:y
]
].
^ self
].
^ super keyPress:key x:x y:y
!
redrawX:x y:y width:w height:h
"a region must be redrawn"
|savClip startLn sel
lnSpace "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
visStart "{ Class:SmallInteger }"
visEnd "{ Class:SmallInteger }"
stopLn "{ Class:SmallInteger }"
maxY "{ Class:SmallInteger }"
maxX "{ Class:SmallInteger }"
dltLine "{ Class:SmallInteger }"
startY "{ Class:SmallInteger }"|
shown ifFalse:[^ self].
visStart := self visibleLineOfY:(y + 1).
startLn := self visibleLineToAbsoluteLine:visStart.
self paint:bgColor.
self fillRectangleX:x y:y width:w height:h.
startLn isNil ifTrue:[ ^ self ].
sel := nil.
maxX := x + w.
maxY := y + h.
lnSpace := lineSpacing // 2.
visEnd := self visibleLineOfY:maxY.
startY := self yOfVisibleLine:visStart.
dltLine := startLn - visStart.
stopLn := dltLine + visEnd.
savClip := clipRect.
self clippingRectangle:(Rectangle left:x top:y width:w height:h).
self hasSelection ifTrue:[
"/ redraw the background for all selected lines in the invalid range
self selectionDo:[:lnNr|
(lnNr between:startLn and:stopLn) ifTrue:[
sel isNil ifTrue:[
sel := OrderedCollection new.
self paint:hilightBgColor.
].
sel add:(y0 := self yOfVisibleLine:(lnNr - dltLine)).
y0 := y0 - lnSpace.
y1 := y0 + fontHeight min:maxY.
y0 := y0 max:y.
self fillRectangleX:x y:y0 width:w height:y1 - y0.
]
]
].
self redrawLinesX:x y:startY - lnSpace toX:maxX start:startLn stop:stopLn.
"/ draw selection frames
self redrawSelFrameForYs:sel fromX:x toX:maxX.
self clippingRectangle:savClip.
! !
!SelectionInTreeView methodsFor:'initialization'!
create
super create.
lineMask := lineMask onDevice:device.
lineColor notNil ifTrue:[
lineColor := lineColor onDevice:device
]
!
destroy
"remove dependencies
"
rootHolder removeDependent:self.
selectionHolder removeDependent:self.
model notNil ifTrue:[
model stopRunningTasks
].
super destroy.
!
fetchDefaultImages
"returns a directory with default keys and images; could be
redefined by subclass.
"
^ nil
!
fetchDeviceResources
"initialize heavily used device resources - to avoid rendering
images again and again later"
super fetchDeviceResources.
self refetchDeviceResources
!
fetchImageResources
"initialize heavily used device resources - to avoid rendering
images again and again later; returns maximum extent of the images used.
Could be redefined by subclass
"
|img x y keysAndIcons|
imageOpened isNil ifTrue:[
imageOpened := (self class imageOpened) onDevice:device
].
imageClosed isNil ifTrue:[
imageClosed := self imageOnDevice:(self class imageClosed)
].
x := (imageOpened width) max:(imageClosed width).
y := (imageOpened height) max:(imageClosed height).
imageItem isNil ifTrue:[
imageItem := self imageOnDevice:(self class imageItem)
].
x := (imageItem width) max:x.
y := (imageItem height) max:y.
(keysAndIcons := self fetchDefaultImages) notNil ifTrue:[
keysAndIcons keysAndValuesDo:[:aKey :anIcon|
(anIcon isImage and:[aKey notNil]) ifTrue:[
registeredImages at:aKey put:(self imageOnDevice:anIcon copy)
]
]
].
registeredImages keysAndValuesDo:[:k :img|
x := (img width) max:x.
y := (img height) max:y.
].
(listOfNodes size > 0 and:[(img := listOfNodes first icon) isImage]) ifTrue:[
x := (img width) max:x.
y := (img height) max:y.
].
^ x @ y
!
getFontParameters
"save old computed height derived from images
"
|lineHeight|
lineHeight := fontHeight ? 0.
super getFontParameters.
labelOffsetY := fontAscent - (fontHeight - lineSpacing // 2).
lineHeight > fontHeight ifTrue:[
fontHeight := lineHeight
].
fontHeight odd ifTrue:[
fontHeight := fontHeight + 1
]
!
initialize
"setup instance attributes
"
super initialize.
supportsExpandAll := true.
self bitGravity:#NorthWest.
showRoot := showDirectoryIndicatorForRoot := showLines := computeResources := true.
showDirectoryIndicator := discardMotionEvents := false.
lineMask := Form width:2 height:2 fromArray:#[16rAA 16r55].
registeredImages := IdentityDictionary new.
textInset := 4.
imageInset := 0. "/ set during indication enabled
imageWidth := 8. "/ default: will change during startup
self model:nil. "/ creates a default model.
!
realize
super realize.
self refetchDeviceResources.
!
recomputeDirectoryIndicator
"setup attributes used by directory indicator
"
|x w|
imageInset := 0.
(showDirectoryIndicator and:[computeResources not]) ifFalse:[
^ self
].
openIndicator isNil ifTrue:[
openIndicator := self imageOnDevice:(self class openIndicator)
].
closeIndicator isNil ifTrue:[
closeIndicator := self imageOnDevice:(self class closeIndicator)
].
x := (openIndicator width) max:(closeIndicator width).
x := x // 2.
w := imageWidth // 2.
(x := x + self class minImageInset) > w ifTrue:[
imageInset := x - w.
].
!
refetchDeviceResources
"reinitialize heavily used device resources - to avoid rendering
images again and again later
"
|extent|
(realized and:[computeResources and:[listOfNodes size ~~ 0]]) ifTrue:[
computeResources := false.
extent := self fetchImageResources.
extent y >= fontHeight ifTrue:[
fontHeight := 1 + extent y.
].
fontHeight odd ifTrue:[
fontHeight := fontHeight + 1
].
imageWidth := extent x.
self recomputeDirectoryIndicator.
self computeNumberOfLinesShown.
]
! !
!SelectionInTreeView methodsFor:'model'!
getListFromModel
"if I have a model, get my list from it using the listMessage.
If listMessage is nil, try aspectMessage for backward compatibilty.
"
super list:(self listFromModel) keepSelection:true
!
listFromModel
"get list from model and return the new list.
If listMessage is nil, try aspectMessage for backward compatibilty.
"
|msg list
runs "{ Class: SmallInteger }"
idx "{ Class: SmallInteger }"
|
widthOfWidestLine := nil.
(msg := listMsg ? aspectMsg) notNil ifTrue:[
listOfNodes := model perform:msg.
(runs := listOfNodes size) ~~ 0 ifTrue:[
self refetchDeviceResources.
idx := 1.
list := OrderedCollection new:runs.
runs timesRepeat:[
list add:(listOfNodes at:idx) name.
idx := idx + 1.
].
^ list
]
].
listOfNodes := #().
^ #()
!
model:aModel
"check whether model is nil; than a default model is created
"
|model|
model notNil ifTrue:[
model stopRunningTasks
].
model := aModel ? (SelectionInTree new).
model showRoot:showRoot.
super model:model.
!
rootFromModel
"update hierarchical list from root model; 'rootHolder'
"
|root|
root := rootHolder root.
self root == root ifFalse:[
self selection:nil.
self root:root.
].
!
selectionFromModel
"set the selection derived from the selectionHolder
"
|coll value sz|
(value := selectionHolder value) isNil ifTrue:[
^ self deselect
].
multipleSelectOk ifFalse:[
self selectNode:value
] ifTrue:[
(sz := value size) ~~ 0 ifTrue:[
coll := OrderedCollection new:sz.
value do:[:aNode||i|
(i := self indexOfNode:aNode) notNil ifTrue:[
coll add:i
]
]
].
coll size == 0 ifTrue:[self deselect]
ifFalse:[self selection:coll]
]
!
selectionToModel
"write selection to selection holder
"
|newSel oldSel|
oldSel := selectionHolder value.
multipleSelectOk ifFalse:[
(newSel := self selectedNode) ~~ oldSel ifTrue:[
selectionHolder value:newSel
]
] ifTrue:[
selection size == 0 ifTrue:[
oldSel notNil ifTrue:[
selectionHolder value:nil
]
] ifFalse:[
newSel := selection collect:[:i| listOfNodes at:i].
newSel size ~~ oldSel size ifTrue:[
selectionHolder value:newSel.
] ifFalse:[
newSel do:[:aNode|
(oldSel includesIdentical:aNode) ifFalse:[
^ selectionHolder value:newSel
]
]
]
]
]
! !
!SelectionInTreeView methodsFor:'private'!
list:aList keepSelection:keepSelection
"setup new list; keep selection dependent on the boolean state
keepSelection
"
|list time|
list := aList.
list size == 0 ifTrue:[
listOfNodes := #()
] ifFalse:[
(list first respondsTo:#hasChildren) ifTrue:[
listOfNodes := aList.
self refetchDeviceResources.
list := listOfNodes collect:[:aNode| aNode name ].
]
].
super list:list keepSelection:keepSelection
!
nodeAt:anIndex expand:doExpand
"expand or collapse the node at an index, anIndex dependent on the boolean state
of doExpand
"
|node|
node := listOfNodes at:anIndex.
node hasChildren ifFalse:[ "/ no children exists
^ self
].
node isExpandable ifTrue:[
doExpand ifFalse:[^ self]. "/ already expanded
node expand
] ifFalse:[
doExpand ifTrue:[^ self]. "/ already collapsed
node collapse
].
node children isEmpty ifTrue:[
"/ no children; redraw selected line (image might change)
self redrawLine:anIndex.
] ifFalse:[
"/ with children; update list and redraw to end.
self recomputeListFromNodeAt:anIndex
]
!
recomputeListFromNodeAt:anIndex
model removeDependent:self.
model recomputeList.
model addDependent:self.
list := self listFromModel.
self redrawFromLine:anIndex.
self contentsChanged.
! !
!SelectionInTreeView methodsFor:'private - drag and drop'!
collectionOfDragObjects
"returns collection of dragable objects assigned to selection
Here, by default, a collection of text-dragObjects is generated;
however, if a dragObjectConverter is defined, that one gets a chance
to convert as appropriate."
|collection converted selection dLbl dObj node|
selection := self selectionAsCollection.
collection := selection collect:[:nr|
node := listOfNodes at:nr.
dObj := self dragObjectForNode:node.
dObj theObject:(node contents).
dLbl := LabelAndIcon icon:(self figureFor:node) string:(list at:nr).
dObj displayObject:dLbl.
dObj
].
dragObjectConverter notNil ifTrue:[
converted := OrderedCollection new.
collection keysAndValuesDo:[:nr :obj |
(dObj := dragObjectConverter value:obj) notNil ifTrue:[
dLbl := LabelAndIcon icon:(self figureFor:(listOfNodes at:nr)) string:(list at:nr).
converted displayObject:dLbl.
converted add:dObj
]
].
collection := converted
].
^ collection.
!
dragObjectForNode:aNode
"returns the dragable object for a node; could be redefined in subclass
"
^ DropObject new:aNode.
!
startDragX:x y:y
"start drag
"
dragIsActive := true.
DragAndDropManager startDrag:(self collectionOfDragObjects)
from:self
atEnd:endDragAction
! !
!SelectionInTreeView methodsFor:'private queries'!
lengthOfLongestLineBetween:firstLine and:lastLine
"return the length (in characters) of the longest line in a line-range
"
|max|
max := self widthOfContents:firstLine and:lastLine.
^ (max // fontWidth) + 1
!
widthOfContents
"return the width of the contents in pixels
- used for scrollbar interface"
list isNil ifTrue:[^ 0].
(widthOfWidestLine isNil or:[widthOfWidestLine == 0]) ifTrue:[
widthOfWidestLine := self widthOfContents:1 and:(self size).
].
^ widthOfWidestLine + (leftMargin * 2)
!
widthOfContents:firstLine and:lastLine
"return the length (in pixels) of the longest line in a line-range
"
|parent name item tmpValue
max "{ Class: SmallInteger }"
index "{ Class: SmallInteger }"
runs "{ Class: SmallInteger }"
level "{ Class: SmallInteger }"
xOfStr "{ Class: SmallInteger }"
dltX "{ Class: SmallInteger }"
width "{ Class: SmallInteger }"
newSz "{ Class: SmallInteger }"
maxSz "{ Class: SmallInteger }"|
( (listOfNodes size == 0)
or:[(runs := lastLine min:(listOfNodes size)) < firstLine]
) ifTrue:[
^ 0
].
level := 1.
xOfStr := self xOfStringLevel:level.
max := xOfStr.
dltX := imageInset + imageWidth.
width := '1' widthOn:self.
parent := 4711. "/ to force a computation
index := firstLine.
runs := runs - index + 1.
runs timesRepeat:[
item := listOfNodes at:index.
name := item name.
index := index + 1.
(newSz := name size) ~~ 0 ifTrue:[
item parent ~~ parent ifTrue:[
parent := item parent.
tmpValue := item level.
xOfStr := xOfStr + ((tmpValue - level) * dltX).
level := tmpValue.
maxSz := 0.
].
maxSz < newSz ifTrue:[
maxSz := newSz.
max := max max:(xOfStr + (maxSz * width)).
]
]
].
^ max + leftOffset.
!
withoutRedrawAt:anIndex put:aString
"change a line without redisplay"
|width|
width := widthOfWidestLine.
widthOfWidestLine := nil.
super withoutRedrawAt:anIndex put:aString.
(widthOfWidestLine := width) notNil ifTrue:[
width := self widthOfContents:anIndex and:anIndex.
widthOfWidestLine := widthOfWidestLine max:width.
].
! !
!SelectionInTreeView methodsFor:'queries'!
figureFor:aNode
"access figure for a node
"
|icon img|
(icon := aNode icon) notNil ifTrue:[
img := registeredImages at:icon ifAbsent:nil.
img notNil ifTrue:[
^ img
].
icon isImage ifTrue:[
img := self imageOnDevice:(icon copy).
registeredImages at:icon put:img.
^ img
]
].
"/ fallback solution
aNode hasChildren ifTrue:[
^ aNode isExpandable ifTrue:[imageClosed] ifFalse:[imageOpened]
].
^ imageItem
!
indexOfNode:aNode
"returns index of a node
"
^ listOfNodes identityIndexOf:aNode
!
xOfFigureLevel:aLevel
"origin x where to draw the icon
"
|l "{ Class:SmallInteger }"|
l := showRoot ifTrue:[aLevel] ifFalse:[aLevel - 1].
showDirectoryIndicator ifFalse:[
l := l - 1
] ifTrue:[
showDirectoryIndicatorForRoot ifFalse:[
l := l - 1
]
].
^ (l * (imageInset + imageWidth)) + imageInset - leftOffset + leftMargin
!
xOfFigureNode:aNode
"origin x where to draw the icon
"
^ self xOfFigureLevel:(aNode level)
!
xOfStringLevel:aLevel
"origin x where to draw the text( label )
"
^ (self xOfFigureLevel:aLevel) + imageWidth + textInset
!
xOfStringNode:aNode
"origin x where to draw the text( label )
"
^ self xOfStringLevel:(aNode level)
! !
!SelectionInTreeView methodsFor:'selection'!
selectFromListOfNames:aListOfNames
"set selection from a list of names
"
|node rdwNd chgd|
aListOfNames size < 1 ifTrue:[
^ self selection:nil
].
node := model root.
chgd := false.
aListOfNames do:[:el||next|
next := node detectChild:[:e|e name = el].
next notNil ifTrue:[
node hidden ifTrue:[
chgd := true.
node expand
].
node := next
]
].
chgd ifTrue:[
model recomputeList.
].
self selectNode:node.
!
selectNode:aNode
"change selection to a node
"
self selection:(self indexOfNode:aNode)
!
selectedIndex
"get single selected index or 0
"
selection size == 1 ifTrue:[^ selection first].
selection isNumber ifTrue:[^ selection].
^ 0
!
selectedNode
"get the single selected node or nil
"
|idx|
(idx := self selectedIndex) ~~ 0 ifTrue:[
^ listOfNodes at:idx
].
^ nil
!
selectionChangedFrom:oldSelection
"update selectionHolder if not nil
"
"/ first change my selectionHolders value ...
selectionHolder notNil ifTrue:[
self selectionToModel.
].
"/ ... then make notifications.
super selectionChangedFrom:oldSelection.
! !
!SelectionInTreeView methodsFor:'selection-actions'!
selectedNodeAdd:something
"add a node or collection of nodes after selected node
"
|node|
something notNil ifTrue:[
(node := self selectedNode) notNil ifTrue:[
node parent notNil ifTrue:[
node isCollapsable ifTrue:[
model add:something beforeIndex:1 below:node
] ifFalse:[
model add:something after:node
]
] ifFalse:[
model add:something beforeIndex:1 below:(self root)
]
]
]
!
selectedNodeBecomeChildOfNext
"become node a child of followd node
"
|idx node cprt nprt|
((node := self selectedNode) isNil or:[(cprt := node parent) isNil]) ifFalse:[
idx := cprt indexOfChild:node.
idx == cprt children size ifFalse:[
nprt := cprt childAt:(idx + 1).
nprt notNil ifTrue:[
model removeDependent:self.
model removeSelection.
selection := nil.
model collapse:nprt.
model add:node beforeIndex:1 below:nprt.
model addDependent:self.
model expand:nprt.
self selectNode:node.
]
]
]
!
selectedNodeBecomeSisterOfParent
"become node a sister of its current parent
"
|node cprt nprt|
( (node := self selectedNode) isNil
or:[(cprt := node parent) isNil
or:[(nprt := cprt parent) isNil]]
) ifFalse:[
model removeDependent:self.
model removeSelection.
selection := nil.
model addDependent:self.
model add:node afterIndex:(nprt indexOfChild:cprt) below:nprt.
self selectNode:node.
]
!
selectedNodeChangeSequenceOrder:anOffset
"move child 'anOffset' forward or backward in list of children
"
|idx node size parent|
( (node := self selectedNode) notNil
and:[(parent := node parent) notNil
and:[(size := parent children size) > 1]]
) ifTrue:[
idx := parent indexOfChild:node.
model removeDependent:self.
model removeSelection.
selection := nil.
model addDependent:self.
(idx := idx + anOffset) < 1 ifTrue:[
idx := size
] ifFalse:[
idx > size ifTrue:[idx := 1]
].
model add:node beforeIndex:idx below:parent.
self selectNode:node.
]
!
selectedNodeExpand:doExpand
"collapse or expand selected node
"
|index|
(index := self selectedIndex) ~~ 0 ifTrue:[
self nodeAt:index expand:doExpand
].
!
selectedNodesRemove
"remove selected nodes
"
model removeSelection.
self selection:nil.
! !
!SelectionInTreeView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.53 1998-04-04 08:45:17 ca Exp $'
! !