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 = 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;
|
