[Kevin Walzer]: For some time I've been looking for a simple mechanism to provide drag-and-drop within a Tk application. The idea is to register widgets to be drag sources and/or drop targets, to provide a means for visual display of the drag, and a mechanism to execute a callback when a valid drop is made. While there are lots of code snippets and packages available at the wiki and elsewhere, they are either too complicated (such as [BWidgets] drag and drop), or binary extensionsnot supported on all platforms (such as [TkDND]).

The result is that I have developed my own package, called SimpleDND. The basic code, including a demo, is below. If others find this useful, I may submit it to [tklib] in the future. Feedback and improvements are also welcome!

namespace eval simplednd {


    #create the drag icon with text and image; then hide the icon
    proc makeDragIcon {txt img} {

	toplevel .dnd

	wm overrideredirect .dnd true

	label .dnd.view  -image $img -text $txt -compound left
	pack .dnd.view

	wm withdraw .dnd

    }

    #register widget to respond to drag events: widget to register, its target widget, callback to associate with this drag event, text for the drag label, and image for the drag label
    proc dragRegister {w target cmd txt img } {

	catch {simplednd::makeDragIcon $txt $img}


	puts "$w registered as dragsite with $target as the drop target"

	#binding for when drag motion begins
	bind $w <B1-Motion> [list [namespace current]::dragMove %W %X %Y $txt $img]

	#binding for when drop event occurs
	bind $w <ButtonRelease-1> [list [namespace current]::dragStop %W %X %Y $target $cmd ]

    }




    #drag motion with following args: source widget, cursor x position, cursor y position, label text, label image
    proc dragMove {w x y txt img} {

	wm deiconify .dnd

	#configure drag icon with customized text and image
	.dnd.view configure -text [[namespace current]::getText $w]  -image [[namespace current]::getImg $w]
	catch {raise .dnd}

	set x [expr {$x - ([winfo reqwidth .dnd] / 2)}]
	set y [expr {$y - [winfo reqheight .dnd] + 4}]
	wm geometry .dnd +$x+$y 

	update


    }

    #dragstop/drop event with following args:  source widget, cursor x position, cursor y position, target widget, callback: if over drop target, execuate callback; otherwise simply return
    proc dragStop {w x y target cmd} {

	wm withdraw .dnd

	if {[winfo containing $x $y] != $target} {
	    puts "target $w not reached"
	} else {

	    focus -force $target
	    eval $cmd
	    
	}
    }


    #demo package
    proc demo {} {


	#create image for demo
	image create photo dnd_demo -data {R0lGODlhEAAQALMAAAAAAMbGxv//////////////////////////////////\
					  /////////////////////yH5BAEAAAEALAAAAAAQABAAAAQwMMhJ6wQ4YyuB\
					  +OBmeeDnAWNpZhWpmu0bxrKAUu57X7VNy7tOLxjIqYiapIjDbDYjADs=}

	listbox .l -selectmode single -activestyle none
	listbox .b -selectmode single -activestyle none

	foreach item {do re mi} {
	    .l insert end $item
	}

	foreach item {fa so la} {
	    .b insert end $item
	}
	

	pack .l -side left
	pack .b -side right
	

	#register drag sources with empty text and image to initialize
	dragRegister .l .b [namespace current]::move_l {} {}

	dragRegister .b .l [namespace current]::move_b {} {}

    }

    #callback for demo
    proc move_l {} {

	set item [lindex [.l get [.l curselection]]]
	.b insert end $item
	
	.l delete [.l curselection]
    }

    #second callback for demo
    proc move_b {} {

	set item [lindex [.b get [.b curselection]]]
	.l insert end $item
	
	.b delete [.b curselection]
    }

    #utility proc to get text for icon label; may need replacing in code
    proc getText {w} {

	set item [lindex [$w get [$w curselection]]]
	return $item

    }

    #utility proc to get image for icon label; may need replacing in code
    proc getImg {w} {

	return dnd_demo

    }

    namespace export *

}




----
!!!!!!
%| enter categories here |%
!!!!!!