"
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' }"
View subclass:#ListModelView
instanceVariableNames:'list listHolder textStartLeft viewOrigin enabled fgColor bgColor
lineSpacing widthOfContents computeWidthInRange startOfLinesY
autoScroll autoScrollBlock scrollWhenUpdating hasConstantHeight
constantHeight previousExtent renderer'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultShadowColor
DefaultLightColor StopRedrawSignal'
poolDictionaries:''
category:'Views-Lists'
!
Object subclass:#Renderer
instanceVariableNames:'view'
classVariableNames:''
poolDictionaries:''
privateIn:ListModelView
!
!ListModelView 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 widget is a new improved revision of the good-old ListView.
In contrast to ListView, this one reacts on changes of the
underlying model and performs optimized redraws.
It requires a List (or alike) as model.
This class can only passively display collections of elements.
The class doesn't keep its own list, it works directly on
the model( List or HierarchicalList ).
Each list item is obligated to provide 3 services:
- heightOn:aGC
- widthOn:aGC
- displayOn:aGC x:x y:y
[Instance variables:]
list <List-Model> List or HierarchicalList ...
listHolder <Model> Model, which keeps a List
textStartLeft <Number> left inset of text
viewOrigin <Point> the current origin
enabled <Boolean> widget is enabled/disabeled
fgColor <Color> color to draw characters
bgColor <Color> the background
lineSpacing <Number> pixels between lines
widthOfContents <Number> cached width of widest line
computeWidthInRange <Point> used for recompute width of contents
startOfLinesY <Collection> keeps all the absolute Y-start positions
for each line in the list. The first
entry into the list is the top Y inset.
supportsDisplayInRange <Boolean> set to true if the list elements
supports the service:
#displayOn:x:y:h:
hasConstantHeight <Boolean> true, than each line has the same height
constantHeight <SmallInteger> hasConstantHeight is turned on, this
is the used line height
[author:]
Claus Atzkern
[see also:]
SelectionInListModelView
HierarchicalListView
List
HierarchicalList
"
!
examples
"
[exBegin]
|top list view up index|
list := List new.
top := StandardSystemView new; extent:300@300.
view := ScrollableView for:ListModelView miniScroller:true
origin:0.0@0.0 corner:1.0@1.0 in:top.
view list:list.
top openAndWait.
up := true.
[top shown] whileTrue:[
Delay waitForSeconds:0.2.
up ifTrue:[
index := 1 + (list size).
list add:('element: ', index printString).
up := index < 20
] ifFalse:[
list removeIndex:1.
up := list isEmpty.
]
].
[exEnd]
"
! !
!ListModelView class methodsFor:'initialization'!
initialize
"setup the signals
"
StopRedrawSignal := Notification newSignalMayProceed:true.
StopRedrawSignal nameClass:self message:#stopRedrawSignal.
! !
!ListModelView class methodsFor:'Signal constants'!
stopRedrawSignal
^ StopRedrawSignal
! !
!ListModelView class methodsFor:'defaults'!
defaultRenderer
^ Renderer
!
updateStyleCache
"extract values from the styleSheet and cache them in class variables"
<resource: #style (
#'text.backgroundColor' #'text.foregroundColor'
#'selection.shadowColor' #'selection.lightColor'
#'text.font'
)>
DefaultForegroundColor := StyleSheet colorAt:'text.foregroundColor' default:Black.
DefaultBackgroundColor := StyleSheet colorAt:'text.backgroundColor'.
DefaultShadowColor := StyleSheet colorAt:'selection.shadowColor'.
DefaultLightColor := StyleSheet colorAt:'selection.lightColor'.
DefaultFont := StyleSheet fontAt:'text.font'.
"
self updateStyleCache
"
! !
!ListModelView methodsFor:'accessing'!
list
"get the list of items
"
^ list
!
list:aList
"set the list of items
"
|negatedOrg|
renderer listWillChange.
list ~~ aList ifTrue:[
list removeDependent:self.
list := aList.
list isNil ifTrue:[list := self newDefaultList ].
list addDependent:self
].
preferredExtent := nil.
widthOfContents := nil.
self realized ifFalse:[^ self].
self recomputeHeightOfContents.
scrollWhenUpdating == #beginOfText ifTrue:[
viewOrigin = (0@0) ifFalse:[
self originWillChange.
negatedOrg := viewOrigin negated.
viewOrigin := (0@0).
self originChanged:negatedOrg.
].
] ifFalse:[
scrollWhenUpdating == #endOfText ifTrue:[
self scrollTo:(0 @ self heightOfContents - self innerHeight) redraw:false
]
].
self invalidate.
self contentsChanged
!
renderer
"returns the used renderer
"
^ renderer
!
renderer:aRenderer
"change the used renderer
"
aRenderer isNil ifTrue:[^ self].
renderer == aRenderer ifTrue:[^ self].
renderer notNil ifTrue:[renderer release].
renderer := aRenderer.
renderer isBehavior ifTrue:[
renderer := renderer basicNew initialize.
].
renderer forView:self.
! !
!ListModelView methodsFor:'accessing-behavior'!
autoScroll
"returns true if auto scrolling is enabled
"
^ autoScroll
!
autoScroll:aBool
"returns true if auto scrolling is enabled
"
autoScroll := aBool ? true.
!
enabled
"returns the enabled state
"
^ enabled
!
enabled:aBoolean
"set the enabled state
"
enabled := aBoolean
!
hasConstantHeight
"user configured; true if each line has the same lineHeight
optimize for scroller update
"
^ hasConstantHeight
!
hasConstantHeight:aBool
"user configured; true if each line has the same lineHeight
optimize for scroller update
"
aBool == hasConstantHeight ifTrue:[
^ self
].
constantHeight := nil.
hasConstantHeight := aBool.
self lostSynchronisation.
!
scrollWhenUpdating:aSymbolOrNil
"define how to scroll, when I get a new text
(via the model or the #contents/#list)
Allowed arguments are:
#keep / nil -> no change
#endOfText -> scroll to the end
#beginOfText -> scroll to the top
The default is #beginOfText.
This may be useful for fields which get new values assigned from
the program (i.e. not from the user)
"
scrollWhenUpdating := aSymbolOrNil
! !
!ListModelView methodsFor:'accessing-items'!
at:anIndex
"return the list element at an index
"
^ list at:anIndex
!
at:anIndex ifAbsent:exceptionBlock
"return the list element at an index if valid.
If the index is invalid, return the result of evaluating
the exceptionblock.
"
^ list at:anIndex ifAbsent:exceptionBlock
!
findLast:aOneArgBlock
"find the last list entry, for which evaluation of the argument, aOneArgBlock
returns true; return its index or 0 if none detected.
"
^ list findLast:aOneArgBlock
!
identityIndexOf:anElement
"returns the index of an element or nil
"
^ list identityIndexOf:anElement
!
last
"returns the last list entry
"
^ list last
! !
!ListModelView methodsFor:'accessing-look'!
backgroundColor
"get the background color
"
^ bgColor
!
font:aFont
"set a new font
"
|oldWidth oldHeight|
(aFont isNil or:[aFont = font]) ifFalse:[
oldWidth := font width.
oldHeight := font height.
super font:aFont.
(font widthOn:device) ~~ oldWidth ifTrue:[ "/ force a recomputation
preferredExtent := nil.
widthOfContents := nil.
].
oldHeight ~~ (font heightOn:device) ifTrue:[
self recomputeHeightOfContents.
].
self invalidate
].
!
foregroundColor
"get the foreground color
"
^ fgColor
!
foregroundColor:aColor
"set the foreground color
"
(aColor notNil and:[fgColor ~~ aColor]) ifTrue:[
self realized ifTrue:[
fgColor := aColor onDevice:device.
self invalidate
] ifFalse:[
fgColor := aColor
]
]
!
lineSpacing
"get the lineSpacing - thats an additional number of pixels,
by which lines are vertically separated.
"
^ lineSpacing
!
lineSpacing:aNumber
"set the lineSpacing - thats an additional number of pixels,
by which lines are vertically separated.
"
lineSpacing ~= aNumber ifTrue:[
lineSpacing := aNumber.
self recomputeHeightOfContents.
self invalidate
]
!
viewBackground:aColor
"set the background color
"
(aColor notNil and:[bgColor ~~ aColor]) ifTrue:[
bgColor := aColor.
super viewBackground:bgColor.
self realized ifTrue:[
bgColor := bgColor onDevice:device.
self invalidate
].
].
! !
!ListModelView methodsFor:'accessing-mvc'!
listHolder
"returns the listHolder or nil
"
^ listHolder
!
listHolder:aListHolder
"set a new listHolder
"
listHolder removeDependent:self.
(listHolder := aListHolder) notNil ifTrue:[
listHolder addDependent:self.
].
self list:(listHolder value).
! !
!ListModelView methodsFor:'change & update'!
lineChangedAt:aLnNr with:arg
"line changed at position; check whether line height changed"
|cache
oldHeight "{ Class:SmallInteger }"
dltHeight "{ Class:SmallInteger }" |
(arg == #icon or:[arg == #hierarchy]) ifTrue:[
^ self
].
hasConstantHeight ifTrue:[
self invalidateLineAt:aLnNr.
^ self
].
oldHeight := (self yVisibleOfLine:(aLnNr + 1)) - (self yVisibleOfLine:aLnNr).
dltHeight := (self heightOfLineAt:aLnNr) - oldHeight.
dltHeight == 0 ifTrue:[
self invalidateLineAt:aLnNr.
^ self
].
cache := self startOfLinesY.
aLnNr + 1 to:cache size do:[:i|
cache at:i put:((cache at:i) + dltHeight)
].
self invalidate.
!
listChangedInsert:start nItems:nLines
"list changed; items are added
"
|newLines
run "{ Class: SmallInteger }"
newSz "{ Class: SmallInteger }"
cpyHg "{ Class: SmallInteger }"
absY0 "{ Class: SmallInteger }"
absY1 "{ Class: SmallInteger }"
visY0 "{ Class: SmallInteger }"
visY1 "{ Class: SmallInteger }"
orgY "{ Class: SmallInteger }"
dltY "{ Class: SmallInteger }"
maxHg "{ Class: SmallInteger }"
|
nLines == 0 ifTrue:[^ self ].
self listSizeChanged:start nLines:nLines.
shown ifFalse:[^ self].
newSz := startOfLinesY size + nLines.
(newSz - 1) ~~ self size ifTrue:[
"/
"/ no longer synchrounous
"/
^ self lostSynchronisation
].
newLines := startOfLinesY copy.
newLines addAll:(Array new:nLines) beforeIndex:start + 1.
absY0 := newLines at:start.
absY1 := absY0.
run := start.
nLines timesRepeat:[
absY1 := absY1 + (self heightOfLineAt:run).
run := run + 1.
newLines at:run put:absY1.
].
dltY := absY1 - absY0.
run + 1 to:newSz do:[:i||v|
newLines at:i put:((newLines at:i) + dltY)
].
startOfLinesY := newLines.
orgY := viewOrigin y.
absY1 := absY0 + dltY.
visY0 := absY0 - orgY.
visY1 := absY1 - orgY.
maxHg := height - margin.
absY0 < orgY ifTrue:[
self originWillChange.
viewOrigin y:(dltY + orgY).
self originChanged:(0 @ dltY).
].
(visY0 >= maxHg or:[visY1 <= margin]) ifTrue:[
^ self contentsChanged
].
visY0 := visY0 max:margin.
visY1 := visY1 min:maxHg.
self hasDamage ifTrue:[
self invalidate:(Rectangle left:0
top:visY0
width:width
height:height - visY0).
^ self contentsChanged.
].
(start == self size or:[(cpyHg := maxHg - visY1) < 20]) ifTrue:[
visY1 := maxHg
] ifFalse:[
self catchExpose.
self copyFrom:self x:0 y:visY0
toX:0 y:visY1
width:width height:cpyHg async:true.
self waitForExpose
].
self invalidateX:margin
y:visY0
width:width - margin - margin
height:(visY1 - visY0).
self contentsChanged.
!
listChangedRemove:aStart toIndex:aStop
"list changed; items are removed
"
|noRedraw newLines
size "{ Class: SmallInteger }"
absY0 "{ Class: SmallInteger }"
absY1 "{ Class: SmallInteger }"
visY0 "{ Class: SmallInteger }"
visY1 "{ Class: SmallInteger }"
orgY "{ Class: SmallInteger }"
orgX "{ Class: SmallInteger }"
dltY "{ Class: SmallInteger }"
cpyHg "{ Class: SmallInteger }"
maxHg "{ Class: SmallInteger }"
stop "{ Class: SmallInteger }"
start "{ Class: SmallInteger }"
newSz "{ Class: SmallInteger }"
|
stop := aStop.
start := aStart.
(size := stop - start + 1) == 0 ifTrue:[
^ self
].
self listSizeChanged:start nLines:(size negated).
shown ifFalse:[^ self].
newSz := startOfLinesY size - size.
(newSz - 1) ~~ self size ifTrue:[
"/
"/ no longer synchrounous
"/
^ self lostSynchronisation
].
absY0 := self yAbsoluteOfLine:start.
absY1 := self yAbsoluteOfLine:stop + 1.
dltY := absY1 - absY0.
newLines := startOfLinesY copy.
newLines removeFromIndex:(start + 1) toIndex:(stop + 1).
(start + 1) to:newSz do:[:i|
absY0 := newLines at:i.
newLines at:i put:(absY0 - dltY).
].
startOfLinesY := newLines.
orgY := viewOrigin y.
orgX := viewOrigin x.
absY0 := self yAbsoluteOfLine:start.
absY1 := absY0 + dltY.
visY0 := absY0 - orgY.
visY1 := absY1 - orgY.
maxHg := height - margin.
(self size == 0 or:[(orgY ~~ 0 and:[self maxViewOriginY == 0])]) ifTrue:[
(orgX ~~ 0 or:[orgY ~~ 0]) ifTrue:[
self originWillChange.
viewOrigin := 0@0.
self originChanged:((orgX @ orgY) negated).
].
self invalidate.
^ self contentsChanged
].
visY0 < margin ifTrue:[
noRedraw := visY1 <= margin.
noRedraw ifTrue:[dltY := dltY negated] ifFalse:[dltY := visY0].
self originWillChange.
viewOrigin y:(dltY + orgY).
self originChanged:(0 @ dltY).
] ifFalse:[
noRedraw := visY0 >= maxHg
].
visY0 := visY0 max:margin.
self hasDamage ifTrue:[
self invalidate:(Rectangle left:0
top:visY0
width:width
height:height - visY0).
noRedraw := true
].
noRedraw ifFalse:[
cpyHg := maxHg - visY1.
cpyHg > 20 ifTrue:[
self catchExpose.
self copyFrom:self x:0 y:visY1 toX:0 y:visY0
width:width height:cpyHg async:true.
self waitForExpose.
visY0 := visY0 + cpyHg.
].
self invalidateX:margin
y:visY0
width:width - margin - margin
height:(maxHg - visY0).
].
self contentsChanged.
!
update:what with:aPara from:chgObj
"catch and handle any notification raised from the list model
or list holder
"
chgObj ~~ self list ifTrue:[
chgObj == self listHolder ifTrue:[
self list:(chgObj value).
] ifFalse:[
super update:what with:aPara from:chgObj
].
^ self.
].
renderer withinUpdateFromListDo:[
self updateFromList:what with:aPara.
].
!
updateFromList:what with:aPara
"called if the list changed
"
|arg1 arg2|
aPara isCollection ifFalse:[
what == #at: ifTrue:[self lineChangedAt:aPara with:nil. ^ self].
what == #insert: ifTrue:[self listChangedInsert:aPara nItems:1. ^ self].
what == #remove: ifTrue:[self listChangedRemove:aPara toIndex:aPara. ^ self].
^ self.
].
arg1 := aPara at:1.
arg2 := aPara at:2.
(arg1 == 1 and:[arg2 == self size]) ifTrue:[
self list:(self list). "/ reload list
^ self
].
what == #at: ifTrue:[self lineChangedAt:arg1 with:arg2. ^ self].
what == #insertCollection: ifTrue:[self listChangedInsert:arg1 nItems:arg2. ^ self].
what == #removeFrom: ifTrue:[self listChangedRemove:arg1 toIndex:arg2. ^ self].
what == #replace: ifTrue:[
arg1 to:arg2 do:[:i|self lineChangedAt:i with:nil].
^ self
].
! !
!ListModelView methodsFor:'drawing'!
drawElementsFrom:start to:stop x:x y:y w:w
"draw lines from start to stop.
clipping and clearing the background is already done
"
|item
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
|
self paint:fgColor on:bgColor.
x0 := textStartLeft - viewOrigin x.
y1 := y.
start to:stop do:[:i|
item := self at:i ifAbsent:self. "/ list changed during draw
item == self ifTrue:[^ self].
y0 := y1.
y1 := self yVisibleOfLine:(i + 1).
item notNil ifTrue:[
renderer display:item atX:x0 y:y0 lineHeight:(y1 - y0).
]
]
!
drawFrom:start to:stop x:xLft y:yTop w:aWidth
"draw lines from start to stop. Test whether a new clip
must be setup.
"
|maxX w|
maxX := renderer maxItemWidthOrNil.
w := aWidth.
maxX notNil ifTrue:[ |clip|
maxX := maxX - viewOrigin x.
maxX > xLft ifFalse:[^ self.].
w := maxX - xLft min:aWidth.
(clip := self clipRect copy) notNil ifTrue:[
clip width:w
] ifFalse:[
clip := Rectangle left:xLft top:yTop width:w height:(height - yTop - margin).
].
self clippingRectangle:clip.
].
self drawElementsFrom:start to:stop x:xLft y:yTop w:w.
!
invalidateLineAt:aLineNr
"add a damage to redraw a line specified by its line number to the
input event queue.
"
^ self invalidateLineAt:aLineNr fromX:0.
!
invalidateLineAt:aLineNr fromX:x
"add a damage to redraw a line specified by its line number to the
input event queue.
"
|y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
yB "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
xR "{ Class:SmallInteger }"
|
(shown and:[aLineNr notNil and:[aLineNr > 0]]) ifFalse:[
^ self
].
xR := width - margin.
x0 := x max:margin.
x0 < xR ifFalse:[ ^ self].
yB := height - margin.
y0 := (self yVisibleOfLine:aLineNr) max:margin.
y0 < yB ifTrue:[
y1 := (self yVisibleOfLine:(aLineNr + 1)) min:yB.
y1 > y0 ifTrue:[
self invalidateX:x0 y:y0 width:(xR - x0) height:(y1 - y0) repairNow:false.
]
].
!
redraw
"redraw complete view
"
self redrawX:0 y:0 width:width height:height.
!
redrawX:x y:y width:w height:h
"redraw part of myself immediately, given logical coordinates
"
|start stop yAbs yStart|
shown ifFalse:[^ self].
(self startOfLinesY size == 1 and:[self size > 1]) ifTrue:[
"oops, recompute the height of the contents (the first time after creation).
"
self recomputeHeightOfContents.
self startOfLinesY size > 1 ifTrue:[
"oops, the contents height changed
"
self invalidate.
self contentsChanged.
^ self
].
].
widthOfContents isNil ifTrue:[
self preferredExtent
].
yStart := y.
start := self yVisibleToLineNr:y.
start notNil ifTrue:[
yAbs := y + h.
stop := self yVisibleToLineNr:yAbs.
stop isNil ifTrue:[
stop := self size.
] ifFalse:[ |y0|
y0 := self startOfLinesY at:stop ifAbsent:nil.
y0 isNil ifTrue:[^ self]. "/ oops, lines differ (will be changed)
yAbs == y0 ifTrue:[
stop := (stop - 1) max:start
].
].
start > stop ifTrue:[
start := stop := nil.
] ifFalse:[
(renderer validateDrawableItemsFrom:start to:stop) ifFalse:[
self invalidate.
^ self.
].
yStart := self yVisibleOfLine:start.
].
].
self paint:bgColor.
self fillRectangleX:x y:y width:w height:h.
StopRedrawSignal handle:[:ex|
"/ an item changed its dimension during drawing, draw is aborted
self invalidate
] do:[
start notNil ifTrue:[
self drawFrom:start to:stop x:x y:yStart w:w.
].
renderer postRedrawX:x y:yStart w:w from:start to:stop.
].
! !
!ListModelView methodsFor:'event handling'!
keyPress:aKey x:x y:y
"a key was pressed - handle page-keys here"
<resource: #keyboard( #PreviousPage #NextPage #HalfPageUp #HalfPageDown
#BeginOfText #EndOfText #ScrollUp #ScrollDown
)>
|n|
self size ~~ 0 ifTrue:[
(aKey == #PreviousPage) ifTrue:[^ self pageUp].
(aKey == #NextPage) ifTrue:[^ self pageDown].
(aKey == #HalfPageUp) ifTrue:[^ self halfPageUp].
(aKey == #HalfPageDown) ifTrue:[^ self halfPageDown].
(aKey == #BeginOfText) ifTrue:[^ self scrollToTop].
(aKey == #EndOfText) ifTrue:[^ self scrollToBottom].
(aKey == #ScrollUp or:[aKey == #ScrollDown]) ifTrue:[
n := 1 + (self sensor compressKeyPressEventsWithKey:aKey).
n := n * self verticalScrollStep.
aKey == #ScrollUp ifTrue:[self scrollUp:n]
ifFalse:[self scrollDown:n].
^ self
].
].
super keyPress:aKey x:x y:y
!
sizeChanged:how
previousExtent := self extent.
super sizeChanged:how.
! !
!ListModelView methodsFor:'event simulation'!
syncronizeEvents
self obsoleteMethodWarning:'no longer supported'.
^ false
!
syncronizeEvents:aBoolean
self obsoleteMethodWarning:'no longer supported'.
! !
!ListModelView methodsFor:'fetch resources'!
colorOnDevice:aColor
"fetch a device colors
"
^ aColor notNil ifTrue:[aColor onDevice:device] ifFalse:[nil]
!
imageOnMyDevice:anImage
"associate image to device and clear pixel mask
returns the new image.
"
|deviceImage|
anImage isNil ifTrue:[^ anImage].
deviceImage := anImage onDevice:device.
deviceImage isImage ifTrue:[
deviceImage clearMaskedPixels.
].
^ deviceImage
"/ |image|
"/
"/ (image := anImage) notNil ifTrue:[
"/ image device ~~ device ifTrue:[
"/ image := image copy.
"/ ].
"/ image := image onDevice:device.
"/ image := image clearMaskedPixels.
"/ ].
"/ ^ image
! !
!ListModelView methodsFor:'focus handling'!
wantsFocusWithButtonPress
"catch the keyboard focus on button click
"
^ true
!
wantsFocusWithPointerEnter
"views which like to take the keyboard focus
when the pointer enters can do so by redefining this
to return true"
^ true
! !
!ListModelView methodsFor:'initialization & release'!
create
"fetch device dependent resources
"
super create.
self fetchResources.
!
initStyle
"setup viewStyle specifics
"
super initStyle.
DefaultBackgroundColor notNil ifTrue:[
viewBackground := DefaultBackgroundColor
].
lineSpacing := 0.
textStartLeft := 2.
fgColor := DefaultForegroundColor.
bgColor := viewBackground.
startOfLinesY := OrderedCollection new.
startOfLinesY add:(2 + margin). "/ top inset of first line
DefaultShadowColor notNil ifTrue:[
shadowColor := DefaultShadowColor
].
DefaultLightColor notNil ifTrue:[
lightColor := DefaultLightColor
].
!
initialize
"setup default attributes
"
super initialize.
viewOrigin := 0@0.
bitGravity := #NorthWest.
enabled := true.
autoScroll := true.
scrollWhenUpdating := #beginOfText.
hasConstantHeight := false.
renderer isNil ifTrue:[
renderer := self class defaultRenderer forView:self.
].
self list:(self newDefaultList).
!
mapped
"recompute list
"
shown ifFalse:[
self recomputeHeightOfContents.
self contentsChanged.
].
renderer mapped.
super mapped
!
recreate
"sent after a snapin or a migration, reinit for new device"
super recreate.
self fetchResources.
!
reinitialize
"reinit after snapIn (font geometry might be different)
"
super reinitialize.
self recomputeHeightOfContents.
self contentsChanged.
!
release
"remove dependencies
"
renderer release.
self listHolder removeDependent:self.
self list removeDependent:self.
super release
! !
!ListModelView methodsFor:'private'!
hasDamage
"return true, if any damage events (i.e. expose or resize) are pending"
^ self sensor hasDamageFor:self
!
startOfLinesY
"returns a sequencable list which keeps all the absolute Y-start positions
for each line into the list. The first entry is the top Y inset.
"
^ startOfLinesY
!
xAbsoluteOfItem:anItem
"returns the absolute x of the labeled text
"
^ (self xVisibleOfItem:anItem) + viewOrigin x.
!
xVisibleOfItem:anItem
"returns the visible x of the labeled text
"
^ textStartLeft - viewOrigin x
!
yAbsoluteOfLine:aLineNr
"given a lineNr, return y-coordinate absolute
"
|y y2 y1 cash|
cash := self startOfLinesY.
(y := cash at:aLineNr ifAbsent:nil) notNil ifTrue:[
^ y
].
"/ recompute a y position
y1 := cash at:1 ifAbsent:2.
y2 := cash at:2 ifAbsent:10.
^ aLineNr * (y2 - y1) + y1
!
yVisibleOfLine:aLineNr
"given a lineNr, return y-coordinate in view
"
^ (self yAbsoluteOfLine:aLineNr) - viewOrigin y
!
yVisibleToLineNr:yVisible
"returns the line number assigned to a physical y or nil if out of list
"
|cash
yAbs "{ Class: SmallInteger}"
size "{ Class: SmallInteger}"
ictr "{ Class: SmallInteger}"
yRun "{ Class: SmallInteger}"
|
cash := self startOfLinesY.
(size := cash size) < 2 ifTrue:[^ nil]. "/ empty list
yAbs := yVisible + viewOrigin y.
yRun := cash at:size.
yAbs >= yRun ifTrue:[
yAbs == yRun ifTrue:[ ^ size - 1].
^ nil "/ out of list
].
constantHeight notNil ifTrue:[
yAbs := yAbs - (cash at:1).
yAbs < constantHeight ifTrue:[ ^ 1 ].
^ yAbs // constantHeight + 1
].
ictr := yAbs // (cash at:2).
ictr < 1 ifTrue:[ ictr := 1 ]
ifFalse:[ ictr := ictr min:size ].
yRun := cash at:ictr.
yRun > yAbs ifTrue:[
[(ictr := ictr - 1) > 0 ] whileTrue:[
yRun := cash at:ictr.
yRun <= yAbs ifTrue:[ ^ ictr ].
].
^ 1
].
[ yRun ~~ yAbs ] whileTrue:[
ictr := ictr + 1.
yRun := cash at:ictr.
yRun > yAbs ifTrue:[ ^ ictr - 1 ].
].
^ ictr
!
yVisibleToRowNr:yVisible
"for protocol compatibility with DSVColumnView"
^ self yVisibleToLineNr:yVisible
! !
!ListModelView methodsFor:'protocol'!
fetchResources
"fetch device colors and ..., to avoid reallocation at redraw time;
*** called after a create or snapin to fetch all device resources
"
fgColor := self colorOnDevice:fgColor.
bgColor := self colorOnDevice:bgColor.
font := font onDevice:device.
!
lineHeightFor:anItem
"returns the computed line height for an item
"
^ lineSpacing + (renderer heightFor:anItem)
!
listSizeChanged:anIndex nLines:noLines
"list size changed; information is stored to recompute the
width if required( preferredExtent, horizontal scroller ... ).
see: widthOfContents
*** if nLines is negative, lines are removed otherwise added.
"
|start "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
|
preferredExtent := nil.
widthOfContents isNil ifTrue:[ "/ recompute whole list
^ self
].
(noLines < 0 or:[(size := self size) <= noLines]) ifTrue:[
widthOfContents := nil. "/ force recompute whole list
^ self
].
stop := anIndex + noLines - 1. "/ recompute a range
start := anIndex.
computeWidthInRange notNil ifTrue:[
start := computeWidthInRange y.
stop < start ifTrue:[stop := start min:size].
start := (computeWidthInRange x) min:anIndex.
].
computeWidthInRange := start@stop
!
lostSynchronisation
"called when the changes derived from the model are faster than the handling
"
shown ifTrue:[
self recomputeHeightOfContents.
self invalidate.
self contentsChanged
].
!
newDefaultList
"creates and returns a new default list class, on default a List
"
^ List new
!
widthOfWidestLineBetween:firstLine and:lastLine
"return the width in pixels of the widest line in a range
"
|item width|
width := renderer widthOfWidestLineBetween:firstLine and:lastLine.
width notNil ifTrue:[^ width].
width := textStartLeft.
firstLine to:lastLine do:[:anIndex|
item := self at:anIndex ifAbsent:nil.
item isNil ifTrue:[^ width + textStartLeft].
width := (renderer widthFor:item) max:width
].
^ width + textStartLeft
! !
!ListModelView methodsFor:'queries'!
isLineVisible:aLineNr
"returns true if the line is visible"
^ self isLineVisible:aLineNr in:self extent
!
isLineVisible:aLineNr in:anExtentPoint
"returns true if the line is visible"
|y|
y := self yVisibleOfLine:aLineNr.
^ (y between:margin and:(anExtentPoint y - margin))
!
size
"returns the number of list entries
"
^ self list size
! !
!ListModelView methodsFor:'recomputation'!
preferredExtent
"returns the preferred extent
"
|x y|
preferredExtent isNil ifTrue:[
y := self heightOfContents.
x := self widthOfContents.
preferredExtent := x@y
].
^ preferredExtent
!
recomputeHeightOfContents
"recompute all the y positions
"
|newList
yAbs "{ Class: SmallInteger }"
lnHg "{ Class: SmallInteger }"
size "{ Class: SmallInteger }"
|
yAbs := startOfLinesY at:1. "/ top inset of first line
size := self size.
newList := OrderedCollection new:(size + 1).
newList add:yAbs.
size == 0 ifTrue:[
startOfLinesY := newList.
^ self
].
hasConstantHeight ifTrue:[
constantHeight notNil ifTrue:[ lnHg := constantHeight ]
ifFalse:[ lnHg := self heightOfLineAt:1 ].
1 to:size do:[:anIndex|
newList add:(yAbs := yAbs + lnHg)
].
startOfLinesY := newList.
^ self
].
1 to:size do:[:anIndex|
lnHg := self heightOfLineAt:anIndex.
newList add:(yAbs := yAbs + lnHg)
].
startOfLinesY := newList.
! !
!ListModelView methodsFor:'scroller interface'!
getWidthOfContents
^ widthOfContents
!
heightOfContents
"return the height of the contents in pixels
"
^ self startOfLinesY last ? 0
!
heightOfLineAt:aLineNr
"returns the total height for a line at an index( including lineSpacing ... )
"
|item|
hasConstantHeight ifTrue:[
constantHeight notNil ifTrue:[ ^ constantHeight ].
item := self at:1 ifAbsent:nil.
item notNil ifTrue:[
constantHeight := self lineHeightFor:item.
^ constantHeight
]
] ifFalse:[
item := self at:aLineNr ifAbsent:nil.
item notNil ifTrue:[
^ self lineHeightFor:item
]
].
^ 4
!
innerHeight
"returns the inner height of the contents shown
"
^ height - margin - margin
!
innerWidth
"returns the inner width of the contents shown
"
^ width - margin - margin
!
maxViewOriginY
"returns the maximum possible y of the view origin
"
^ (self heightOfContents - self innerHeight) max:0
!
setWidthOfContents: aWidth
widthOfContents := aWidth.
!
verticalScrollStep
"return the amount to scroll when stepping up/down.
"
^ 10
!
viewOrigin
"return the viewOrigin; thats the coordinate of the contents
which is shown topLeft in the view.
"
^ viewOrigin
!
widthOfContents
"return the width of the contents in pixels
"
|range
size "{ Class:SmallInteger }"
start "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
|
(widthOfContents notNil and:[computeWidthInRange isNil]) ifTrue:[
^ widthOfContents + textStartLeft
].
range := computeWidthInRange.
computeWidthInRange := nil.
preferredExtent := nil.
shown ifFalse:[ ^ 60 ].
size := self size.
size == 0 ifTrue:[
widthOfContents := 20.
] ifFalse:[
widthOfContents isNil ifTrue:[
widthOfContents := self widthOfWidestLineBetween:1 and:size
] ifFalse:[
start := range x.
stop := range y min:size.
start > stop ifFalse:[
size := self widthOfWidestLineBetween:start and:stop.
widthOfContents < size ifTrue:[
widthOfContents := size
]
]
]
].
^ widthOfContents + textStartLeft
!
xOriginOfContents
"return the horizontal origin of the contents in pixels
"
^ viewOrigin x
!
yOriginOfContents
"return the vertical origin of the contents in pixels
"
^ viewOrigin y
! !
!ListModelView methodsFor:'scrolling'!
halfPageDown
"scroll down half a page
"
self scrollDown:(height // 2).
!
halfPageUp
"scroll up half a page
"
self scrollUp:(height // 2).
!
makeLineVisible:aLnNr
"make the line visible
"
aLnNr notNil ifTrue:[
self scrollToLine:aLnNr
].
!
scrollTo:anOrigin redraw:doRedraw
"change origin to have newOrigin be visible at the top-left.
"
|newOrg dltOrg winGrp
innerWT "{ Class:SmallInteger }"
innerHG "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
x "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
dX "{ Class:SmallInteger }"
dY "{ Class:SmallInteger }"
|
realized ifFalse:[
^ self
].
innerWT := self innerWidth.
innerHG := self innerHeight.
h := viewOrigin y.
(y := anOrigin y) > h ifTrue:[ "/ end of contents
y > (dY := self maxViewOriginY) ifTrue:[
y := dY max:h
]
] ifFalse:[
y := y max:0.
].
(x := anOrigin x) > 0 ifTrue:[
x := x min:(self widthOfContents - innerWT).
].
x := x max:0.
newOrg := (x @ y).
dltOrg := newOrg - viewOrigin.
dX := dltOrg x.
dY := dltOrg y.
(dX == 0 and:[dY == 0]) ifTrue:[
^ self
].
dY := dY abs.
dX := dX abs.
( (dX ~~ 0 and:[dY ~~ 0]) "/ scroll vertical & horizontal
or:[(innerHG - dY < 20 or:[innerWT - dX < 20])] "/ faster to invalidate screen
) ifTrue:[
viewOrigin := newOrg.
self originChanged:dltOrg.
self invalidate.
^ self
].
(winGrp := self windowGroup) notNil ifTrue:[
winGrp processRealExposeEventsFor:self.
].
self originWillChange.
doRedraw ifFalse:[
viewOrigin := newOrg.
self originChanged:dltOrg.
^ self
].
self catchExpose.
viewOrigin := newOrg.
dY ~~ 0 ifTrue:[ "/ SCROLL VERTICAL
y0 := y1 := margin + dY.
h := innerHG - dY.
dltOrg y < 0 ifTrue:[y0 := margin. y := y0]
ifFalse:[y1 := margin. y := y1 + h].
self copyFrom:self x:margin y:y0 toX:margin y:y1 width:innerWT height:h async:true.
self invalidateX:margin y:y width:innerWT height:(innerHG - h).
] ifFalse:[ "/ SCROLL HORIZONTAL
x0 := x1 := dX + margin.
w := innerWT - dX.
dltOrg x < 0 ifTrue:[x0 := x := margin ]
ifFalse:[x1 := margin. x := w].
self copyFrom:self x:x0 y:margin toX:x1 y:margin width:w height:innerHG async:true.
self invalidateX:x y:margin width:(width - w) height:innerHG.
].
self originChanged:dltOrg.
self waitForExpose.
winGrp notNil ifTrue:[
winGrp processRealExposeEventsFor:self.
].
!
scrollToLine:aLineNumber
"make line visible
"
|inHg "{ Class:SmallInteger }"
yTop "{ Class:SmallInteger }"
orgY "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
|
(shown and:[aLineNumber notNil and:[aLineNumber between:1 and:(self size)]]) ifFalse:[
^ self
].
yTop := self yAbsoluteOfLine:aLineNumber.
inHg := self innerHeight.
orgY := viewOrigin y.
yTop > orgY ifTrue:[
yBot := self yAbsoluteOfLine:(aLineNumber + 1).
yBot <= (orgY + inHg) ifTrue:[
^ self
].
].
yTop := (yTop - (inHg // 2)) max:0.
self scrollTo:(viewOrigin x @ yTop).
! !
!ListModelView methodsFor:'scrolling auto'!
startAutoScroll:aBlock distance:aDistance
"setup for auto-scroll (when button-press-moving below view);
- timeDelta for scroll is computed from distance
"
|timeDelta|
(autoScroll and:[aBlock notNil]) ifFalse:[
^ self stopAutoScroll
].
autoScrollBlock notNil ifTrue:[
Processor removeTimedBlock:autoScrollBlock.
] ifFalse:[
self compressMotionEvents:false.
].
timeDelta := 0.5 / (aDistance abs).
autoScrollBlock := [
aBlock value.
Processor addTimedBlock:autoScrollBlock afterSeconds:timeDelta.
].
Processor addTimedBlock:autoScrollBlock afterSeconds:timeDelta.
!
stopAutoScroll
"stop any autoScroll
"
autoScrollBlock notNil ifTrue:[
Processor removeTimedBlock:autoScrollBlock.
autoScrollBlock := nil.
self compressMotionEvents:true.
].
! !
!ListModelView methodsFor:'selection'!
hasSelection
"on default false is returned
"
^ false
! !
!ListModelView::Renderer class methodsFor:'documentation'!
documentation
"
prepared for ListItemRenderer
.... SelectionItemRenderer ...
goal:
allow the user to redefine the display operation and the dimesion queries
"
! !
!ListModelView::Renderer class methodsFor:'instance creation'!
forView:aView
|renderer|
renderer := self basicNew initialize.
renderer forView:aView.
^ renderer
! !
!ListModelView::Renderer methodsFor:'change & update'!
listWillChange
"called before the list changed, clear cashes ect.
here nothing is done
"
!
withinUpdateFromListDo:aBlock
"handle an update from the list
"
aBlock value
! !
!ListModelView::Renderer methodsFor:'displaying'!
display:anItem atX:xLeft y:yTop lineHeight:h
"display the item on the view
"
|x0 y0 label|
x0 := xLeft.
y0 := yTop.
anItem isHierarchicalItem ifTrue:[
anItem displayOn:view x:x0 y:y0 h:h
] ifFalse:[
anItem isNil ifTrue:[^ self].
y0 := y0 - ((self heightFor:anItem) + 1 - h // 2).
label := anItem.
label isImageOrForm ifFalse:[
label isNumber ifTrue:[
label := label printString
].
y0 := y0 + view font ascent
].
label displayOn:view x:x0 y:y0
].
!
postRedrawX:damageX y:yStartOrYDamage w:damageWidth from:startOrNil to:stopOrNil
"called after redraw of the items in range from start to stop is done;
if no items are damaged, start and stop is set to nil.
"
!
validateDrawableItemsFrom:start to:stop
"called before drawing items from start to stop; if the method returns false
nothing will be drawn and a invalidate is pushed on the event queue.
On default true is returned.
"
^ true
! !
!ListModelView::Renderer methodsFor:'instance creation'!
forView:aView
view := aView.
view shown ifTrue:[ self mapped ].
!
mapped
"called if the view is mapped; can be redefined by subclass
"
!
release
"called if the view is gone; can be redefined by subclass
"
! !
!ListModelView::Renderer methodsFor:'queries-behavior'!
autoScrollHorizontal
"returns true if automatic scrolling horizontal
is allowed (the default is true).
"
^ true
! !
!ListModelView::Renderer methodsFor:'queries-dimensions'!
heightFor:anItem
"returns the height of an item on the view
"
^ anItem heightOn:view
!
maxItemWidthOrNil
"returns the maximum item width for drawing or nil
if unspecified (the default); used for cliping
"
^ nil
!
widthFor:anItem
"returns the width of an item on the view
"
^ anItem widthOn:view
!
widthOfWidestLineBetween:firstLine and:lastLine
"returns the width of the longest line in pixels in a range; if the rendere
cannot compute the width, nil is returned (the default).
"
^ nil
! !
!ListModelView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/ListModelView.st,v 1.93 2004-02-26 12:19:31 cg Exp $'
! !
ListModelView initialize!