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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#!/usr/local/bin/perl -w
use Tk;
use strict;
use Tk::DropSite;
use vars qw($kind $STRING $FILE_NAME);
BEGIN
{
$kind = ($^O eq 'MSWin32' or ($^O eq 'cygwin' and $Tk::platform eq 'MSWin32'))?
['Win32'] : ['Sun','XDND','KDE']
}
use Tk::DropSite @$kind;
use Tk::DragDrop @$kind;
use Tk::Menubar;
sub enter_leave
{
my ($ds,$flag) = @_;
$ds->configure(-relief => ($flag) ? 'sunken' : 'ridge');
return 1;
}
my $top = MainWindow->new();
my $mb = $top->Menubar;
$mb->Menubutton(-text => '~File', -menuitems => [
[ Button => 'E~xit', -command => [ destroy => $top]],
]);
my $but = $top->Frame->pack;
my $lb = $top->Scrolled('Listbox',-width => 40)->pack(-side => 'bottom');
$but->Button('-text' => "Primary Targets", '-command' => [\&ShowTargets,$lb,'PRIMARY'])->pack('-side'=>'left');
$but->Button('-text' => "Quit", '-command' => ['destroy',$top])->pack('-side'=>'right');
my $filename = "/tmp/SomethingSilly";
open(FOO,">$filename");
print FOO "Hi There\n";
close(FOO);
my $src = $top->Frame->pack;
foreach my $k ('Local',@$kind,'Any')
{
# next if $k eq 'KDE';
my $thing = $src->Message('-text' => "$k Source")->pack(-side => 'left');
my @list;
@list = (-sitetypes => $k) unless $k eq 'Any';
$thing->DragDrop(-event => '<B1-Motion>', @list,
-handlers => [
[-type => 'text/plain',[\&string_handler,"This is text/plain"]],
[-type => 'FILE_NAME',[\&string_handler,$filename]],
[[\&string_handler,"This is STRING"]]
]);
}
my $dst = $top->Frame->pack;
foreach my $k ('Local',@$kind,'Any')
{
my @list;
@list = (-droptypes => $k) unless $k eq 'Any';
my $sun = $dst->Message('-text' => "$k Drops here", '-relief' => 'ridge' )->pack(-side => 'left');
$sun->DropSite(-dropcommand => [\&ShowTargets,$lb],
-entercommand => [\&enter_leave,$sun],
@list);
}
my $str = $top->Frame->pack(-fill => 'x');
foreach my $targ (qw(STRING FILE_NAME))
{
no strict 'refs';
my $l = $str->Label(-anchor => 'e', -justify => 'right', -text => $targ);
my $v = $str->Label(-anchor => 'w', -justify => 'left', -relief => 'groove',
-textvariable => \${$targ});
Tk::grid($l,$v,-sticky => 'ew');
}
$str->gridColumnconfigure(0,-weight => 0);
$str->gridColumnconfigure(1,-weight => 1);
sub string_handler
{
my ($text,$offset,$max) = @_;
return substr($text,$offset,$max);
}
MainLoop;
use Data::Dumper;
sub ShowTargets
{
my $lb = shift;
my $seln = shift;
my $own = $lb->SelectionExists('-selection'=>$seln);
printf "owner of $seln is %x\n",$own;
my @targ = $lb->SelectionGet('-selection'=>$seln,'TARGETS');
$lb->delete(0,'end');
$lb->insert('end',@targ);
$STRING = $FILE_NAME = '';
foreach (@targ)
{
if (/FILE_NAME/)
{
$FILE_NAME = $lb->SelectionGet('-selection'=>$seln,'FILE_NAME');
}
if (/_SUN/ && !/(END|ACK|DONE|YIELD)/)
{
my @info;
Tk::catch { @info = $lb->SelectionGet('-selection'=>$seln,$_) };
if ($@)
{
print "Cannot get $_\n";
}
else
{
print "$_:",Dumper(\@info);
}
}
if (m#^(STRING|text/plain)$#)
{
my $string = $lb->SelectionGet('-selection'=>$seln,$_);
$string = substr($string,0,37)."..." if length($string) > 40;
$STRING = $string;
}
}
}
|
