"

 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

		displayedFrames syncronizeEvents autoScroll autoScrollBlock'

	classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultShadowColor

		DefaultLightColor StopRedrawSignal'

	poolDictionaries:''

	category:'Views-Lists'

!

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

        displayedFrames        <WeakIdentityDictionary>

                                                keep the frames within the widget

        syncronizeEvents       <Boolean>        set to true if list and model changes

                                                should be handled synchronized; an event

                                                will be pushed on the event loop.

                                                on default it is disabled.

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

        ] ifFalse:[

            list removeIndex:1.

            up := list isEmpty.

        ]

    ].

                                                                        [exEnd]

"

! !

!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   (

                        #'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

    "

    |size negatedOrg|

    self syncFlushEvent:#syncUpdate:with:.

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

    displayedFrames := WeakIdentityDictionary new.

    list ~~ aList ifTrue:[

        list removeDependent:self.

    ].

    (list := aList) notNil ifTrue:[

        list addDependent:self

    ].

    self recomputeHeightOfContents.

    preferredExtent := nil.

    widthOfContents := nil.

    viewOrigin = (0@0) ifFalse:[

        self originWillChange.

        negatedOrg := viewOrigin negated.

        viewOrigin := (0@0).

        self originChanged:negatedOrg.

    ].

    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

!

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)

    "

    "/ NOT YET SUPPORTED

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

        ^ list at:anIndex ifAbsent:exceptionBlock

    ].

    ^ nil.

!

identityIndexOf:anElement

    "returns the index of an element or nil

    "

    ^ list notNil ifTrue:[list identityIndexOf:anElement]

                 ifFalse:[0]

! !

!ListModelView methodsFor:'accessing-look'!

backgroundColor

    "get the background color

    "

    ^ bgColor

!

backgroundColor:aColor

    "set the background color

    "

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

        super viewBackground:bgColor.

        self realized ifTrue:[

            bgColor := aColor on:device.

            self invalidate

        ] ifFalse:[

            bgColor := aColor

        ]

    ]

!

font:aFont

    "set a new font

    "

    |oldWidth oldHeight|

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

        oldWidth  := font width.

        oldHeight := font height.

        super font:aFont.

        (font width) ~~ oldWidth ifTrue:[       "/ force a recomputation

            preferredExtent := nil.

            widthOfContents := nil.

        ].

        oldHeight ~~ font height ifTrue:[

            self recomputeHeightOfContents.

        ].

        shown ifTrue:[ 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 on:device.

            self invalidate

        ] ifFalse:[

            fgColor := aColor

        ]

    ]

! !

!ListModelView methodsFor:'accessing-mvc'!

listHolder

    "returns the listHolder or nil

    "

    ^ listHolder

!

listHolder:aListHolder

    "set a new listHolder

    "

    |newList|

    listHolder removeDependent:self.

    (listHolder := aListHolder) notNil ifTrue:[

        listHolder addDependent:self.

    ].

    self list:(listHolder value).

! !

!ListModelView methodsFor:'accessing-views'!

destroyFrame:aFrame

    "destroy a frame

    "

    aFrame notNil ifTrue:[

        displayedFrames removeKey:aFrame ifAbsent:nil.

        aFrame destroy.

    ].

!

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

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

    "

    |x y h item index|

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

        ^ self

    ].

    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|

        (idx := list identityIndexOf:anItem) == 0 ifTrue:[

            aFrame beInvisible.

        ] ifFalse:[

            y := self yVisibleOfLine:idx.

            x := aFrame origin x.

            aFrame origin:(x @ y).

            aFrame beVisible.

        ]

    ].

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

        ^ self

    ].

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

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

    dltHeight == 0 ifTrue:[

        ^ self redrawLineAt:aLnNr

    ].

    aLnNr + 1 to:startOfLinesY size do:[:i|

        startOfLinesY at:i put:((startOfLinesY at:i) + dltHeight)

    ].

    self invalidate.

!

listChangedInsert:start nItems:nLines

    "list changed; items are added

    "

    |

     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 not ifTrue:[^ self].

    newSz := startOfLinesY size + nLines.

    (newSz - 1) ~~ list size ifTrue:[

        "/

        "/ no longer synchrounous

        "/

        ^ self lostSynchronisation

    ].

    startOfLinesY addAll:(Array new:nLines) beforeIndex:start + 1.

    absY0 := startOfLinesY at:start.

    absY1 := absY0.

    run   := start.

    nLines timesRepeat:[

        absY1 := absY1 + (self heightOfLineAt:run).

        run   := run + 1.

        startOfLinesY at:run put:absY1.

    ].

    dltY := absY1 - absY0.

    run + 1 to:newSz do:[:i||v|

        startOfLinesY at:i put:((startOfLinesY at:i) + dltY)

    ].

    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).

    ].