home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2004 July / APC0407D2.iso / workshop / apache / files / ActivePerl-5.6.1.638-MSWin32-x86.msi / _0f8bf72d6dd4c32fb6d3ea23cdf4d91a < prev    next >
Encoding:
Text File  |  2004-04-13  |  1.2 KB  |  51 lines
  1. package Tk::DragDrop::KDESite;
  2. use strict;
  3. use vars qw($VERSION);
  4. $VERSION = '3.007'; # $Id: //depot/Tk8/DragDrop/DragDrop/KDESite.pm#7 $
  5. use base qw(Tk::DropSite);
  6.  
  7. Tk::DropSite->Type('KDE');
  8.  
  9. sub InitSite
  10. {my ($class,$site) = @_;
  11.  my $w = $site->widget;
  12.  $w->BindClientMessage('DndProtocol',[\&KDEDrop,$site]);
  13. }
  14.  
  15. sub HandleLoose
  16. {
  17.  my ($w,$seln) = @_;
  18.  return '';
  19. }            
  20.  
  21. sub HandleData
  22. {
  23.  my ($string,$offset,$max) = @_;
  24.  return substr($string,$offset,$max);
  25. }
  26.  
  27. sub KDEDrop
  28. {
  29.  my ($w,$site) = @_;
  30.  my $event = $w->XEvent;
  31.  my ($type,$time,$flags,$X,$Y) = unpack('LLLLL',$event->A);
  32.  my @data = $w->property('get','DndSelection','root');
  33.  if ($type == 128 && @data == 1 && $data[0] =~ /^file:(.*)$/)
  34.   {
  35.    # Grab a selection for compatibility with other DND schemes
  36.    my $seln = 'XdndSelection';
  37.    $w->SelectionHandle('-selection' => $seln, -type => 'FILE_NAME', 
  38.                         [\&HandleData,"$1"]);   
  39.    $w->SelectionOwn('-selection' => $seln, 
  40.                        -command  => [\&HandleLoose,$w,$seln]);    
  41.    $site->Apply(-dropcommand => $Y, $Y, $seln); 
  42.   } 
  43.  else
  44.   {
  45.    print join(' ',$type,$time,$flags,$X,$Y),':"',join(',',@data),'"',"\n";
  46.   }
  47. }
  48.  
  49. 1;
  50. __END__
  51.