| 1 | package Tk::DragDrop::SunSite; |
| 2 | require Tk::DropSite; |
| 3 | |
| 4 | use vars qw($VERSION); |
| 5 | $VERSION = '3.011'; # $Id: //depot/Tk8/DragDrop/DragDrop/SunSite.pm#11 $ |
| 6 | |
| 7 | use Tk::DragDrop::SunConst; |
| 8 | use base qw(Tk::DropSite); |
| 9 | use strict; |
| 10 | |
| 11 | Tk::DropSite->Type('Sun'); |
| 12 | |
| 13 | sub SunDrop |
| 14 | { |
| 15 | my ($w,$site) = @_; |
| 16 | my $e = $w->XEvent; |
| 17 | my ($atom,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$e->A); |
| 18 | $x -= $site->X; |
| 19 | $y -= $site->Y; |
| 20 | my $seln = $w->GetAtomName($atom); |
| 21 | if ($flags & &ACK_FLAG) |
| 22 | { |
| 23 | eval {local $SIG{__DIE__}; $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_ACK');}; |
| 24 | } |
| 25 | $site->Callback(-dropcommand => $seln, $x, $y); |
| 26 | if ($flags & &TRANSIENT_FLAG) |
| 27 | { |
| 28 | eval {local $SIG{__DIE__}; $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_DONE');}; |
| 29 | } |
| 30 | $w->configure('-relief' => $w->{'_DND_RELIEF_'}) if (defined $w->{'_DND_RELIEF_'}); |
| 31 | $site->Callback(-entercommand => 0, $x, $y); |
| 32 | } |
| 33 | |
| 34 | sub SunPreview |
| 35 | { |
| 36 | my ($w,$site) = @_; |
| 37 | my $event = $w->XEvent; |
| 38 | my ($kind,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$event->A); |
| 39 | $x -= $site->X; |
| 40 | $y -= $site->Y; |
| 41 | if ($kind == _enter) |
| 42 | { |
| 43 | $site->Callback(-entercommand => 1, $x, $y); |
| 44 | } |
| 45 | elsif ($kind == _leave) |
| 46 | { |
| 47 | $site->Callback(-entercommand => 0, $x, $y); |
| 48 | } |
| 49 | elsif ($kind == _motion) |
| 50 | { |
| 51 | $site->Callback(-motioncommand => $x, $y); |
| 52 | } |
| 53 | } |
| 54 | |
| 55 | sub InitSite |
| 56 | { |
| 57 | my ($class,$site) = @_; |
| 58 | my $w = $site->widget; |
| 59 | $w->BindClientMessage('_SUN_DRAGDROP_TRIGGER',[\&SunDrop,$site]); |
| 60 | $w->BindClientMessage('_SUN_DRAGDROP_PREVIEW',[\&SunPreview,$site]); |
| 61 | } |
| 62 | |
| 63 | sub NoteSites |
| 64 | { |
| 65 | my ($class,$t,$sites) = @_; |
| 66 | my $count = @$sites; |
| 67 | my @data = (0,0); |
| 68 | my ($wrapper,$offset) = $t->wrapper; |
| 69 | if ($t->viewable) |
| 70 | { |
| 71 | my $s; |
| 72 | my $i = 0; |
| 73 | my @win; |
| 74 | my $bx = $t->rootx; |
| 75 | my $by = $t->rooty - $offset; |
| 76 | $t->MakeWindowExist; |
| 77 | foreach $s (@$sites) |
| 78 | { |
| 79 | my $w = $s->widget; |
| 80 | if ($w->viewable) |
| 81 | { |
| 82 | $w->MakeWindowExist; |
| 83 | $data[1]++; |
| 84 | push(@data,${$w->WindowId}); # XID |
| 85 | push(@data,$i++); # Our 'tag' |
| 86 | push(@data,ENTERLEAVE|MOTION); # Flags |
| 87 | push(@data,0); # Kind is 'rect' |
| 88 | push(@data,1); # Number of rects |
| 89 | push(@data,$s->X-$bx,$s->Y-$by,$s->width,$s->height); # The rect |
| 90 | } |
| 91 | } |
| 92 | } |
| 93 | if ($data[1]) |
| 94 | { |
| 95 | $t->property('set', |
| 96 | '_SUN_DRAGDROP_INTEREST', # name |
| 97 | '_SUN_DRAGDROP_INTEREST', # type |
| 98 | 32, # format |
| 99 | \@data,$wrapper); # the data |
| 100 | } |
| 101 | else |
| 102 | { |
| 103 | $t->property('delete','_SUN_DRAGDROP_INTEREST',$wrapper); |
| 104 | } |
| 105 | } |
| 106 | |
| 107 | |
| 108 | 1; |