diff options
Diffstat (limited to 'Master/texmf-dist/doc/latex/ucs/makeunidef.pl')
-rwxr-xr-x | Master/texmf-dist/doc/latex/ucs/makeunidef.pl | 1565 |
1 files changed, 1565 insertions, 0 deletions
diff --git a/Master/texmf-dist/doc/latex/ucs/makeunidef.pl b/Master/texmf-dist/doc/latex/ucs/makeunidef.pl new file mode 100755 index 00000000000..3952b3bdb45 --- /dev/null +++ b/Master/texmf-dist/doc/latex/ucs/makeunidef.pl @@ -0,0 +1,1565 @@ +#!/usr/bin/perl -w + +=head1 NAME + +makeunidef.pl - Generates Unicode data files for B<ucs.sty>. + +=head1 SYSNOPSIS + +makeunidef.pl [B<--database>=I<file>] [B<--targetdir>=I<dir>] +[B<--verbose>] [B<--help>] [B<--comments>] [B<--nocomments>] +[B<--compress>] [B<--nocompress>] [B<--exclude>=I<option>] +I<configfiles> + +=head1 DESCRIPTION + +Generate the F<uni-....def>-files for use by B<ucs.sty>. These are +generated out of one ore more config files (with suffix C<.gz> if +gzipped), whose format is described below (see L<"CONFIG FILES">). + +For some characters there will be autogenerated code, if none is +supplied by the config files, this code will be associated with the +Unicode option C<autogenerated>. + +=head1 OPTIONS + +=over 4 + +=item B<--comments>, B<--nocomments> + +Enable or disable the automatic generation of comments. +Defaults to B<--comments>. + +=item B<--compress>, B<--nocompress> +Enable or disable the compression of uninames.dat. +Defaults to B<--compress>. + +=item B<-d>, B<--db>, B<--database>=I<file> + +Specify the Unicode database, as provided by the Unicode +Consortium. Defaults to F<UnicodeData.txt>. The file must have the +suffix C<.gz> if it is gzipped. + +=item B<--dir> + +See B<-target>. + +=item B<--exclude>, B<--ex>=I<option> + +Do not include the characters associated with option I<option>. This +is e.g. useful for saving space by not including all CJK +characters. When an excluded option is used in documents, an error is +yielded. + +=item B<-h>, B<--help> + +Shows help. + +=item B<--nocomments> + +See B<--comments>. + +=item B<--nocompress> + +See B<--compress>. + +=item B<-t>, B<--dir>, B<--target>, B<--targetdir>=I<dir> + +Sets the target directory for the generated files to I<dir>. The default is +the current directory. + +=item B<-v>, B<--verbose> + +Be verbose. + +=back + +=head1 CONFIG FILES + +The config files (which may be gzipped) are to be written in a line +oriented format. C<#> starts a comment which end at the end of the +actual line. The C<#> must be preceded by a whitespace, except for +lines consisting only of a comment. An empty line or a line containing +only a comment is ignored. + +A line can be a command or a character definition. +For possible commands see L<"CONFIG COMMANDS">. +A character +definition has the following syntax: + +I<code> I<macro> + +where I<code> is the code position and I<macro> a LaTeX-macro to +render the glyph. I<macro> is stripped of surrounding whitespaces, and +I<code> has one of the following formats (all case insensitive): + +=over 4 + +=item U+I<num>, 0xI<num>, $I<num> + +I<num> being the hexadecimal representation of the code position. + +=item I<num> + +I<num> being the decimal representation of the code position, whereby +I<num> must not start with 0. + +=item 0I<num> + +I<num> being the octal representation of the code position. + +=back + +In all the above formats, I<num> can have any number of digits. + +=head2 CONFIG COMMANDS + +A command line consists of an command name and optional space +separated command arguments. The following commands are defined: + +=over 4 + +=item B<AUTOOPTION> + +Same as B<OPTION>, by the second argument specifies a LaTeX +package. If this package is loaded, the option is set automatically. + +This option is deprecated. + +=item B<BEGIN>, B<{> + +This starts a group. All options set after this are only valid up to +the matching B<END> or B<}>. Config files, which set options, should +be enclosed in a block, so that they can't have side effects on other +parts of the config file. Each config file is contained in an implicit +block. Blocks can be nested. + +=item B<END>, B<}> + +See B<BEGIN>. + +=item B<ENVELOPE> + +All macros are wrapped inside the envelope given by this command. The +original macro is inserted into the envelope instead of every +occurrence of C<@@@> and the decimal character code is inserted for +each occurrence of C<$$$>. B<ENVELOPE> will override B<ENVELOPE> +commands executed before. + +=item B<GLOBAL> + +Inserts some code into F<uni-global.def>. This file is loaded with +F<ucs.sty> in the preamble. F<uni-global.def> is not executed in a group, +so defining globally is not necessary. See also B<PROVIDE>. + +=item B<OPTION> + +This command takes one argument. It is the name of the Unicode option +to associate with the macros defined after this command. An option set +by B<OPTION> is valid until it is overridden by another B<OPTION> +command or until the block ends. + +=item B<PROVIDE> + +Associates a piece of code with characters defined afterwards (until +the block ends). The code is inserted into every B<uni-....def>-file +containing one of these characters, so the code is guaranteed to have +been executed before the corresponding characters are executed. No +assumption should be made whether the code is executed in a group or +at top level, i.e. declarations should be made globally, but no +garbage should be defined or catcodes modified without restoring +them afterwards. The code may be executed several times. See also B<GLOBAL>. + +=back + +=head1 KNOWN BUGS AND PROBLEMS + +There should be a better way to quote whitespaces in command arguments +and to insert C<#>s. Perhaps I will add this in future, thereby trying +to preserve backward compatibility. + +=head1 REPORTING BUGS + +Send bug reports to Dominique Unruh <I<dominique@unruh.de>>, the mails +containing the words B<bug report: makeunidef.pl> in the subject. + +=head1 AUTHOR + +Dominique Unruh <I<dominique@unruh.de>>. + +=head1 FILES + +=over 4 + +=item F<uni-I<N>.def>, F<uni-global.def>, F<uninames.dat> + +Unicode definitions for B<ucs.sty>, created by this program, I<N> +stands for different decimal numbers. + +=item F<UnicodeData.txt> + +Unicode database by the Unicode Consortium, read only. This file can be +found at F<http://www.unicode.org/Public/UNIDATA/UnicodeData.txt> + +=back + +=head1 SEE ALSO + +The LaTeX package B<ucs.sty>. + +=cut +#'; # for emacs + + +use IO::Handle; +use IO::File; +use Data::Dumper; +use Getopt::Long; +use Carp; + +use strict; + +# prototypes +sub dumphuffman($$$); #{} + + +use vars qw/$createcomments $targetdir @configfiles @characters + %files @unidata $unidata $messagebreak $dump_unidata + $verbose $generate_uninames $tables_to_dump $tabledir $autogen + %knownoptions $loadunidata %stats_charsperoption + %providehandlers $providehandlerseq %provides $huffman_decoder + %file_attribs $compressnames %excludedoptions %uninames_abbrev @ranges + $onlyfile $fileswritten $devnull + /; + +$messagebreak = '\MessageBreak '; +$autogen = 'autogenerated by makeunidef.pl'; + +%uninames_abbrev = + ( +# "\000" => '{Character available with following options:'. +# '\MessageBreak\space\space\space}', + "\001" => '{Unicode character \number\uc@got\uc@spc = U+\uc@temp@a:'. + '\MessageBreak}', +# "\002" => '{No name found}', + "\003" => '{Character available with following excluded options:'. + '\MessageBreak\space\space\space}', + "\n" => '\MessageBreak', + " " => '{ }', + ); + +sub globalcode ($) { + my $code = shift; + return unless $dump_unidata; + my $filename = "$targetdir/uni-global.def"; + my $file = openfile($filename, + "%%% unicode global data for ucs.sty, $autogen", + "Unicode global data"); + print $file "$code\n"; +} + +sub getprovidehandler($) { + my $code = shift; + return undef unless defined $code; + my $handler = $providehandlers{$code}; + unless (defined $handler) { +# print "NEW HANDLER: '$code'\n"; + $handler = $providehandlerseq++; + $providehandlers{$code} = $handler; + } + $provides{$handler} = { code => $code }; + return $handler; +} + +sub openreadfile($) { + my $filename = shift; + $filename .= ".gz" if (!-e $filename && -e "$filename.gz"); + if ($filename =~ /\.gz/) { + die "Could not read file $filename" unless -r $filename; + return new IO::File("gzip -cdf ''\Q$filename\E |"); + } else { + return new IO::File($filename,"r"); + } +} + +sub optionname($) { + my $o = shift; + return 'default' unless define($o) ne ''; + return $o; +} + +sub loadconfig ($) { + my ($filename) = @_; + my $fh = openreadfile $filename or + die "Could not open configfile $filename: $!"; + my %options; + my @optionstack; + while (my $line = <$fh>) { + chomp($line); + my $linepos = "$filename:$."; + $line =~ s/(^|\s)\#.*$//; + $line =~ s/^\s*//; + $line =~ s/\s*$//; + next if $line eq ''; + if ($line =~ /^[0-9]/ || $line =~ /^u\+/i) { + my ($num,$command) = split ' ',$line,2; + $num = oct($num) if $num =~ /^0/; + $num = hex($num) if $num =~ s/^\$//; + $num = hex($num) if $num =~ s/^u\+//i; + #print "Line: $line, Num: $num, Command: $command\n"; + my %o = %options; + $o{definedat} = $linepos; + $command = '' if lc($command) eq '<empty>'; + unless (defined ($command)) { + warn "$linepos: Use <empty> to declare an empty ". + "glyph macro.\n"; next; }; + $o{combining} = 1 + if (($command =~ /(^|[^\#])\#1/) || + (defined $o{envelope} && $o{envelope} =~ /(^|[^\#])\#1/)); + if (isprivate($num) && + optionname($o{onoption}) !~ /^(private|local)./) { + warn sprintf "%s: Character U+%04X is in private area, ". + "but has option '%s' (not 'private...' or 'local...').\n", + $linepos,$num,optionname($o{onoption}); + } + push @{$characters[$num]}, [ $command, \%o ]; + my $range = findrange2($num); + if (defined $range) { ${$$range{options}}{optionname($o{onoption})} =1}; + if ($unidata[$num]) { $ {$ {$unidata[$num]}{options}}{optionname($o{onoption})} =1}; + $stats_charsperoption{define($o{onoption})}++; + } else { + my @cmd = split ' ',$line; + if ($cmd[0] eq 'BEGIN' || $cmd[0] eq '{') { + my %t = %options; + push @optionstack, \%t; + } elsif ($cmd[0] eq 'END' || $cmd[0] eq '}') { + if (@optionstack) { + my $t = pop @optionstack; + %options = %$t + } else { + warn "$linepos: '$cmd[0]' outside a block.\n"; + } + } elsif ($cmd[0] eq 'OPTION') { + $options{onoption} = $cmd[1]; + unless (defined $knownoptions{$cmd[1]}) { + $knownoptions{$cmd[1]} = []; + } + } elsif ($cmd[0] eq 'AUTOOPTION') { + $options{onoption} = $cmd[1]; + unless (defined $knownoptions{$cmd[1]}) { + $knownoptions{$cmd[1]} = [ $cmd[2] ]; + } else { + # ************ DOUBLED + push @{$knownoptions{$cmd[1]}}, $cmd[2]; + } + } elsif ($cmd[0] eq 'ENVELOPE') { + $options{envelope} = join ' ',@cmd[1..$#cmd]; +# } elsif ($cmd[0] eq 'GLOBAL') { +# globalcode(join ' ',@cmd[1..$#cmd]); + } elsif (($cmd[0] eq 'PROVIDE') || ($cmd[0] eq 'GLOBAL')) { + my $prov = ''; + if ($cmd[1] eq 'MULTILINE') { + my ($e,$l) = (0); + my $xlinepos = $linepos; + while (!$e && defined($l = <$fh>)) { + if ($l =~ /^\s*END\s*$/) { $e = 1 } + else { $prov .= $l; } + } + unless ($e) { + warn "$xlinepos: Unfinished PROVIDE MULTILINE.\n"; + $prov = undef; + } + } else { + $prov = join ' ',@cmd[1..$#cmd]; + } + chomp $prov; $prov =~ s/%$//s; + if ($cmd[0] eq 'PROVIDE') { + $options{provide} = getprovidehandler($prov); + } else { + globalcode($prov); } + } elsif ($cmd[0] eq 'FONTENC') { + $options{fontenc} = $cmd[1]; + } elsif ($cmd[0] eq 'FONTFAMILY') { + $options{fontfamily} = $cmd[1]; + } elsif ($cmd[0] eq 'RIGHTLEFT') { + $options{rightleft} = 1; + } elsif ($cmd[0] eq 'TABLECODE') { + $options{tablecode} = join ' ',@cmd[1..$#cmd]; + } elsif ($cmd[0] eq 'CTRLGLYPH') { + $options{ctrlglyph} = 1; + } elsif ($cmd[0] eq 'COMBINECHAR') { + if ($cmd[1] =~ /^U\+[0-9A-F]+$/i) { + my ($n) = ($cmd[1] =~ /^U\+([0-9A-F]+)$/i); + $options{combinechar} = hex($n); + delete $options{combineglyph}; + delete $options{combineoption}; + } elsif ($cmd[1] =~ /^[a-z]+\/U\+[0-9A-F]+$/i) { + my ($o,$n) = ($cmd[1] =~ /^([a-z]+)\/U\+([0-9A-F]+)$/i); + $options{combinechar} = hex($n); + $options{combineoption} = $o; + delete $options{combineglyph}; + } else { + $options{combineglyph} = $cmd[1]; + delete $options{combinechar}; + delete $options{combineoption}; + } + } elsif ($cmd[0] eq 'LOADFONTENC') { + $options{loadfontenc} = $cmd[1]; + } elsif ($cmd[0] eq 'PACKAGE') { + $options{package} = $cmd[1]; + } elsif ($cmd[0] eq 'TABLEGLYPH') { + $options{tableglyph} = join ' ',@cmd[1..$#cmd]; + } elsif ($cmd[0] eq 'TABLEENVELOPE') { + $options{tableenvelope} = join ' ',@cmd[1..$#cmd]; + } else { + warn "$linepos: Malformed line $line"; + } + } + }; + close $fh or die "Something went wrong when closing $filename: $!"; +}; + +sub openfile ($$$%) { + my ($filename,$header,$description,%attribs) = @_; + my $file = $files{$filename}; + unless (defined $file) { + my $nowrite = 0; + $nowrite = 1 if defined($onlyfile) && $filename !~ m@(^|/)$onlyfile$@; + $fileswritten ++ unless $nowrite; + $attribs{nowrite} = 1 if $nowrite; + if (!$nowrite) { + $file = new IO::File($filename,O_CREAT|O_WRONLY|O_EXCL) or + die "Could not open $filename for writing: $!"; + } else { + print "Not writing file $filename\n" if $verbose; + $devnull = new IO::File('/dev/null',O_WRONLY) unless ($devnull); + $file = $devnull; } + print $file "$header\n"; + my @date = localtime; + my $date = sprintf "%04d/%02d/%02d", + $date[5]+1900, $date[4]+1, $date[3]; + my $basename = $filename; $basename =~ s@.*/@@; + print $file "\\ifx\\ProvidesFile\\undefined\\else +\\ProvidesFile{$basename}[$date UCS: $description]% +\\fi +"; + flush $file; + $files{$filename} = $file; + $file_attribs{$filename} = \%attribs; + } + return $file; +} + +sub dumpcharacters() { + for (my $i=0; $i<=$#characters; $i++) { + next unless defined $characters[$i]; + my %seen = (); + for my $j (@{$characters[$i]}) { + my $val = $$j[0]; + my $options = $$j[1]; + my $envelope = $$options{envelope}; + if (define($envelope) ne '') { + my $t = $val; + $val = $envelope; + $val =~ s/\$\$\$/$i/g; + $val =~ s/\@\@\@/$t/g; + } + $val = "\\uc\@cmb$val" if ($$options{combining}); + my $comment = define($$options{comment}); + my $onoption = $$options{onoption}; + next if $excludedoptions{(defined $onoption)?$onoption:'default'}; + my $page = int($i/256); + my $filename = "$targetdir/uni-$page.def"; + #print "Character $i ($filename):\n"; + my $range = sprintf("U+%04X..U+%04X", + $page*256,$page*256+255); + my $provide = $$options{provide}; + my $header = "%%% Unicode to TeX mapping, file uni-$page.def, ". + "$range, autogenerated by makeunidef.pl"; + my $file = openfile($filename,$header,"Unicode data $range"); + + if (defined $provide) { + $provide = $provides{$provide}; + unless (defined $$provide{"done:$filename"}) { + $$provide{"done:$filename"} = 1; + print $file "$$provide{code}%\n"; + #print "Providing $$provide{code} to $filename\n"; + } + } + + my $texcmd = ''; + if (defined $val) { + $texcmd = "\\uc\@dclc{$i}{". + (defined $onoption?$onoption:'default'). + "}{$val}"; + } + $texcmd .= "% $comment"; + $texcmd .= " (missing)" unless defined $val; + $texcmd =~ s/\s+$//; + print $file "$texcmd\n"; + my $tag = define($onoption); + if (defined $seen{$tag}) { + warn sprintf + "%s: Character U+%04X(%s) redefined. ". + "(First definition in %s).\n", + $$options{definedat},$i,optionname($onoption),$seen{$tag}; + } else { + $seen{$tag} = define($$options{definedat}); + } + #print "$texcmd\n"; + } + } + flushfiles(); +} + +sub loadunidata($) { + my ($filename) = @_; + my $f = openreadfile $unidata or + die "Could not open $unidata for reading: $!"; + my $inrange = undef; + my $rangestart; + while (my $line = <$f>) { + chomp($line); + my @line = split ';', $line; + my %line = (); + $line{num} = hex($line[0]); + $line{name} = $line[1]; + $line{category} = $line[2]; + $line{combining} = $line[3]; + $line{flags} = $line[4]; + my @compose = split ' ',$line[5]; + my $compflag = undef; + if (defined $compose[0] && $compose[0] =~ /^</) { + $compflag = shift @compose; + $compflag =~ s/^<//; + $compflag =~ s/>$//; + } + $line{compose} = \@compose; + $line{compflag} = $compflag; + $line{decdigit} = $line[6]; + $line{digit} = $line[7]; + $line{numerical} = $line[8]; + $line{bracket} = $line[9]; + $line{alias} = $line[10]; + $line{comment} = $line[11]; + $line{upcase} = $line[12]; + $line{downcase} = $line[13]; + $line{titlecase} = $line[14]; + $line{case3} = $line[15]; + + my ($rangename,$rangedir) = + ($line{name} =~ /^\<(.*), (First|Last)\>$/); + if (defined $rangename) { + if ($rangedir eq 'First') { + if (defined $inrange) { + warn "$filename:$.: Range '$rangename' started while ". + "in range '$inrange'.\n"; + } + #warn "Starting: '$rangename'"; + $inrange = $rangename; + $rangestart = $line{num}; + next; + } elsif ($rangedir eq 'Last') { + if (defined $inrange && $rangename eq $inrange) { + #warn "Ending: '$inrange'"; + $line{rangestart} = $rangestart; + $line{rangeend} = $line{num}; +# $line{num} = $line{rangestart}; + $line{name} = "Contained in range '$rangename'"; + #printf "Range found: U+%04X..U+%04X '%s'\n", + #$rangestart, $line{num}, $rangename if $verbose; + } elsif (defined $inrange) { + warn "$filename:$.: ". + "Range '$inrange' ended by '$rangename'"; + } + $inrange = undef; + } else { + die "Internal error"; + } + } else { + if (defined $inrange) { + warn "$filename:$.: ". + "Range '$inrange' not ended on next line.\n"; + $inrange = undef; + } + } + $unidata[$line{num}] = \%line; + push @ranges, \%line if $line{rangestart}; + } + close $f or die "Something went wrong when closing $filename: $!"; +} + +sub generate_globals() { + while (my ($option,$pkgs) = each %knownoptions) { + if (!$excludedoptions{$option}) { + if (@$pkgs == 1) { + my $pkg = $$pkgs[0]; + globalcode("\\DeclareUnicodeOption[$pkg]{$option}\%"); + } else { + globalcode("\\DeclareUnicodeOption{$option}\%"); + for my $pkg (@$pkgs) { + globalcode("\\LinkUnicodeOptionToPkg{$option}{$pkg}\%"); + } + } + } else { + globalcode + ("\\XDeclareUnicodeOption{}{$option}{}{". + "\\PackageError{ucs}{Option $option has not been generated}". + "{run makeunidef.pl without --exclude $option.}}{}"); + } + } + flushfiles(); +} + +sub define($) { + my $str = shift; + return $str if defined $str; + return ''; +} + +sub define0($) { + my $str = shift; + return $str if defined $str; + return 0; +} + +sub findrange($) { + my $i = shift; + for my $r (@ranges) { + if ($i>=$$r{rangestart} && $i<=$$r{rangeend}) { + return $$r{name}; + } + } + return undef; +} + +sub findrange2($) { + my $i = shift; + for my $r (@ranges) { + if ($i>=$$r{rangestart} && $i<=$$r{rangeend}) { + return $r; + } + } + return undef; +} + +sub generate() { + for (my $i=0; $i<=$#unidata; $i++) { + my $char = $unidata[$i]; + my $tex = undef; + next unless defined $char; + next unless %$char; + next if (defined $characters[$i]); + if (@{$$char{compose}}) { + my $success = 1; + for my $comp (@{$$char{compose}}) { + $success = 0 unless defined $characters[hex($comp)]; + } + if ($success) { + my $compflag = $$char{compflag}; + my $compmode = 'none'; + if (define($compflag) eq '') { $compmode = 'normal' } + elsif ($compflag eq 'fraction') { $compmode = 'normal' } + elsif ($compflag eq 'compat') { $compmode = 'normal' } + elsif ($compflag eq 'noBreak') { $compmode = 'normal' } + elsif ($compflag eq 'super') { $compmode = 'normal.super' } + elsif ($compflag eq 'sub') { $compmode = 'normal.sub' } + elsif ($compflag eq 'font') { $compmode = 'normal' } + elsif ($compflag eq 'circle') { $compmode = 'normal.circle' } + elsif ($compflag eq 'square') { $compmode = 'normal.square' } + elsif ($compflag eq 'wide') { $compmode = 'normal.wide' } + elsif ($compflag eq 'narrow') { $compmode = 'normal.narrow' } + elsif ($compflag eq 'vertical') { $compmode = 'normal.vertical' } + elsif ($compflag eq 'small') { $compmode = 'normal.small' } + else { warn "Unknown composition flag \<$compflag\> ". + "in character ".sprintf("%04X",$$char{num}); }; + if ($compmode =~ /^normal/) { + $tex = join '', map { + my $a = hex($_); + "\\unichar{$a}" } @{$$char{compose}}; + if ($compmode eq 'normal.super') { + $tex = "\\unicodesuper{$tex}"; + } elsif ($compmode eq 'normal.sub') { + $tex = "\\unicodesub{$tex}"; + } elsif ($compmode eq 'normal.square') { + $tex = "\\unicodesquare{$tex}"; + } elsif ($compmode eq 'normal.circle') { + $tex = "\\unicodecircle{$tex}"; + } elsif ($compmode eq 'normal.wide') { + $tex = "\\unicodewide{$tex}"; + } elsif ($compmode eq 'normal.narrow') { + $tex = "\\unicodenarrow{$tex}"; + } elsif ($compmode eq 'normal.vertical') { + $tex = "\\unicodevertical{$tex}"; + } elsif ($compmode eq 'normal.small') { + $tex = "\\unicodesmall{$tex}"; + } + } elsif ($compmode eq 'none') { + } else { + die "Unknown composition mode $compmode. INTERNAL ERROR"; + } + } + if (!$success && $$char{numerical} ne '') { + #print "NUMERICAL $i\n"; + $tex = $$char{numerical}; + } + #print "C: $$char{compflag}\n" if defined $$char{compflag}; + + if ($tex) { + push @{$characters[$i]}, + [ "$tex", #"\\dirtyunicode{$i}{$tex}" + { dirty => 1, + onoption => 'autogenerated' } ]; + unless (defined $knownoptions{autogenerated}) { + $knownoptions{autogenerated} = []; + } + } + } + } +} + +sub initcharacters() { +# for (my $i=0; $i<128; $i++) { +# push @{$characters[$i]}, [ "\\char$i\\relax", { comment => 'ASCII' } ]; +# } +} + +sub makecomments() { + for (my $i=0; $i<$#unidata; $i++) { + next unless defined $unidata[$i]; + push @{$characters[$i]}, [] unless defined $characters[$i]; + for my $char (@{$characters[$i]}) { + my $options = $$char[1]; + next if defined $$options{comment}; + my $onoption = $$options{onoption}; + #print "CHAR: $char\n"; + #print "CHAR2: $$char[1]\n"; + my $utf8 = utf16toutf8($i); + my $comment = ''; + $comment .= "OPTION: $onoption, " if ($onoption); + $comment .= sprintf "0x%04X = %d (%s) - %s", + $i ,$i, $utf8, $ {$unidata[$i]}{name}; + $$options{comment} = $comment; + $$char[1] = $options; + } + } +} + +sub utf16toutf8($) { + my $char = shift; + if ($char<0x80) { return $char; } + if ($char<0x0800) { + return chr(0xc0+int($char/64)).chr(0x80+($char%64)); } + return chr(0xe0+int($char/0x1000)). + chr(0x80+int(($char%0x1000)/64)). + chr(0x80+($char%64)); +} + +sub flushfiles() { + for my $file (values %files) { + flush $file; + } +} + +sub closefiles() { + for my $filename (keys %files) { + my $file = $files{$filename}; + my $attrib = $file_attribs{$filename}; + next if $$attrib{nowrite}; + my $cs = 'utf-8'; + $cs = $$attrib{coding} if defined $$attrib{coding}; + print $file <<EOT; +%%% Local Variables: +%%% mode: latex +%%% coding: $cs +%%% End: +EOT + close $file or die "Something went wrong when closing $filename: $!"; + } + if (define0($fileswritten)==0) { + warn "No files written"; } +} + +sub showhelp() { + print <<EOT; +Generates uni-....def files for ucs.sty + +Options: + --database <file> Set unicode database (default: UnicodeData.txt; short -d) + --nocomments Disable comments in generated files + --targetdir <dir> Set target directory (default: .; short: -t) + --verbose Be verbose (short: -v) + --help This page (short: -h) + <file(s)> Use this configfile(s) + +Configfiles consists of lines, each like this +<unicode number> <LaTeX-Code> +where <unicode number> may be prefixed by 0x or 0 to denote hex or oct. +Lines beginning with # denote a comment. +EOT +} + +sub optioneq($$) { + my ($a,$b) = @_; + $a = 'default' if define($a) eq ''; + $b = 'default' if define($b) eq ''; + return $a eq $b; +} + +sub getchar($$) { + my ($c,$option) = @_; + + #print "getchar($c,$option)\n"; + return undef unless $characters[$c]; + for my $char (@{$characters[$c]}) { + my $options = $$char[1]; + return $char if define($$options{onoption}) eq $option; + return $char if define($$options{onoption}) eq '' && $option eq 'default'; + } + return undef; +} + +sub expand_tablespec($); + +sub expand_tablespec($) { + my $tablesize = 256; + + my $spec = shift; + my @specs = (); + $spec = '*:*' if $spec eq '*'; + my @spec = ($spec =~ /^([a-z0-9]+|\*):(.*)$/i); + my $option = $spec[0]; + my $range = $spec[1]; + if (define($option) eq '') { + warn "Invalid table specifier '$spec'. Ignoring"; + return (); + } + if ($option eq '*') { + push @specs, expand_tablespec("default:$range"); + for my $o (sort keys %knownoptions) { + push @specs, expand_tablespec("$o:$range") unless $o eq 'default'; + } + } elsif ($range eq '*') { + for (my $i=0; $i<=$#characters; $i+=$tablesize) { + for (my $j=0; $j<$tablesize; $j++) { + if (my $c = getchar($i+$j,$option)) { + my $options = $$c[1]; + #next if $$options{dirty}; + push @specs, expand_tablespec + (sprintf "%s:%04X-%04X", + $option,$i,$i+$tablesize-1); + last; + } + } + } + } else { + warn "Unknown option '$option' in table spec '$spec'. Ignoring" + unless $option eq 'default' || defined $knownoptions{$option}; + my @range = map { hex } split '-', $range, 2; + + push @specs, { option => $option, + start => $range[0], + end => $range[1], + format => 'table', }; + } + return @specs; +} + +sub dump_charactertables() { + my @tables = map { + expand_tablespec($_) + } map { + s/\s+$//; s/^\s+//; $_ + } split /,/, $tables_to_dump; + for my $spec (@tables) { + dump_charactertable($spec); + } + flushfiles(); +} + +sub default_entrydata($) { + my $i = shift; + return + ( 'code' => $i, + 'hexcode' => sprintf("%04X", $i), + 'hexcodebeforelast' => sprintf("%1X", int($i%256/16)), + ); +} + +sub make_entrydata($$$$); +sub make_entrydata($$$$) { + my ($option,$i,$options,$hasctrlglyph) = @_; + my %entrydata = default_entrydata($i); + if (defined $$options{tableglyph}) { + warn sprintf "%s: Character %s/U+%04X has ". + "TABLEGLYPH specification.\n", + $$options{definedat},$option,$i; + } + if ($$options{ctrlglyph}) { + if ($hasctrlglyph) { + %entrydata = %{make_entrydata('ctrlglyphs',$i,$hasctrlglyph,0)}; + $entrydata{ctrlglyph} = 1; + $entrydata{option} = 'ctrlglyphs'; + return \%entrydata; + } else { + warn sprintf "%s: Char U+%04X has no control ". + "glyph.\n",$$options{definedat},$i; + $entrydata{tableglyph} = + sprintf('{\tiny %04X}',$i); + } + } + $entrydata{dirty} = ($$options{dirty})?1:0; + $entrydata{rightleft} = ($$options{rightleft})?1:0; + $entrydata{combining} = ($$options{combining})?1:0; + $entrydata{fontfamily} = $$options{fontfamily} + if defined $$options{fontfamily}; + $entrydata{combinechar} = $$options{combinechar} + if defined $$options{combinechar}; + $entrydata{combineglyph} = $$options{combineglyph} + if defined $$options{combineglyph}; + $entrydata{combineoption} = $$options{combineoption} + if defined $$options{combineoption}; + $entrydata{fontenc} = $$options{fontenc} + if defined $$options{fontenc}; + if (defined $$options{tableglyph}) { + warn sprintf "Add to ctrlglyphs.ucf:\nU+%04X\t%s\n", + $i,$$options{tableglyph} + unless $hasctrlglyph; + $entrydata{tableglyph} = $$options{tableglyph}; + } + if (defined $$options{tableenvelope}) { + warn sprintf "%s: Character %s/u+%04x has ". + "TABLEENVELOPE specification.\n", + $$options{definedat},$option,$i; + $entrydata{tableenvelope} = $$options{tableenvelope}; + $entrydata{tableenvelope} =~ s/\@\@\@/\#1/g; + $entrydata{"tableenvelope.optspec"} = '#1'; + } +# $entrydata{fontenc} = 'T1' +# unless defined $entrydata{fontenc}; + for my $x (qw/loadfontenc package tablecode/) { + $entrydata{"$x.option"} = $$options{$x}; } + return \%entrydata; +} + +sub dump_charactertable($$$$) { + my $spec = shift; + my $option = $$spec{option}; + my $start = $$spec{start}; + my $end = $$spec{end}; + my $format = $$spec{format}; + + my $hstart = sprintf "%04X", $start; + my $hend = sprintf "%04X", $end; + my $filename = "$tabledir/table-$option-$hstart-$hend.tex"; + + print "Generating $filename\n" if $verbose; + + my $file = openfile("$tabledir/table-$option-$hstart-$hend.tex", + "%%% table for option $option, U+$hstart..U+$hend, $autogen", + "Unicode chart U+$hstart..U+$hend"); + + print $file <<EOT; +\\input{tables.inc} + +\\def\\gformat{$format}% +\\def\\goption{$option}% +\\def\\ghstart{$hstart}% +\\def\\ghend{$hend}% +\\def\\gstart{$start}% +\\def\\gend{$end}% +EOT + + my $table = "\\tstart%\n"; + my %fontencs = (); + my %packages = (); + my %tablecode = (); + for (my $i=$start; $i<=$end; $i++) { + my @chars = (); + @chars = @{$characters[$i]} if defined @{$characters[$i]}; + my $entry = ($unidata[$i])?"\\noglyph":"\\unassigned"; + my $found = 0; + my $hasctrlglyph = undef; + for my $char (@chars) { + my $options = $$char[1]; + if (define($$char[0]) ne '' || + define($$options{envelope}) ne '') { + if (optioneq($$options{onoption},'ctrlglyphs')) { + $hasctrlglyph = $options; + } + } + } + + my $entrydata = {default_entrydata($i)}; + + for my $char (@chars) { + my $options = $$char[1]; + if (define($$char[0]) ne '' || + define($$options{envelope}) ne '') { + if (optioneq($$options{onoption},$option)) { + $entry = '\glyph'; + $entrydata = make_entrydata($option,$i,$options, + $hasctrlglyph); + $fontencs{$$entrydata{fontenc}} = 1 + if defined $$entrydata{fontenc} && + $$entrydata{fontenc} ne 'T1'; + $fontencs{$$entrydata{'loadfontenc.option'}} = 1 + if defined $$entrydata{'loadfontenc.option'}; + if (defined $$entrydata{"package.option"}) { + for my $p (split ';', $$entrydata{'package.option'}) { + $packages{$p} = 1; }} + $tablecode{$$entrydata{"tablecode.option"}} = 1 + if defined $$entrydata{"tablecode.option"}; + $found = 1; + } elsif (!$found) { + if (!$$options{dirty} || $entry eq '') { + $entry = '\withoption'; + } + } + } + } + for my $i (keys %$entrydata) { + next if $i =~ /\./; + my $os = define($$entrydata{"$i.optspec"}); + $table .= "\\gdef\\a$i$os\{$$entrydata{$i}\}%\n"; } + my $comment = sprintf "%04X %s %s", $i, utf16toutf8($i), + define($unidata[$i]->{name}); + $table .= "$entry\% $comment\n"; + } + $table .= "\\tend%\n"; + + print $file "\\def\\gfontencs{",join(',',keys %fontencs,'T1'),"}%\n"; + for my $p (keys %packages) { + $p = "{$p}" unless $p =~ /\}$/; + print $file "\\usepackage$p%\n"; + } + for my $c (keys %tablecode) { + print $file "$c%\n"; + } + print $file $table; + flush $file; +} + + +sub parseargs() { + #Getopt::Long::Configure(qw/bundling/); + my %opt = (); + unless (GetOptions(\%opt,qw/config|configfile|c=s@ + exclude|ex=s@ + database|db|d=s + comments! + names! + data! + loadunidata! + tables=s + tabledir=s + targetdir|dir|t|target=s + help|h + verbose|v + compress! + onlyfile=s + /)) { + die "Bad command line options, try --help"; + } + if ($opt{help}) { + showhelp(); + exit; + } + unless ($opt{forceasterisk}) { + @ARGV = grep { if (/\*/ && !-e $_) { + print "Configfile $_ seems to be unmatched wildcard. Ignoring.\n" + if $opt{verbose}; + 0; } else { 1; } + } @ARGV; + } + push @{$opt{config}}, @ARGV if @ARGV; + die "You must supply at least one config file" + unless defined $opt{config}; + $opt{exclude} = [] unless defined $opt{exclude}; + @{$opt{exclude}} = split /,/,join ',',@{$opt{exclude}}; + $opt{database} = 'UnicodeData.txt' unless defined $opt{database}; + $opt{comments} = 1 unless defined $opt{comments}; + $opt{names} = 1 unless defined $opt{names}; + $opt{data} = 1 unless defined $opt{data}; + $opt{targetdir} = '.' unless defined $opt{targetdir}; + $opt{loadunidata} = 1 unless defined $opt{loadunidata}; + $opt{tables} = '*' if $opt{tabledir} && !defined $opt{tables}; + $opt{tabledir} = '.' unless defined $opt{tabledir}; + $opt{compress} = 1 unless defined $opt{compress}; + @configfiles = @{$opt{config}}; + $unidata = $opt{database}; + $createcomments = $opt{comments}; + $targetdir = $opt{targetdir}; + $verbose = $opt{verbose}; + $generate_uninames = $opt{names}; + $tabledir = $opt{tabledir}; + $tables_to_dump = $opt{tables}; + $dump_unidata = $opt{data}; + $loadunidata = $opt{loadunidata}; + $compressnames = $opt{compress}; + $onlyfile = $opt{onlyfile}; + %excludedoptions = map { $_ => 1 } @{$opt{exclude}}; +} + +sub untaint($) { + my $str = shift; + my ($unt) = ($str =~ /^(.*)$/); + return $unt; +} + +sub unlinkfile($) { + my $fullname = shift; + return 1 if defined($onlyfile) && $fullname !~ m@(^|/)$onlyfile$@; + return 1 unless -e $fullname; + my $f = new IO::File($fullname,O_RDONLY) or + die "Could not open $fullname for reading: $!"; + my $line = <$f>; + close $f; + unless ($line =~ /^\%\%\%.*autogenerated by makeunidef.pl/) { + die "File $fullname was not generated by me, ". + "will not overwrite it"; } + unlink untaint($fullname) or + die "Could not remove $fullname: $!"; + #print "FILE: $file\n"; +} + +sub unlinkfiles($$) { + my ($pattern,$dir) = @_; + my $d = new IO::Handle; + opendir $d, $dir or + die "Could not open directory $targetdir: $!"; + while (my $file = readdir $d) { + #print "F: $file\n"; + next unless $file =~ /$pattern/x; + #print "UF: $file\n"; + unlinkfile("$dir/$file") or + die "Could not unlink $dir/$file"; + } +} + +$huffman_decoder = '\count255=128 +\loop\ifnum\count255<256\relax + \catcode\count255=13 + \advance\count255by1\relax +\repeat +\catcode`\G=13 +\catcode`\H=13 +\catcode`\I=13 +\def\uncompress{% +\def^^80{\0\0\0\0\0\0\0}% +\def^^81{\0\0\0\0\0\0\1}% +\def^^82{\0\0\0\0\0\1\0}% +\def^^83{\0\0\0\0\0\1\1}% +\def^^84{\0\0\0\0\1\0\0}% +\def^^85{\0\0\0\0\1\0\1}% +\def^^86{\0\0\0\0\1\1\0}% +\def^^87{\0\0\0\0\1\1\1}% +\def^^88{\0\0\0\1\0\0\0}% +\def^^89{\0\0\0\1\0\0\1}% +\def^^8a{\0\0\0\1\0\1\0}% +\def^^8b{\0\0\0\1\0\1\1}% +\def^^8c{\0\0\0\1\1\0\0}% +\def^^8d{\0\0\0\1\1\0\1}% +\def^^8e{\0\0\0\1\1\1\0}% +\def^^8f{\0\0\0\1\1\1\1}% +\def^^90{\0\0\1\0\0\0\0}% +\def^^91{\0\0\1\0\0\0\1}% +\def^^92{\0\0\1\0\0\1\0}% +\def^^93{\0\0\1\0\0\1\1}% +\def^^94{\0\0\1\0\1\0\0}% +\def^^95{\0\0\1\0\1\0\1}% +\def^^96{\0\0\1\0\1\1\0}% +\def^^97{\0\0\1\0\1\1\1}% +\def^^98{\0\0\1\1\0\0\0}% +\def^^99{\0\0\1\1\0\0\1}% +\def^^9a{\0\0\1\1\0\1\0}% +\def^^9b{\0\0\1\1\0\1\1}% +\def^^9c{\0\0\1\1\1\0\0}% +\def^^9d{\0\0\1\1\1\0\1}% +\def^^9e{\0\0\1\1\1\1\0}% +\def^^9f{\0\0\1\1\1\1\1}% +\def^^a0{\0\1\0\0\0\0\0}% +\def^^a1{\0\1\0\0\0\0\1}% +\def^^a2{\0\1\0\0\0\1\0}% +\def^^a3{\0\1\0\0\0\1\1}% +\def^^a4{\0\1\0\0\1\0\0}% +\def^^a5{\0\1\0\0\1\0\1}% +\def^^a6{\0\1\0\0\1\1\0}% +\def^^a7{\0\1\0\0\1\1\1}% +\def^^a8{\0\1\0\1\0\0\0}% +\def^^a9{\0\1\0\1\0\0\1}% +\def^^aa{\0\1\0\1\0\1\0}% +\def^^ab{\0\1\0\1\0\1\1}% +\def^^ac{\0\1\0\1\1\0\0}% +\def^^ad{\0\1\0\1\1\0\1}% +\def^^ae{\0\1\0\1\1\1\0}% +\def^^af{\0\1\0\1\1\1\1}% +\def^^b0{\0\1\1\0\0\0\0}% +\def^^b1{\0\1\1\0\0\0\1}% +\def^^b2{\0\1\1\0\0\1\0}% +\def^^b3{\0\1\1\0\0\1\1}% +\def^^b4{\0\1\1\0\1\0\0}% +\def^^b5{\0\1\1\0\1\0\1}% +\def^^b6{\0\1\1\0\1\1\0}% +\def^^b7{\0\1\1\0\1\1\1}% +\def^^b8{\0\1\1\1\0\0\0}% +\def^^b9{\0\1\1\1\0\0\1}% +\def^^ba{\0\1\1\1\0\1\0}% +\def^^bb{\0\1\1\1\0\1\1}% +\def^^bc{\0\1\1\1\1\0\0}% +\def^^bd{\0\1\1\1\1\0\1}% +\def^^be{\0\1\1\1\1\1\0}% +\def^^bf{\0\1\1\1\1\1\1}% +\def^^c0{\1\0\0\0\0\0\0}% +\def^^c1{\1\0\0\0\0\0\1}% +\def^^c2{\1\0\0\0\0\1\0}% +\def^^c3{\1\0\0\0\0\1\1}% +\def^^c4{\1\0\0\0\1\0\0}% +\def^^c5{\1\0\0\0\1\0\1}% +\def^^c6{\1\0\0\0\1\1\0}% +\def^^c7{\1\0\0\0\1\1\1}% +\def^^c8{\1\0\0\1\0\0\0}% +\def^^c9{\1\0\0\1\0\0\1}% +\def^^ca{\1\0\0\1\0\1\0}% +\def^^cb{\1\0\0\1\0\1\1}% +\def^^cc{\1\0\0\1\1\0\0}% +\def^^cd{\1\0\0\1\1\0\1}% +\def^^ce{\1\0\0\1\1\1\0}% +\def^^cf{\1\0\0\1\1\1\1}% +\def^^d0{\1\0\1\0\0\0\0}% +\def^^d1{\1\0\1\0\0\0\1}% +\def^^d2{\1\0\1\0\0\1\0}% +\def^^d3{\1\0\1\0\0\1\1}% +\def^^d4{\1\0\1\0\1\0\0}% +\def^^d5{\1\0\1\0\1\0\1}% +\def^^d6{\1\0\1\0\1\1\0}% +\def^^d7{\1\0\1\0\1\1\1}% +\def^^d8{\1\0\1\1\0\0\0}% +\def^^d9{\1\0\1\1\0\0\1}% +\def^^da{\1\0\1\1\0\1\0}% +\def^^db{\1\0\1\1\0\1\1}% +\def^^dc{\1\0\1\1\1\0\0}% +\def^^dd{\1\0\1\1\1\0\1}% +\def^^de{\1\0\1\1\1\1\0}% +\def^^df{\1\0\1\1\1\1\1}% +\def^^e0{\1\1\0\0\0\0\0}% +\def^^e1{\1\1\0\0\0\0\1}% +\def^^e2{\1\1\0\0\0\1\0}% +\def^^e3{\1\1\0\0\0\1\1}% +\def^^e4{\1\1\0\0\1\0\0}% +\def^^e5{\1\1\0\0\1\0\1}% +\def^^e6{\1\1\0\0\1\1\0}% +\def^^e7{\1\1\0\0\1\1\1}% +\def^^e8{\1\1\0\1\0\0\0}% +\def^^e9{\1\1\0\1\0\0\1}% +\def^^ea{\1\1\0\1\0\1\0}% +\def^^eb{\1\1\0\1\0\1\1}% +\def^^ec{\1\1\0\1\1\0\0}% +\def^^ed{\1\1\0\1\1\0\1}% +\def^^ee{\1\1\0\1\1\1\0}% +\def^^ef{\1\1\0\1\1\1\1}% +\def^^f0{\1\1\1\0\0\0\0}% +\def^^f1{\1\1\1\0\0\0\1}% +\def^^f2{\1\1\1\0\0\1\0}% +\def^^f3{\1\1\1\0\0\1\1}% +\def^^f4{\1\1\1\0\1\0\0}% +\def^^f5{\1\1\1\0\1\0\1}% +\def^^f6{\1\1\1\0\1\1\0}% +\def^^f7{\1\1\1\0\1\1\1}% +\def^^f8{\1\1\1\1\0\0\0}% +\def^^f9{\1\1\1\1\0\0\1}% +\def^^fa{\1\1\1\1\0\1\0}% +\def^^fb{\1\1\1\1\0\1\1}% +\def^^fc{\1\1\1\1\1\0\0}% +\def^^fd{\1\1\1\1\1\0\1}% +\def^^fe{\1\1\1\1\1\1\0}% +\def^^ff{\1\1\1\1\1\1\1}% +\readline}% +\@tempcnta=0 +\def\readline#1 +{\toks255{}\toks254{}\relax + #1% + \let\uc@temp@c\uc@temp@a + \unicode@numtohex\uc@temp@a\uc@got4% + \edef\uc@temp@b{\the\toks254}% + \edef\uc@temp@b{\uc@temp@b}% + \global\let\uc@temp@a\uc@temp@c + \expandafter\info\expandafter{\uc@temp@b}% + \endinput}% +\def\skipcodes#1G{\advance\@tempcnta by"#1\relax\checkline}% +\def\skipline#1 +{}% +\def\add#1{\toks254\expandafter{\the\toks254 #1}}% +\def\checkline{\advance\@tempcnta by1\relax + \ifnum\@tempcnta=\uc@got + \expandafter\uncompress\else\expandafter\skipline\fi}% +\def\checkrange#1I#2G{% + \advance\@tempcnta by"#1\relax + \@tempcntb\@tempcnta\advance\@tempcntb by-"#2\relax + \ifnum\@tempcntb>\uc@got\let\uc@temp@c\skipline\else + \ifnum\@tempcnta<\uc@got\let\uc@temp@c\skipline\else + \let\uc@temp@c\uncompress + \fi\fi + \uc@temp@c}% +\letG\checkline +\letH\skipcodes +\letI\checkrange +\def\1{\toks255\expandafter{\the\toks255 b}\2}% +\def\0{\toks255\expandafter{\the\toks255 a}\2}% +\def\2{\expandafter\ifx\csname hc@\the\toks255\endcsname\relax + \else\csname hc@\the\toks255\endcsname\toks255{}\fi}%'; + +sub getname($) { + my $i = shift; + my $fullname; my $rangeend; my $xoptions; + if (defined $unidata[$i]) { + my $name = $ {$unidata[$i]}{name}; + my $alias = $ {$unidata[$i]}{alias}; + my $comment = $ {$unidata[$i]}{comment}; + $rangeend = $ {$unidata[$i]}{rangeend}; + $fullname = $name; + $fullname .= "\n$alias" if $alias; + $fullname .= "\n$comment" if $comment; + $xoptions = join ', ', grep { $excludedoptions{$_} } + keys %{$ {$unidata[$i]}{options}}; + $xoptions = undef if $xoptions eq ''; + } + +# if ($characters[$i]) { +# $options = grep { defined $_ } join ', ', map { +# my $o = $$_[1]; $o = $$o{onoption}; +# $o = 'default' if (!defined $o) || ($o eq ''); $o; +# $o = undef unless $excludedoptions{$o}; $o; +# } @{$characters[$i]}; +# if (defined $rangeend) { +# $options2 = $options; $options = undef; +# $fullname2 = findrange($i); +# } else { +# $fullname = findrange($i) unless defined $fullname; +# } +# } + + return undef unless defined $fullname; + + my $str = "\001"; + if (defined $fullname) { $str .= "$fullname\n" } else { $str .= "\002\n" }; + if (defined $xoptions) { $str .= "\003$xoptions\n" }; + chomp $str; + +# my $str2 = undef; +# if (defined $options2) { +# $str2 = "\001"; +# if (defined $fullname2) { $str2 .= "$fullname\n" } +# else { $str2 .= "\002\n" }; +# { $str2 .= "\000$options2\n" }; +# chomp $str2; +# } + + return ($str); +} + +sub dumpnames_compressed() { + my $file = openfile("$targetdir/uninames.dat", + "%%% unicode name hash for ucs.sty, $autogen", + "Unicode character names, compressed", + coding => 'no-conversion'); + print "Creating Huffman code\n" if $verbose; + my (@weight, @tree, %lookup); + my $nexthuffman = 0; + my $upto = $#unidata; $upto = $#characters if $#characters > $upto; + for (my $i=1; $i<=$upto; $i++) { + for my $str (getname $i) { + next unless defined $str; + for my $c (split '',$str) { + my $n = $lookup{$c}; + unless (defined $n) { $n = $nexthuffman++; $lookup{$c} = $n }; + $weight[$n]++; + $tree[$n] = $c; + } + } + } + + my $highnum = 9999999; + while (1) { + my ($smallest, $smallest2); + my $smallestval = $highnum; + my $smallest2val = $highnum; + for (my $i=0; $i<$nexthuffman; $i++) { + my $val = $weight[$i]; + my $j = $i; + next unless defined $val; +# print "0: $j\n"; + if ($val < $smallestval) { + my $tmp = $val; $val = $smallestval; $smallestval = $tmp; + $tmp = $j; $j = $smallest; $smallest = $tmp; + } + if ($val < $smallest2val) { + $smallest2val = $val; $smallest2 = $j; + } +# print "A: $smallest, $smallest2\n"; + } + last if ($smallest2val==$highnum); + $weight[$smallest] = undef; + $weight[$smallest2] = undef; + $tree[$nexthuffman] = [$tree[$smallest],$tree[$smallest2]]; + $weight[$nexthuffman] = $smallestval+$smallest2val; +# print "$smallest + $smallest2 => $nexthuffman\n"; +# print Dumper($tree[$nexthuffman]); + $nexthuffman++; + } + + dumphuffman($tree[$nexthuffman-1],'',\%lookup); + my $padding = undef; + for my $i (values %lookup) { + if (length($i)>7) { + $padding = $i; last; + } + } + unless (defined $padding) { + warn "There is no huffman bit sequence longer than 7 bit. ". + "Padding with spaces"; + $padding = $lookup{' '} x 8; + } + + print "Compressing\n" if $verbose; + + for my $c (keys %lookup) { + my $v = $lookup{$c}; + $v =~ s/1/b/g; $v =~ s/0/a/g; + $c = $uninames_abbrev{$c} if defined $uninames_abbrev{$c}; + print $file "\\def\\hc\@$v\{\\add $c\}\%\n"; + } + print $file "$huffman_decoder\n"; + + my $cp = 0; + for (my $i=1; $i<=$#unidata; $i++) { + for my $str (getname $i) { + next unless defined $str; + my $rangestart; + if ($unidata[$i]) { $rangestart = $ {$unidata[$i]}{rangestart}; }; + + $str =~ s/./ + if (!defined $lookup{$&}) { print "L: '$&'\n"; }; + $lookup{$&}; + /egs; +# $str = join '', map { if ($_) { +# pack "B*", sprintf "3%-7s", $_; +# } } split /(.{1,7})/, $str; + $str =~ s/.{1,7}/ + sprintf "3%s%s",$&,substr($padding,0,7-length($&)); + /eg; + $str = pack("B*",$str); + $cp++; + if (defined $rangestart) { +# printf $file "I%XI%X", $i-$cp+1, $rangeend-$i; +# $cp=$rangeend; + printf $file "I%XI%X", $i-$cp+1, $i-$rangestart; + $cp=$i; + } else { + if ($i>$cp) { printf $file "H%X", $i-$cp; $cp=$i}; + } + print $file "G$str\n"; + } + } + + flushfiles(); +} + +sub dumphuffman($$$) { + my ($tree,$prefix,$lookup) = @_; +# print Dumper([$tree]); return; + if (ref $tree) { + dumphuffman($$tree[0],$prefix.'0',$lookup); + dumphuffman($$tree[1],$prefix.'1',$lookup); + } else { +# print "HUFFMAN: '$tree' => '$prefix'\n"; + $$lookup{$tree} = $prefix; + } +} + +sub isprivate($) { + my $cp = shift; + return 1 if ($cp>=0xe000 && $cp<=0xf8ff); + return 1 if ($cp>=0xf0000 && $cp<=0xffffd); + return 1 if ($cp>=0x100000 && $cp<=0x10fffd); + return 0; +} + +sub dumpnames_uncompressed() { + my $file = openfile("$targetdir/uninames.dat", + "%%% unicode name hash for ucs.sty, $autogen", + "Unicode character names"); + warn "Dumping uncompressed unicode data, ". + "this is no longer maintained and may give unpredicted results.\n"; + dump_ranges($file); + for (my $i=1; $i<=$#unidata; $i++) { + next unless defined $unidata[$i]; + my $name = $ {$unidata[$i]}{name}; + my $alias = $ {$unidata[$i]}{alias}; + my $comment = $ {$unidata[$i]}{comment}; + my $str = sprintf "Unicode character %d = 0x%04x:${messagebreak}%s", + $i, $i, $name; + $str .= "${messagebreak}$alias" if $alias; + $str .= "${messagebreak}$comment" if $comment; + print $file "\\info{$str}\%\n"; + } + flushfiles(); +} + +parseargs(); +print "PASS: initcharacters\n" if $verbose; +initcharacters(); +if ($dump_unidata) { + print "PASS: unlink unidata files\n" if $verbose; + unlinkfiles(' + ^uni-[0-9]+\.def$| + ^uninames.dat$| + ^uni-global\.def$ ',$targetdir); +} +if ($tables_to_dump) { + print "PASS: unlink tables\n" if $verbose; + unlinkfiles(' ^table-.*-.*-.*\.tex$ ',$tabledir); +} +if ($loadunidata) { + print "PASS: loadunidata($unidata)\n" if $verbose; + loadunidata($unidata); } +for my $configfile (@configfiles) { + print "PASS: loadconfig($configfile)\n" if $verbose; + loadconfig($configfile); } +print "PASS: generate\n" if $verbose; +generate(); +if ($dump_unidata) { + print "PASS: generate globals\n" if $verbose; + generate_globals(); } +if ($createcomments) { + print "PASS: makecomments\n" if $verbose; + makecomments(); } +if ($dump_unidata) { + print "PASS: dumpcharacters\n" if $verbose; + dumpcharacters(); +} +if ($tables_to_dump) { + print "PASS: dumping character tables to directory $tabledir/\n" + if $verbose; + dump_charactertables(); +} +if ($generate_uninames && $dump_unidata && $loadunidata) { + if ($compressnames) { + print "PASS: dumpnames (compressed)\n" if $verbose; + dumpnames_compressed(); + } else { + print "PASS: dumpnames (uncompressed)\n" if $verbose; + dumpnames_uncompressed(); + }} +print "PASS: closefiles\n" if $verbose; +closefiles(); + +### LocalVariables: +### mode: perl +### End: +### Local IspellDict: british + + +# LocalWords: uni def makeunidef pl de ucs sty AUTOOPTION num configfiles dir +# LocalWords: nocomments SYSNOPSIS targetdir db UnicodeData txt uninames dat +# LocalWords: UNIDATA org www http unicode |