RE: tkdnd

[email protected] ("Konovalov, Vadim (Vadim)** CTR **") Wed, 23 Feb 2011 14:31:55 +0100
Newsgroups perl.tcltk
Message-ID <35BF8D9716175C43BB9D67CA60CC345E2770D21D@FRMRSSXCHMBSC2.dc-m.alcatel-lucent.com>
> -----Original Message-----
> From: gary sachs [mailto:[email protected]] 
> I am trying to implement drag and drop in a perl application. 
> The problem I am having at the moment is getting the drag to 
> work from a listbox to a entry widget. Activestate PERL 5.12 on XP.
> 
> does any one have a small snippet of code showing the bind(s) 
> needed and their associated subroutines? I am also confused 
> on the order of the return values.

Hi Gary

you probably need inter-tk DND,
Here is an example with Tcl::Tk usage, it shows miscellaneous drag-n-drops involving BWidget package

use strict;
use Tcl::Tk;

my $mw = Tcl::Tk::MainWindow("Simple Drag & Drop Demo...");
my $int = $mw->interp;

my $e = '';
my $e0 = 'la-bell';
my $w_e = $mw->Entry(-textvariable=>\$e)->pack(-fill=>'x');
my $w_l = $mw->Label(-textvariable=>\$e0)->pack(-fill=>'x');

$int->packageRequire('BWidget');

my $w_lb = $mw->Scrolled('Listbox',-selectmode=>'extended')->pack;
$w_lb->_insertEnd("list item $_") for 'aaa' .. 'zzz';
$w_lb->_seeEnd;

$int->call('DropSite::register', $w_l,
    -droptypes=>  [text=>[copy=>'']],
    -dropcmd => sub {
	my $dt = shift; # drop target
	my $ds = shift; # drop source
	my ($x, $y) = (shift, shift);
	my $op = shift; # operation
	my ($datatype, $data) = (shift, shift);
	$e0 = $data;
    });

$int->call('DropSite::register', $w_e,
    -droptypes=>  [text=>[copy=>'']],
    -dropcmd => sub {
	my ($dt, $ds, $x, $y, $op, $datatype, $data) = @_;
	$e = $data;
    });

$int->call('DropSite::register', $w_lb->Subwidget,
    -droptypes=>  [text=>[copy=>'']],
    -dropcmd => sub {
	print "drop, $w_e;[[@_]]\n";
	my $dt = shift; # drop target
	my $ds = shift; # drop source
	my ($x, $y) = (shift, shift);
	my $op = shift; # operation
	my ($datatype, $data) = (shift, shift);
	$w_lb->_insertEnd($data);
	$w_lb->_seeEnd;
    });

$int->call('DragSite::register', $w_l, -draginitcmd => sub {
	print "draginit, $w_l;[[@_]]\n";
	return ['text','copy',$e0];
    });
$int->call('DragSite::register', $w_lb->Subwidget, -draginitcmd => sub {
	print "draginit, $w_lb;[[@_]]\n";
	return ['text','copy',join '+',map {$w_lb->get($_)} $w_lb->curselection];
    });


$int->MainLoop;


Also, here is a simple example that allows extra-application DND, which looks even simplier, but requires tkdnd package, I do not know if Activeperl comes with it pre-packaged (I wish it is prepackaged, but I do not know)

use strict;
use Tcl::Tk;

my $mw = Tcl::Tk::MainWindow("Simple Drag & Drop Demo...");
my $int = $mw->interp;

my $e = '';
my $lab = $mw->Entry(-textvariable=>\$e)->pack(-pady=>5, -fill=>'x');

# following line will do 'package require tkdnd' in Tcl/Tk
$int->packageRequire('tkdnd','2.0');

$int->tkdnd__drop_target(register => $lab, "*");

# Add a specialised <<Drop>> event, when will be called if a file is dropped.
$lab->bind('<<Drop:DND_Files>>', \\'D', sub {
	my $data = shift;
	($e) = $int->SplitList($data);
});

$int->MainLoop;


And same program but with Tkx syntax:

use strict;
use Tkx;

Tkx::package_require('tkdnd');

my $e;
my $mw = Tkx::widget->new(".");
my $w_edit = $mw->new_entry(-name=>".current_dir",-textvariable=>\$e);
$w_edit->g_pack(qw '-fill both -expand true');

Tkx::tkdnd__drop___target_register($w_edit,'*');
Tkx::bind ($w_edit, '<<Drop:DND_Files>>', [ sub {
       $e = shift;
       print "I have '$e'\n";
}, Tkx::Ev("%D")]);

Tkx::MainLoop;


Best regards,
Vadim.