Hi Dave,

sorry for delay in help.

There are several approaches to do DND, and the approach you've mentioned in 
the very end of message
  $interp->packageRequire('tkdnd', '2.0');
is different to BWidget's DND.

Moreover, the BWidget DND will not allow you DND with external applications 
(i.e. windows explorer)

You need "tkdnd" for that.
I'll produce working example of "tkdnd" approach for Tkx soon, but you must 
understand that you need to have "tkdnd" in your tcl/tk installation (this is 
not always the case).

Now returning to your BWidget approach - I am new to BWidget DND, so I am nof 
little use here.
I've looked into http://wiki.tcl.tk/16126 and found some errors in your code as 
well.
your 
     return ("text", ("copy"), $data);
should be 
     return ["text", "copy", $data];
or something similar - you should use array refs when transfering to Tcl lists.
I'll provide mnore information when I'll get working code, but, to my taste, 
BWidget DND isn't obvious., compared to tkdnd discussed earlier.

Sorry for little information so far :)

Best regards,
Vadim.

> 
> 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: 'tcltk@perl.org'
> 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
> 

Reply via email to