#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
        exec wish8.4 "$0" ${1+"$@"}

## Check Tk version:
package require Tk 8.3

if {$::tcl_version == "8.3" && ![package vsatisfies $::tcl_patchLevel 8.3.3]} {
    tk_messageBox -type ok -icon error \
            -message "  =====> TkDND requires at least tk8.3.3! <====="
    exit 1
}

catch {console show}
if {[string equal $tcl_platform(platform) unix]} {
    option add *font {arial 12}
}
set ::win_bg [. cget -background]

## This is the main dnd demo...
## Author: George Petasis, petasis@iit.demokritos.gr
set ME  [file normalize [info script]]
set DIR [file dirname $::ME]
## Make sure that we can find the tkdnd package even if the user has not yet
## installed the package.
lappend auto_path [file dirname $DIR] [file dirname $DIR]/lib
package require tkdnd
if {[catch {package require Img} version]} {
    set image_formats none
} else {
    set image_formats image/tiff
    puts "Found Img package, version $version"
}

image create photo itk -data {
R0lGODlhKwBAAPf/AP//////zP//mf//Zv//M///AP/M///MzP/Mmf/MZv/M
M//MAP+Z//+ZzP+Zmf+ZZv+ZM/+ZAP9m//9mzP9mmf9mZv9mM/9mAP8z//8z
zP8zmf8zZv8zM/8zAP8A//8AzP8Amf8AZv8AM/8AAMz//8z/zMz/mcz/Zsz/
M8z/AMzM/8zMzMzMmczMZszMM8zMAMyZ/8yZzMyZmcyZZsyZM8yZAMxm/8xm
zMxmmcxmZsxmM8xmAMwz/8wzzMwzmcwzZswzM8wzAMwA/8wAzMwAmcwAZswA
M8wAAJn//5n/zJn/mZn/Zpn/M5n/AJnM/5nMzJnMmZnMZpnMM5nMAJmZ/5mZ
zJmZmZmZZpmZM5mZAJlm/5lmzJlmmZlmZplmM5lmAJkz/5kzzJkzmZkzZpkz
M5kzAJkA/5kAzJkAmZkAZpkAM5kAAGb//2b/zGb/mWb/Zmb/M2b/AGbM/2bM
zGbMmWbMZmbMM2bMAGaZ/2aZzGaZmWaZZmaZM2aZAGZm/2ZmzGZmmWZmZmZm
M2ZmAGYz/2YzzGYzmWYzZmYzM2YzAGYA/2YAzGYAmWYAZmYAM2YAADP//zP/
zDP/mTP/ZjP/MzP/ADPM/zPMzDPMmTPMZjPMMzPMADOZ/zOZzDOZmTOZZjOZ
MzOZADNm/zNmzDNmmTNmZjNmMzNmADMz/zMzzDMzmTMzZjMzMzMzADMA/zMA
zDMAmTMAZjMAMzMAAAD//wD/zAD/mQD/ZgD/MwD/AADM/wDMzADMmQDMZgDM
MwDMAACZ/wCZzACZmQCZZgCZMwCZAABm/wBmzABmmQBmZgBmMwBmAAAz/wAz
zAAzmQAzZgAzMwAzAAAA/wAAzAAAmQAAZgAAM+4AAN0AALsAAKoAAIgAAHcA
AFUAAEQAACIAABEAAADuAADdAAC7AACqAACIAAB3AABVAABEAAAiAAARAAAA
7gAA3QAAuwAAqgAAiAAAdwAAVQAARAAAIgAAEe7u7t3d3bu7u6qqqoiIiHd3
d1VVVURERCIiIhEREQAAACwAAAAAKwBAAAAI/wABCBxIsCDBevYOKHRwwKDD
gvUUHkDgoKKMGTky5tABpCOQICBBAsnR8KHBAx9DqlzJsiUQGRIpWpShMWHL
mzhztrRXL6XOn0CDAAHQM6jRnEMB+Lx5JOSRpkdX6hC4tOWOkDWuRlWZg2rO
BTueRihQYytXry2P7FgQRC1bsypnCNTBtEaNpmChOm1rVIbAHEx3hN0RQS/f
BwccGHXwN3DbCGGdAjlQ78kTHYZxMgYAWGcElUeA1MuDzJkzfUFLdg5cGGTo
A3lMmz6UujHOI5D1Oogte1VQ0QJneHZaoYps02RU5g7yWWVSADKGh7xXWjYi
bCoXFMYdWeTA6DmbH//Jwdu0b6Eh8wbRGnKqQMU5tR6RUR05GXz1cuDF2fW9
zu5WHGcaMsg84YBazbXUHwDw/QQEIAKa9gw+DmSTVWYhyeUfUECQEqEzqxyg
X4It+SXQAb95GOE+KK2HYUibAYAihyoKmM+B7N0U44xAqUhKfTLQ9VNJMgLV
1CogAlIdKTO8yBKR9nAYBJKH5CObPlXdBJxARelUEZJd6GEeXw4elOVKRyDw
hIdhIscRhwWduZIDHj6TgyfmrYDZT+4NJKdTMni4SqAD3vPnWQN1eRuhg6qI
DAJB9UnUoW09AGGjppFyIJwDRanTERVAeAg+1QGyaZkD8XibDlYeQp1p+jz/
4ORKzxXpYKuvOjOGrBzWkyqHXTjjanVd6Nfrr0DlgMywpq0GFJEN5hQaMqvc
4+EhFjirE7RGBkHKKvh4eN+pQw4ULU4frYKpM8jIMOtKCJj703gHkPKMDHg6
Q4qxQMV4Lk7U3ctbPkC8q1KM4H2ag4c4xNbuUQgbpWwXxpGyZ1AmAiCcUfro
Y9wY2PU1kLY/3UdbVBpyBhpOM7gbhAM+6QWEAxevtKCzQu7VVg4HHgFzSB2F
JOJTLN0MtKJAvDlezxlBJaLQOSRd9Mjt1UPXETM4wPNTWx+hg7GTbRzEATPM
kGWfOYtW8NjRfbR0U0CIjQC/CiGA4XNpA3B1RUFca50DpCCZDRICZr9G0r/P
LYVRSBullJHbUYP0eGgbfV1V4qDpRbRrMqe0eVtP3e0nXFttSSnpO6GFulEN
Kbr6s5O+zrqtDp7+E2M8epRRyxUpVA9CEtVd0fAyFF+2RhnpoEPrCPhu0vPQ
PxQQADs=
====}

############################################################################
##  Some utilities...
##
proc preview_selection {} {
    ## Use selection to preview data :-)
    puts ############################################################
    foreach type {STRING ATOM INTEGER image/xpm} {
        catch {selection get -selection XdndSelection -type $type} data
        puts "Type:$type $data"
    }
};# preview_selection

proc Drag {action actions type win X Y x y {data {}}} {
    set t [winfo toplevel $win]
    if {[string length $data] > 60} {
      set data [string range $data 0 60]...
    }
    if {[string equal $t .]} {
        .drag config -text \
                "<Drag>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
        foreach w {.dragleave .drop} {$w conf -text {}}
    } else {
        .t.drag config -text \
                "<Drag>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
        foreach w {.t.dragleave .t.drop} {$w conf -text {}}
    }
    update
    if {[lsearch -exact $actions ask] != -1} {
        set ret_action ask
    } elseif {[lsearch -exact $actions copy] != -1} {
        set ret_action copy
    } else {
        set ret_action $action
    }
    return $ret_action
}

proc DragRefuse {action actions type win X Y x y} {
    $win configure -bg red
    update
    return none
}

proc DragEnter {action actions type win X Y x y {data {}}} {
    set t [winfo toplevel $win]
    if {[string length $data] > 60} {
      set data [string range $data 0 60]...
    }
    if {[string equal $t .]} {
        .dragenter config -text \
                "<DragEnter>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
        foreach w {.drag .dragleave .drop} {$w conf -text {}}
    } else {
        .t.dragenter config -text \
                "<DragEnter>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
        foreach w {.t.drag .t.dragleave .t.drop .t.getdata} {$w conf -text {}}
    }
    $win configure -bg green
    update
    return $action
}

proc DragLeave {action actions type win X Y x y {data {}}} {
    set t [winfo toplevel $win]
    if {[string length $data] > 60} {
      set data [string range $data 0 60]...
    }
    if {[string equal $t .]} {
        .dragleave config -text \
                "<DragLeave>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
        foreach w {.drag .dragenter .drop} {$w conf -text {}}
    } else {
        .t.dragleave config -text \
                "<DragLeave>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
        foreach w {.t.drag .t.dragenter .t.drop .t.getdata} {$w conf -text {}}
    }
    $win configure -bg $::win_bg
    update
}

proc Drop {action actions type win X Y x y data} {
    set t [winfo toplevel $win]
    if {[string match text/* $type]} {
        if {[string length $data] > 250} {
            set Data "[string range $data 0 250]..."
        } else {
            set Data $data
        }
    } else {
        set Data "Binary data dropped..."
    }
    if {[string equal $t .]} {
        .drop config -text \
                "<Drop>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$Data\""
        foreach w {.drag .dragleave .dragenter} {$w conf -text {}}
    } else {
        .t.drop config -text \
                "<Drop>: Type=$type, Action=$action ($actions),\
                win=$win, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$Data\""
        foreach w {.t.drag .t.dragleave .t.dragenter} {$w conf -text {}}
    }
    switch -glob $type {
        image/* {
            switch [string range $type 6 end] {
                xpm {image create pixmap itk -data $data}
                xbm {image create bitmap itk -data $data}
                default {image create photo itk -data $data}
            }
            $win configure -image itk -bg $::win_bg
        }
        TK_COLOR {$win configure -bg $data}
        default {$win configure -text $data -bg $::win_bg -image {}}
    }
}

proc GetData {action actions type win X Y x y} {
    .t.getdata conf -text \
            "<GetData>: Type=$type, Action=$action ($actions),\
            win=$win, X=$X, Y=$Y, x=$x, y=$y"
    switch -glob $type {
        image/*       {
            set image_data [itk data -format [string range $type 6 end]]
            binary scan $image_data {}
            return $image_data
        }
        text/uri-list {
            return "file:[file join [pwd] [file tail $::ME]]"
        }
        text/plain    {return "-- DND DATA -- ($type-$action)"}
        text/plain;charset=UTF-8 {
            set text "-- \u0395\u03bb\u03bb\u03b7\u03bd\u03b9\u03ba\u03ac\
                    (That means Greek) -- ($type-$action)"
            return $text
        }
        TK_COLOR      {return darkgreen}
        default       {return "-- DND DATA -- ($type-$action)"}
    }
    update
}

proc BindTarget {win Type {p 50}} {
    foreach type $Type {
        dnd bindtarget $win $type <DragEnter> \
                {DragEnter %A %a %T %W %X %Y %x %y %D} $p
        dnd bindtarget $win $type <Drag> \
                {Drag %A %a %T %W %X %Y %x %y %D} $p
        dnd bindtarget $win $type <DragLeave> \
                {DragLeave %A %a %T %W %X %Y %x %y %D} $p
        dnd bindtarget $win $type <Drop> \
                {Drop %A %a %T %W %X %Y %x %y %D} $p
    }
}

image create photo doc   -file $::DIR/doc-img.gif
image create photo nodoc -file $::DIR/nodoc-img.gif

proc CursorWindow {} {
    set win .cursor_window
    catch {destroy .cursor_window}
    toplevel .cursor_window
    wm withdraw .cursor_window
    wm overrideredirect .cursor_window 1
    pack [canvas .cursor_window.workarea -bd 0 -highlightthick 0 \
            -height 32 -width 32]
    .cursor_window.workarea create image 3 4 -anchor nw -image doc -tags image
    update idletasks
    shape set .cursor_window.workarea -offset 3 4 bitmap @$::DIR/doc-mask.xbm
    shape set .cursor_window window .cursor_window.workarea
    wm deiconify .cursor_window
}
proc CursorCallback {action} {
    if {[string length $action]} {
        .cursor_window.workarea itemconf image -image doc
    } else {
        .cursor_window.workarea itemconf image -image nodoc
    }
}
proc BindSource {win Type {priority 50}} {
    global tcl_platform
    set urls 0
    foreach type $Type {
        dnd bindsource $win $type {GetData %A %a %T %W %X %Y %x %y} $priority
        if {[string match text/ur* $type]} {set urls 1}
    }
    if {$tcl_platform(platform) != "windows"} {
        if {$urls} {
            bind $win <1> {
                CursorWindow
                dnd drag %W -actions {ask copy move link} -descriptions \
                        {{Please Select an Available Action:} \
                        {Copy...} {Move...} {Link...}} -cursor .cursor_window 
                destroy .cursor_window
            }
        } else {
            bind $win <1> {
                CursorWindow
                dnd drag %W -cursor .cursor_window \
                        -callback {CursorCallback %%A}
                destroy .cursor_window
            }
        }
    } else {
        if {$urls} {
            bind $win <1> {
                dnd drag %W -actions {ask copy move link} \
                        -descriptions {{Please Select an Available Action:} \
                        {Copy...} {Move...} {Link...}}
            }
        } else {
            bind $win <1> {dnd drag %W}
        }
    }
}

############################################################################
############################################################################
##  Create the Drop targets window...
##
wm geometry . +20+40
wm title . {D R O P    T A R G E T S    W I N D O W}
label .dragenter -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 2 -text {}
label .drag -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 2 -text {}
label .dragleave -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 2 -text {}
label .drop -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 6 -text {}
label .l1 -text {Drop Text:}
label .d1 -text { -- Drop some text here -- } -bd 2 -relief ridge -width 70
label .l2 -text {Drop Image:}
label .d2 -text { -- Drop an image here -- } -bd 2 -relief ridge -width 70
label .l3 -text {Drop URLs/files:}
label .d3 -text { -- Drop a uri-list here (Even from Explorer!) -- } -bd 2 -relief ridge -width 70
label .l4 -text {Drop a color:}
label .d4 -text "Change my color by\ndropping something on me" -bd 2 -relief \
        ridge -width 70 -fg white
## Place them on window...
for {set i 1} {$i < 5} {incr i} {
    grid .l$i .d$i -sticky snew
}
grid .dragenter -columnspan 2
grid .drag -columnspan 2
grid .dragleave -columnspan 2
grid .drop -columnspan 2
## Under unix, window must have been created!
update

## Make .d1 a drop target that accepts plain text...
BindTarget .d1 text/plain 
BindTarget .d1 {text/plain;charset=UTF-8} 1
## Make .d2 a drop target that accepts images...
BindTarget .d2 $image_formats
## Make .d3 a drop target that accepts files...
BindTarget .d3 text/uri-list
## Make .d4 a drop target that accepts images...
BindTarget .d4 {TK_COLOR} ;# This is a user defined type.
## Redefine the <Drop> event...
#dnd bindtarget .d4 {TK_COLOR} <Drop> {.d4 configure -bg %D}
#dnd bindtarget .d4 {TK_COLOR} <DragEnter> {}
puts [dnd bindtarget .d4 {TK_COLOR} <DragEnter>]
puts [dnd bindtarget .d4 {TK_COLOR} <Drag>]
puts [dnd bindtarget .d4 {TK_COLOR} <DragLeave>]
puts [dnd bindtarget .d4 {TK_COLOR} <Drop>]


############################################################################
############################################################################
##  Create the Drop Sources window...
##
toplevel .t
wm title .t {D R A G    S O U R C E S    W I N D O W}
wm geometry .t +20+400

label .t.dragenter -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 2 -text {}
label .t.drag -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 2 -text {}
label .t.dragleave -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 2 -text {}
label .t.drop -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 6 -text {}
label .t.getdata -bg black -fg green -borderwidth 2 -relief ridge -width 95\
        -height 1 -text {}
label .t.l1 -text {Drag & Drop Text:}
label .t.d1 -text { -- Drop some text here -- } -bd 2 -relief ridge -width 70
label .t.l2 -text {Drag & Drop Image:}
label .t.d2 -text { -- Drop an image here -- } -bd 2 -relief ridge -width 70
label .t.l3 -text {Drag & Drop URLs/files:}
label .t.d3 -text { -- Drop a uri-list here (Even from Explorer!) -- } \
        -bd 2 -relief ridge -width 70
label .t.l4 -text {Drag & Drop a color:}
label .t.d4 -text "Change my color by\ndropping something on me" \
        -bd 2 -relief ridge -width 70 -fg white
## Place them on window...
for {set i 1} {$i < 5} {incr i} {
    grid .t.l$i .t.d$i -sticky snew
}
grid .t.dragenter -columnspan 2
grid .t.drag -columnspan 2
grid .t.dragleave -columnspan 2
grid .t.drop -columnspan 2
grid .t.getdata -columnspan 2
## Under unix window must be visible
update

## Make .t.d1 a drop target that accepts plain text...
BindTarget .t.d1 text/plain
BindTarget .t.d1 {text/plain;charset=UTF-8} 1
BindSource .t.d1 text/plain
BindSource .t.d1 {text/plain;charset=UTF-8} 1
## Make .t.d2 a drop target that accepts images...
BindTarget .t.d2 $image_formats
BindSource .t.d2 $image_formats
## Make .t.d3 a drop target that accepts files...
BindTarget .t.d3 text/uri-list
BindSource .t.d3 text/uri-list
## Make .t.d4 a drop target that accepts images...
BindTarget .t.d4 {TK_COLOR} ;# This is a user defined type.
BindSource .t.d4 {TK_COLOR} ;# This is a user defined type.


#############################################################################
## A canvas demo...
toplevel .c
wm title .c "Canvas DND!"
wm protocol .c WM_DELETE_WINDOW {exit}
wm geometry .c +700+40

canvas .c.c -bg white -width 300 -height 250
pack .c.c -fill both -expand 1
## Create some items...
.c.c create rectangle 4 4 298 100 -fill #FFFF00 -tags {img_area}
.c.c create text  150 15 -tags {des} -text "Drop something here!"
.c.c create image 150 150 -tags {image} -anchor n
.c.c create text  150 150 -tags {text} -width 296 -justify center
label .c.c.l -textvariable CanvasDeliverEventStatus(item) \
        -relief raised -bd 2 -width 6
.c.c create window 10 230 -window .c.c.l -anchor w
.c.c lower text
.c.c lower text

## In order to simulate the DND callbacks that can be sent only to windows for
## canvas items, we follow the following idea:
##  1) We create the canvas widget, and make it a drop target.
##  2) For all DND events, we bind a procedure that does the following:
##     *) Finds the item the mouse is over. The tag "current" cannot be used,
##        because during a DND operation the only events tk gets are redraw
##        events.
##     *) Looks if this item has a binding for the specified event.
##     *) If it has, it tries to do % substitutions.
##     *) It executes the binding script.
##
##  Slow, but works :-)

## Bind the items to the virtual DND events...
foreach tag {img_area} {
    .c.c bind $tag <<DragEnter>> {CanvasDragEnter %A %T %W %I %X %Y %x %y %D}
    .c.c bind $tag <<Drag>>      {CanvasDrag %A %T %W %I %X %Y %x %y %D}
    .c.c bind $tag <<DragLeave>> {CanvasDragLeave %A %T %W %I %X %Y %x %y %D}
    .c.c bind $tag <<Drop>>      {CanvasDrop %A %T %W %I %X %Y %x %y %D}
}

## Make the canvas a drop target
update
set win .c.c
foreach type [list text/uri-list text/plain TK_COLOR $image_formats] {
    dnd bindtarget $win $type <DragEnter> {
        ::dnd::CanvasDeliverEvent <<DragEnter>> \
                %A %a %b %C %c %D %d %m %T %t %W %X %x %Y %y
    }
    dnd bindtarget $win $type <DragLeave> {
        ::dnd::CanvasDeliverEvent <<DragLeave>> \
                %A %a %b %C %c %D %d %m %T %t %W %X %x %Y %y
    }
    dnd bindtarget $win $type <Drag> {
        ::dnd::CanvasDeliverEvent <<Drag>> \
                %A %a %b %C %c %D %d %m %T %t %W %X %x %Y %y
    }
    dnd bindtarget $win $type <Drop> {
        ::dnd::CanvasDeliverEvent <<Drop>> \
                %A %a %b %C %c %D %d %m %T %t %W %X %x %Y %y
    }
}

dnd bindtarget .c.c.l TK_COLOR   <Drop> {.c.c conf -bg %D}
dnd bindtarget .c.c.l text/plain <Drop> {.c.c itemconfigure text -text %D}

## And finaly, the actual binding scripts...
proc CanvasDragEnter {action type win item X Y x y {data {}}} {
    if {[string length $data] > 60} {
      set data [string range $data 0 60]...
    }
    .t.dragenter config -text \
            "<DragEnter>: Type=$type, Action=$action,\
            win=$win, item=$item, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
    foreach w {.t.drag .t.dragleave .t.drop .t.getdata} {$w conf -text {}}
    $win itemconfigure $item -fill green
    $win itemconfigure des -text {Drop something here!}
    $win configure -bg white
    update
    return $action
}
proc CanvasDragLeave {action type win item X Y x y {data {}}} {
    if {[string length $data] > 60} {
      set data [string range $data 0 60]...
    }
    .t.dragleave config -text \
            "<DragLeave>: Type=$type, Action=$action,\
            win=$win, item=$item, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
    foreach w {.t.drag .t.dragenter .t.drop .t.getdata} {$w conf -text {}}
    $win itemconfigure $item -fill #FFFF00
    $win itemconfigure des -text {Drop something here!}
    update
}
proc CanvasDrag {action type win item X Y x y {data {}}} {
    if {[string length $data] > 60} {
      set data [string range $data 0 60]...
    }
    .t.drag config -text "<Drag>: Type=$type, Action=$action,\
            win=$win, item=$item, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
    foreach w {.t.dragleave .t.drop} {$w conf -text {}}
    $win itemconfigure des -text $type
    update
    return $action
}
proc CanvasDrop {action type win item X Y x y data} {
    .t.drop config -text \
            "<Drop>: Type=$type, Action=$action,\
            win=$win, item=$item, X=$X, Y=$Y, x=$x, y=$y\ndata=\"$data\""
    foreach w {.t.drag .t.dragleave .t.dragenter} {$w conf -text {}}
    switch -glob $type {
        image/* {
            switch [string range $type 6 end] {
                xpm {image create pixmap itk -data $data}
                xbm {image create bitmap itk -data $data}
                default {image create photo itk -data $data}
            }
            $win itemconfigure image -image itk
            $win itemconfigure text -text {}
        }
        TK_COLOR {
            $win configure -bg $data
        }
        default {
            $win itemconfigure text -text $data
            $win itemconfigure image -image {}
        }
    }
    $win itemconfigure des -text $type
    $win itemconfigure img_area -fill #FFFF00
    update
}

## Text widget...
toplevel .text_window
text .text_window.text -bg white -fg navy -width 60 -height 10 -state normal \
        -exportselection 0
.text_window.text insert end "Drop some UTF-8 strings here!"
.text_window.text tag bind sel <Motion><Leave> {HandleSelection %W}
pack .text_window.text
update

proc HandleSelection {text} {
    set start [$text index sel.first]
    set end   [$text index sel.last]
    puts "$start $end"
    dnd bindsource $text text/plain "return [list [$text get $start $end]]"
    puts [dnd drag $text]
    after idle "$text tag add sel $start $end"
}

set text_index 1.0
foreach type {text/plain text/plain\;charset=UTF-8} priority {50 1} {
    dnd bindtarget .text_window.text $type <DragEnter> \
            {raise [winfo toplevel %W];update; return default}
    dnd bindtarget .text_window.text $type <Drag> \
            {set text_index [%W index @%x,%y];%W mark set insert $text_index
    focus -force %W; update; set action copy} $priority
    dnd bindtarget .text_window.text $type \
            <Drop> {%W insert $text_index %D} $priority
}

tkwait window .t
exit
