"{ 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 $'
! !