"

 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 lineColor showRoot showLines

		useDefaultIcons icons openIndicator closeIndicator alignTextRight

		alignTextRightX maxWidthOfText minLineHeight levelOfLastItem

		expandOnSelect autoScrollHorizontal showIndicators

		showLeftIndicators indicatorAction'

	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

        minLineHeight       <Integer>              minimum required line height

                                                   including open/close indication ...

        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

        showIndicators      <Boolean>              show or hide indicators

        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 (0/1/2 arguments)

        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

        levelOfLastItem     <Integer>              keeps the level of the last item;

                                                   in case of a delete last items from list

                                                   we know were to redraw lines from

        autoScrollHorizontal <Boolean>             true, than automatically scroll horizontal upto

                                                   the text label of the current selected line.

        expandOnSelect      <Boolean>              true, than the item selected by a buttonPress

                                                   event will be immediately expanded.

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

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

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

    sel list:list.

    sel multipleSelectOk:true.

    sel alignTextRight:true.

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

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

    top open.

                                                                        [exBegin]

"

!

test

    |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 miniScrollerH:true

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

    sel useDefaultIcons:false.

    sel list:list.

    sel multipleSelectOk:true.

    sel showLines:false.

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

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

    top open.

! !

!HierarchicalListView class methodsFor:'resources'!

closeIndicator

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self closeIndicator inspect

     ImageEditor openOnClass:self andSelector:#closeIndicator

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:#'HierarchicalListView class closeIndicator'

        ifAbsentPut:[(Depth2Image new) width: 9; height: 9; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUU@Z*)@Z")@Z")@X@I-Z")@Z")KZ*)@UUU;') ; colorMapFromArray:#[0 0 0 128 128 128 255 255 255]; yourself]

!

collapsedIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self collapsedIcon inspect

     ImageEditor openOnClass:self andSelector:#collapsedIcon

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:#'HierarchicalListView class collapsedIcon'

        ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@UP@@@@@@@@EUUUPAUUUT@UUUU@EUUUPAUUUT@UUUU@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 0]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@O@A>@O?<??3??O?<??3??O?<??0@@@@@@@@b') ; yourself); yourself]

!

emptyIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self emptyIcon inspect

     ImageEditor openOnClass:self andSelector:#emptyIcon

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:#'HierarchicalListView class emptyIcon'

        ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@EUTP@AUUE@@UUP@@EUUU@AUUUP@UUUT@EUUU@AUUUP@UUUT@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@O?@?>C?<O?8??#?>O?8??#?>O?8?? @@@@@@@@b') ; yourself); yourself]

!

expandedIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self expandedIcon inspect

     ImageEditor openOnClass:self andSelector:#expandedIcon

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:#'HierarchicalListView class expandedIcon'

        ifAbsentPut:[(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@@@@@@UP@@@UU@@@EUUUPA@@@@@R*** B***(@***(@****@@@@@@@@@@@@@@@@@@@@@@@@a') ; colorMapFromArray:#[0 0 0 179 179 179 255 255 0]; mask:((ImageMask new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@O@A>@O?<??3???????;??/?<??0@@@@@@@@b') ; yourself); yourself]

!

openIndicator

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self openIndicator inspect

     ImageEditor openOnClass:self andSelector:#openIndicator

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:#'HierarchicalListView class openIndicator'

        ifAbsentPut:[(Depth2Image new) width: 9; height: 9; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'UUU@Z*)@Z*)(Z*)HX@I@Z*)@Z*)@Z*)@UUU.') ; colorMapFromArray:#[0 0 0 128 128 128 255 255 255]; yourself]

! !

!HierarchicalListView methodsFor:'accessing'!

font:aFont

    "set a new font; if the font changed, all my items

     has to clear their cashed width and height

    "

    |root|

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

        root := self root.

        root notNil ifTrue:[ root fontChanged ].

        super font:aFont

    ].

!

list:aList

    "test whether the list is not a hierarchical item and

     retrieve the showRoot attribute from the list

    "

    aList notNil ifTrue:[

        aList isHierarchicalItem ifTrue:[

            self list root:aList.

            aList expand.

            ^ self

        ].

        showRoot := aList showRoot.

    ].

    super list:aList

!

newDefaultList

    "creates and returns a new default list class, on default a HierarchicalList

    "

    |list|

    list := HierarchicalList new.

    list showRoot:(showRoot ? true).

    ^ list

!

root

    "returns the anchor of the list or nil

    "

    ^ self list root

! !

!HierarchicalListView methodsFor:'accessing-behavior'!

autoScrollHorizontal

    "true, than automatically scroll horizontal upto the text label

     of the current selected line.

    "

    autoScrollHorizontal == true ifTrue:[

        ^ renderer autoScrollHorizontal

    ].

    ^ false

!

autoScrollHorizontal:aBoolean

    "true, than automatically scroll horizontal upto the text label

     of the current selected line.

    "

    autoScrollHorizontal := aBoolean.

!

expandOnSelect

    "true, than the item selected by a buttonPress event will

     be immediately expanded.

    "

    ^ expandOnSelect

!

expandOnSelect:aBoolean

    "true, than the item selected by a buttonPress event will

     be immediately expanded.

    "

    expandOnSelect := aBoolean.

! !

!HierarchicalListView methodsFor:'accessing-colors'!

lineColor

    "get the color of the horizontal and vertical lines

    "

    ^ lineColor

!

lineColor:aColor

    "set the color of the horizontal and vertical lines

    "

    (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 > 0 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 notNil ifTrue:[^ icon].

    icon := aBlock value.

    icon isNil ifTrue:[^ nil].

    realized ifTrue:[

        icon := self imageOnMyDevice: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 imageOnMyDevice:anImage) notNil ifTrue:[