OK, I found this test application from the DragDrop directory (site_test, I think). It works great under ActivePerl on Win32 ... but it seriously doesn't work on my Mandrake 9.1 home desktop, nor can I make it work.

The first problem I encounter is that the Tk::DragDrop::*Site/Drop modules are not loading correctly, I have to explicitly add

use Tk::DragDrop::XDNDSite;
use Tk::DragDrop::XDNDDrop;

use Tk::DragDrop::SunSite;
use Tk::DragDrop::SunDrop;

use Tk::DragDrop::KDESite;
use Tk::DragDrop::KDEDrop;

... which doesn't seem right (but I don't know much about how perl decides to decompress certain modules and not others, so I can't debug this)

But more importantly, the application window still does not accept drops from other apps. I've tried MozillaFirebird as well - another XDND supporting application, and anything I drag to the perl/Tk window is just not accepted ... (How humiliating - a perl app works better in Win32 than it does under linux ...:) 

----- site_test.pl -----

#!/usr/local/bin/perl -w
use Tk;
use strict;
use Tk::DropSite;
use vars qw($kind $STRING $FILE_NAME);
BEGIN
{
 $kind = ($^O eq 'MSWin32' or ($^O eq 'cygwin' and $Tk::platform eq 'M
+SWin32'))?
          ['Win32'] : ['Sun','XDND','KDE']
}
use Tk::DropSite @$kind;
use Tk::DragDrop @$kind;
use Tk::Menubar;

sub enter_leave
{
 my ($ds,$flag) = @_;
 $ds->configure(-relief => ($flag) ? 'sunken' : 'ridge');
 return 1;
}

my $top = MainWindow->new();
my $mb  = $top->Menubar;
$mb->Menubutton(-text => '~File', -menuitems => [
                [ Button => 'E~xit', -command => [ destroy => $top]],
                ]);

my $but = $top->Frame->pack;

my $lb = $top->Scrolled('Listbox',-width => 40)->pack(-side => 'bottom
+');

$but->Button('-text' => "Primary Targets", '-command' => [\&ShowTarget
+s,$lb,'PRIMARY'])->pack('-side'=>'left');
$but->Button('-text' => "Quit", '-command' => ['destroy',$top])->pack(
+'-side'=>'right');

my $filename = "/tmp/SomethingSilly";

open(FOO,">$filename");
print FOO "Hi There\n";
close(FOO);

my $src = $top->Frame->pack;
foreach my $k ('Local',@$kind,'Any')
 {
  # next if $k eq 'KDE';
  my $thing = $src->Message('-text' => "$k Source")->pack(-side => 'le
+ft');
  my @list;
  @list = (-sitetypes => $k) unless $k eq 'Any';
  $thing->DragDrop(-event => '<B1-Motion>', @list,
                 -handlers => [
                   [-type => 'text/plain',[\&string_handler,"This is t
+ext/plain"]],
                   [-type => 'FILE_NAME',[\&string_handler,$filename]]
+,
                   [[\&string_handler,"This is STRING"]]
                 ]);
 }


my $dst = $top->Frame->pack;
foreach my $k ('Local',@$kind,'Any')
 {
  my @list;
  @list = (-droptypes => $k) unless $k eq 'Any';
  my $sun = $dst->Message('-text' => "$k Drops here", '-relief' => 'ri
+dge' )->pack(-side => 'left');
  $sun->DropSite(-dropcommand => [\&ShowTargets,$lb],
                 -entercommand => [\&enter_leave,$sun],
                 @list);
 }

my $str = $top->Frame->pack(-fill => 'x');
foreach my $targ (qw(STRING FILE_NAME))
 {
  no strict 'refs';
  my $l = $str->Label(-anchor => 'e', -justify => 'right', -text => $t
+arg);
  my $v = $str->Label(-anchor => 'w', -justify => 'left', -relief => '
+groove',
              -textvariable => \${$targ});
  Tk::grid($l,$v,-sticky => 'ew');
 }
$str->gridColumnconfigure(0,-weight => 0);
$str->gridColumnconfigure(1,-weight => 1);

sub string_handler
{
 my ($text,$offset,$max) = @_;
 return substr($text,$offset,$max);
}

MainLoop;

use Data::Dumper;

sub ShowTargets
{
 my $lb = shift;
 my $seln = shift;
 my $own =  $lb->SelectionExists('-selection'=>$seln);
 printf "owner of $seln is %x\n",$own;
 my @targ = $lb->SelectionGet('-selection'=>$seln,'TARGETS');
 $lb->delete(0,'end');
 $lb->insert('end',@targ);
 $STRING = $FILE_NAME = '';
 foreach (@targ)
  {
   if (/FILE_NAME/)
    {
     $FILE_NAME = $lb->SelectionGet('-selection'=>$seln,'FILE_NAME');
    }
   if (/_SUN/ && !/(END|ACK|DONE|YIELD)/)
    {
     my @info;
     Tk::catch { @info  = $lb->SelectionGet('-selection'=>$seln,$_) };
     if ($@)
      {
       print "Cannot get $_\n";
      }
     else
      {
       print "$_:",Dumper(\@info);
      }
    }
   if (m#^(STRING|text/plain)$#)
    {
     my $string = $lb->SelectionGet('-selection'=>$seln,$_);
     $string = substr($string,0,37)."..." if length($string) > 40;
     $STRING = $string;
    }
  }
}

[download]

In reply to Re: Perl/Tk remote drag-and-drop by Anonymous Monk
in thread Perl/Tk remote drag-and-drop by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.