#!/usr/local/bin/perl -w

use Tk;
use Tk::DragDrop;
use Tk::DropSite;
use strict;
use vars qw($top $listbox $dnd);

$top = new MainWindow;
$top->Label(-text => "The drop area:")->pack;

$listbox = $top->Scrolled('Listbox', -scrollbars => "osoe")->pack;

$listbox->DropSite(
    -dropcommand => [\&accept_drop, $listbox],
    -droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['KDE', 'XDND', 'Sun'])
);

$dnd = $listbox->DragDrop(
    -event => '<B1-Motion>',
    -sitetypes => ($^O eq 'MSWin32' ? 'Win32' : ['KDE', 'XDND', 'Sun']),
    -startcommand => \&start_drag,
    -handlers => [[-type => 'STRING', \&send_string]]
);

MainLoop;

sub start_drag
{
    my($token) = @_;
    my $w = $token->parent;
    my $e = $w->XEvent;
    my $idx = $w->nearest($e->y);

    if(defined $idx)
    {
        $token->configure(-text => $w->get($idx));
        my($X, $Y) = ($e->X, $e->Y);
        $token->MoveToplevelWindow($X, $Y);
        $token->raise;
        $token->deiconify;
        $token->FindSite($X, $Y, $e);
    }
}

sub send_string
{
    my ($offset, $max) = @_;

    my ($lb_sel) = $listbox->curselection;
    my ($req) = $listbox->get($lb_sel);
    return $req;
}


sub accept_drop
{
    my($widget, $selection) = @_;

    my $filename;
    eval {
        if ($^O eq 'MSWin32') {
            $filename = $widget->SelectionGet(-selection => $selection, 'STRING');
        } else {
            $filename = $widget->SelectionGet(-selection => $selection, 'FILE_NAME');
        }
    };
    if (defined $filename) {
        $widget->insert(0, $filename);
    }
}