intitial checkin
authorca
Thu, 03 Jul 1997 10:24:27 +0200
changeset 444 6d40e2c4ed53
parent 443 fdff91162cac
child 445 0595adddd619
intitial checkin
SelTreeV.st
SelectionInTreeView.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/SelTreeV.st	Thu Jul 03 10:24:27 1997 +0200
@@ -0,0 +1,389 @@
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+              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.
+"
+
+
+SelectionInListView subclass:#SelectionInTreeView
+	instanceVariableNames:'listOfNodes figuresWidth figuresInset dblClickEvt'
+	classVariableNames:'ImageOpened ImageClosed ImageItem'
+	poolDictionaries:''
+	category:'Views-Text'
+!
+
+!SelectionInTreeView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+              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
+"
+    somewhat like a SelectionInListView; but specialized for hierarchical (i.e. tree-like)
+    lists and adds the functions to show/hide subtrees. 
+    Requires SelectionInHierarchy as model and HierarchyNode (or compatible) list entries.
+
+    [see also:]
+        SelectionInHierarchy
+        HierarchyNode
+        SelectionInListView
+        SelectionInHierarchyView
+
+    [author:]
+        Claus Atzkern
+"
+
+!
+
+examples
+"
+    shows the tree of smalltalk classes:
+                                                                        [exBegin]
+      |top hierarchy hierarchyV scroller|
+
+      hierarchy := SelectionInHierarchy new.
+      hierarchy root:(HierarchyNode newAsTreeFromSmalltalkClass:Object level:1).
+      hierarchy setHideToChildren:true startingAt:hierarchy root.
+
+      top := StandardSystemView new.
+      top extent:300@300.
+
+      hierarchyV := SelectionInTreeView new.
+      hierarchyV model: hierarchy.
+      hierarchyV action:[:nr | Transcript show:'selected:'; showCR:nr].
+
+      top add:(ScrollableView forView:hierarchyV)
+          in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
+      top open.
+                                                                        [exEnd]
+"
+
+! !
+
+!SelectionInTreeView class methodsFor:'constants'!
+
+imageClosed
+    ImageClosed isNil ifTrue:[
+        ImageClosed := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm').
+    ].
+  ^ ImageClosed
+"
+ImageClosed := nil
+"
+
+!
+
+imageItem
+    ImageItem isNil ifTrue:[
+        ImageItem := Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')  
+
+    ].
+  ^ ImageItem
+"
+ImageItem := nil
+"
+
+!
+
+imageOpened
+    ImageOpened isNil ifTrue:[
+        ImageOpened := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm').
+
+    ].
+  ^ ImageOpened
+"
+ImageOpened := nil
+"
+! !
+
+!SelectionInTreeView methodsFor:'accessing'!
+
+list:aList keepSelection:keepSelection
+    |list|
+
+    list := aList.
+
+    list size == 0 ifTrue:[
+        listOfNodes := #()
+    ] ifFalse:[
+        (list first respondsTo:#hasChildren) ifTrue:[
+            listOfNodes := aList.
+            list := listOfNodes collect:[:aNode| aNode name ].
+        ]
+    ].
+    super list:list keepSelection:keepSelection
+! !
+
+!SelectionInTreeView methodsFor:'drawing'!
+
+drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
+
+    startVisLineNr to:endVisLineNr do:[:visLineNr|
+        self drawLineVisLineNr:visLineNr with:fg and:bg
+    ]
+!
+
+drawLine:line atX:atX inVisible:visLineNr with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+!
+
+drawLine:line fromX:x inVisible:visLineNr with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+
+!
+
+drawLine:line inVisible:visLineNr with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+
+!
+
+drawVisibleLine:visLineNr col:col with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+
+!
+
+drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg
+!
+
+drawVisibleLine:visLineNr from:startCol with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg
+
+! !
+
+!SelectionInTreeView methodsFor:'drawing basics'!
+
+drawLabelIndex:anIndex atX:x y:yCenter
+    "draw text label at x and y centered
+    "
+    |y lbl|
+
+    lbl := (listOfNodes at:anIndex) name.
+
+    lbl notNil ifTrue:[
+        y := yCenter - ((lbl heightOn:self) // 2).
+
+        (lbl respondsTo:#string) ifTrue:[
+            y := y + fontAscent.
+        ].
+        self displayOpaqueString:lbl x:x y:y.
+    ]    
+!
+
+drawLineVisLineNr:aVisLineNr with:fg and:bg
+    "draw a given string at visible lines position with
+     given x position in fg/bg. Clears the whole line before drawing the string.
+     Low level entry; not meant for public use."
+
+    |x y x1 x2 xFigure node yTop yBottom yCenter level size index fig indent|
+
+    index := self visibleLineToAbsoluteLine:aVisLineNr.
+    size  := listOfNodes size.
+    yTop  := self yOfVisibleLine:aVisLineNr.
+
+"/  clear rectangle line and set background color
+    self paint:bg.
+    self fillRectangleX:0 y:yTop width:width height:fontHeight.
+
+    (index notNil and:[index <= size]) ifFalse:[
+        ^ self
+    ].
+    node    := listOfNodes at:index.
+    yBottom := yTop + fontHeight.
+    yCenter := yTop + (fontHeight // 2).
+    xFigure := self xOfFigureNode:node.
+    indent  := self indent.
+
+    self paint:fg on:bg.
+    x := xFigure + (figuresWidth // 2).
+
+"/  draw figure in case of children
+    fig := self figureFor:node.
+
+    node isCollapsable ifTrue:[
+        self displayLineFromX:x y:yCenter toX:x y:yBottom
+    ].
+
+    (fig := self figureFor:node) notNil ifTrue:[
+        y := yCenter - (fig height // 2).
+        self displayForm:fig x:xFigure y:y.
+        x2 := xFigure
+    ] ifFalse:[
+        x2 := xFigure + figuresWidth
+    ].
+
+"/  draw horizontal and vertical line
+    x1 := x - indent.
+    self displayLineFromX:x1 y:yTop    toX:x1 y:yCenter.        "/ vertical
+    self displayLineFromX:x1 y:yCenter toX:x2 y:yCenter.        "/ horizontal
+
+"/  draw text label
+    self drawLabelIndex:index atX:(self xOfStringNode:node) y:yCenter.
+
+"/  draw vertical lines
+    index ~~ size ifTrue:[
+        level := node level.
+        x := indent - (figuresWidth//2).
+
+        [(level > 0 and:[(index := index + 1) <= size])] whileTrue:[
+            node := listOfNodes at:index.
+
+            node level > level ifFalse:[
+                x1 := (self xOfFigureNode:node) - x.
+                self displayLineFromX:x1 y:yTop toX:x1 y:yBottom.
+                level := node level - 1
+            ]
+        ]
+    ]
+! !
+
+!SelectionInTreeView methodsFor:'initialization'!
+
+getFontParameters
+    |image1 image2 height|
+
+    super getFontParameters.
+
+    figuresInset := 4.
+
+    image1 := self class imageClosed.
+    image2 := self class imageOpened.
+    height := image1 heightOn:self.
+    figuresWidth := image1 widthOn:self.
+
+    height < (image2 heightOn:self) ifTrue:[
+        height := image2 heightOn:self
+    ].
+    (height := height + figuresInset) > fontHeight ifTrue:[
+        fontHeight := height
+    ].
+
+    figuresWidth < (image2 widthOn:self) ifTrue:[
+        figuresWidth := image2 widthOn:self
+    ].
+
+!
+
+initialize
+    super initialize.
+    dblClickEvt := false
+! !
+
+!SelectionInTreeView methodsFor:'private'!
+
+figureFor:aNode
+    "access figure for a node
+    "
+    aNode hasChildren ifTrue:[
+        aNode isExpandable ifTrue:[ ^ self class imageClosed ]
+                          ifFalse:[ ^ self class imageOpened ]
+    ].
+  ^ self class imageItem
+!
+
+getListFromModel
+    "if I have a model, get my list from it using the listMessage.
+     If listMessage is nil, try aspectMessage for backward compatibilty.
+    "
+    |newList newSize msg|
+
+    model isNil ifTrue:[^ self].
+
+    (msg := listMsg) isNil ifTrue:[msg := aspectMsg].
+
+    msg notNil ifTrue:[listOfNodes := model perform:msg].
+
+    listOfNodes size == 0 ifTrue:[
+        listOfNodes := #()
+    ].
+    newList := listOfNodes collect:[:aNode| aNode name ].
+
+    dblClickEvt ifFalse:[
+        ^ super list:newList keepSelection:true
+    ].
+    list := newList.
+    self redrawFromLine:selection.
+    self contentsChanged.
+
+!
+
+indent
+    "get the indent
+    "
+    ^ figuresInset + figuresWidth
+!
+
+xOfFigureNode:aNode
+    "origin x where to draw the icon
+    "
+    ^ ((aNode level-1) * self indent) + figuresInset
+
+!
+
+xOfStringNode:aNode
+    "origin x where to draw the text( label )
+    "
+    ^ (self xOfFigureNode:aNode) + figuresInset + figuresWidth
+
+! !
+
+!SelectionInTreeView methodsFor:'selection'!
+
+doubleClicked
+    "handle a double click; collapse or expand selected entry
+     in case of having children
+    "
+    |node y|
+
+    dblClickEvt := true.
+
+    selection notNil ifTrue:[
+        node := listOfNodes at:selection.
+
+        node hasChildren ifTrue:[
+            node isExpandable ifTrue:[model expand]
+                             ifFalse:[model collapse]
+        ]
+    ].
+    dblClickEvt := false.
+    super doubleClicked.
+
+!
+
+selectedNode
+    "get the single selected node or nil
+    "
+    selection notNil ifTrue:[
+        selection isCollection ifFalse:[
+            ^ listOfNodes at:selection
+        ].
+        selection size == 1 ifTrue:[
+            ^ listOfNodes at:(selection first)
+        ]
+    ].
+  ^ nil
+! !
+
+!SelectionInTreeView class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libwidg2/Attic/SelTreeV.st,v 1.1 1997-07-03 08:24:27 ca Exp $'
+! !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/SelectionInTreeView.st	Thu Jul 03 10:24:27 1997 +0200
@@ -0,0 +1,389 @@
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+              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.
+"
+
+
+SelectionInListView subclass:#SelectionInTreeView
+	instanceVariableNames:'listOfNodes figuresWidth figuresInset dblClickEvt'
+	classVariableNames:'ImageOpened ImageClosed ImageItem'
+	poolDictionaries:''
+	category:'Views-Text'
+!
+
+!SelectionInTreeView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
+              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
+"
+    somewhat like a SelectionInListView; but specialized for hierarchical (i.e. tree-like)
+    lists and adds the functions to show/hide subtrees. 
+    Requires SelectionInHierarchy as model and HierarchyNode (or compatible) list entries.
+
+    [see also:]
+        SelectionInHierarchy
+        HierarchyNode
+        SelectionInListView
+        SelectionInHierarchyView
+
+    [author:]
+        Claus Atzkern
+"
+
+!
+
+examples
+"
+    shows the tree of smalltalk classes:
+                                                                        [exBegin]
+      |top hierarchy hierarchyV scroller|
+
+      hierarchy := SelectionInHierarchy new.
+      hierarchy root:(HierarchyNode newAsTreeFromSmalltalkClass:Object level:1).
+      hierarchy setHideToChildren:true startingAt:hierarchy root.
+
+      top := StandardSystemView new.
+      top extent:300@300.
+
+      hierarchyV := SelectionInTreeView new.
+      hierarchyV model: hierarchy.
+      hierarchyV action:[:nr | Transcript show:'selected:'; showCR:nr].
+
+      top add:(ScrollableView forView:hierarchyV)
+          in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).
+      top open.
+                                                                        [exEnd]
+"
+
+! !
+
+!SelectionInTreeView class methodsFor:'constants'!
+
+imageClosed
+    ImageClosed isNil ifTrue:[
+        ImageClosed := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm').
+    ].
+  ^ ImageClosed
+"
+ImageClosed := nil
+"
+
+!
+
+imageItem
+    ImageItem isNil ifTrue:[
+        ImageItem := Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')  
+
+    ].
+  ^ ImageItem
+"
+ImageItem := nil
+"
+
+!
+
+imageOpened
+    ImageOpened isNil ifTrue:[
+        ImageOpened := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm').
+
+    ].
+  ^ ImageOpened
+"
+ImageOpened := nil
+"
+! !
+
+!SelectionInTreeView methodsFor:'accessing'!
+
+list:aList keepSelection:keepSelection
+    |list|
+
+    list := aList.
+
+    list size == 0 ifTrue:[
+        listOfNodes := #()
+    ] ifFalse:[
+        (list first respondsTo:#hasChildren) ifTrue:[
+            listOfNodes := aList.
+            list := listOfNodes collect:[:aNode| aNode name ].
+        ]
+    ].
+    super list:list keepSelection:keepSelection
+! !
+
+!SelectionInTreeView methodsFor:'drawing'!
+
+drawFromVisibleLine:startVisLineNr to:endVisLineNr with:fg and:bg
+
+    startVisLineNr to:endVisLineNr do:[:visLineNr|
+        self drawLineVisLineNr:visLineNr with:fg and:bg
+    ]
+!
+
+drawLine:line atX:atX inVisible:visLineNr with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+!
+
+drawLine:line fromX:x inVisible:visLineNr with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+
+!
+
+drawLine:line inVisible:visLineNr with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+
+!
+
+drawVisibleLine:visLineNr col:col with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg.
+
+!
+
+drawVisibleLine:visLineNr from:startCol to:endCol with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg
+!
+
+drawVisibleLine:visLineNr from:startCol with:fg and:bg
+    self drawLineVisLineNr:visLineNr with:fg and:bg
+
+! !
+
+!SelectionInTreeView methodsFor:'drawing basics'!
+
+drawLabelIndex:anIndex atX:x y:yCenter
+    "draw text label at x and y centered
+    "
+    |y lbl|
+
+    lbl := (listOfNodes at:anIndex) name.
+
+    lbl notNil ifTrue:[
+        y := yCenter - ((lbl heightOn:self) // 2).
+
+        (lbl respondsTo:#string) ifTrue:[
+            y := y + fontAscent.
+        ].
+        self displayOpaqueString:lbl x:x y:y.
+    ]    
+!
+
+drawLineVisLineNr:aVisLineNr with:fg and:bg
+    "draw a given string at visible lines position with
+     given x position in fg/bg. Clears the whole line before drawing the string.
+     Low level entry; not meant for public use."
+
+    |x y x1 x2 xFigure node yTop yBottom yCenter level size index fig indent|
+
+    index := self visibleLineToAbsoluteLine:aVisLineNr.
+    size  := listOfNodes size.
+    yTop  := self yOfVisibleLine:aVisLineNr.
+
+"/  clear rectangle line and set background color
+    self paint:bg.
+    self fillRectangleX:0 y:yTop width:width height:fontHeight.
+
+    (index notNil and:[index <= size]) ifFalse:[
+        ^ self
+    ].
+    node    := listOfNodes at:index.
+    yBottom := yTop + fontHeight.
+    yCenter := yTop + (fontHeight // 2).
+    xFigure := self xOfFigureNode:node.
+    indent  := self indent.
+
+    self paint:fg on:bg.
+    x := xFigure + (figuresWidth // 2).
+
+"/  draw figure in case of children
+    fig := self figureFor:node.
+
+    node isCollapsable ifTrue:[
+        self displayLineFromX:x y:yCenter toX:x y:yBottom
+    ].
+
+    (fig := self figureFor:node) notNil ifTrue:[
+        y := yCenter - (fig height // 2).
+        self displayForm:fig x:xFigure y:y.
+        x2 := xFigure
+    ] ifFalse:[
+        x2 := xFigure + figuresWidth
+    ].
+
+"/  draw horizontal and vertical line
+    x1 := x - indent.
+    self displayLineFromX:x1 y:yTop    toX:x1 y:yCenter.        "/ vertical
+    self displayLineFromX:x1 y:yCenter toX:x2 y:yCenter.        "/ horizontal
+
+"/  draw text label
+    self drawLabelIndex:index atX:(self xOfStringNode:node) y:yCenter.
+
+"/  draw vertical lines
+    index ~~ size ifTrue:[
+        level := node level.
+        x := indent - (figuresWidth//2).
+
+        [(level > 0 and:[(index := index + 1) <= size])] whileTrue:[
+            node := listOfNodes at:index.
+
+            node level > level ifFalse:[
+                x1 := (self xOfFigureNode:node) - x.
+                self displayLineFromX:x1 y:yTop toX:x1 y:yBottom.
+                level := node level - 1
+            ]
+        ]
+    ]
+! !
+
+!SelectionInTreeView methodsFor:'initialization'!
+
+getFontParameters
+    |image1 image2 height|
+
+    super getFontParameters.
+
+    figuresInset := 4.
+
+    image1 := self class imageClosed.
+    image2 := self class imageOpened.
+    height := image1 heightOn:self.
+    figuresWidth := image1 widthOn:self.
+
+    height < (image2 heightOn:self) ifTrue:[
+        height := image2 heightOn:self
+    ].
+    (height := height + figuresInset) > fontHeight ifTrue:[
+        fontHeight := height
+    ].
+
+    figuresWidth < (image2 widthOn:self) ifTrue:[
+        figuresWidth := image2 widthOn:self
+    ].
+
+!
+
+initialize
+    super initialize.
+    dblClickEvt := false
+! !
+
+!SelectionInTreeView methodsFor:'private'!
+
+figureFor:aNode
+    "access figure for a node
+    "
+    aNode hasChildren ifTrue:[
+        aNode isExpandable ifTrue:[ ^ self class imageClosed ]
+                          ifFalse:[ ^ self class imageOpened ]
+    ].
+  ^ self class imageItem
+!
+
+getListFromModel
+    "if I have a model, get my list from it using the listMessage.
+     If listMessage is nil, try aspectMessage for backward compatibilty.
+    "
+    |newList newSize msg|
+
+    model isNil ifTrue:[^ self].
+
+    (msg := listMsg) isNil ifTrue:[msg := aspectMsg].
+
+    msg notNil ifTrue:[listOfNodes := model perform:msg].
+
+    listOfNodes size == 0 ifTrue:[
+        listOfNodes := #()
+    ].
+    newList := listOfNodes collect:[:aNode| aNode name ].
+
+    dblClickEvt ifFalse:[
+        ^ super list:newList keepSelection:true
+    ].
+    list := newList.
+    self redrawFromLine:selection.
+    self contentsChanged.
+
+!
+
+indent
+    "get the indent
+    "
+    ^ figuresInset + figuresWidth
+!
+
+xOfFigureNode:aNode
+    "origin x where to draw the icon
+    "
+    ^ ((aNode level-1) * self indent) + figuresInset
+
+!
+
+xOfStringNode:aNode
+    "origin x where to draw the text( label )
+    "
+    ^ (self xOfFigureNode:aNode) + figuresInset + figuresWidth
+
+! !
+
+!SelectionInTreeView methodsFor:'selection'!
+
+doubleClicked
+    "handle a double click; collapse or expand selected entry
+     in case of having children
+    "
+    |node y|
+
+    dblClickEvt := true.
+
+    selection notNil ifTrue:[
+        node := listOfNodes at:selection.
+
+        node hasChildren ifTrue:[
+            node isExpandable ifTrue:[model expand]
+                             ifFalse:[model collapse]
+        ]
+    ].
+    dblClickEvt := false.
+    super doubleClicked.
+
+!
+
+selectedNode
+    "get the single selected node or nil
+    "
+    selection notNil ifTrue:[
+        selection isCollection ifFalse:[
+            ^ listOfNodes at:selection
+        ].
+        selection size == 1 ifTrue:[
+            ^ listOfNodes at:(selection first)
+        ]
+    ].
+  ^ nil
+! !
+
+!SelectionInTreeView class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.1 1997-07-03 08:24:27 ca Exp $'
+! !