in reply to Re^3: Drag and Drop in Tkx
in thread Drag and Drop in Tkx

the only sure way is to help yourself, funny :)

Replies are listed 'Best First'.
Re^5: Drag and Drop in Tkx
by Anonymous Monk on Feb 13, 2010 at 06:51 UTC
    Here is rough translation of BWidget example: Drag and Drop Demo, not very difficult, does require learning TCL (easy with tkdocs tutorial), I don't think it will help David 
    #!/usr/bin/perl --
use strict;
use warnings;
use Tkx;

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();
} ## end sub Main

sub drawGUI {
  our @wList;

#~ http://wiki.tcl.tk/16126# BWidget example: Drag and Drop Demo
#~     wm withdraw .
#~     Tkx::wm_withdraw('.');

#~     set t [toplevel .t]
#~     wm title $t "BWidgets Demo for Drag 'n Drop enabled buttons."
  our $t = Tkx::widget->new(".");
  $t = $t->new_toplevel( -name => ".t" );
  $t->g_wm_title("BWidgets Demo for Drag 'n Drop enabled buttons.")
    ;    ## wm title $t "BWidgets Demo for Drag 'n Drop enabled button
+s."

#~ use DDS; Dump($t);
#~ #    $Tkx_widget1 = \do { my $v = '.t' };
#~ #    bless( $Tkx_widget1, 'Tkx::widget' );

#~ proc wrap {wtype wpath args} {
#~     if { [catch {uplevel "#0" package require tile}] == 0 } {
#~         return [eval ttk::${wtype} $wpath $args]
#~     } else {
#~         return [eval $wtype $wpath $args]
#~     }
#~ }
#~         sub wrap {
#~             my( $wtype ) = shift;
#~             $wtype = "Tkx::new_ttk__$wtype";
#~             return $wtype->(@_);
#~         }
#~     pack [set f [wrap frame $t.f]] -fill both -expand true
#~     pack [set f [ttk::frame $t.f]] -fill both -expand true
  $t = $t->new_ttk__frame( -name => '.t.f' );
  $t->g_pack(qw' -fill both -expand true ');

#~     pack [wrap button $f.b1 \
#~              -text "1.) Drag" -image [Bitmap::get new] -compound le
+ft \
#~              -command {tk_messageBox -message "Drag"}] -padx 5 -pad
+y 5

#~     pack [wrap button $f.b2 \
#~              -text "2.) and"  -image [Bitmap::get file] -compound l
+eft \
#~              -command {tk_messageBox -message "and"}] -padx 5 -pady
+ 5

#~     pack [wrap button $f.b3 \
#~              -text "3.) Drop" -image [Bitmap::get copy] -compound l
+eft \
#~              -command {tk_messageBox -message "Drop"}] -padx 5 -pad
+y 5

#~     pack [wrap button $f.b4 \
#~              -text "4.) Demo" -image [Bitmap::get redo] -compound l
+eft \
#~              -command {tk_messageBox -message "Demo"}] -padx 5 -pad
+y 5
  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;
  } ## end for my $i ( 1 .. 4 )

#~     enableDnD [list $f.b1 $f.b2 $f.b3 $f.b4]
  enableDnD( map { "$t.b$_" } 1 .. 4 );

#~     pack [wrap label $f.lbl -text ""] -padx 5 -pady 5
#~     pack [wrap button $f.b5 -text "Exit Demo." -command {exit 0}] -
+padx 5 -pady 5
  $t->new_ttk__label( -text => "" )->g_pack(qw' -padx 5 -pady 5 ');
  $t->new_ttk__button(
    -text => "Exit Demo",

#~         -command => sub { Tkx::destroy('.'); exit; },
    -command => [ \&Tkx::destroy, '.' ],
  )->g_pack(qw' -padx 5 -pady 5 ');

#~     Tkx::raise('.');
} ## end sub drawGUI

sub enableDnD {
  for my $w (@_) {

# Here we register the widget as a dropsite.

#~         Tkx::BWidget__DropSite__register(
#~         Tkx::DropSite__register(
    Tkx::DropSite__register(
      $w,

#~             -dropcmd => \&dropbuttonCmd,
      -dropcmd => sub { print "dropbuttonCmd\n" },

#~ http://docs.activestate.com/activetcl/8.6/bwidget/DropSite.html
#~             -droptypes => {
#~                 BUTTON_ITEM  => {copy => {}, move => {} , link => {
+}},
#~             },
    );

# Here we register the widget as a dragsite.
    Tkx::DragSite__register(
      $w,
      -dragevent => 1,

#~             -draginitcmd => \&dragbuttonCmd,
#~             -dragendcmd => \&droppedOntoButtonCmd,
      -draginitcmd => sub {
        print "dragbuttonCmd\n";
        print "\t $_\n" for @_;
        print "\t--\n";
      },
      -dragendcmd => sub {
        print "droppedOntoButtonCmd\n";
        print "\t $_\n" for @_;
        print "\t--\n";
      },
    );

# Here we have to bind the data type BUTTON_ITEM to the mouse.
#~     Tkx::DragSite__include(qw' Widget BUTTON_ITEM <B1-Motion> ');
  } ## end for my $w (@_)
} ## end sub enableDnD

    [download]
[reply]
[d/l]

      Thanks. That helped a little. But, the code you have doesn't seem to do anything about the drop site. The Tkx::DropSite_Register() call has a -dropcmd that simply prints "dropbuttonCmd", but that is never printed. I tried creating an entry widget and registering it as a drop site and was not able to get the -dropcmd or -dropovercmd commands to fire.

      So, I'm still unable to do what I would like to do: drag a file from windows explorer onto a widget and have the widget know the name of the file that was dropped.

      I took the code you had and modified it. I took out the comments that were from the original TCL BWidget code (for simplicity) and I specified subs for the various drag/drop commands. Also took out the extraneous topwindow. Also, when the -draginitcmd sub is called it must return 3 things (type of data, list of operations, and the data), so I added a return to my sub. The data part is then successfully passed to the -dragendcmd sub, but I'm not clear as far as what should be specified for the type and list of operations.

      Seems close, but still doesn't work.

      Dave

      My version that does 'drag' but not 'drop':

      #!/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(q
+w '-padx 5 -pady 5');

    my $entry = $t->new_ttk__entry(-width => 20, -textvariable => \$te
+xt);
    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";
}

      [download]
[reply]
[d/l]
        I don't know if BWidget supports remote dnd. tkdnd apparently does.
[reply]
        Ha ha ha ha, I knew it wouldn't help you.
[reply]

In Section Seekers of Perl Wisdom