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 >