"

 COPYRIGHT (c) 1999 by eXept Software AG

 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

		displayedFrames syncronizeEvents autoScroll autoScrollBlock

		scrollWhenUpdating hasConstantHeight constantHeight'

	classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultShadowColor

		DefaultLightColor StopRedrawSignal'

	poolDictionaries:''

	category:'Views-Lists'

!

!ListModelView class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1999 by eXept Software AG

 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:

    [Instance variables:]

    [author:]

    [see also:]

"

!

examples

"

    |top list view up index|

    list := List new.

    top  := StandardSystemView new; extent:300@300.

    view := ScrollableView for:ListModelView miniScroller:true

    view list:list.

    top  openAndWait.

    up := true.

    [top shown] whileTrue:[

    ].

"

! !

!ListModelView class methodsFor:'initialization'!

initialize

    "setup the signals

    "

    super initialize.

    StopRedrawSignal := Notification newSignalMayProceed:false.

! !

!ListModelView class methodsFor:'Signal constants'!

stopRedrawSignal

    ^ StopRedrawSignal

! !

!ListModelView class methodsFor:'defaults'!

updateStyleCache

    "extract values from the styleSheet and cache them in class variables"

    <resource: #style   (

    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|

    self syncFlushEvent:#syncUpdate:with:.

    displayedFrames keys do:[:aView| aView destroy].

    displayedFrames := WeakIdentityDictionary new.

    list ~~ aList ifTrue:[

    ].

    (list := aList) notNil ifTrue:[

    ].

    preferredExtent := nil.

    widthOfContents := nil.

    self realized ifFalse:[^ self].

    self recomputeHeightOfContents.

    scrollWhenUpdating == #beginOfText ifTrue:[

    ] ifFalse:[

    ].

    self invalidate.

    self contentsChanged

! !

!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:[

    ].

    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:

     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 notNil ifTrue:[

    ].

    ^ nil.

!

identityIndexOf:anElement

    "returns the index of an element or nil

    "

    ^ list notNil ifTrue:[list identityIndexOf:anElement]

! !

!ListModelView methodsFor:'accessing-look'!

backgroundColor

    "get the background color

    "

    ^ bgColor

!

backgroundColor:aColor

    "set the background color

    "

    (aColor notNil and:[bgColor ~~ aColor]) ifTrue:[

    ]

!

font:aFont

    "set a new font

    "

    |oldWidth oldHeight|

    (aFont isNil or:[aFont = font]) ifFalse:[

    ].

!

foregroundColor

    "get the foreground color

    "

    ^ fgColor

!

foregroundColor:aColor

    "set the foreground color

    "

    (aColor notNil and:[fgColor ~~ aColor]) ifTrue:[

    ]

!

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:[

    ]

! !

!ListModelView methodsFor:'accessing-mvc'!

listHolder

    "returns the listHolder or nil

    "

    ^ listHolder

!

listHolder:aListHolder

    "set a new listHolder

    "

    listHolder removeDependent:self.

    (listHolder := aListHolder) notNil ifTrue:[

    ].

    self list:(listHolder value).

! !

!ListModelView methodsFor:'accessing-views'!

destroyFrame:aFrame

    "destroy a frame

    "

    aFrame notNil ifTrue:[

    ].

!

registerFrame:aView atLine:aLineNr x:logX width:w

    "register a frame for a line and set the origin@corner of the frame

    "

    (item := list at:aLineNr ifAbsent:nil) isNil ifTrue:[

    ].

    y := self yVisibleOfLine:aLineNr.

    x := logX - viewOrigin x.

    h := (startOfLinesY at:(aLineNr + 1)) - (startOfLinesY at:aLineNr).

    aView origin:(x@y) extent:(w@h).

    self addSubView:aView.

    displayedFrames at:aView put:item.

    realized ifTrue:[aView realize].

! !

!ListModelView methodsFor:'change & update'!

contentsChanged

    "contents changed; recompute origin Y of registered views

    "

    |idx y x|

    displayedFrames keysAndValuesDo:[:aFrame :anItem|

    ].

    super contentsChanged.

!

lineChangedAt:aLnNr with:arg

    "line changed at position; check whether line height changed

    "

    |

     oldHeight "{ Class:SmallInteger }"

     dltHeight "{ Class:SmallInteger }"

    |

    (arg notNil and:[(arg == #icon or:[arg == #hierarchy])]) ifTrue:[

    ].

    hasConstantHeight ifTrue:[

      ^ self

    ].

    oldHeight := (self yVisibleOfLine:(aLnNr + 1)) - (self yVisibleOfLine:aLnNr).

    dltHeight := (self heightOfLineAt:aLnNr) - oldHeight.

    dltHeight == 0 ifTrue:[