"

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

SelectionInListModelView subclass:#HierarchicalListView

	instanceVariableNames:'imageInset imageWidth lineMask lineColor showRoot showLines

		showLeftIndicators indicatorAction useDefaultIcons icons

		openIndicator closeIndicator alignTextRight alignTextRightX

		maxWidthOfText'

	classVariableNames:''

	poolDictionaries:''

	category:'Views-Trees'

!

!HierarchicalListView 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 class implements a hierarchical list view based on a

    hierachical list.

    It provides functionality similar to SelectionInTreeView, but optimizes

    redraws, and operates directly upon the model (in contrast to

    SelectionInTreeView, which generates a list internally).

    [Instance variables:]

        textStartLeft       <Integer>              inset between icon and text 

        imageInset          <Integer>              inset between left side and icon

        imageWidth          <Integer>              width of widest icon

        lineMask            <Form>                 line mask

        lineColor           <Color>                line color

        showRoot            <Boolean>              root element is shown or hidden

                                                   derives from the hierachical list.

        showLines           <Boolean>              show or hide lines

        useDefaultIcons     <Boolean>              use the default icons if no icon

                                                   for an item is specified

        icons               <IdentityDictionary>   list of registered icons;

                                                   identifier := <key> value := <icon>

        showLeftIndicators  <Boolean>              show or hide indicator for most left items

        indicatorAction     <Block>                action evaluated if indicator is pressed

        openIndicator       <Icon, Image or Form>  expanded indicator      

        closeIndicator      <Icon, Image or Form>  collapsed indicator

        alignTextRight      <Boolean>              enable disable of align the text right

                                                   icon            text

                                                        icon       text of child

                                                   should be set after creation of the widget!!

        alignTextRightX     <Integer>              left x position of aligned right text

        maxWidthOfText      <Integer>              keeps the maximum width of a text label

    [author:]

        Claus Atzkern

    [see also:]

        ListModelView

        SelectionInListModelView

        HierarchicalList

        HierarchicalItem

"

!

examples

"

    show a hierarchical list

                                                                        [exBegin]

    |top sel list item|

    list := HierarchicalList new.

    item := HierarchicalItem::Example labeled:'Root Item'.

    item expand.

    list showRoot:false.

    list root:item.

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

    sel := ScrollableView for:HierarchicalListView miniScroller:true

                       origin:0.0@0.0 corner:1.0@1.0 in:top.

    sel list:list.

    sel multipleSelectOk:true.

    sel doubleClickAction:[:i| (list at:i) toggleExpand ].

    sel   indicatorAction:[:i| (list at:i) toggleExpand ].

    top open.

                                                                        [exEnd]

    show a hierarchical list; open an editor on reselect a

    line with label is a string.

                                                                        [exBegin]

    |top sel list item|

    list := HierarchicalList new.

    item := HierarchicalItem::Example labeled:'Root Item'.

    item expand.

    list showRoot:false.

    list root:item.

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

    sel := ScrollableView for:HierarchicalListView miniScroller:true

                       origin:0.0@0.0 corner:1.0@1.0 in:top.

    sel list:list.

    sel openEditorAction:[:ln :aGC| |field item|

        item  := list at:ln.

        item label isString ifFalse:[

            field := nil

        ] ifTrue:[

            field := EditField new.

            field level:0.

            field acceptOnLostFocus:true.

            field acceptAction:[:x| item label:(field contents) ].

            field font:(aGC font).

            field contents:(item label).

        ].

        field

    ].

    sel multipleSelectOk:true.

    sel doubleClickAction:[:i| (list at:i) toggleExpand ].

    sel   indicatorAction:[:i| (list at:i) toggleExpand ].

    top open.

                                                                        [exEnd]

"

! !

!HierarchicalListView class methodsFor:'resources'!

closeIndicator

    "returns a little [+] bitmap"

    <resource: #fileImage>

    ^ Icon constantNamed:#plus

             ifAbsentPut:[Smalltalk imageFromFileNamed:'plus.xpm' forClass:self]

!

collapsedIcon

    "returns icon to indicate a collapsed entry

    "

    <resource: #fileImage>

    ^ Icon constantNamed:#directory

             ifAbsentPut:[Smalltalk imageFromFileNamed:'dir.xpm' forClass:self]

!

emptyIcon

    "returns icon to indicate an not extendable entry

    "

    <resource: #fileImage>

    ^ Icon constantNamed:#plainFile

             ifAbsentPut:[Smalltalk imageFromFileNamed:'file_plain.xpm' forClass:self]

!

expandedIcon

    "returns icon to indicate an extended entry

    "

    <resource: #fileImage>

    ^ Icon constantNamed:#directoryOpened

             ifAbsentPut:[Smalltalk imageFromFileNamed:'dir_open.xpm' forClass:self]

!

openIndicator

    "returns a little [-] bitmap"

    <resource: #fileImage>

    ^ Icon constantNamed:#minus

             ifAbsentPut:[Smalltalk imageFromFileNamed:'minus.xpm' forClass:self]

! !

!HierarchicalListView methodsFor:'accessing'!

font:aFont

    "set a new font

    "

    |root|

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

        (list notNil and:[(root := list root) notNil]) ifTrue:[

            root fontChanged

        ].

        super font:aFont

    ].

!

list:aList

    "get the status of <showRoot> from the list

    "

    aList notNil ifTrue:[

        showRoot := aList showRoot

    ].

    super list:aList

!

parentToChildInset

    "returns the computed inset between parent / child

    "

    ^ imageInset + imageWidth

! !

!HierarchicalListView methodsFor:'accessing-colors'!

lineColor

    "get the line color

    "

    ^ lineColor

!

lineColor:aColor

    "set the line color

    "

    (aColor notNil and:[aColor ~= lineColor]) ifTrue:[

        lineColor := aColor.

        shown ifTrue:[

            lineColor := lineColor onDevice:device.

            showLines ifTrue:[

                self invalidate

            ]

        ]

    ]

! !

!HierarchicalListView methodsFor:'accessing-look'!

alignTextRight

    "align the text right

    "

    ^ alignTextRight

!

alignTextRight:aBool

    "align the text right

    "

    alignTextRight := aBool ? false.

!

alignTextRightX

    "returns the minimum used text inset, if text is aligned right.

    "

    ^ alignTextRightX

!

alignTextRightX:aNumber

    "set the minimum used text inset, if text is aligned right.

    "

    aNumber > self parentToChildInset ifTrue:[

        alignTextRightX := aNumber.

        (alignTextRight and:[widthOfContents notNil]) ifTrue:[

            widthOfContents := alignTextRightX + maxWidthOfText.

            shown ifTrue:[

                self invalidate.

                self contentsChanged.

            ]

        ]

    ].

!

iconAt:aKey ifAbsentPut:aBlock

    "return the icon stored under a key; if not present,the

     result of the block if not nil is stored under the key

     and returned.

    "

    |icon|

    icon := icons at:aKey ifAbsent:nil.

    icon ifNotNil:[^ icon].

    icon := aBlock value.

    icon ifNil:[^ nil].

    realized ifTrue:[

        icon := self imageOnDevice:icon

    ].

    icons at:aKey put:icon.

  ^ icon

!

registerKeysAndIcons:aDictionary

    "register icons by key and value derived from a directory

    "

    |image|

    (aDictionary isNil or:[aDictionary isEmpty]) ifTrue:[

        ^ self

    ].

    aDictionary keysAndValuesDo:[:aKey :anImage|

        (image := self imageOnDevice:anImage) notNil ifTrue:[

            icons at:aKey put:image

        ] ifFalse:[

            icons removeKey:aKey ifAbsent:nil

        ]

    ]

!

showLeftIndicators

    "show or hide the indicators for the most left items

    "

    ^ showLeftIndicators

!

showLeftIndicators:aState

    "show or hide the indicators for the most left items

    "

    aState ~~ showLeftIndicators ifTrue:[

        showLeftIndicators := aState.

        self invalidate

    ].

!

showLines

    "returns true if lines are shown

    "

  ^ showLines

!

showLines:aState

    "show or hide lines

    "

    aState ~~ showLines ifTrue:[

        showLines := aState.

        self invalidate

    ].

!

useDefaultIcons

    "use the default icons if no icon for an item is specified;

     ** default: true

    "

    ^ useDefaultIcons

!

useDefaultIcons:aBool

    "use the default icons if no icon for an item is specified;

     ** default: true

    "

    useDefaultIcons ~~ aBool ifTrue:[

        useDefaultIcons := aBool.

        shown ifTrue:[

            self invalidate

        ]

    ]

! !

!HierarchicalListView methodsFor:'actions'!

indicatorAction

    "if the action is not nil, indicators are shown and a click on the indicator

     will evaluate the action with none or one argument, the index into the list

    "

    ^ indicatorAction

!

indicatorAction:anAction

    "if the action is not nil, indicators are shown and a click on the indicator

     will evaluate the action with none or one argument, the index into the list

    "

    |wasNilBefore|

    wasNilBefore    := indicatorAction isNil.

    indicatorAction := anAction.

    wasNilBefore == (anAction isNil) ifTrue:[

        self invalidate

    ].

! !

!HierarchicalListView methodsFor:'change & update'!

indicatorPressedAt:aLnNr

    |item|

    indicatorAction notNil ifTrue:[

        item := list at:aLnNr ifAbsent:nil.

        (item notNil and:[item hasChildren]) ifTrue:[

            indicatorAction valueWithOptionalArgument:aLnNr

        ]

    ]

!

lineChangedAt:aLnNr with:arg

    "line changed at position; check whether line height changed

    "

    |item

     lv "{ Class:SmallInteger }"

     x0 "{ Class:SmallInteger }"

     x1 "{ Class:SmallInteger }"

     h  "{ Class:SmallInteger }"

     y0 "{ Class:SmallInteger }"

     y1 "{ Class:SmallInteger }"

    |

    (arg == #icon or:[arg == #hierarchy]) ifFalse:[

        ^ super lineChangedAt:aLnNr with:arg

    ].

    shown ifFalse:[^ self].

    y0 := (self yVisibleOfLine:aLnNr)       max:margin.

    y1 := (self yVisibleOfLine:(aLnNr + 1)) min:(height - margin).

    (h := y1 - y0) > 0 ifTrue:[

        x0 := margin.

        x1 := width - margin.

        (item := list at:aLnNr ifAbsent:nil) isNil ifFalse:[

            lv := item level.

            x1 := (self xOfStringLevel:lv) - (textStartLeft // 2).

            arg == #hierarchy ifTrue:[

                x0 := self xOfFigureLevel:(lv -1).

            ] ifFalse:[

                x0 := self xOfFigureLevel:lv

            ].

            x0 := x0 max:margin.

            x1 := x1 min:(width - margin).

            x1 > x0 ifFalse:[^ self]

        ].

        self repairDamage.

        self invalidate:(Rectangle left:x0 top:y0 width:(x1 - x0) height:h) 

              repairNow:true.

    ]

!

listChangedInsert:firstAddedIndex nItems:nLines

    "must draw vertical lines above the added items

    "

    |item prnt idx level yTop yBot xLft rec start maxY|

    super listChangedInsert:firstAddedIndex nItems:nLines.

    (     shown

     and:[showLines

     and:[firstAddedIndex > 1

     and:[nLines ~~ 0

     and:[(item := list at:firstAddedIndex ifAbsent:nil) notNil

     and:[(level := item level) > 1]]]]]

    ) ifFalse:[

         ^ self.

    ].

    xLft := (self xOfFigureLevel:(level - 1)) + (imageWidth // 2) - 1.

    (xLft > margin and:[xLft < (width - margin)]) ifFalse:[

        ^ self

    ].

    start := firstAddedIndex - 1.

    start to:1 by:-1 do:[:i| |el|