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
|
#!/usr/bin/perl -w
use Tk;
use Encode qw(decode);
use Encode::Guess;
use strict;
$Tk::FontRank = \&Ranker;
my $mw = MainWindow->new();
my $seln;
my $tb = $mw->Frame->pack(-fill => 'x');
my $lb = $mw->Scrolled('Listbox',-width => 40, -exportselection => 0);
my $entry = $mw->Entry->pack(-fill => 'x');
$tb->Button('-text' => "Primary Targets", '-command' => [\&ShowTargets,$lb,'PRIMARY'])->pack('-side'=>'left');
$tb->Button('-text' => "Clipboard Targets", '-command' => [\&ShowTargets,$lb,'CLIPBOARD'])->pack('-side'=>'left');
$tb->Label('-textvariable' => \$seln)->pack('-side'=>'left');
$tb->Button('-text' => "Quit", '-command' => ['destroy',$mw])->pack('-side'=>'right');
$lb->packAdjust(-expand => 1, -fill => 'both');
my $tx = $mw->Scrolled('ROText',-width => 40, -exportselection => 0, -wrap => 'none')->pack(-expand => 1, -fill => 'both');
$lb->bind('<ButtonRelease-1>',[\&GetSelected,$tx]);
ShowTargets($lb,'PRIMARY');
MainLoop;
sub GetSelected
{
my ($lb,$tx) = @_;
my $name = $lb->getSelected;
if (defined $name)
{
$tx->insert('end',"----- $name -----\n");
my @targ = $lb->SelectionGet('-selection'=>$seln,$name);
if ($name eq 'text/html')
{
my $targ = join("", @targ);
$targ = decode("Guess", $targ);
$tx->insert('end', $targ);
}
else
{
foreach (@targ)
{
$tx->insert('end',"$_\n");
}
}
$tx->see('end');
}
}
sub ShowTargets
{
my $lb = shift;
$seln = shift;
my $own = $lb->SelectionExists('-selection'=>$seln);
if ($own)
{
printf "owner of $seln is %x\n",$own;
$lb->delete(0,'end');
eval {
my @targ = $lb->SelectionGet('-selection'=>$seln,'TARGETS');
$lb->insert('end',@targ);
foreach (@targ)
{
if (/FILE_NAME/)
{
print $lb->SelectionGet('-selection'=>$seln,'FILE_NAME'),"\n";
}
}
};
}
}
sub Ranker
{
my ($cost,$ch,$want,$got) = @_;
return $cost if $ch == 32;
if ($cost == 0)
{
printf "U+%04x for ",$ch;
print $want->family," use ",$got->Xname,"\n";
}
elsif ($cost == -1)
{
printf "U+%04x $ch not in ",$ch;
print $got->Xname,"\n";
}
else
{
return (1 << 30) if ($got->size && $want->size != $got->size);
if ($got->encoding eq 'iso10646-1')
{
$cost = ($cost >> 3) || 1;
}
printf "%08x for U+%04x ",$cost,$ch;
print $want->family,' got ',$got->family,'/',$got->encoding,"\n";
}
return $cost;
}
|
