/usr/lib/perl5/Tk/DragDrop/SunSite.pm is in perl-tk 1:804.031-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | package Tk::DragDrop::SunSite;
require Tk::DropSite;
use vars qw($VERSION);
$VERSION = '4.007'; # sprintf '4.%03d', q$Revision: #6 $ =~ /\D(\d+)\s*$/;
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 ($seln,$t,$x,$y,$id,$flags) = unpack('LLSSLL',$e->A);
$w->MakeAtom($seln);
if ($flags & &ACK_FLAG)
{
Tk::catch { $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_ACK') };
}
my @targ = $w->SelectionGet(-selection => $seln,'TARGETS');
$site->Apply(-dropcommand => $x, $y, $seln, SunDrop => \@targ);
if ($flags & &TRANSIENT_FLAG)
{
Tk::catch { $w->SelectionGet('-selection'=>$seln,'_SUN_DRAGDROP_DONE') };
}
$w->configure('-relief' => $w->{'_DND_RELIEF_'}) if (defined $w->{'_DND_RELIEF_'});
$site->Apply(-entercommand => $x, $y, 0);
}
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;
|