# Drag & Drop Example by Bryan Oakley
# bryan@bitmover.com
# http://purl.oclc.org/net/oakley
#
# The way bindings work, as long as a button is pressed, the widget
# that handles the press event is the only widget that sees the
# motion event (someobody correct me if I'm wrong or if it's
# slightly more complex than that).
#
# But, you can use this to your advantage. Remember that you can get
# the absolute (root) x and y coordinates of the mouse with your
# event. And we have the command [winfo containing], which tells us
# which widget "contains" this x,y position. So, your command that
# handles the motion can modify the appearance of widgets that it
# moves over, or perhaps send them events to process (such as
# <<DragEnter>>, for example).
#
# Here's a quick hack I just threw together to illustrate the
# possibilities. The example is contrived and hard-coded for some
# specific widgets, but you can see the general idea.
catch {destroy .l1 .l2 .reset}
label .l1 \
-text "Right-click and drag this label..." \
-bd 2 \
-padx 10 \
-relief groove \
-height 4
pack .l1 -fill x -pady 10
label .l2 \
-text "... and drag it over this label" \
-bd 2 \
-padx 10 \
-relief groove \
-height 4
pack .l2 -fill x -pady 10
bind .l1 <ButtonPress-3> [list drag start %W]
bind .l1 <Motion> [list drag motion %X %Y]
bind .l1 <ButtonRelease-3> [list drag stop %X %Y]
bind .l2 <<DragOver>> [list drag over %W]
bind .l2 <<DragLeave>> [list drag leave %W]
bind .l2 <<DragDrop>> [list drag drop %W]
button .reset -text "Reset" -command {
.l2 configure \
-foreground black \
-text "... and drag it over this label"
}
pack .reset
proc drag {command args} {
global _dragging
global _lastwidget
global _dragwidget
switch $command {
init {
# one-time code to initialize variables
set _lastwidget {}
set _dragging 0
}
start {
set w [lindex $args 0]
set _dragging 1
set _lastwidget $w
set _dragwidget $w
$w configure -cursor gobbler
}
motion {
if {!$_dragging} {return}
set x [lindex $args 0]
set y [lindex $args 1]
set w [winfo containing $x $y]
if {$w != $_lastwidget && [winfo exists $_lastwidget]} {
event generate $_lastwidget <<DragLeave>>
}
set _lastwidget $w
if {[winfo exists $w]} {
event generate $w <<DragOver>>
}
if {$w == ".l2"} {
$_dragwidget configure -cursor gumby
} else {
$_dragwidget configure -cursor gobbler
}
}
stop {
if {!$_dragging} {return}
set x [lindex $args 0]
set y [lindex $args 1]
set w [winfo containing $x $y]
if {[winfo exists $w]} {
event generate $w <<DragLeave>>
event generate $w <<DragDrop>>
}
set _dragging 0
$_dragwidget configure -cursor {}
}
over {
if {!$_dragging} {return}
set w [lindex $args 0]
$w configure -relief raised
}
leave {
if {!$_dragging} {return}
set w [lindex $args 0]
$w configure -relief groove
$w configure -cursor {}
}
drop {
set w [lindex $args 0]
$w configure -foreground red -text "THUD!!!"
}
}
}
drag initIf anyone is interested in producing a more complete drag and drop system (i.e. one that can interact with non-Tk applications on the platform you are using,) then I advise you to have a good look at XDND [1] when you come to working out how to interface with the Unix/X world. CDE/Motif support would be even neater, but the documentation there is abysmal and the Mofif DnD protocol is a bit of a stinker...Offix DND [2], for all that it is really easy to support, is so simple as to be verifiably brain dead. It does not provide any reasonable level of feedback to the user at all.DKFNEM - Georgios Petasis notes on news:comp.lang.tcl
: "...[T]he tkdnd extension (http://sourceforge.net/projects/tkdnd) that already has these capabilities (XDND dnd, Motif drops & Windows OLE dnd) and suports text, file & image dnd. Tkdnd has been available for a couple of years and I think it should be advertised, so as not to give the impression that tk lacks dnd support...George"