jcavanaugh has asked for the wisdom of the Perl Monks concerning the following question:

Ive been playing around a bit with the drag-n-drop feature in perl tk.

Starting with the droptest.pl script below. 

#!/usr/local/bin/perl -w

use Tk;
use Tk::DropSite;
use strict;
use vars qw($top $drop);

$top = new MainWindow;
$top->Label(-text => "The drop area:")->pack;
$drop = $top->Scrolled('Listbox',
               -scrollbars => "osoe",
              )->pack;

# Tell Tk that $drop should accept drops.
# The allowed drag and drop types on Unix systems are "KDE", "XDND" an
+d "SUN"
# and on Windows systems the "Win32" dnd type.
# When dropping occurs, execute the accept_drop callback.
$drop->DropSite
  (-dropcommand => [\&accept_drop, $drop],
   -droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['KDE', 'XDND', 'Sun'])
  );
MainLoop;

sub accept_drop {
    my($widget, $selection) = @_;

    my $filename;
    eval {
    if ($^O eq 'MSWin32') {
        $filename = $widget->SelectionGet(-selection => $selection,
                          'STRING');
    } else {
        $filename = $widget->SelectionGet(-selection => $selection,
                          'FILE_NAME');
    }
    };
    if (defined $filename) {
    $widget->insert(0, $filename);
    }
}

__END__

[download]
Everything works fine. But...

What I need is a way to get the entire list of dropped files as part of a callback. Unfortunately what I get is a callback for each file dropped.

To give a little context, Im writing some code that will launch a script for all the files dropped on it. I dont want to launch the script 100 times if a 100 files are dropped. Instead I will pass the 100 files to the script once.

Im sure there is some way in Tk to know when a drop is complete or something. That way I could build up an array on the per file callbacks, then just call my script when the "Drop Complete" or something is signaled.

Any assistance would be appreciated...

-- John Cavanaugh

Replies are listed 'Best First'.
Re: Perl Tk: Dropsite aggregation vs singles
by pg (Canon) on Jan 04, 2004 at 21:49 UTC

    Yes, you can, but need to hack into Perl.

    Assume the platform is win32, rest are similar. Goto directory site/lib/Tk/DragDrop. In that directory, there is a module Win32Site.pm. In that module, there is a sub Win32Drop(). In that sub, there is a foreach loop, and that is where, it loops through the list of all dropped files, and append them to Tk::clipboard (one of the communication channel among Tk components). You can hack your code there, obviously you have the entire list of file there and then.

    The other way is to monitor clipboard.

[reply]
Re: Perl Tk: Dropsite aggregation vs singles
by JamesNC (Chaplain) on Jan 05, 2004 at 16:04 UTC
    I ran into this a while back too. Here is how I handled it: 
    #!/perl/bin/perl -w

use Tk;
use Tk::DropSite;
use strict;
use vars qw($top $drop @files $start_drop @null $lbox $btn );
$start_drop = time;

$top = new MainWindow;
$top->Label(-text => "The drop area:")->pack;
$drop = $top->Scrolled('Listbox',
               -scrollbars => "osoe",-height, 3, -width, 30,
              )->pack(-fill, 'both', -expand, '1');

# Tell Tk that $drop should accept drops.
# The allowed drag and drop types on Unix systems are "KDE", "XDND" an
+d "SUN"
# and on Windows systems the "Win32" dnd type.
# When dropping occurs, execute the accept_drop callback.
$drop->DropSite
  (-dropcommand => [\&accept_drop, $drop],
   -droptypes => ($^O eq 'MSWin32' ? 'Win32' : ['KDE', 'XDND', 'Sun'])
  );

$lbox = $top->Scrolled('Listbox',
               -scrollbars => "osoe",
    -height, 3, -width, 30,
              )->pack(-fill, 'both', -expand, '1');
$btn = $top->Button(-text, 'Show Files', -command, \&show_files)->pack
+();


MainLoop;

sub accept_drop {
    my($widget, $selection) = @_;

    my $filename;
    my $time = time-$start_drop;

    eval {
    if ($^O eq 'MSWin32') {
        $filename = $widget->SelectionGet(-selection => $selection,
                          'STRING');
    } else {
        $filename = $widget->SelectionGet(-selection => $selection,
                          'FILE_NAME');
    }
    };
    
    if($time > 1){ @files= @null; }
    $drop->delete('0', 'end');
    push @files, $filename;

    my $x = 0;
    foreach(@files){
    $drop->insert($x, $_);
    $x++;
    }

    $start_drop = time;
       
}

sub show_files {
    $lbox->delete('0','end');

    foreach(@files){ $lbox->insert('end', $_); }


}

    [download]
    I just compare the time... this will fail if someone is faster than 1 second or if the callbacks take longer than 1 second to complete... I tested it with 100 files. This is the only hack *cough, *cough... I could think of.
    Hope it helps...
    JamesNC
    fixed typo
[reply]
[d/l]
Re: Perl Tk: Dropsite aggregation vs singles
by jcavanaugh (Novice) on Jan 06, 2004 at 08:48 UTC

    Ok, here is what I ended up doing. I modified the Win32Site.pm so that the Win32Drop looks like the following. 

    sub Win32Drop
{
 # print join(',',@_),"\n";
 my ($w,$site,$msg,$wParam,$lParam) = @_;
 my ($x,$y,@files) = DropInfo($wParam);
 my $cb = $site->{'-dropcommand'};
 $site->Apply(-entercommand => $x, $y, 0);
 if ($cb)
  {
   foreach my $file (@files)
    {
     # print "$file @ $x,$y\n";
     $w->clipboardClear;
     $w->clipboardAppend('--',$file);
     $cb->Call('CLIPBOARD',$x,$y);
    }
  }
 $site->Apply(-entercommand => $x, $y, 1);
 return 0;
}

    [download]

    Basically all I did was change it so that it calls the "EnterCommand" before it processes a group of dropped files and "LeaveCommands" after. That gave me the necessary functionality.

    Now, how do I get this change incorporated into the main codebase??

[reply]
[d/l]

Back to Seekers of Perl Wisdom