diff -r 3548d53b14ae -r 62dc950b9140 HierarchicalListView.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/HierarchicalListView.st Sun May 23 14:56:33 1999 +0200 @@ -0,0 +1,889 @@ +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 inset between icon and text + imageInset inset between left side and icon + imageWidth width of widest icon + lineMask
line mask + lineColor line color + showRoot root element is shown or hidden + derives from the hierachical list. + showLines show or hide lines + useDefaultIcons use the default icons if no icon + for an item is specified + icons list of registered icons; + identifier := value := + showLeftIndicators show or hide indicator for most left items + indicatorAction action evaluated if indicator is pressed + openIndicator expanded indicator + closeIndicator 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" + + + + ^ Icon constantNamed:#plus + ifAbsentPut:[Image fromFile:('xpmBitmaps/plus.xpm')] + + +! + +collapsedIcon + "returns icon to indicate a collapsed entry + " + + + ^ Icon constantNamed:#directory + ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')] + +! + +emptyIcon + "returns icon to indicate an not extendable entry + " + + + ^ Icon constantNamed:#plainFile + ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')] + +! + +expandedIcon + "returns icon to indicate an extended entry + " + + + ^ Icon constantNamed:#directoryOpened + ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')] + +! + +openIndicator + "returns a little [-] bitmap" + + + + ^ Icon constantNamed:#minus + ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')] + +! ! + +!HierarchicalListView methodsFor:'accessing'! + +list:aList + "get the status of 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 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'! + +drawElementsFrom:start to:stop x:x0 y:y0 width:aWidth + "draw the items between start to stop without clearing the background + " + |item prevItem parent icon showIndc showIcon showText nxtPrnt + + x1 "{ Class:SmallInteger }" + 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 }" + | + x1 := x0 + aWidth. + 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:x0 y:y0 width:aWidth + ]. + + parent := 4711. "/ to force a recompute + prevItem := 4711. "/ to force a recomputation of the level + yBot := y0. + + 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 < x1 and:[xText > x0]. + showText := xText < x1. + + indicatorAction notNil ifTrue:[ + xIndc := xIcon + offIndcX. + + showIndc := ( (parent notNil or:[showLeftIndicators]) + and:[(xIcon > x0 and:[xIndc < x1])] + ) + ] + ]. + + (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:xText y:yTop h:(yBot - yTop) index:anIndex + ]. + (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:x0 y:y0 width:aWidth + "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 }" + x1 "{ 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 }" + | + x1 := x0 + aWidth. + 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 := y0. + begHLnY := runHLnY := y0. + + 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 >= x0 and:[level > 1]. + showHLine := x0 < endHLnX and:[x1 > 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 <= x1]) 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 + "/ + x := limitLvX. + y := begHLnY. + + limitLvI to:startLvI do:[:i| + (yBot := buildInArray at:i) ~~ 0 ifTrue:[ + self displayLineFromX:x y:y toX:x y:yBot + ]. + x := x + widthLvl. + ]. + ( start == stop + and:[(item := list at:start ifAbsent:nil) notNil + and:[item isExpanded + and:[item hasChildren]]] + ) ifTrue:[ + x := begHLnX + widthLvl. + + (x >= x0 and:[x <= x1]) ifTrue:[ + yBot := self yVisibleOfLine:(start + 1). + yCtr := y0 + (yBot - y0 // 2). + self displayLineFromX:x y:yCtr toX:x y:yBot. + ] + ]. + self mask:nil. + + +! + +redrawLabelFromItem:anItem atY:y h:h + "called to redraw a label caused by a selection change + " + |w "{ Class:SmallInteger }" + x "{ Class:SmallInteger }" + | + x := (self xOfStringLevel:(anItem level)) - (textStartLeft // 2). + x := x max:margin. + + (w := width - x) > 0 ifTrue:[ + self redrawX:x y:y width:w height:h + ] + + +! ! + +!HierarchicalListView methodsFor:'event handling'! + +buttonMultiPress:button x:x y:y + "handle a button multiPress event + " + |lnNr| + + enabled ifTrue:[ + ( (button == 1 or:[button == #select]) + and:[(lnNr := self indicatorLineAtX:x y:y) notNil] + ) ifFalse:[ + super buttonMultiPress:button x:x y:y + ] + ] +! + +buttonPress:button x:x y:y + "handle a button press event + " + |lnNr menu item appl| + + enabled ifTrue:[ + ((button == 2) or:[button == #menu]) ifTrue:[ + ( (item := self selectedElement) notNil + and:[(menu := item middleButtonMenu) notNil] + ) ifTrue:[ + menu isCollection ifTrue:[ + menu := Menu new fromLiteralArrayEncoding:menu. + appl := self application. + + appl notNil ifTrue:[ + menu findGuiResourcesIn:appl. + menu receiver:appl + ] ifFalse:[ + menu receiver:item + ] + ]. + ^ menu startUp + ]. + ] ifFalse:[ + (lnNr := self indicatorLineAtX:x y:y) notNil ifTrue:[ + (indicatorAction numArgs == 1) ifTrue:[ + indicatorAction value:lnNr + ] ifFalse:[ + indicatorAction value + ]. + ^ self + ] + ]. + super buttonPress:button x:x y:y + ] +! + +keyPress:aKey x:x y:y + "a key was pressed - handle page-keys here + " + + + |item parent index size stop step| + + (aKey == #CursorLeft or:[aKey == #CursorRight]) ifFalse:[ + ^ super keyPress:aKey x:x y:y + ]. + + ( enabled + and:[(size := list size) > 1 + and:[(index := self selectedIndex) ~~ 0 + and:[(item := list at:index ifAbsent:nil) notNil]]] + ) ifTrue:[ + parent := item parent. + + aKey == #CursorLeft ifTrue:[step := -1. stop := 1] + ifFalse:[step := 1. stop := size]. + + (index + step) to:stop by:step do:[:i| + item := list at:i ifAbsent:[^ nil ]. + item parent ~~ parent ifTrue:[^ self selection:i] + ]. + + index := aKey == #CursorLeft ifTrue:[size] ifFalse:[1]. + self selection:index + ]. +! ! + +!HierarchicalListView methodsFor:'fetch resources'! + +fetchResources + "fetch device colors and ..., to avoid reallocation at redraw time; + *** called after a create or snapin to fetch all device resources + " + |image| + + super fetchResources. + + lineMask := lineMask onDevice:device. + lineColor := lineColor onDevice:device. + openIndicator := self imageOnDevice:openIndicator. + closeIndicator := self imageOnDevice:closeIndicator. + imageWidth := 4. + + icons keysAndValuesDo:[:aKey :anImage| + image := self imageOnDevice:anImage. + icons at:aKey put:image. + imageWidth := image width max:imageWidth. + ]. + imageWidth := imageWidth // 2. + imageWidth odd ifTrue:[imageWidth := imageWidth + 1]. + imageWidth := imageWidth * 2. + + + +! ! + +!HierarchicalListView methodsFor:'initialize / release'! + +initStyle + "setup viewStyle specifics + " + |cls| + + super initStyle. + + cls := self class. + + lineMask := Form width:2 height:2 fromArray:#[16rAA 16r55]. + icons := IdentityDictionary new. + + icons at:#expanded ifAbsentPut:[cls expandedIcon]. + icons at:#collapsed ifAbsentPut:[cls collapsedIcon]. + icons at:#empty ifAbsentPut:[cls emptyIcon]. + + openIndicator := self class openIndicator. + closeIndicator := self class closeIndicator. + lineColor := fgColor. + highlightMode := #label. + showRoot := true. + showLeftIndicators := true. + useDefaultIcons := true. + showLines := true. + imageInset := 4. + imageWidth := 8. "/ default +! ! + +!HierarchicalListView methodsFor:'private'! + +figureFor:anItem + "return a (bitmap) figure for an item + " + |key image w h| + + "/ the item may provide an icon + "/ (it knows for itself if its open or closed) + + (key := anItem icon) notNil ifTrue:[ + (key isImageOrForm and:[key device == device]) ifTrue:[ + ^ key + ]. + + (image := icons at:key ifAbsent:nil) notNil ifTrue:[ + ^ image + ]. + + key isImageOrForm ifTrue:[ + image := self imageOnDevice:key. + icons at:key put:image. + ^ image + ] + ]. + + useDefaultIcons ifFalse:[^ nil]. + + "/ ok, item did not return an icon - use default. + + anItem hasChildren ifTrue:[ + key := anItem isExpanded ifTrue:[#expanded] ifFalse:[#collapsed] + ] ifFalse:[ + key := #empty + ]. + ^ icons at:key +! + +heightOfLineAt:aLineNr + "returns the total height for a line at an index, including + lineSpacing, the figure and the label + " + |item icon height| + + item := list at:aLineNr ifAbsent:[^ 4]. + height := item heightOn:self. + + (icon := self figureFor:item) notNil ifTrue:[ + height := (item heightOn:self) max:height. + ]. + ^ lineSpacing + height + + +! + +indicatorLineAtX:x y:y + "returns the lineNumber assigned to an indicator at x/y or nil + " + |lnNr item x0| + + ( indicatorAction isNil + or:[(lnNr := self yVisibleToLineNr:y) isNil + or:[(item := list at:lnNr ifAbsent:nil) isNil + or:[item hasChildren not]]] + ) ifFalse:[ + x0 := self xOfFigureLevel:(item level - 1). + + (x > x0 and:[(x0 + imageWidth) > x]) ifTrue:[ + ^ lnNr + ] + ]. + ^ nil +! + +smallestLevelBetween:start and:stop + "returns the smallest level between a range + " + |prevItem currParent nextParent item + + lvl "{ Class:SmallInteger }" + min "{ Class:SmallInteger }" + beg "{ Class:SmallInteger }" + | + + prevItem := list at:start ifAbsent:[ ^ 1 ]. + + (currParent := prevItem parent) isNil ifTrue:[ + ^ 1 + ]. + + (min := prevItem level) == 2 ifTrue:[ + ^ min + ]. + beg := start + 1. + + beg to:stop do:[:i| + item := list at:i ifAbsent:[^ min]. + + (nextParent := item parent) == currParent ifFalse:[ + (currParent := nextParent) == prevItem ifFalse:[ + (lvl := item level) == 2 ifTrue:[ + ^ 2 + ]. + min := min min:lvl + ] + ]. + prevItem := item + ]. + ^ min + + + + + +! + +widthOfWidestLineBetween:firstLine and:lastLine + "return the width of the longest line in pixels + " + |nprnt pprnt pitem item + textX "{ Class: SmallInteger }" + level "{ Class: SmallInteger }" + width "{ Class: SmallInteger }" + deltaX "{ Class: SmallInteger }" + startX "{ Class: SmallInteger }" + | + + pprnt := 4711. "/ force a computation + pitem := 4712. "/ force a computation + width := 20. + deltaX := imageInset + imageWidth. + startX := self xOfStringLevel:1. + + firstLine to:lastLine do:[:idx| + item := list at:idx ifAbsent:[^ width + startX]. + + (nprnt := item parent) ~~ pprnt ifTrue:[ + (pprnt := nprnt) == pitem ifTrue:[ + level := level + 1. + textX := textX + deltaX. + ] ifFalse:[ + level := item level. + textX := level - 1 * deltaX. + ] + ]. + pitem := item. + width := (item widthOn:self) max:width + ]. + ^ width + startX + + +! + +xOfFigureLevel:aLevel + "origin x where to draw the icon + " + |l "{ Class:SmallInteger }"| + + l := showRoot ifTrue:[aLevel] ifFalse:[aLevel - 1]. + + indicatorAction isNil ifTrue:[ + l := l - 1 + ] ifFalse:[ + showLeftIndicators ifFalse:[ + l := l - 1 + ] + ]. + ^ (l * (imageInset + imageWidth)) + imageInset - (viewOrigin x) +! + +xOfStringLevel:aLevel + "origin x where to draw the text( label ) + " + ^ (self xOfFigureLevel:aLevel) + imageWidth + textStartLeft + +! ! + +!HierarchicalListView class methodsFor:'documentation'! + +version + ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalListView.st,v 1.1 1999-05-23 12:56:26 cg Exp $' +! !