SelectionInTreeView.st
changeset 811 a688e8f11bc6
parent 792 5a0af910519e
child 825 7ff8686e8774
--- a/SelectionInTreeView.st	Mon Mar 09 17:07:25 1998 +0100
+++ b/SelectionInTreeView.st	Mon Mar 09 17:08:44 1998 +0100
@@ -14,11 +14,11 @@
 SelectionInListView subclass:#SelectionInTreeView
 	instanceVariableNames:'validateDoubleClickBlock selectionHolder rootHolder imageWidth
 		showLines listOfNodes imageInset textInset labelOffsetY lineMask
-		lineColor openIndicator computeResources closeIndicator showRoot
-		extentOpenIndicator extentCloseIndicator showDirectoryIndicator
-		showDirectoryIndicatorForRoot indicatorExtentDiv2 imageOpened
-		imageClosed imageItem discardMotionEvents registeredImages'
-	classVariableNames:'ImageOpened ImageClosed ImageItem OpenIndicator CloseIndicator'
+		lineColor computeResources showRoot showDirectoryIndicator
+		closeIndicator openIndicator showDirectoryIndicatorForRoot
+		imageOpened imageClosed imageItem discardMotionEvents
+		registeredImages'
+	classVariableNames:''
 	poolDictionaries:''
 	category:'Views-Text'
 !
@@ -123,78 +123,61 @@
 
 ! !
 
-!SelectionInTreeView class methodsFor:'default images'!
+!SelectionInTreeView class methodsFor:'resources'!
 
 closeIndicator
     <resource: #fileImage>
 
-    CloseIndicator isNil ifTrue:[
-        CloseIndicator := Image fromFile:('xpmBitmaps/plus.xpm').
-    ].
-  ^ CloseIndicator
-"
-CloseIndicator := nil
-"
+    ^ Icon
+        constantNamed:#plus
+        ifAbsentPut:[Image fromFile:('xpmBitmaps/plus.xpm')]
+
 
-    "Modified: / 29.10.1997 / 03:36:00 / cg"
+
+
+
+
 !
 
 imageClosed
     <resource: #fileImage>
 
-    ImageClosed isNil ifTrue:[
-        ImageClosed := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm').
-    ].
-  ^ ImageClosed
-"
-ImageClosed := nil
-"
+    ^ Icon
+        constantNamed:#directory
+        ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')]
 
-    "Modified: / 29.10.1997 / 03:36:05 / cg"
 !
 
 imageItem
     <resource: #fileImage>
 
-    ImageItem isNil ifTrue:[
-        ImageItem := Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')  
+    ^ Icon
+        constantNamed:#plainFile
+        ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')]
 
-    ].
-  ^ ImageItem
-"
-ImageItem := nil
-"
+
 
-    "Modified: / 29.10.1997 / 03:36:10 / cg"
+
+
 !
 
 imageOpened
     <resource: #fileImage>
 
-    ImageOpened isNil ifTrue:[
-        ImageOpened := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm').
+    ^ Icon
+        constantNamed:#directoryOpened
+        ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')]
 
-    ].
-  ^ ImageOpened
-"
-ImageOpened := nil
-"
-
-    "Modified: / 29.10.1997 / 03:36:15 / cg"
 !
 
 openIndicator
     <resource: #fileImage>
 
-    OpenIndicator isNil ifTrue:[
-        OpenIndicator := Image fromFile:('xpmBitmaps/minus.xpm').
-    ].
-  ^ OpenIndicator
-"
-OpenIndicator := nil
-"
+    ^ Icon
+        constantNamed:#minus
+        ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')]
 
-    "Modified: / 29.10.1997 / 03:36:21 / cg"
+
 ! !
 
 !SelectionInTreeView methodsFor:'accessing'!
@@ -452,24 +435,31 @@
         ]
     ] ifFalse:[
         (aModel isKindOf:TreeItem) ifTrue:[
-            something == #value ifTrue:[  
-                idx := self indexOfNode:aModel.
-
-                idx ~~ 0 ifTrue:[
-                    list at:idx put:(aModel name).
-                    self redrawLine:idx
-                ].
+            (something == #size or:[something == #children]) ifTrue:[
+                model recomputeList.
                 ^ self
             ].
-            something == #children ifTrue:[
-                ^ model recomputeList
-            ]
+
+            (idx := self indexOfNode:aModel) ~~ 0 ifTrue:[
+                something == #value ifTrue:[  
+                    list at:idx put:(aModel name).
+                    self redrawLine:idx.
+                    ^ self
+                ].
+
+                something == #indication ifTrue:[
+                    self redrawIndicatorLine:idx.
+                    ^ self
+                ].
+            ].
+            ^ self
         ]
     ].
     ^ super update:something with:aParameter from:aModel.
 
 
 
+
 ! !
 
 !SelectionInTreeView methodsFor:'drawing'!
@@ -537,10 +527,54 @@
     ]    
 !
 
+redrawIndicatorLine:aLineNr
+    "redraw the directory indicator for a line
+    "
+    |node ext img visLn
+     x  "{ Class:SmallInteger }"
+     y  "{ Class:SmallInteger }"
+     lv "{ Class:SmallInteger }"
+     dX "{ Class:SmallInteger }"
+    |
+
+    (     shown
+     and:[showDirectoryIndicator
+     and:[(visLn := self listLineToVisibleLine:aLineNr) notNil]]
+    ) ifFalse:[
+        ^ self
+    ].
+
+    node := listOfNodes at:aLineNr.
+
+    ((lv := node level) ~~ 1 or:[showDirectoryIndicatorForRoot]) ifFalse:[
+        ^ self
+    ].
+
+    (x := imageWidth // 2) odd ifTrue:[x := x + 1].
+    x := (self xOfFigureLevel:(lv - 1)) + x.
+
+    "/ draw directory indicator
+
+    img := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
+    ext := img extent // 2.
+    dX  := ext x.
+
+    (x + dX > 0 and:[(x := x - dX) < (width - margin)]) ifTrue:[
+        (self isInSelection:aLineNr) ifTrue:[ self paint:hilightFgColor on:hilightBgColor ]
+                                    ifFalse:[ self paint:fgColor on:bgColor ].
+
+        y := (self yOfVisibleLine:visLn) + (fontHeight // 2) - 1.
+        self displayForm:img x:x y:(y - ext y)
+    ].
+
+
+
+!
+
 redrawLinesX:x0 y:y0 toX:x1 start:start stop:stop
     "redraw from line to line without clearing the background
     "
-    |node image isSelected defLineColor rnode ext prnt
+    |node image extent isSelected defLineColor rnode prnt
      x       "{ Class:SmallInteger }"
      y       "{ Class:SmallInteger }"
      level   "{ Class:SmallInteger }"
@@ -608,7 +642,9 @@
 
                 "/ vertical line from previous to current form
                 (xCross >= x0 and:[level ~~ 1]) ifTrue:[
-                    lv := node parent children last == node ifTrue:[yCtr] ifFalse:[yBot].
+                    prnt := node parent children.
+                    prnt isEmpty ifTrue:[ ^ self ]. "/ error occured
+                    lv := prnt last == node ifTrue:[yCtr] ifFalse:[yBot].
                     self displayLineFromX:xCross y:yTop - 1 toX:xCross y:lv
                 ].
 
@@ -655,17 +691,12 @@
 
         (showDirectoryIndicator and:[node showIndicator]) ifTrue:[
             (level ~~ 1 or:[showDirectoryIndicatorForRoot]) ifTrue:[
-                node isCollapsable ifTrue:[
-                    image := openIndicator.
-                    ext := extentOpenIndicator.
-                ] ifFalse:[
-                    image := closeIndicator.
-                    ext := extentCloseIndicator.
-                ].
-                x := ext x.
+                image  := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
+                extent := image extent // 2.
+                x := extent x.
 
-                (xCross - x < x1 and:[xCross + x > x0]) ifTrue:[
-                    self displayForm:image x:(xCross - x) y:(yCtr - ext y)
+                (xCross + x > x0 and:[(x := xCross - x) < x1]) ifTrue:[
+                    self displayForm:image x:x y:(yCtr - extent y)
                 ]
             ]
         ].
@@ -673,6 +704,7 @@
         index := index + 1.
         yTop  := yBot.
     ]
+
 !
 
 redrawSelFrameForYs:aList fromX:x0 toX:x1
@@ -782,11 +814,11 @@
     ].
     node := listOfNodes at:lineNr.
 
-    (     validateDoubleClickBlock isNil
-     or:[(validateDoubleClickBlock value:node) ~~ false]
-    ) ifFalse:[
-        ^ super buttonPress:button x:x y:y
-    ].
+"/    (     validateDoubleClickBlock isNil
+"/     or:[(validateDoubleClickBlock value:node) ~~ false]
+"/    ) ifFalse:[
+"/        ^ super buttonPress:button x:x y:y
+"/    ].
     discardMotionEvents := true.
     dragIsActive  := false.
     clickPosition := nil.
@@ -880,6 +912,38 @@
     self gotoLine:index
 !
 
+keyPress:key x:x y:y
+    "handle keyboard input"
+
+    <resource: #keyboard ( #CursorLeft #CursorRight ) >
+
+    |idx node inc end|     
+
+    enabled ifFalse:[
+        ^ self
+    ].
+
+    (key == #CursorLeft or:[key == #CursorRight]) ifTrue:[
+        (idx := self selectedIndex) == 0 ifTrue:[ ^ self ].
+
+        (key == #CursorLeft) ifTrue:[ inc := -1. end := 0 ]
+                            ifFalse:[ inc :=  1. end := 1 + listOfNodes size ].
+
+        [(idx := idx + inc) ~~ end] whileTrue:[
+            node := listOfNodes at:idx.
+            node isDirectory ifTrue:[
+                ^ self key:key select:idx x:x y:y
+            ]
+        ].
+        ^ self
+    ].
+    ^ super keyPress:key x:x y:y
+
+
+
+
+!
+
 redrawX:x y:y width:w height:h
     "a region must be redrawn"
 
@@ -957,15 +1021,14 @@
 destroy
     "remove dependencies
     "
-    rootHolder notNil ifTrue:[
-        rootHolder removeDependent:self
-    ].
-    selectionHolder notNil ifTrue:[
-        selectionHolder removeDependent:self
+    rootHolder removeDependent:self.
+    selectionHolder removeDependent:self.
+
+    model notNil ifTrue:[
+        model stopRunningTasks
     ].
     super destroy.
 
-
 !
 
 fetchDefaultImages
@@ -1064,6 +1127,34 @@
     self  refetchDeviceResources.
 !
 
+recomputeDirectoryIndicator
+    "setup attributes used by directory indicator
+    "
+    |x w|
+
+    imageInset := 0.
+
+    (showDirectoryIndicator and:[computeResources not]) ifFalse:[
+        ^ self
+    ].
+    openIndicator isNil ifTrue:[
+        openIndicator  := self imageOnDevice:(self class openIndicator)
+    ].
+    closeIndicator isNil ifTrue:[
+        closeIndicator := self imageOnDevice:(self class closeIndicator)
+    ].
+    x := (openIndicator width) max:(closeIndicator width).
+    x := x // 2.
+    w := imageWidth // 2.
+
+    (x := x + self class minImageInset) > w ifTrue:[
+        imageInset := x - w.
+    ].
+
+
+
+!
+
 refetchDeviceResources
     "reinitialize heavily used device resources - to avoid rendering
      images again and again later
@@ -1120,9 +1211,14 @@
     "
     |model|
 
+    model notNil ifTrue:[
+        model stopRunningTasks
+    ].
+
     model := aModel ? (SelectionInTree new).
     model showRoot:showRoot.
     super model:model.
+
 !
 
 rootFromModel
@@ -1226,60 +1322,88 @@
 
     node := listOfNodes at:anIndex.
 
-    node hasChildren ifTrue:[
-        node isExpandable ifTrue:[
-            doExpand ifFalse:[^ self].
-            node expand
-        ] ifFalse:[
-            doExpand ifTrue:[^ self].
-            node collapse
-        ].
+    node hasChildren ifFalse:[          "/ no children exists
+        ^ self
+    ].
+
+    node isExpandable ifTrue:[
+        doExpand ifFalse:[^ self].      "/ already collapsed
+        node expand
+    ] ifFalse:[
+        doExpand ifTrue:[^ self].       "/ already expanded
+        node collapse
+    ].
+
+    node children isEmpty ifTrue:[
+     "/ no children; redraw selected line (image might change)
+        self redrawLine:anIndex.
+    ] ifFalse:[
+     "/ with children; update list and redraw to end.
+        model removeDependent:self.
+        model recomputeList.
+        model addDependent:self.
+        list := self listFromModel.
+        self redrawFromLine:anIndex.
+        self contentsChanged.
+    ]
+
+! !
+
+!SelectionInTreeView methodsFor:'private - drag and drop'!
 
-        node children isEmpty ifTrue:[
-            "/ no children; redraw selected line (image might change)
-            self redrawLine:anIndex.
-        ] ifFalse:[
-            "/ with children; update list and redraw to end.
-            model removeDependent:self.
-            model recomputeList.
-            model addDependent:self.
-            list := self listFromModel.
-            self redrawFromLine:anIndex.
-            self contentsChanged.
-        ]
-    ]
+collectionOfDragObjects
+    "returns collection of dragable objects assigned to selection
+     Here, by default, a collection of text-dragObjects is generated;
+     however, if a dragObjectConverter is defined, that one gets a chance
+     to convert as appropriate."
+
+    |collection converted selection dLbl dObj node|
+
+    selection  := self selectionAsCollection.
+
+    collection := selection collect:[:nr|
+        node := listOfNodes at:nr.
+        dObj := self dragObjectForNode:node.
+        dObj theObject:(node contents).
+        dLbl := LabelAndIcon icon:(self figureFor:node) string:(list at:nr).
+        dObj displayObject:dLbl.
+        dObj
+    ].
+
+    dragObjectConverter notNil ifTrue:[
+        converted := OrderedCollection new.
+        collection keysAndValuesDo:[:nr :obj | 
+            (dObj := dragObjectConverter value:obj) notNil ifTrue:[
+                dLbl := LabelAndIcon icon:(self figureFor:(listOfNodes at:nr)) string:(list at:nr).
+                converted displayObject:dLbl.
+                converted add:dObj
+            ]
+        ].
+        collection := converted
+    ].
+    ^ collection.
+
+
 
 !
 
-recomputeDirectoryIndicator
-    "setup attributes used by directory indicator
+dragObjectForNode:aNode
+    "returns the dragable object for a node; could be redefined in subclass
     "
-    |x1 x2 y|
+    ^ DropObject new:aNode.
 
-    imageInset := 0.
+
+!
 
-    (showDirectoryIndicator and:[computeResources not]) ifFalse:[
-        ^ self
-    ].
-    openIndicator isNil ifTrue:[
-        openIndicator  := self imageOnDevice:(self class openIndicator)
-    ].
-    closeIndicator isNil ifTrue:[
-        closeIndicator := self imageOnDevice:(self class closeIndicator)
-    ].
+startDragX:x y:y
+    "start drag
+    "
+    dragIsActive := true.
 
-    x1 := (openIndicator widthOn:self) // 2.
-    y  := openIndicator heightOn:self.
-    extentOpenIndicator := Point x:x1 y:(y // 2).
-    x2 := (closeIndicator widthOn:self) // 2.
-    y  := closeIndicator heightOn:self.
-    extentCloseIndicator := Point x:x2 y:(y // 2).
+    DragAndDropManager startDrag:(self collectionOfDragObjects)
+                            from:self
+                           atEnd:endDragAction
 
-    x2 > x1 ifTrue:[x1 := x2].
-
-    (x1 := x1 + self class minImageInset) > (imageWidth // 2) ifTrue:[
-        imageInset := x1 - (imageWidth // 2).
-    ].
 
 ! !
 
@@ -1607,33 +1731,10 @@
 selectedNodeExpand:doExpand
     "collapse or expand selected node
     "
-    |node index|
+    |index|
 
     (index := self selectedIndex) ~~ 0 ifTrue:[
-        node := listOfNodes at:index.
-
-        node hasChildren ifTrue:[
-            node isExpandable ifTrue:[
-                doExpand ifFalse:[^ self].
-                node expand
-            ] ifFalse:[
-                doExpand ifTrue:[^ self].
-                node collapse
-            ].
-
-            node children isEmpty ifTrue:[
-                "/ no children; redraw selected line (image might change)
-                self redrawLine:index.
-            ] ifFalse:[
-                "/ with children; update list and redraw to end.
-                model removeDependent:self.
-                model recomputeList.
-                model addDependent:self.
-                list := self listFromModel.
-                self redrawFromLine:index.
-                self contentsChanged.
-            ]
-        ]
+        self nodeAt:index expand:doExpand
     ].
 
 !
@@ -1649,5 +1750,5 @@
 !SelectionInTreeView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.49 1998-02-26 07:43:55 ca Exp $'
+    ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.50 1998-03-09 16:08:44 ca Exp $'
 ! !