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 / SunSite.pm

package Tk::DragDrop::SunSite;
require Tk::DropSite;

use vars qw($VERSION);
$VERSION = '3.011'; # $Id: //depot/Tk8/DragDrop/DragDrop/SunSite.pm#11 $

use Tk::DragDrop::SunConst;
use base  qw(Tk::DropSite);
use strict;

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

sub SunDrop
{
 my ($w,$site) = @_;
 my $e = $w->XEvent;
 my ($atom,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$e->A);
 $x -= $site->X;
 $y -= $site->Y;
 my $seln = $w->GetAtomName($atom);
 if ($flags & &ACK_FLAG)
  {
   eval {local $SIG{__DIE__}; $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_ACK');};
  }
 $site->Callback(-dropcommand => $seln, $x, $y);
 if ($flags & &TRANSIENT_FLAG)
  {
   eval {local $SIG{__DIE__};  $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_DONE');};
  }
 $w->configure('-relief' => $w->{'_DND_RELIEF_'}) if (defined $w->{'_DND_RELIEF_'});
 $site->Callback(-entercommand => 0, $x, $y);
}

sub SunPreview
{
 my ($w,$site) = @_;
 my $event = $w->XEvent;
 my ($kind,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$event->A);
 $x -= $site->X;
 $y -= $site->Y;
 if ($kind == _enter)
  {
   $site->Callback(-entercommand => 1, $x, $y);
  }
 elsif ($kind == _leave)
  {
   $site->Callback(-entercommand => 0, $x, $y);
  }
 elsif ($kind == _motion)
  {
   $site->Callback(-motioncommand => $x, $y);
  }
}

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

sub NoteSites
{
 my ($class,$t,$sites) = @_;
 my $count = @$sites;
 my @data  = (0,0);
 my ($wrapper,$offset) = $t->wrapper;
 if ($t->viewable)
  {
   my $s;
   my $i = 0;
   my @win;
   my $bx = $t->rootx;
   my $by = $t->rooty - $offset;
   $t->MakeWindowExist;
   foreach $s (@$sites)
    {
     my $w = $s->widget;
     if ($w->viewable)
      {
       $w->MakeWindowExist;
       $data[1]++;
       push(@data,${$w->WindowId});                   # XID
       push(@data,$i++);                              # Our 'tag'
       push(@data,ENTERLEAVE|MOTION);                 # Flags
       push(@data,0);                                 # Kind is 'rect'
       push(@data,1);                                 # Number of rects
       push(@data,$s->X-$bx,$s->Y-$by,$s->width,$s->height);  # The rect
      }
    }
  }
 if ($data[1])
  {
   $t->property('set',
                '_SUN_DRAGDROP_INTEREST',           # name
                '_SUN_DRAGDROP_INTEREST',           # type
                32,                                 # format
                \@data,$wrapper);                   # the data
  }
 else
  {
   $t->property('delete','_SUN_DRAGDROP_INTEREST',$wrapper);
  }
}


1;