"

 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 }"

   |