Win32Site.pm drag and drop problem

[Erik Lechak]

Hello All,

When I use the Win32 type DropSite. I keep getting extra things
printed out to the current (selected) filehandle ( i.e. STDOUT). You
can try it out if you are using a Widows machine by running the first
chunk of code attached to this message.

You will notice that there isn't a print in the entire program. But
it sure does like to print.

I did some snooping in the source and I found 2 print statements and
an annoying warn in Win32Site.pm (the second bit of perl code is a
section from this file that contains the print statements).

I downloaded the most recent version of tk from cpan just to make sure
that the prints were still in there. And they are.

My question is does this look like some debugging stuff left in or
should it be there? And if it should go away, who do you talk to to
make the fix?

Thanks,
Erik Lechak
ele...@bigfoot.com

#---------------------------------------------------------
#
# PROGRAM TO TRY WIN DND
#
#!/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;

$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);
}
}

#---------------------------------------------------------------
#
# SECTION OF CODE FROM WIN32SITE.PM
#

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