summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/DragDrop/XDNDDrop.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/DragDrop/XDNDDrop.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/DragDrop/XDNDDrop.pm145
1 files changed, 0 insertions, 145 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/DragDrop/XDNDDrop.pm b/Master/tlpkg/tlperl/lib/Tk/DragDrop/XDNDDrop.pm
deleted file mode 100644
index 7376c8d69c5..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/DragDrop/XDNDDrop.pm
+++ /dev/null
@@ -1,145 +0,0 @@
-package Tk::DragDrop::XDNDDrop;
-use strict;
-use vars qw($VERSION);
-$VERSION = sprintf '4.%03d', q$Revision: #6 $ =~ /\D(\d+)\s*$/;
-use base qw(Tk::DragDrop::Rect);
-
-sub XDND_PROTOCOL_VERSION () { 4 }
-
-Tk::DragDrop->Type('XDND');
-
-sub NewDrag
-{
- my ($class,$token) = @_;
- $token->{$class} = {};
-}
-
-sub new
-{
- my ($class,$token,$id,@prop) = @_;
- my $ver = $token->InternAtom(shift(@prop));
- # warn "XDND version $ver ".join(' ',@prop)."\n";
- $ver = XDND_PROTOCOL_VERSION if $ver > XDND_PROTOCOL_VERSION;
- my $site = bless { id => $id, token => $token, ver => $ver, state => 0, accept => \@prop}, $class;
- my $w = $token->parent;
- $w->BindClientMessage('XdndStatus',[$site => 'XdndStatus']);
- $w->BindClientMessage('XdndFinished',[$site => 'XdndFinished']);
- return $site;
-}
-
-sub Drop
-{
- my ($site,$token,$seln,$e) = @_;
- my $w = $token->parent;
- my $data = pack('LLLLL',oct($w->id),0,$e->t,0,0);
- $w->SendClientMessage('XdndDrop',$site->{id},32,$data);
-}
-
-sub FindSite
-{
- my ($class,$token,$X,$Y) = @_;
- my $id = $token->PointToWindow($X,$Y);
- while ($id)
- {
- my @prop;
- Tk::catch { @prop = $token->property('get','XdndAware', $id) };
- if (!$@ && shift(@prop) eq 'ATOM')
- {
- my $hash = $token->{$class};
- my $site = $hash->{$id};
- if (!defined $site)
- {
- $site = $class->new($token,$id,@prop);
- $hash->{$id} = $site;
- }
- return $site;
- }
- $id = $token->PointToWindow($X,$Y,$id)
- }
- return undef;
-}
-
-sub Enter
-{
- my ($site,$token,$e) = @_;
- my $w = $token->parent;
- $token->InstallHandlers('XdndSelection');
- my $seln = $token->cget('-selection');
- my @targets = grep(!/^(TARGETS|MULTIPLE|TIMESTAMP)$/,reverse($token->SelectionGet('-selection'=> 'XdndSelection','TARGETS')));
- # print join(' ',@targets),"\n";
- my $flags = ($site->{ver} << 24);
- my @atarg = map($token->InternAtom($_),@targets);
- my $ntarg = @atarg;
- if ($ntarg > 3)
- {
- $flags |= 1;
- $w->property('set','XdndTypeList','ATOM',32,\@atarg);
- splice(@atarg,3);
- }
- else
- {
- splice(@atarg,$ntarg,(0 x 3 - $ntarg));
- }
- unshift(@atarg,oct($w->id),$flags);
- # print join(' ',map(sprintf("%08X",$_),@atarg)),"\n";
- my $data = pack('LLLLL',@atarg);
- $w->SendClientMessage('XdndEnter',$site->{id},32,$data);
-}
-
-sub Leave
-{
- my ($site,$token,$e) = @_;
- my $w = $token->parent;
- my $data = pack('LLLLL',oct($w->id), 0, 0, 0, 0);
- $w->SendClientMessage('XdndLeave',$site->{id},32,$data);
-}
-
-sub Motion
-{
- my ($site,$token,$e) = @_;
- my $X = $e->X;
- my $Y = $e->Y;
- my $w = $token->parent;
- my $action = $token->InternAtom($site->{'action'} || 'XdndActionCopy');
- my @atarg = (oct($w->id),0,($X << 16) | $Y, $e->t, $action);
- # print join(' ',map(sprintf("%08X",$_),@atarg)),"\n";
- my $data = pack('LLLLL',@atarg);
- $w->SendClientMessage('XdndPosition',$site->{id},32,$data);
-}
-
-sub XdndFinished
-{
- my ($site) = @_;
- my $token = $site->{token};
- # printf "XdndFinished $site\n",
- $token->Done;
-}
-
-sub XdndStatus
-{
- my ($site) = @_;
- my $token = $site->{token};
- my $w = $token->parent;
- my $event = $w->XEvent;
- my ($tid,$flags,$xy,$wh,$action) = unpack('LLLLL',$event->A);
- $action = $w->GetAtomName($action) if $action;
- $site->{flags} = $flags;
- $site->{'X'} = $xy >> 16;
- $site->{'Y'} = $xy & 0xFFFF;
- $site->{'width'} = $wh >> 16;
- $site->{'height'} = $wh & 0xFFFF;
- #printf "XdndStatus $site targ=%x flags=%08X x=%d y=%d w=%d h=%d a=%s\n",
- # $tid,$flags,$xy >> 16, $xy & 0xFFFF, $wh >> 16, $wh & 0xFFFF,$action;
- if ($flags & 1)
- {
- $token->AcceptDrop;
- }
- else
- {
- $token->RejectDrop;
- }
-}
-
-
-1;
-__END__