--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/HierarchicalDropTargetController.st	Tue Mar 25 11:11:43 2008 +0100
@@ -0,0 +1,205 @@
+"{ Package: 'stx:libwidg2' }"
+
+Object subclass:#HierarchicalDropTargetController
+	instanceVariableNames:'expandBlock highlightMode receiver dropOverLine dropSelector
+		canDropSelector'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Interface-DragAndDrop'
+!
+
+
+!HierarchicalDropTargetController class methodsFor:'instance creation'!
+
+receiver:aReceiver argument:anArgument dropSelector:aDropSelector canDropSelector:aCanDropSelector
+    |target|
+
+    target := self new.
+    ^ target receiver:aReceiver argument:anArgument dropSelector:aDropSelector canDropSelector:aCanDropSelector
+!
+
+receiver:aReceiver dropSelector:aDropSelector canDropSelector:aCanDropSelector
+    ^ self receiver:aReceiver argument:nil dropSelector:aDropSelector canDropSelector:aCanDropSelector
+! !
+
+!HierarchicalDropTargetController class methodsFor:'constants'!
+
+delayMilliSecondsBeforeExpand
+    ^ 1000
+! !
+
+!HierarchicalDropTargetController methodsFor:'drop actions'!
+
+canDrop:aDropContext
+    "return true, if the DropContext can be dropped into the list of items"
+
+    dropOverLine isNil ifTrue:[ ^ false ].      "/ never setup by dropEnter:
+    dropOverLine > 0 ifFalse:[ ^ false ].
+
+    canDropSelector numArgs == 2 ifTrue:[
+        ^ receiver perform:canDropSelector with:aDropContext with:dropOverLine .
+    ].
+    ^ receiver perform:canDropSelector with:aDropContext.
+!
+
+drop:aDropContext
+    "drop the dropContext into the hierachical list of items
+    "
+    |lnNr|
+
+    lnNr := dropOverLine.
+    lnNr isNil ifTrue:[^ false ].      "/ never setup by dropEnter:
+
+    self dropLeave:aDropContext.
+
+    dropSelector isNil ifTrue:[  ^ false ].
+
+    dropSelector numArgs == 2 ifTrue:[
+        receiver perform:dropSelector with:aDropContext with:lnNr .
+    ] ifFalse:[
+        receiver perform:dropSelector with:aDropContext.
+    ].
+    ^ true
+!
+
+dropEnter:aDropContext
+    "a drop operation enters my widget; set the highlightMode in the target widget"
+
+    |widget|
+
+    dropOverLine := 0.
+
+    widget := aDropContext targetWidget.
+    highlightMode := widget highlightMode.
+
+    highlightMode notNil ifTrue:[
+        aDropContext saveDraw:[
+            widget highlightMode: #dropMode.
+            widget windowGroup processExposeEvents.
+        ].
+    ].
+!
+
+dropLeave:aDropContext
+    "the widget is leaved; restore drop indications drawn ...
+    "
+    self changeDropLineTo:nil in:aDropContext.
+!
+
+dropOver:aDropContext
+    |target lineNr|
+
+    dropOverLine isNil ifTrue:[^ self ].       "/ never setup by dropEnter:
+
+    target := aDropContext targetWidget.
+    lineNr := target yVisibleToLineNr:(aDropContext targetPoint y).
+
+    lineNr isNil ifTrue:[ lineNr := 0. ].
+
+    lineNr > target size ifTrue:[
+        lineNr := 0.
+    ].
+    self changeDropLineTo:lineNr in:aDropContext.
+! !
+
+!HierarchicalDropTargetController methodsFor:'instance creation'!
+
+receiver:aReceiver argument:anArgument dropSelector:aDropSelector canDropSelector:aCanDropSelector
+    |target|
+
+    receiver        := aReceiver.
+    dropSelector    := aDropSelector.
+    canDropSelector := aCanDropSelector.
+
+    target := DropTarget
+        receiver:self
+        argument:anArgument
+        dropSelector:#drop:
+        canDropSelector:#canDrop:.
+
+    target enterSelector:#dropEnter:.
+    target leaveSelector:#dropLeave:.
+    target overSelector:#dropOver:.
+
+    ^ target
+! !
+
+!HierarchicalDropTargetController methodsFor:'private'!
+
+changeDropLineTo:aLineOrNil in:aDropContext
+    |x0 y0 y1 view item bgColor fgColor processEvents|
+
+    aLineOrNil == dropOverLine ifTrue:[ ^ self ]. "/ nothing changed
+
+    view := aDropContext targetWidget.
+
+    expandBlock notNil ifTrue:[
+        Processor removeTimedBlock:expandBlock.
+    ].
+    processEvents := (aLineOrNil isNil).
+    aDropContext contentsWillChange.
+
+    (aLineOrNil isNil and:[highlightMode notNil]) ifTrue:[
+        "/ resore the selection mode
+        view highlightMode: highlightMode.
+        highlightMode := nil.
+        processEvents := true.
+    ].
+    (dropOverLine notNil and:[dropOverLine ~~ 0]) ifTrue:[
+        "/ invalidate old line
+        view invalidateLineAt:dropOverLine.
+        processEvents := true.
+    ].
+    processEvents ifTrue:[
+        view windowGroup processExposeEvents.
+    ].
+
+    dropOverLine := aLineOrNil.
+
+    (dropOverLine isNil or:[dropOverLine == 0]) ifTrue:[
+        ^ self
+    ].
+    item := view at:dropOverLine ifAbsent:nil.
+    item isNil ifTrue:[ ^ self ].
+
+    y0 := view yVisibleOfLine:dropOverLine.
+    y1 := view yVisibleOfLine:(dropOverLine + 1).
+    x0 := view xVisibleOfTextAtLevel:item level.
+
+    bgColor := view hilightBackgroundColor.
+    fgColor := view hilightForegroundColor.
+
+    view paint: bgColor.
+    view fillRectangle:(Rectangle left:(x0 - 2) top:y0 width:(item widthOn:view) + 4 height:(y1 - y0)).
+
+    view paint:fgColor on:bgColor.
+    item displayOn:view x:x0 y:y0 h:(y1 - y0).
+
+    (item isExpanded not and:[item canExpand]) ifTrue:[
+        Processor 
+            addTimedBlock: [self expandForDrop:aDropContext at:aLineOrNil]
+            afterMilliseconds:(self class delayMilliSecondsBeforeExpand).
+    ].
+!
+
+expandForDrop:aDropContext at:aLnNr
+    |item view|
+
+    expandBlock := nil.
+    aLnNr == dropOverLine ifFalse:[ ^ self].
+
+    view := aDropContext targetWidget.
+    item := view at:aLnNr ifAbsent:nil.
+    item isNil ifTrue:[^ self].
+
+    aDropContext saveDraw:[
+        item expand.
+        view windowGroup processExposeEvents.
+    ].
+! !
+
+!HierarchicalDropTargetController class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalDropTargetController.st,v 1.1 2008-03-25 10:11:43 ab Exp $'
+! !