home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / DragDrop / SunSite.pm < prev   
Encoding:
Perl POD Document  |  1997-08-10  |  2.3 KB  |  92 lines
  1. package Tk::DragDrop::SunSite;
  2. require Tk::DropSite;
  3. use Tk::DragDrop::SunConst;
  4. @ISA = qw(Tk::DropSite);
  5. use strict;
  6.  
  7. Tk::DropSite->Type('Sun');
  8.  
  9. sub SunDrop
  10. {
  11.  my ($w,$site) = @_;
  12.  my $e = $w->XEvent;
  13.  my ($atom,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$e->A);
  14.  $x -= $site->X;
  15.  $y -= $site->Y;
  16.  my $seln = $w->GetAtomName($atom);
  17.  if ($flags & &ACK_FLAG)
  18.   {
  19.    eval {local $SIG{__DIE__}; $w->SelectionGet('-selection'=>$seln,"_SUN_DRAGDROP_ACK");};
  20.   }
  21.  $site->Callback(-dropcommand => $seln, $x, $y);
  22.  if ($flags & &TRANSIENT_FLAG)
  23.   {
  24.    eval {local $SIG{__DIE__};  $w->SelectionGet('-selection'=>$seln,"_SUN_DRAGDROP_DONE");};
  25.   }
  26.  $w->configure('-relief' => $w->{'_DND_RELIEF_'}) if (defined $w->{'_DND_RELIEF_'})
  27. }
  28.  
  29. sub SunPreview
  30. {
  31.  my ($w,$site) = @_;
  32.  my $event = $w->XEvent;
  33.  my ($kind,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$event->A);
  34.  $x -= $site->X;
  35.  $y -= $site->Y;
  36.  if ($kind == _enter)
  37.   {
  38.    $site->Callback(-entercommand => 1, $x, $y);
  39.   }
  40.  elsif ($kind == _leave)
  41.   {
  42.    $site->Callback(-entercommand => 0, $x, $y);
  43.   }
  44.  elsif ($kind == _motion)
  45.   {
  46.    $site->Callback(-motioncommand => $x, $y);
  47.   }
  48. }
  49.  
  50. sub InitSite
  51. {
  52.  my ($class,$site) = @_;
  53.  my $w = $site->widget;
  54.  $w->BindClientMessage('_SUN_DRAGDROP_TRIGGER',[\&SunDrop,$site]);
  55.  $w->BindClientMessage('_SUN_DRAGDROP_PREVIEW',[\&SunPreview,$site]);
  56. }
  57.  
  58. sub NoteSites
  59. {
  60.  my ($class,$t,$sites) = @_;
  61.  my $count = @$sites;
  62.  if ($count)
  63.   {
  64.    my @data  = (0,$count);
  65.    my $s;             
  66.    my $i = 0;         
  67.    foreach $s (@$sites)
  68.     {                 
  69.      my $w = $s->widget;
  70.      $w->MakeWindowExist;
  71.      push(@data,${$w->WindowId});                   # XID
  72.      push(@data,$i++);                              # Our "tag"
  73.      push(@data,&ENTERLEAVE|&MOTION);               # Flags
  74.      push(@data,0);                                 # Kind is "rect"
  75.      push(@data,1);                                 # Number of rects
  76.      push(@data,$s->x,$s->y,$s->width,$s->height);  # The rect
  77.     }                 
  78.    $t->property('set',
  79.                 "_SUN_DRAGDROP_INTEREST",           # name
  80.                 "_SUN_DRAGDROP_INTEREST",           # type
  81.                 32,                                 # format 
  82.                 \@data);                            # the data 
  83.   }
  84.  else
  85.   {
  86.    $t->property('delete',"_SUN_DRAGDROP_INTEREST");
  87.   }
  88. }
  89.  
  90.  
  91. 1;
  92.