"

 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.

"

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

"

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

"

! !

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

list:aList

    "get the status of <showRoot> from the list

    "

    aList notNil ifTrue:[

        showRoot := aList showRoot

    ].

    super list:aList

! !

!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 on:device.

            showLines ifTrue:[

                self invalidate

            ]

        ]

    ]

! !

!HierarchicalListView methodsFor:'accessing look'!

alignTextRight

    "align the text right

    "

    ^ alignTextRight

!

alignTextRight:aBool

    "align the text right

    "

    alignTextRight := aBool ? false.

!

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

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.

    ]

!

update:what with:aPara from:chgObj

    "get the status of <showRoot> from the list

    "

    chgObj == list ifTrue:[

        showRoot ~~ list showRoot ifTrue:[

            showRoot := list showRoot.

            self invalidate.

        ]

    ].

    super update:what with:aPara from:chgObj

! !

!HierarchicalListView methodsFor:'drawing basics'!

displayElement:anItem x:x y:y h:h

    "draw a label at x/y; fg/bg colors are already set

    "

    anItem displayOn:self x:x y:y h:h

!

drawElementsFrom:start to:stop x:xLeft y:yT w:w

    "draw the items between start to stop without clearing the background

    "

    |item prevItem parent icon showIndc showIcon showText nxtPrnt

     yTop      "{ Class:SmallInteger }"

     yCtr      "{ Class:SmallInteger }"

     yBot      "{ Class:SmallInteger }"

     xIndc     "{ Class:SmallInteger }"

     xIcon     "{ Class:SmallInteger }"

     xText     "{ Class:SmallInteger }"

     xDeltaIT  "{ Class:SmallInteger }"

     xL        "{ Class:SmallInteger }"

     xR        "{ Class:SmallInteger }"

     height    "{ Class:SmallInteger }"

     widthLvl  "{ Class:SmallInteger }"

     insetTxt  "{ Class:SmallInteger }"

     offIndcX  "{ Class:SmallInteger }"

     offIndcY  "{ Class:SmallInteger }"

     offIconX  "{ Class:SmallInteger }"

     iconWidth "{ Class:SmallInteger }"

     iconRgtX  "{ Class:SmallInteger }"

    |

    widthLvl := imageInset    + imageWidth.

    insetTxt := textStartLeft + imageWidth.

    xL       := xLeft.

    xR       := xL + w.

    alignTextRight ifTrue:[

        xText    := alignTextRightX - (viewOrigin x).

        showText := xText < xR.

    ].

    offIconX := self xOfFigureLevel:0.

    showIndc := false.

    indicatorAction notNil ifTrue:[

        icon     := openIndicator extent // 2.

        offIndcX := imageWidth // 2 - widthLvl.

        offIndcX := offIndcX - icon x.

        offIndcY := icon y.

    ].

    showLines ifTrue:[

        self drawLinesFrom:start to:stop x:xL y:yT toX:xR

    ].

    parent   := 4711.   "/ to force a recompute

    prevItem := 4711.   "/ to force a recomputation of the level

    yBot     := yT.

    start to:stop do:[:anIndex|

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

            ^ self      "/ list changed

        ].

        yTop := yBot.

        yBot := self yVisibleOfLine:(anIndex + 1).

        height := yBot - yTop.

        yCtr := yTop + (height // 2).

        (nxtPrnt := item parent) ~~ parent ifTrue:[

            parent := nxtPrnt.

            xIcon  := prevItem == parent ifTrue:[xIcon + widthLvl]

                                        ifFalse:[item level * widthLvl + offIconX].

            alignTextRight ifFalse:[

                xText    := xIcon + insetTxt.

                showText := xText < xR.

            ].

            showIcon := xIcon < xR and:[xText > xL].

            indicatorAction notNil ifTrue:[

                xIndc := xIcon + offIndcX.

                showIndc := (      (parent notNil or:[showLeftIndicators])

                              and:[(xIcon > xL and:[xIndc < xR])]

                            )

            ]

        ].

        (showIcon and:[(icon := self figureFor:item) notNil]) ifTrue:[

            iconWidth := icon width.

            iconRgtX  := xIcon + iconWidth.

            xDeltaIT  := xText - textStartLeft - iconRgtX.

            xDeltaIT < 0 ifTrue:[

                alignTextRightX := alignTextRightX - xDeltaIT.

                alignTextRight ifFalse:[

                    imageWidth := iconWidth.

                    widthOfContents := widthOfContents - xDeltaIT.

                ] ifTrue:[

                    widthOfContents := alignTextRightX + maxWidthOfText

                ].

                self contentsChanged.

                StopRedrawSignal raise

            ].

            iconRgtX > xL ifTrue:[

                self displayForm:icon x:xIcon y:(yCtr - (icon height // 2))

            ]

        ].

        showText ifTrue:[

            self drawLabelAt:anIndex x:xText y:yTop h:height

        ].

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

            icon := item isExpanded ifTrue:[openIndicator] ifFalse:[closeIndicator].

            self displayForm:icon x:xIndc y:(yCtr - offIndcY)

        ].

        prevItem := item.

    ]

!

drawLinesFrom:start to:stop x:xL y:yT toX:xR

    "draw the lines between start to stop without clearing the background

    "

    |item prevItem parent p1 p2 showVLines showHLine lv nxtPrnt