use strict;
use vars qw($opt_in_cs $opt_order $opt_kage $opt_replace
+ $opt_latin
$opt_use_kage_for_Ext_B $opt_allow_unification
$opt_help $usage
$in_cs $out_cs $i @chars
"order=s"=>\$opt_order,
"replace",\$opt_replace,
"kage",\$opt_kage,
+ "latin",\$opt_latin,
"unify",\$opt_allow_unification,
"help",\$opt_help);
$usage=<<EOF;
-Usage: $0 [-i <input coding system>] [-o <order of kanji>] [-kru] <filename>
+Usage: $0 [-i <input coding system>] [-o <order of kanji>] [-klru] <filename>
-i: input coding system: (default: ucs\@mcs)
ucs\@mcs, ucs\@cns, ucs\@gb, ucs\@jis, ucs\@ks
-o: order of kanji: (default: j)
k: KS
G: GT
m: Multi, use \\UTFM of otf.sty
- You can also combine them, ex. jtcgkm
+ You can also combine them, ex. jGcgkm
-k: use Kage server.
+ -l: preserve latin characters also in ucs\@jis environment.
-r: replace r and l with dot below to those with circle below.
-u: allow unification.
EOF
# or GETA character if ids is invalid for KAGE.
my($ids)=@_;
# return $geta if(not $exec_makefonts);
- $ids=&normalize_ids($ids,"UniJIS");
+# $ids=&normalize_ids($ids,"UniJIS");
return $geta if(($ids!~/[$idc]/)
or($ids=~/[\x{10000}-]/));
#irregular for KAGE.
- if(not defined($ids{$ids}) and $ids{$ids}[1]>=0){
+ if(not defined($ids{$ids})){
$ids{$ids}[0]=$font_start;
$ids{$ids}[1]=$ids_start;
$ids_start++;
# return: char in ucs@mcs.
my($char,$in_cs)=@_;
my($output_char);
+ my $char_id=unpack("U",$char);
- if(($output_char)=&get_chars_matching("=$in_cs",unpack("U",$char))){
+ if($opt_latin and $texmacro[$char_id]){
+ return $char;
+ }
+ if(($output_char)=&get_chars_matching("=$in_cs",$char_id)){
return $output_char;
}else{
return $char;
### Options ###
-#$opt_order{'UniMulti'}='jcgk';
-$opt_order{'UniMulti'}='jGcgkHC';
+$opt_order{'UniMulti'}='jGcgk';
+#$opt_order{'UniMulti'}='jGcgkHC';
$opt_order{'UniCNS'}='c';
$opt_order{'UniGB'}='g';
$opt_order{'UniJIS'}='j';
### End ###
+$/="";
+
my $strictly_forbidden_after = '「【『[(〈‘‛“‟(〔{《{\[\(〖{「';
my $forbidden_after = "\x{0000}";
while(<>){
utf8::decode($_);
- print '\relax{}';
+ print '{\relax{}';
if($in_cs ne 'ucs@mcs'){
s/(.)/&get_char_in_mcs($1,$in_cs)/ge;
}
s/(amp.+?;)/&de_tex_er($1)/ge;
# s/(&.+?;)/&de_tex_er($1)/ge;
- s/([$asian])\s+/$1/go unless($opt_preserve_spaces);
- s/\s+([$asian])/$1/go unless($opt_preserve_spaces);
+ s/([$asian])[$space]+/$1/go unless($opt_preserve_spaces);
+ s/[$space]+([$asian])/$1/go unless($opt_preserve_spaces);
s/([$asian])\s*([^$asian$space])/$1 $2/go;
s/([^$asian$idc])\s*([$asian])/$1 $2/go;
s/\-\-\-/pack("U",0x2014)/geo;# EM DASH
s/\'\'/pack("U",0x201d)/geo;# RIGHT DOUBLE QUOTATION MARK
s/\'/pack("U",0x2019)/geo;# RIGHT DOUBLE QUOTATION MARK
@chars=split(//);
+
CHAR:
for($i=0;$i<=$#chars;$i++){
$char=$chars[$i];
- $char_id=unpack("U",$char);
+ if($char_id=&get_char_attribute($char,'=ucs@unicode')){
+ $char=pack("U",$char_id);
+ }else{
+ $char_id=unpack("U",$char);
+ }
if($char_id<=0x20){
# add quarter space between asian and non-asian.
}
}
}
+ print '}';
}
print IDSDATA 'use utf8;',"\n";
}
return "{\\fontencoding{OT1}\\fontfamily{"
.sprintf("chise%03d",$ids{$ids}[0])
- ."}\\selectfont\\char$ids{$ids}[1]}";
+ ."}\\selectfont\\char$ids{$ids}[1]}\\relax{}";
}
sub normalize_ids{
# return: ids
my($char)=@_;
my $ids="";
- $ids=&get_char_attribute($char,"ids-aggregated")
- or $ids=&get_char_attribute($char,"ids");
-# $ids=&get_char_attribute($char,"ids-decomposed")
+# $ids=&get_char_attribute($char,"ids-aggregated")
# or $ids=&get_char_attribute($char,"ids");
-# or $ids=&get_char_attribute($char,"ideographic-structure");
-# $ids=~s/[? ()]//g;
+ $ids=&get_char_attribute($char,"ids-decomposed")
+ or $ids=&get_char_attribute($char,"ids")
+ or $ids=&get_char_attribute($char,"ideographic-structure");
+ $ids=~s/[? ()]//g;
return $ids;
}
sub get_chars_unified{
my($char)=@_;
- my($chars,$ucs,$char_ucs);
+ my($chars,$ucs,$char_ucs,$char_sub);
my(@chars);
if($chars=&get_char_attribute($char,'->ucs-unified')){
$chars=~s/^\((.*)\)$/$1/;
return (split(/\s*\?/,$chars));
}elsif($ucs=&get_char_attribute($char,'=>ucs*')
- or $ucs=&get_char_attribute($char,'=>ucs')){
+ or $ucs=&get_char_attribute($char,'=>ucs')){
$char_ucs=pack("U",$ucs);
if($chars=&get_char_attribute($char_ucs,'->ucs-unified')){
$chars=~s/^\((.*)\)$/$1/;
push(@chars,$char_ucs);
return @chars;
}
+ }elsif($char_sub=&get_char_attribute($char,'<-subsumptive')){
+ $char_sub=~s/[? ()]//g;
+ $chars=&get_char_attribute($char_sub,'->subsumptive');
+ @chars=grep {not /^$char$/} (split(/\s*\?/,$chars));
+ push(@chars,$char_sub);
+ return @chars;
+ }else{
+ return ();
}
}