summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/DragDrop/SunSite.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/DragDrop/SunSite.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/DragDrop/SunSite.pm107
1 files changed, 107 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/DragDrop/SunSite.pm b/Master/tlpkg/tlperl/lib/Tk/DragDrop/SunSite.pm
new file mode 100644
index 00000000000..ac6f7488a7a
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/DragDrop/SunSite.pm
@@ -0,0 +1,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;