/[suikacvs]/perl/lib/Encode/Table/tool/tbr2tbl.pl
Suika

Diff of /perl/lib/Encode/Table/tool/tbr2tbl.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by wakaba, Sat Oct 5 01:34:55 2002 UTC revision 1.5 by wakaba, Sun Oct 6 06:00:16 2002 UTC
# Line 91  if (/^(....)           ([^\t]+)/) { Line 91  if (/^(....)           ([^\t]+)/) {
91  }  }
92  }  }
93  sub charname ($) {  sub charname ($) {
94      my $U = shift;
95      if ($U =~ /[^0-9]/) {
96        $U =~ s/^[Uu]\+|^0[Xx]//;
97        $U = hex $U;
98      }
99    ## TODO: be more strict!    ## TODO: be more strict!
100    $_[0] < 0x0020 ? '<control>' :    $U < 0x0020 ? '<control>' :
101    $_[0] < 0x007F ? $name{$_[0]} :    $U < 0x007F ? $name{$U} :
102    $_[0] < 0x00A0 ? '<control>' :    $U < 0x00A0 ? '<control>' :
103    $name{$_[0]} ? $name{$_[0]} :    $name{$U} ? $name{$U} :
104    $_[0] < 0x00A0 ? '<control>' :    $U < 0x00A0 ? '<control>' :
105    $_[0] < 0x3400 ? '' :    $U < 0x3400 ? '' :
106    $_[0] < 0xA000 ? '<cjk>' :    $U < 0xA000 ? '<cjk>' :
107    $_[0] < 0xE000 ? '<hangul>' :    $U < 0xE000 ? '<hangul>' :
108    $_[0] < 0xF900 ? '<private>' :    $U < 0xF900 ? '<private>' :
109    '';    '';
110  }  }
111  }  }
# Line 129  sub array_to_table (@%) { Line 134  sub array_to_table (@%) {
134        push @r, &{ $CMD{ $opt{cmd} } } (\%opt) if ref $CMD{ $opt{cmd} };        push @r, &{ $CMD{ $opt{cmd} } } (\%opt) if ref $CMD{ $opt{cmd} };
135      } elsif (/^##/) {   ## Comment      } elsif (/^##/) {   ## Comment
136        push @r, $_;        push @r, $_;
137        } elsif (/^#;/) {   ## Comment
138      } elsif (/^#/) {    ## Comment or unsupported function      } elsif (/^#/) {    ## Comment or unsupported function
139      } elsif (/^0x($o->{except} [0-9A-Fa-f]+)\t([^\t]*)\t([^\t]*)\t(.*)/x) {        push @r, $_;
140        } elsif (/^0x($o->{except} [0-9A-Fa-f]+)(?:\t([^\t]*)(?:\t([^\t]*)(?:\t(.*))?)?)?/x) {
141        my ($u, $l, $f, $m) = (hex $1, $2, $3, $4);        my ($u, $l, $f, $m) = (hex $1, $2, $3, $4);
142        $f = $o->{fallback} if $o->{fallback};        $f = $o->{fallback} if $o->{fallback};
143        my $offset = $o->{offset};        my $offset = $o->{offset};
# Line 140  sub array_to_table (@%) { Line 147  sub array_to_table (@%) {
147          $u+$offset, $l, $f, $m || charname ($l);          $u+$offset, $l, $f, $m || charname ($l);
148      } elsif (/^$/) {      } elsif (/^$/) {
149      } else {      } else {
150        push @r, $_;        #push @r, $_;
151      }      }
152            
153      }   # / mode is enabled      }   # / mode is enabled
# Line 156  $CMD{import} = sub { Line 163  $CMD{import} = sub {
163      my @tbl = <TBL>;  close TBL;  map {s/[\x0D\x0A]+$//} @tbl;      my @tbl = <TBL>;  close TBL;  map {s/[\x0D\x0A]+$//} @tbl;
164      my $m = {}; for (split /,/, $opt->{mode}) { $m->{$_} = 1 }      my $m = {}; for (split /,/, $opt->{mode}) { $m->{$_} = 1 }
165      shift (@tbl) if $tbl[0] =~ m!^#\?PETBL/1.0 SOURCE!;      shift (@tbl) if $tbl[0] =~ m!^#\?PETBL/1.0 SOURCE!;
166        $opt->{except} = $opt->{except} ? qq((?!(?i)$opt->{except})) : '';
167      array_to_table (\@tbl, {offset => hex $opt->{offset},      array_to_table (\@tbl, {offset => hex $opt->{offset},
168        fallback => $opt->{fallback}, mode => $m,        fallback => $opt->{fallback}, mode => $m,
169        except => $opt->{except}, right => $opt->{right}});        except => $opt->{except}, right => $opt->{right}});
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24