RE: Drag-n-Drop in Perl/Tkx

With some help from www.perlmonks.org
<BLOCKED::http://www.perlmonks.org> , I have the following.  It handles
the drag part of a widget in the window, but the drop part doesn't do
anything.  I ultimately want to be able to drag a file from windows
explorer and have the filename (and path) recognized in the widget.
Can't get 'drop' to work in Perl/Tkx.  Any help would be appreciated.
 
Dave
 
________________________________

#!/usr/bin/perl --
use strict;
use warnings;
use Tkx;
 
my $text = "abc";
 
Main(@ARGV);
exit(0);
 
sub Main {
  local $Tkx::TRACE = 64;
  Tkx::package_require('tile');
  Tkx::package_require('BWidget');
  eval      { Tkx::tile__setTheme('xpnative'); 1 }
    || eval { Tkx::ttk__setTheme('xpnative');  1 };
  drawGUI();
  Tkx::MainLoop();
}
 
sub drawGUI
{
    our $t = Tkx::widget->new(".");
    $t->g_wm_title("BWidgets Demo for Drag 'n Drop enabled buttons.");
 
    $t = $t->new_ttk__frame( -name => '.f' );
    $t->g_pack(qw '-fill both -expand true');
 
    for my $i ( 1 .. 4 )
    {
        my $m  = (qw' 0 Drag and Drop Demo ')[$i];
        my $bb = $t->new_ttk__button(-name => "$t.b$i",    # auto-name
is .b .b2 .b3...
                                     -image => Tkx::Bitmap__get( (qw'0
new file copy redo ')[$i] ),
                                     -text  => "$i.) $m",
                                     -command => sub { print "$m\n"; });
        $bb->g_pack;
    }
 
    enableDnD( map { "$t.b$_" } 1 .. 4 );
 
    $t->new_ttk__button(-text => "Exit Demo",
                        -command => [ \&Tkx::destroy, '.' ])->g_pack(qw
'-padx 5 -pady 5');
 
    my $entry = $t->new_ttk__entry(-width => 20, -textvariable =>
\$text);
    Tkx::DropSite__register($entry,
                            -dropcmd => \&dropcmdEntry,
                            -dropovercmd => \&dropovercmdEntry,
                            -droptypes => {"text", {"copy", "none"}});
    $entry->g_pack(qw '-padx 5 -pady 5');
}
 
sub enableDnD
{
    for my $w (@_)
    {
        Tkx::DropSite__register($w,
                                -dropcmd => \&dropButtonCmd);
        Tkx::DragSite__register($w,
                                -dragevent => 1,
                                -draginitcmd => \&dragInitCmd,
                                -dragendcmd => \&dragEndCmd);
    }
}
 

sub dropButtonCmd
{
    my @args = (@_);
 
    print "in dropButtonCmd\n";
    for (my $i = 0; $i < scalar @args; $i++)
    {
        print "arg $i = '$args[$i]'\n"  if defined $args[$i];
    }
    return "abc";
}
 
sub dragInitCmd
{
    my @args = (@_);
 
    print "in dragInitCmd\n";
    for (my $i = 0; $i < scalar @args; $i++)
    {
        print "arg $i = '$args[$i]'\n"  if defined $args[$i];
    }
    my $data = "\"Button " . $args[3] . "\"";
    return ("text", ("copy"), $data);
}
 
sub dragEndCmd
{
    my @args = (@_);
 
    print "in dragEndCmd\n";
    for (my $i = 0; $i < scalar @args; $i++)
    {
        print "arg $i = '$args[$i]'\n"  if defined $args[$i];
    }
}
 
sub dropcmdEntry
{
    print "dropcmdEntry\n";
    return "entry";
}
 
sub dropovercmdEntry
{
    print "dropovercmdEntry\n";
}

________________________________

 
When I run the script and drag one of the buttons around, I get
something like the following, but I can't seem to get the drop commands
to ever fire.
 
Tkx-1-0.0s-dnd2.pl-13: package require tile
Tkx-2-0.1s-dnd2.pl-14: package require BWidget
Tkx-3-0.1s-dnd2.pl-15: tile::setTheme xpnative
Tkx-4-0.1s-dnd2.pl-24: wm title . {BWidgets Demo for Drag 'n Drop
enabled buttons.}
Tkx-5-0.1s-dnd2.pl-26: ttk::frame .f
Tkx-6-0.1s-dnd2.pl-27: pack .f -fill both -expand true
Tkx-7-0.1s-dnd2.pl-35: Bitmap::get new
Tkx-8-0.1s-dnd2.pl-35: ttk::button .f.b1 -image image1 -text {1.) Drag}
-command perl::callback
Tkx-9-0.1s-dnd2.pl-36: pack .f.b1
Tkx-10-0.1s-dnd2.pl-35: Bitmap::get file
Tkx-11-0.1s-dnd2.pl-35: ttk::button .f.b2 -image image2 -text {2.) and}
-command perl::callback
Tkx-12-0.1s-dnd2.pl-36: pack .f.b2
Tkx-13-0.1s-dnd2.pl-35: Bitmap::get copy
Tkx-14-0.1s-dnd2.pl-35: ttk::button .f.b3 -image image3 -text {3.) Drop}
-command perl::callback
Tkx-15-0.1s-dnd2.pl-36: pack .f.b3
Tkx-16-0.1s-dnd2.pl-35: Bitmap::get redo
Tkx-17-0.1s-dnd2.pl-35: ttk::button .f.b4 -image image4 -text {4.) Demo}
-command perl::callback
Tkx-18-0.1s-dnd2.pl-36: pack .f.b4
Tkx-19-0.1s-dnd2.pl-56: DropSite::register .f.b1 -dropcmd perl::callback
Tkx-20-0.1s-dnd2.pl-58: DragSite::register .f.b1 -dragevent 1
-draginitcmd perl::callback -dragendcmd perl::callback
Tkx-21-0.1s-dnd2.pl-56: DropSite::register .f.b2 -dropcmd perl::callback
Tkx-22-0.1s-dnd2.pl-58: DragSite::register .f.b2 -dragevent 1
-draginitcmd perl::callback -dragendcmd perl::callback
Tkx-23-0.2s-dnd2.pl-56: DropSite::register .f.b3 -dropcmd perl::callback
Tkx-24-0.2s-dnd2.pl-58: DragSite::register .f.b3 -dragevent 1
-draginitcmd perl::callback -dragendcmd perl::callback
Tkx-25-0.2s-dnd2.pl-56: DropSite::register .f.b4 -dropcmd perl::callback
Tkx-26-0.2s-dnd2.pl-58: DragSite::register .f.b4 -dragevent 1
-draginitcmd perl::callback -dragendcmd perl::callback
Tkx-27-0.2s-dnd2.pl-41: winfo children .f
Tkx-28-0.2s-dnd2.pl-41: ttk::button .f.b -text {Exit Demo} -command
perl::callback
Tkx-29-0.2s-dnd2.pl-41: pack .f.b -padx 5 -pady 5
Tkx-30-0.2s-dnd2.pl-44: winfo children .f
Tkx-31-0.2s-dnd2.pl-44: ttk::entry .f.e -width 20 -textvariable
SCALAR(0x1830104)
Tkx-32-0.2s-dnd2.pl-45: DropSite::register .f.e -dropcmd perl::callback
-dropovercmd perl::callback -droptypes HASH(0x1b1e38c)
Tkx-33-0.2s-dnd2.pl-49: pack .f.e -padx 5 -pady 5
in dragInitCmd
arg 1 = 'Tcl=SCALAR(0x189f2fc)'
arg 2 = '::perl::CODE(0x18c6bb8)'
arg 3 = '.f.b1'
arg 4 = '181'
arg 5 = '145'
arg 6 = '.drag'
in dragEndCmd
arg 1 = 'Tcl=SCALAR(0x189f2fc)'
arg 2 = '::perl::CODE(0x18c6cb4)'
arg 3 = '.f.b1'
arg 4 = ''
arg 5 = ''
arg 6 = 'Button .f.b1'
arg 7 = ''
arg 8 = '0'
 

________________________________

From: Swingle David-QWHM86 
Sent: Tuesday, January 26, 2010 12:46 PM
To: '[email protected]'
Subject: Drag-n-Drop in Perl/Tkx


I'm converting Perl/Tk to Perl/Tkx and I'm struggling with getting Drag
and Drop to work in Perl/Tkx.  I had found help for DND in Perl/Tk and
use in in a large script I wrote, but for simplicity, here is a simple
Perl/Tk script that supports DND:
 
use strict;
use Tk;
use Tk::Pane;
 
my $textVariable = "my text";
 
my $mw = MainWindow->new;
my $frame = $mw->Frame()->pack(-side => 'top', -expand => 1, -fill =>
'x');
$frame->Label(-text => "My Label",
              -anchor => 'w',
              -width => 10)->pack(-ipady => 1,
                                  -side => 'left');
my $entry = $frame->Entry(-textvariable => \$textVariable,
                          -width => 40)->pack(-side => 'left');
$frame->DropSite(-dropcommand => [\&AcceptDrop, $frame],
                 -droptypes => ('Win32'));
 
MainLoop;
 

sub AcceptDrop
{
    my ($widget, $selection) = @_;
    my $filename;
 
    $filename = $widget->SelectionGet(-selection => $selection,
'STRING');
    $textVariable = $filename;
}

 
Is there an easy way to convert this simple script to use Tkx?  I know
there was a post about this in the past, but I couldn't figure out
exactly what was meant.  For example, in that post there was
 
    $interp->packageRequire('tkdnd', '2.0');
 
But $interp wasn't initialized to anything.
 
I'm using perl, v5.8.8, binary build 822.
 
Thanks,
David