Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / DragDrop / KDESite.pm

package Tk::DragDrop::KDESite;
use strict;
use vars qw($VERSION);
$VERSION = '3.007'; # $Id: //depot/Tk8/DragDrop/DragDrop/KDESite.pm#7 $
use base qw(Tk::DropSite);

Tk::DropSite->Type('KDE');

sub InitSite
{my ($class,$site) = @_;
my $w = $site->widget;
$w->BindClientMessage('DndProtocol',[\&KDEDrop,$site]);
}

sub HandleLoose
{
my ($w,$seln) = @_;
return '';
}            

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

sub KDEDrop
{
my ($w,$site) = @_;
my $event = $w->XEvent;
my ($type,$time,$flags,$X,$Y) = unpack('LLLLL',$event->A);
my @data = $w->property('get','DndSelection','root');
if ($type == 128 && @data == 1 && $data[0] =~ /^file:(.*)$/)
 {
  # Grab a selection for compatibility with other DND schemes
  my $seln = 'XdndSelection';
  $w->SelectionHandle('-selection' => $seln, -type => 'FILE_NAME', 
                       [\&HandleData,"$1"]);   
  $w->SelectionOwn('-selection' => $seln, 
                      -command  => [\&HandleLoose,$w,$seln]);    
  $site->Apply(-dropcommand => $Y, $Y, $seln); 
 } 
else
 {
  print join(' ',$type,$time,$flags,$X,$Y),':"',join(',',@data),'"',"\n";
 }
}

1;
__END__