"{ Encoding: utf8 }"

"

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

"{ NameSpace: Smalltalk }"

View subclass:#ListModelView

	instanceVariableNames:'list listHolder textStartLeft textStartTop viewOrigin enabled

		fgColor bgColor lineSpacing widthOfContents computeWidthInRange

		startOfLinesY autoScroll autoScrollBlock scrollWhenUpdating

		hasConstantHeight constantHeight previousExtent listRenderer

		cachedPreferredExtent activeScrollProcess'

	classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultShadowColor

		DefaultLightColor StopRedrawSignal'

	poolDictionaries:''

	category:'Views-Lists'

!

Object subclass:#Renderer

	instanceVariableNames:'view'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ListModelView

!

ListModelView::Renderer subclass:#TableRenderer

	instanceVariableNames:'xSplitbars hasFixedItemWidth savedCursor dragCursor

		columnDescriptors separatorOneDColor receiver dragOperation

		requiredColumnHeight minimumRequiredColumnHeight attributes'

	classVariableNames:''

	poolDictionaries:''

	privateIn:ListModelView

!

Object subclass:#ColumnDescriptor

	instanceVariableNames:'dataSetColumnSpec columnNumber width'

	classVariableNames:'ClipColumnQuerySignal'

	poolDictionaries:''

	privateIn:ListModelView::TableRenderer

!

!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 list and performs optimized redraws.

    It requires a List (or alike) as list.

    This class can only passively display collections of elements.

    The class doesn't keep its own list, it works directly on

    the list ( List or HierarchicalList ).

    ATTENTION (warning by cg):

	in contrast to its inappropriate name, this class COMPLETELY ignores the model

	instance variable - all is through the list/listHolder.

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

        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:Color black.

    DefaultBackgroundColor         := StyleSheet colorAt:'text.backgroundColor'.

    DefaultShadowColor             := StyleSheet colorAt:'selection.shadowColor'.

    DefaultLightColor              := StyleSheet colorAt:'selection.lightColor'.

    "/ DefaultFont                    := StyleSheet  fontAt:'text.font'.

    "

     self updateStyleCache

    "

    "Modified: / 14-08-2010 / 12:23:35 / cg"

! !

!ListModelView methodsFor:'accessing'!

list

    "get the list of items

    "

    ^ list

!

list:aList

    "set the list of items

    "

    |negatedOrg|

    listRenderer listWillChange.

    list ~~ aList ifTrue:[

        list removeDependent:self.

        list := aList.

        list isNil ifTrue:[list := self newDefaultList ].

        list addDependent:self

    ].

"/    preferredExtent := nil.

    cachedPreferredExtent := nil.

    widthOfContents := nil.

    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

!

listRenderer

    "returns the used listrenderer

    "

    ^ listRenderer

!

listRenderer:aRendererOrRendererClass

    "change the used listRenderer

    "

    aRendererOrRendererClass isNil ifTrue:[^ self].

    listRenderer == aRendererOrRendererClass ifTrue:[^ self].

    listRenderer notNil ifTrue:[listRenderer release].

    aRendererOrRendererClass isBehavior ifTrue:[

	listRenderer := aRendererOrRendererClass basicNew initialize.

    ] ifFalse:[

	listRenderer := aRendererOrRendererClass.

    ].

    listRenderer forView:self.

!

renderer

    <resource: #obsolete>

    self obsoleteMethodWarning:'naming conflict renderer vs. listRenderer'.

    ^ self listRenderer

!

renderer:aTableRenderer

    <resource: #obsolete>

    self obsoleteMethodWarning:'naming conflict renderer vs. listRenderer'.

    self listRenderer:aTableRenderer

!

setupTableRenderer

    "creates a renderer with columns based on a DataSetColumnSpec

     answer the new renderer"

    self listRenderer:TableRenderer.

    ^ listRenderer

! !

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

     Optimizes scroll and redraw operations

    "

    ^ hasConstantHeight

!

hasConstantHeight:aBool

    "user configured; true if each line has the same lineHeight.

     Optimizes scrolling and redraw.

    "

    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 newFont|

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

        oldWidth  := gc font width.

        oldHeight := gc font height.

        super font:aFont.

        newFont := gc deviceFont.

        newFont width ~~ oldWidth ifTrue:[       "/ force a recomputation

"/            preferredExtent := nil.

            cachedPreferredExtent := nil.

            widthOfContents := nil.

        ].

        realized ifTrue:[

            oldHeight ~~ newFont height ifTrue:[

                self recomputeHeightOfContents.

                self contentsChanged.

            ].

            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 - that's an additional number of pixels,

     by which lines are vertically separated.

    "

    ^ lineSpacing

!

lineSpacing:aNumber

    "set the lineSpacing - that's an additional number of pixels,

     by which lines are vertically separated.

    "

    lineSpacing ~= aNumber ifTrue:[

        lineSpacing := aNumber.

        realized ifTrue:[

            self recomputeHeightOfContents.

            self invalidate

        ].

        self contentsChanged.

    ]

!

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