diff options
author | Karl Berry <karl@freefriends.org> | 2019-03-10 21:56:14 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2019-03-10 21:56:14 +0000 |
commit | e0a2a718e89f9700d627f1e6a8eea8f21d2fbeb8 (patch) | |
tree | 39972f65008b0d70f306a5f976494d29411bc41e /Master/tlpkg/tlperl/site/lib/Tk/DragDrop/SunDrop.pm | |
parent | b206fdc77d81ed1600949062f08de5690a4bf66f (diff) |
tl19 perl 5.28.1 for Windows, from Siep
git-svn-id: svn://tug.org/texlive/trunk@50322 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/Tk/DragDrop/SunDrop.pm')
-rw-r--r-- | Master/tlpkg/tlperl/site/lib/Tk/DragDrop/SunDrop.pm | 200 |
1 files changed, 0 insertions, 200 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/Tk/DragDrop/SunDrop.pm b/Master/tlpkg/tlperl/site/lib/Tk/DragDrop/SunDrop.pm deleted file mode 100644 index 87489fed9a8..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Tk/DragDrop/SunDrop.pm +++ /dev/null @@ -1,200 +0,0 @@ -package Tk::DragDrop::SunDrop; -require Tk::DragDrop::Rect; - -use vars qw($VERSION); -$VERSION = '4.006'; # sprintf '4.%03d', q$Revision: #5 $ =~ /\D(\d+)\s*$/; - -use base qw(Tk::DragDrop::Rect); -use strict; -use Tk::DragDrop::SunConst; - -Tk::DragDrop->Type('Sun'); - -BEGIN - { - # Define the Rect API as members of the array - my @fields = qw(name win X Y width height flags ancestor widget); - my $i = 0; - no strict 'refs'; - for ($i=0; $i < @fields; $i++) - { - my $j = $i; - *{"$fields[$i]"} = sub { shift->[$j] }; - } - } - - -sub Preview -{ - my ($site,$token,$e,$kind,$flags) = (@_); - $token->BackTrace('No flags') unless defined $flags; - my $sflags = $site->flags; - return if ($kind == _motion && !($sflags & MOTION)); - return if ($kind != _motion && !($sflags & ENTERLEAVE)); - my $data = pack('LLSSLL',$kind,$e->t,$e->X,$e->Y,$site->name,$flags); - $token->SendClientMessage('_SUN_DRAGDROP_PREVIEW',$site->win,32,$data); -} - -sub Enter -{ - my ($site,$token,$e) = @_; - $token->AcceptDrop; - $site->Preview($token,$e,_enter,0); -} - -sub Leave -{ - my ($site,$token,$e) = @_; - $token->RejectDrop; - $site->Preview($token,$e,_leave,0); -} - -sub Motion -{ - my ($site,$token,$e) = @_; - $site->Preview($token,$e,_motion,0); -} - -sub HandleDone -{ - my ($token,$seln,$offset,$max) = @_; - $token->Done; - return ''; -} - -sub HandleAck -{ - my ($w,$seln,$offset,$max) = @_; - return ''; -} - -sub HandleItem -{ - my ($w,$seln,$offset,$max) = @_; - return undef; -} - -sub HandleCount -{ - my ($w,$seln,$offset,$max) = @_; - return 1; -} - -sub Drop -{ - my ($site,$token,$seln,$e) = @_; - my $w = $token->parent; - $w->SelectionHandle('-selection'=>$seln,'-type'=>'_SUN_DRAGDROP_ACK',[\&HandleAck,$token,$seln]); - $w->SelectionHandle('-selection'=>$seln,'-type'=>'_SUN_DRAGDROP_DONE',[\&HandleDone,$token,$seln]); - my $atom = $w->InternAtom($seln); - my $flags = ACK_FLAG | TRANSIENT_FLAG; - my $data = pack('LLSSLL',$atom,$e->t,$e->X,$e->Y,$site->name,$flags); - $w->SendClientMessage('_SUN_DRAGDROP_TRIGGER',$site->win,32,$data); -} - -sub FindSite -{ - my ($class,$token,$X,$Y) = @_; - $token->{'SunDD'} = [] unless exists $token->{'SunDD'}; - my $site = $class->SUPER::FindSite($token,$X,$Y); - if (!defined $site) - { - my $id = $token->PointToWindow($X,$Y); - while ($id) - { - my @prop; - Tk::catch { @prop = $token->property('get','_SUN_DRAGDROP_INTEREST', $id) }; - if (!$@ && shift(@prop) eq '_SUN_DRAGDROP_INTEREST' && shift(@prop) == 0) - { - # This is a "toplevel" which has some sites associated with it. - my ($bx,$by) = $token->WindowXY($id); - $token->{'SunDDSeen'} = {} unless exists $token->{'SunDDSeen'}; - return $site if $token->{'SunDDSeen'}{$id}; - $token->{'SunDDSeen'}{$id} = 1; - my $sites = $token->{'SunDD'}; - my $count = shift(@prop); - while (@prop && $count-- > 0) - { - my ($xid,$sn,$flags,$kind,$n) = splice(@prop,0,5); - if ($kind != 0) - { - warn "Don't understand site type $kind"; - last; - } - while (@prop >= 4 && $n-- > 0) - { - my ($x,$y,$w,$h) = splice(@prop,0,4); - push(@$sites,bless [$sn,$xid,$x+$bx,$y+$by,$w,$h,$flags,$id,$token],$class); - } - } - return $class->SUPER::FindSite($token,$X,$Y); - } - $id = $token->PointToWindow($X,$Y,$id) - } - } - return $site; -} - -my $busy = 0; - -sub NewDrag -{ - my ($class,$token) = @_; - delete $token->{'SunDD'} unless $busy; - delete $token->{'SunDDSeen'}; -} - -sub SiteList -{ - my ($class,$token) = @_; - return @{$token->{'SunDD'}}; -} - -1; -__END__ - -# this code is obsolete now that we look at properties ourselves -# which means we don't need dropsite manager running -# On Sun's running OpenLook the window manager or dropsite mananger -# watches for and caches site info in a special selection -# This code got sites from that -# - -sub SiteList -{ - my ($class,$token) = @_; - unless (1 || $busy || exists $token->{'SunDD'}) - { - Carp::confess('Already doing it!') if ($busy++); - my @data = (); - my @sites = (); - my $mw = $token->MainWindow; - $token->{'SunDD'} = \@sites; - Tk::catch { - @data = $mw->SelectionGet( '-selection'=>'_SUN_DRAGDROP_DSDM', '_SUN_DRAGDROP_SITE_RECTS'); - }; - if ($@) - { - $token->configure('-cursor'=>'hand2'); - $token->grab(-global); - } - else - { - while (@data) - { - my $version = shift(@data); - if ($version != 0) - { - warn "Unexpected site version $version"; - last; - } - push(@sites,bless [splice(@data,0,7)],$class); - } - } - $busy--; - } - return @{$token->{'SunDD'}}; -} - -1; - |