SelectionInListModelView subclass:#HierarchicalListView

	instanceVariableNames:'imageInset imageWidth lineMask lineColor showRoot showLines

		showLeftIndicators indicatorAction useDefaultIcons icons

		openIndicator closeIndicator'

	classVariableNames:''

	poolDictionaries:''

	category:'AAA'

!

!HierarchicalListView class methodsFor:'documentation'!

documentation

"

    This class implements a hierarchical list view based on a

    hierachical list

    [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

    [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:[Image fromFile:('xpmBitmaps/plus.xpm')]

!

collapsedIcon

    "returns icon to indicate a collapsed entry

    "

    <resource: #fileImage>

    ^ Icon constantNamed:#directory

             ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')]

!

emptyIcon

    "returns icon to indicate an not extendable entry

    "

    <resource: #fileImage>

    ^ Icon constantNamed:#plainFile

             ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')]

!

expandedIcon

    "returns icon to indicate an extended entry

    "

    <resource: #fileImage>

    ^ Icon constantNamed:#directoryOpened

             ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')]

!

openIndicator

    "returns a little [-] bitmap"

    <resource: #fileImage>

    ^ Icon constantNamed:#minus

             ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')]

! !

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

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

        ]

    ]

!

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

    ].

    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.

            x0 := self xOfFigureLevel:lv.

            x1 := x0 + imageWidth.

            arg == #hierarchy ifTrue:[

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

            ].

            x0 := x0 max:margin.

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

            x1 > x0 ifFalse:[

                ^ self

            ]

        ].

        self redrawX:x0 y:y0 width:x1 - x0 height:h.

    ]

!

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:xL y:yT toX:xR y:yB

    "draw a label at xL/yT; fg/bg colors are already set

    "

    anItem displayOn:self x:xL y:yT toX:xR y:yB

!

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

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

     widthLvl "{ Class:SmallInteger }"

     insetTxt "{ Class:SmallInteger }"

     offIndcX "{ Class:SmallInteger }"

     offIndcY "{ Class:SmallInteger }"

     offIconX "{ Class:SmallInteger }"

    |

    widthLvl := imageInset    + imageWidth.

    insetTxt := textStartLeft + imageWidth.

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

        yCtr := yTop + (yBot - yTop // 2).

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

            parent := nxtPrnt.

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

                                        ifFalse:[item level * widthLvl + offIconX].

            xText    := xIcon + insetTxt.

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

            showText := xText < xR.

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

            icon width > imageWidth ifTrue:[

                imageWidth := icon width.

                StopRedrawSignal raise

            ].

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

        ].

        showText ifTrue:[

            self drawLabelAt:anIndex x:xText y:yTop toX:xR y:yBot

        ].

        (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

     showRootNot isFirst buildInArray

     x        "{ Class:SmallInteger }"

     y        "{ Class:SmallInteger }"

     yTop     "{ Class:SmallInteger }"

     yBot     "{ Class:SmallInteger }"

     yCtr     "{ Class:SmallInteger }"

     begHLnY  "{ Class:SmallInteger }"

     runHLnY  "{ Class:SmallInteger }"

     begHLnX  "{ Class:SmallInteger }"

     endHLnX  "{ Class:SmallInteger }"

     widthLvl "{ Class:SmallInteger }"

     offsHLnX "{ Class:SmallInteger }"

     level    "{ Class:SmallInteger }"

     startLvI "{ Class:SmallInteger }"

     startLvX "{ Class:SmallInteger }"

     limitLvI "{ Class:SmallInteger }"

     limitLvX "{ Class:SmallInteger }"

    |

    widthLvl := imageInset + imageWidth.

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

    parent   := 4711.                           "/ to force a recompute

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

    self setMaskOrigin:(self viewOrigin + (0 @ 1) \\ (lineMask extent)).

    self paint:lineColor on:bgColor.

    self mask:lineMask.

    startLvI := self smallestLevelBetween:start and:stop.

    startLvX := self xOfFigureLevel:startLvI.

    limitLvI := 2.

    limitLvX := limitLvI * widthLvl + offsHLnX.

    buildInArray := Array new:20.

    buildInArray atAllPut:0.

    showRootNot := showRoot not.

    yBot := yT.

    begHLnY := runHLnY := yT.

    start to:stop do:[:anIndex|

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

            ^ self mask:nil     "/ list changed

        ].

        yTop := yBot.

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

        yCtr := yTop + (yBot - yTop // 2).

        anIndex == 1 ifTrue:[ begHLnY := runHLnY := yCtr ].

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

            parent := nxtPrnt.

            prevItem == parent ifTrue:[

                level := level + 1.

                begHLnX := endHLnX.

            ] ifFalse:[

                level   := item level.

                begHLnX := item level * widthLvl + offsHLnX.

            ].

            isFirst    := parent isNil or:[(showRootNot and:[level == 2])].

            endHLnX    := begHLnX + widthLvl.

            showVLines := begHLnX >= xL and:[level > 1].

            showHLine  := xL < endHLnX and:[xR > begHLnX].

            (showHLine and:[isFirst]) ifTrue:[

                showHLine := showLeftIndicators and:[indicatorAction notNil]

            ]

        ].

        showHLine ifTrue:[

            self displayLineFromX:begHLnX y:yCtr toX:endHLnX y:yCtr

        ].

        showVLines ifTrue:[

            y  := (parent last == item) ifTrue:[yCtr] ifFalse:[yBot].

            x  := begHLnX.

            p2 := parent.

            lv := level - 1.

            self displayLineFromX:x y:runHLnY toX:x y:y.

            [((p1 := p2 parent) notNil and:[(x := x - widthLvl) >= limitLvX])] whileTrue:[

                (p1 last ~~ p2 and:[x <= xR]) ifTrue:[

                    x >= startLvX ifTrue:[

                        self displayLineFromX:x y:(yTop - 1) toX:x y:yBot

                    ] ifFalse:[

                        buildInArray at:lv put:yBot

                    ].

                ].

                lv := lv - 1.

                p2 := p1

            ]

        ].

        prevItem := item.

        runHLnY  := yCtr.

    ].

    "/

    "/ draw outstanding verical lines to left

    "/