# Code to make listbox items draggable
#
# This code is in the public domain. See the main program
# file for a disclaimer of liability.
#
# $Header: /home/neil/src/tcl/calc/RCS/mlbid,v 1.3 2000/12/28 14:45:48 neil Exp $

# MakeListboxItemsDraggable makes the items in "lb" draggable.
# "lb" is assumed to be the path name of a listbox widget.

proc MakeListboxItemsDraggable {lb} {
    global listboxDragInfo

    bind $lb <ButtonPress-1> [list __MLID__MarkSpot $lb %x %y]
    bind $lb <Button1-Motion> [list __MLID__Drag $lb %x %y]
}

# __MLID__MarkSpot marks the current location of the cursor
# in listbox "lb".

proc __MLID__MarkSpot {lb x y} {
    global listboxDragInfo

    set listboxDragInfo(index,$lb) [$lb index "@${x},${y}"]
}

# __MLID__Drag implements the actual dragging of listbox
# items in "lb".

proc __MLID__Drag {lb x y} {
    global listboxDragInfo

    set newIndex  [$lb index "@${x},${y}"]
    if {$newIndex > $listboxDragInfo(index,$lb)} {
	# We're dragging down.

	set oldInfo [$lb get $listboxDragInfo(index,$lb)]
	$lb insert [expr {$newIndex + 1}] $oldInfo
	$lb delete $listboxDragInfo(index,$lb)
	set listboxDragInfo(index,$lb) $newIndex
    } elseif {$newIndex < $listboxDragInfo(index,$lb)} {
	# We're dragging up.

	set oldInfo [$lb get $listboxDragInfo(index,$lb)]
	$lb insert $newIndex $oldInfo
	$lb delete [expr {$listboxDragInfo(index,$lb) + 1}]
	set listboxDragInfo(index,$lb) $newIndex
    }

    $lb see $listboxDragInfo(index,$lb)
}

