home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / KDEDrop.pm < prev    next >
Encoding:
Perl POD Document  |  2003-07-20  |  1.5 KB  |  86 lines
  1. package Tk::DragDrop::KDEDrop;
  2. use strict;
  3. use vars qw($VERSION);
  4. $VERSION = '4.004'; # $Id: //depot/Tkutf8/DragDrop/DragDrop/KDEDrop.pm#4 $
  5. use base qw(Tk::DragDrop::Rect);
  6.  
  7. Tk::DragDrop->Type('KDE');
  8.  
  9. sub NewDrag
  10. {
  11.  my ($class,$token) = @_;
  12.  $token->{$class} = {};
  13. }
  14.  
  15. sub new
  16. {
  17.  my ($class,$token,$id) = @_;
  18.  return bless {id => $id, token =>$token},$class;
  19. }
  20.  
  21.  
  22. sub Drop
  23. {
  24.  my ($site,$token,$seln,$e) = @_;
  25.  my $w   = $token->parent;
  26.  my $string;
  27.  Tk::catch { $string = $w->SelectionGet(-selection => $seln, -type => 'FILE_NAME') };
  28.  if (!$@ && defined $string)
  29.   {
  30.    $w->property('set','DndSelection','STRING',8,"file:$string",'root');
  31.    my $data = pack('LLLLL',128,0,0,$e->X,$e->Y);
  32.    $w->SendClientMessage('DndProtocol',$site->{id},32,$data);
  33.   }
  34.  else
  35.   {
  36.    warn $@ if $@;
  37.   }
  38. }
  39.  
  40. sub FindSite
  41. {
  42.  my ($class,$token,$X,$Y) = @_;
  43.  my $id = $token->PointToWindow($X,$Y);
  44.  my $seen = 1;
  45.  my $best;
  46.  while ($id)
  47.   {
  48.    my @prop;
  49.    Tk::catch { @prop = $token->property('get','KDE_DESKTOP_WINDOW', $id) };
  50.    $seen = 1 if (!$@ && shift(@prop) eq 'KDE_DESKTOP_WINDOW');
  51.    $best = $id if $seen;
  52.    $id = $token->PointToWindow($X,$Y,$id)
  53.   }
  54.  if (defined $best)
  55.   {
  56.    my $hash = $token->{$class};
  57.    my $site = $hash->{$best};
  58.    if (!defined $site)
  59.     {
  60.      $site = $class->new($token,$best);
  61.      $hash->{$best} = $site;
  62.     }
  63.    return $site;
  64.   }
  65.  return undef;
  66. }
  67.  
  68. sub Enter
  69. {
  70.  my ($site,$token,$e) = @_;
  71. }
  72.  
  73. sub Leave
  74. {
  75.  my ($site,$token,$e) = @_;
  76. }
  77.  
  78. sub Motion
  79. {
  80.  my ($site,$token,$e) = @_;
  81. }
  82.  
  83.  
  84. 1;
  85. __END__
  86.