#!/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 or 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 ends 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 Wolfgang Jeltsch <I<wolfgang@cs.ioc.ee>>, the mails
containing the words B<bug report: makeunidef.pl> in the subject.

=head1 AUTHOR

Dominique Unruh <I<unruh@ut.ee>>.

=head1 MAINTAINER

Wolfgang Jeltsch <I<wolfgang@cs.ioc.ee>>.

=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
