#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
  exec wish8.4 "$0" ${1+"$@"}
 
## Check Tk version:
## 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}

wm withdraw .
## Load tkdnd package...
set DIR [file dirname [file normalize [info script]]]
## 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 {0} {

<HTML>
<HEAD>
<TITLE>Tcl/Tk Plugin V2 Test</TITLE>
</HEAD>

<BODY>
<embed type="application/x-tcl"
src="dndtest.tcl"
width=400 height=265>
<hr>
</BODY>
</HTML>

}

# multiple source types in one window,
# single type destinations of different types.
#

# Specify font in Window font format (won't work under X)
set font1 "Arial 16 bold"
set font2 "Arial 12"

# Message at top
message .m -text "Tk Drag and Drop Demo" -width 6i -font $font1


#----------------------------------------------------------------------
set f1 .f1
frame $f1

set f2 .f2
frame $f2

#----------------------------------------------------------------------
# Set up the sources
#----------------------------------------------------------------------
set source1 $f1.s1
set source2 $f1.s2
set source3 $f1.s3
set source4 $f1.s4
label $source1 -text "Raging\nRed Source" -bg red  -fg white -height 5
label $source2 -text "Beautiful\nBlue Source" -bg blue -fg white -height 5
label $source3 -text "Pretty\nPurple Source" -bg purple -fg white -height 5
label $source4 -text \
	"Drag any of these\nto an empty space\nin a browser window" \
	-bg darkgreen -fg white -height 5
pack $f1.s1 $f1.s2 $f1.s3 $f1.s4 -side left -expand yes -fill x
update

foreach src [list $source1 $source2 $source3 $source4] {
    dnd bindsource $src UniformResourceLocator {return http://www.[lindex [%W config -bg] 4].com}
    dnd bindsource $src text/plain    {puts text/plain;lindex [%W config -bg] 4}
    dnd bindsource $src TK_COLOR {puts TK_COLOR;lindex [%W config -bg] 4}
    dnd bindsource $src TK_WIDGETNAME {puts TK_WIDGETNAME;return %W}
    dnd bindsource $src TK_WIDGETLABEL {puts TK_WIDGETLABEL;lindex [%W config -text] 4}
    bind $src <1> {dnd drag %W}
}
dnd bindsource $source4 UniformResourceLocator \
	{return http://bmrc.berkeley.edu/people/chaffee/tcltk.html}

#----------------------------------------------------------------------
# Set up the targets
#
# 1. An entry widget will insert the color name of the drag source
# 2. A label widget will configure itself to the color of the source
# 3. Another text entry will display the widget source name when
#    something is dropped on it.
#----------------------------------------------------------------------
set tframe1 [frame $f2.t1]
label $tframe1.l -text "Colorname drop zone==>"
set target1 $tframe1.e
entry $target1 -relief sunken -bd 2
update
dnd bindtarget $target1 text/plain <Drop> {%W delete 0 end; %W insert end %D}
dnd bindtarget $target1 text/plain <Drag> \
  {focus %W;entry_setcursor %W %x %y;set action copy}
pack $tframe1.l -side left
pack $target1 -side left -expand yes -fill x

set tframe2 [frame $f2.t2]
set target2 $tframe2.l
label $target2 -bg darkgreen -fg white -height 5 \
    -text "Change my color by\ndropping something on me"
update
dnd bindtarget $target2 TK_COLOR <Drop> {%W config -bg %D}
pack $target2 -expand yes -fill x

set tframe3 [frame $f2.t3]
label $tframe3.l -text "Widget name drop zone==>"
set target3 $tframe3.e
entry $target3 -relief sunken -bd 2
update
dnd bindtarget $target3 TK_WIDGETNAME <Drop> {%W delete 0 end; %W insert end %D}
pack $tframe3.l -side left
pack $target3 -side left -expand yes -fill x

set tframe4 [frame $f2.t4]
label $tframe4.l -text "Widget label drop zone==>"
set target4 $tframe4.e
entry $target4 -relief sunken -bd 2
update
dnd bindtarget $target4 TK_WIDGETLABEL <Drop> {%W delete 0 end; %W insert end %D}
pack $tframe4.l -side left
pack $target4 -side left -expand yes -fill x

set tframe5 [frame $f2.t5]
label $tframe5.l -text "URL drop zone==>"
set target5 $tframe5.e
entry $target5 -relief sunken -bd 2
update
dnd bindtarget $target5 UniformResourceLocator <Drop> {%W delete 0 end; %W insert end %D}
dnd bindtarget $target5 {Netscape Bookmark} <Drop> {%W delete 0 end; %W insert end %D}
pack $tframe5.l -side left
pack $target5 -side left -expand yes -fill x


set tframe6 [frame $f2.t6]
label $tframe6.l -text "Filename drop zone==>"
set target6 $tframe6.e
entry $target6 -relief sunken -bd 2
update
dnd bindtarget $target6 text/uri-list <Drop> {%W delete 0 end; %W insert end %D}
pack $tframe6.l -side left
pack $target6 -side left -expand yes -fill x

pack $tframe1 $tframe2 $tframe3 $tframe4 $tframe5 $tframe6 \
	-expand yes -side top -fill x
pack .m $f1 $f2 -expand yes -fill x

update
wm deiconify .

proc entry_getpos {w x} {
    set pos [$w index @$x]
    set bbox [$w bbox $pos]
    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
	return $pos
    }
    incr pos
}


proc entry_setcursor {w x y} {
    set pos [entry_getpos $w $x]
    puts "entry_setcursor $w $x $y: pos=$pos"
    $w icursor $pos
    update idletasks
}
