blob: 5ead808405da147584cfb76a66f6a3de9dcc7e1c (
plain)
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
|
package Tk::DummyEncode;
use vars qw($VERSION);
$VERSION = '4.007'; # $Id: //depot/Tkutf8/Tk/DummyEncode.pm#7 $
sub getEncoding
{
my ($class,$name) = @_;
return undef unless ($name =~ /(iso8859-1|X11ControlChars)/);
my $pkg = $name;
$pkg =~ s/\W+/_/g;
return bless {Name => $name},$class.'::'.$pkg;
}
package Tk::DummyEncode::iso8859_1;
sub encode
{
my ($obj,$uni,$chk) = @_;
$_[1] = '' if $chk;
return $uni;
}
sub decode
{
my ($obj,$byt,$chk) = @_;
$_[1]
= '' if $chk;
return $byt;
}
package Tk::DummyEncode::X11ControlChars;
sub encode
{
my ($obj,$uni,$chk) = @_;
my $str = '';
foreach my $ch (split(//,$uni))
{
$str .= sprintf("\\x{%x}",ord($ch));
}
$_[1] = '' if $chk;
return $str;
}
1;
__END__
|
