--- /dev/null
+#!/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
projects / helm.git / blobdiff