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

package Tk::DragDrop::SunDrop;
require  Tk::DragDrop::Rect;

use vars qw($VERSION);
$VERSION = '3.015'; # $Id: //depot/Tk8/DragDrop/DragDrop/SunDrop.pm#15 $

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

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

BEGIN
{
 my @fields = qw(name win X Y width height flags);
 my $i = 0;
 no strict 'refs';
 for ($i=0; $i < @fields; $i++)
  {
   my $j    = $i;
   *{"$fields[$i]"} = sub { shift->[$j] };
  }
}

sub Preview
{
my ($site,$token,$e,$kind,$flags) = (@_);
$token->BackTrace('No flags') unless defined $flags;
my $sflags = $site->flags;
return if ($kind == _motion && !($sflags & MOTION));
return if ($kind != _motion && !($sflags & ENTERLEAVE));
my $data = pack('LLSSLL',$kind,$e->t,$e->X,$e->Y,$site->name,$flags);
$token->SendClientMessage('_SUN_DRAGDROP_PREVIEW',$site->win,32,$data);
}

sub Enter
{
my ($site,$token,$e) = @_;
$token->AcceptDrop;
$site->Preview($token,$e,_enter,0);
}

sub Leave
{
my ($site,$token,$e) = @_;
$token->RejectDrop;
$site->Preview($token,$e,_leave,0);
}

sub Motion
{
my ($site,$token,$e) = @_;
$site->Preview($token,$e,_motion,0);
}

sub HandleDone
{
my ($token,$seln,$offset,$max) = @_;
$token->Done;
return '';
}

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

sub HandleItem
{
my ($w,$seln,$offset,$max) = @_;
return undef;
}

sub HandleCount
{
my ($w,$seln,$offset,$max) = @_;
return 1;
}

sub Drop
{
my ($site,$token,$seln,$e) = @_;
my $w  = $token->parent;
$w->SelectionHandle('-selection'=>$seln,'-type'=>'_SUN_DRAGDROP_ACK',[\&HandleAck,$token,$seln]);
$w->SelectionHandle('-selection'=>$seln,'-type'=>'_SUN_DRAGDROP_DONE',[\&HandleDone,$token,$seln]);
my $atom  = $w->InternAtom($seln);
my $flags = ACK_FLAG | TRANSIENT_FLAG;
my $data  = pack('LLSSLL',$atom,$e->t,$e->X,$e->Y,$site->name,$flags);
$w->SendClientMessage('_SUN_DRAGDROP_TRIGGER',$site->win,32,$data);
}


sub FindSite
{
my ($class,$token,$X,$Y) = @_;
$token->{'SunDD'} = [] unless exists $token->{'SunDD'};
my $site = $class->SUPER::FindSite($token,$X,$Y);
if (!defined $site)
 {
  my $id = $token->PointToWindow($X,$Y);
  while ($id)
   {
    my @prop;
    Tk::catch { @prop = $token->property('get','_SUN_DRAGDROP_INTEREST', $id) };
    if (!$@ && shift(@prop) eq '_SUN_DRAGDROP_INTEREST' && shift(@prop) == 0)
     {
      my ($bx,$by) = $token->WindowXY($id);
      $token->{'SunDDSeen'} = {} unless exists $token->{'SunDDSeen'};
      return $site if $token->{'SunDDSeen'}{$id};
      $token->{'SunDDSeen'}{$id} = 1;
      my $sites = $token->{'SunDD'};
      my $count = shift(@prop);
      while (@prop && $count-- > 0)
       {
        my ($xid,$sn,$flags,$kind,$n) = splice(@prop,0,5);
        if ($kind != 0)
         {
          warn "Don't understand site type $kind";
          last;
         }
        while (@prop >= 4 && $n-- > 0)
         {
          my ($x,$y,$w,$h) = splice(@prop,0,4);
          push(@$sites,bless [$sn,$xid,$x+$bx,$y+$by,$w,$h,$flags],$class);
         }
       }
      return $class->SUPER::FindSite($token,$X,$Y);
     }
    $id = $token->PointToWindow($X,$Y,$id)
   }
 }
return $site;
}

my $busy = 0;

sub NewDrag
{
my ($class,$token) = @_;
delete $token->{'SunDD'} unless $busy;
delete $token->{'SunDDSeen'};
}

sub SiteList
{
my ($class,$token) = @_;
# this code is obsolete now that we look at properties ourselves
# which means we don't need dropsite manager running
unless (1 || $busy || exists $token->{'SunDD'})
 {
  Carp::confess('Already doing it!') if ($busy++);
  my @data  = ();
  my @sites = ();
  my $mw = $token->MainWindow;
  $token->{'SunDD'} = \@sites;
  Tk::catch {
     @data = $mw->SelectionGet( '-selection'=>'_SUN_DRAGDROP_DSDM',  '_SUN_DRAGDROP_SITE_RECTS');
  };
  if ($@)
   {
    $token->configure('-cursor'=>'hand2');
    $token->grab(-global);
   }
  else
   {
    while (@data)
     {
      my $version = shift(@data);
      if ($version != 0)
       {
        warn "Unexpected site version $version";
        last;
       }
      push(@sites,bless [splice(@data,0,7)],$class);
     }
   }
  $busy--;
 }
return @{$token->{'SunDD'}};
}

1;
__END__