#! /usr/bin/perl -CSD
use strict;

sub alphabetically {
  return 0 if $a eq $b;
return -1 unless $a;
return 1 unless $b;
  if ($a=~/^[$@%&]/ && $b=~/^[$@%&]/) {
  return substr($a,0,1) cmp substr($b,0,1) 
    if substr($a,0,1) ne substr($b,0,1);
  local($a, $b) = (substr($a,1), substr($b,1));
  &alphabetically;
}
  return lc($a) cmp lc($b);
}
my ($Prog, $Version) = ("w0-f-latex", "2.0.3");
my ($False, $True) = (0, 1);
my $Macro_start = "<<";
my $Output = \*STDOUT;
my $N_macro = 0;
my %Macro_id = ();
my @Macro_n_ext = ();
my ($cur_macro, $cur_ext) = (0, 0);
my %Func_index = ();
my %Var_index = ();
my %Class_index = ();
my @Macro_x = ();
my $def_id = "";
my $N_errors = 0;
PARAM:
while (@ARGV && $ARGV[0] =~ /^-/) { $_ = shift;
    /^-o$/ and do { $_ = shift;  open(OUT, ">$_") or &Error("Could not create `$_'.");
$Output = \*OUT;
    next PARAM; };
/^-o(.+)$/ and do { $_ = $1;  open(OUT, ">$_") or &Error("Could not create `$_'.");
$Output = \*OUT;
    next PARAM; };
/^-v$/ and do {
    print STDERR "This is $Prog (version $Version)\n";
    next PARAM; };
&Message("Unknown option `$_' ignored.");
}
my @Tokens = ();
while (<>) { chomp;  push(@Tokens, $_);
  /^def:(.*)>>$/ and do { 
  my $symb = $1;
  if (defined $Macro_id{$symb}) {
    ++$Macro_n_ext[$Macro_id{$symb}];
  } else {
    $Macro_id{$symb} = ++$N_macro;  $Macro_n_ext[$N_macro] = 0;
  }
};
}
my @Macro_use = ();
my $Cur_line = 0;
my %message_given = ();
my @macro_ext_cnt = ();
$Cur_line = 0;
foreach (@Tokens) {
    /^def:(.*)>>$/ and do { ++$Cur_line;
    $cur_macro = $Macro_id{$1};
    $cur_ext = $macro_ext_cnt[$cur_macro]++;  next; };
/^use:(.*)>>$/ and do { my $symb = $1;
    if (defined $Macro_id{$symb}) {
      $Macro_use[$Macro_id{$symb}] .= "$cur_macro-$cur_ext ";
    } elsif ($message_given{$symb}++ == 0) {
      &Warning("Macro name $Macro_start$symb>> not defined.");
    } 
    next; };
/^nl$/ and do { ++$Cur_line;  next; };
/^fdef:(.*);/ and do {
    $Func_index{$1} .= $Cur_line . "0 ";  next; };
/^fuse:(.*);/ and do {
    $Func_index{$1} .= $Cur_line . "1 ";  next; };
/^vdef:(.*);/ and do {
    $Var_index{$1} .= $Cur_line . "0 ";  next; };
/^vuse:(.*);/ and do {
    $Var_index{$1} .= $Cur_line . "1 ";  next; };
/^cdef:(.*);/ and do {
    $Class_index{$1} .= $Cur_line . "0 ";  next; };
/^cuse:(.*);/ and do {
    $Class_index{$1} .= $Cur_line . "1 ";  next; };
}
%message_given = ();  @macro_ext_cnt = ();
&Generate_index("class", \%Class_index);
&Generate_index("func", \%Func_index);
&Generate_index("var", \%Var_index);
print $Output "\\def\\wzmacroindex{\\begin{wzindex}",
    "{\\wzmacroindexname}{1}\n";
foreach (sort alphabetically keys %Macro_id) {
    print $Output "\\wzx{\\wzmacro{", &Latexify($_), "~~\\upshape\\#",
        "$Macro_id{$_}}}\\wzlongpageref{$Macro_id{$_}}",
        ($Macro_use[$Macro_id{$_}] ? "" : "\\rlap{~*}"),
        "\\par\n";
}
print $Output "\\smallskip\\raggedright\\wzmacroindexstartext\\par
\\end{wzindex}}\n";
my ($Code_mode, $Cur_line) = ($False, 0);
foreach (@Tokens) {
    /^code:(.*);$/ and do { 
    print $Output &Latexify($1);  next; };
/^bcode:(.*);$/ and do { 
    print $Output "\\textbf{", &Latexify($1), "}";  next; };
/^bicode:(.*);$/ and do { 
    print $Output "\\textit{\\textbf{", &Latexify($1), "}}";  
    next; };
/^icode:(.*);$/ and do { 
    print $Output "\\textit{", &Latexify($1), "}";  next; };
    /^def:(.*)>>$/ and do {
    my $symb = $1;  $def_id = $Macro_id{$symb};
    if (defined $Macro_x[$def_id]) { 
      ++$Macro_x[$def_id];
    } else { 
      $Macro_x[$def_id] = 0;  
    }
    print $Output "%\n\\wzenddef{$def_id}{$Macro_x[$def_id]}{" . 
    ($Macro_x[$def_id]<$Macro_n_ext[$def_id] ? $Macro_x[$def_id]+1 : 0) .
    "}{" . ($Macro_x[$def_id]==0 ? &Format_usage($def_id) : 0),
    "}\\relax\n" if $Code_mode;
$Code_mode = $False;
    print $Output "\\wzdef{", &Latexify($symb), 
        "}{$def_id}{$Macro_x[$def_id]}";
    $Code_mode = $True;  ++$Cur_line;  next; };
    /^file:(.*);$/ and do {
    print $Output "%\n\\wzenddef{$def_id}{$Macro_x[$def_id]}{" . 
    ($Macro_x[$def_id]<$Macro_n_ext[$def_id] ? $Macro_x[$def_id]+1 : 0) .
    "}{" . ($Macro_x[$def_id]==0 ? &Format_usage($def_id) : 0),
    "}\\relax\n" if $Code_mode;
$Code_mode = $False;
    print $Output "\\ifx \\wzfile\\undefined
\\AtBeginDocument{\\wzfile {$1}}\\else \\wzfile {$1}\\fi\n";
    next; };
    /^nl$/ and do {
    print $Output "\\wzeol\\relax\n";  ++$Cur_line;  next; };
    /^text:(.*);$/ and do {
    my $text = $1;  print $Output "%\n\\wzenddef{$def_id}{$Macro_x[$def_id]}{" . 
    ($Macro_x[$def_id]<$Macro_n_ext[$def_id] ? $Macro_x[$def_id]+1 : 0) .
    "}{" . ($Macro_x[$def_id]==0 ? &Format_usage($def_id) : 0),
    "}\\relax\n" if $Code_mode;
$Code_mode = $False;
    print $Output "$text\n";  next; };
    /^use:(.*)>>$/ and do {
    print $Output "\\wzmacro[$Macro_id{$1}]{", &Latexify($1), "}";
    next; };
}
print $Output "%\n\\wzenddef{$def_id}{$Macro_x[$def_id]}{" . 
    ($Macro_x[$def_id]<$Macro_n_ext[$def_id] ? $Macro_x[$def_id]+1 : 0) .
    "}{" . ($Macro_x[$def_id]==0 ? &Format_usage($def_id) : 0),
    "}\\relax\n" if $Code_mode;
$Code_mode = $False;
close $Output unless $Output == \*STDOUT;
exit ($N_errors ? 1 : 0);

sub Format_usage {
    local $_ = $Macro_use[shift];  chomp;
    my @data = ();
    my ($last_x, $x) = ("", "");

    foreach $x (split) { push(@data, $x) if $x ne $last_x;  $last_x = $x; }

    my ($n, $res) = (0, "");
    foreach (@data) {
        if (++$n == @data && @data > 2) { $res .= "\\wzlastsep\n"; }
        elsif ($n == 2 && @data == 2) { $res .= "\\wztwosep\n"; }
        elsif ($n > 1) {$res .= "\\wzsep\n"; }
        $res .= "\\wzxref" . (/^(\d+)-(\d+)$/ ? "{$1}{$2}" : "{$_}{0}");  
    }
    return $res;
}
sub Generate_index {
    my ($cmd, $index) = @_;
    local $_;
    my (@lines, $lx, $initial, $last_initial);

    print $Output "\\def\\wz", $cmd, 
        "index\{\\begin{wzindex}{\\wz", $cmd, "indexname}{2}\n";
    foreach (sort indexwise keys %{$index}) {
        $initial = /^[a-z]/i ? uc(substr($_,0,1)) : uc(substr($_,1,1));
print $Output "\\wzinitial{", &Latexify($initial), "}\n" 
    if $initial && $initial ne $last_initial;
$last_initial = $initial;
        print $Output "\\wzx{", &Latexify($_), "}";
@lines = ();
foreach $lx (sort { $a <=> $b } split(" ",$index->{$_})) {
    push @lines, $lx unless @lines && $lines[$#lines] == $lx;
}
while (@lines) { $lx = shift @lines;
    if (@lines>=2 && $lines[0]==$lx+10 && $lines[1]==$lx+20) {
    print $Output $lx%10 ? ("".int($lx/10)) : ("\\wzul{".int($lx/10)."}");
    $lx = shift(@lines) while @lines && $lines[0]==$lx+10;
    print $Output "--";
    print $Output $lx%10 ? ("".int($lx/10)) : ("\\wzul{".int($lx/10)."}");
    print $Output "\\wzindexsep\n" if @lines;
    next;
}
    print $Output $lx%10 ? ("".int($lx/10)) : ("\\wzul{".int($lx/10)."}");
    print $Output "\\wzindexsep\n" if @lines;
}
print $Output "\\par\n";
    }
    print $Output "\\end{wzindex}\}\n";
}
sub indexwise {
    my $ax = $a=~/^\w/ ? $a : substr($a,1)." $1";
    my $bx = $b=~/^\w/ ? $b : substr($b,1)." $1";
    local ($a, $b) = (uc($ax), uc($bx));
    return &alphabetically;
}
sub Warning {
    &Message(@_);  ++$N_errors;
}
sub Latexify {
    local $_ = shift;
    my $break_spaces = shift;
    my $allow_latex = shift;

    if ($allow_latex && /\|(.*?)\|/) {
    return &Latexify($`,$break_spaces,$allow_latex) . $1 . 
        &Latexify($',$break_spaces,$allow_latex);
}
    s/\\/\\textbackslash%temporaer bakslask%/g;
s/\{/\\{/g;
s/\}/\\}/g;
s/\\textbackslash%temporaer bakslask%/\\textbackslash{}/g;
s/\#/\\\#/g;
s/\$/\\\$/g;
s/\%/\\\%/g;
s/\&/\\\&/g;
s/\_/\\\_/g;
s/\^/\\textasciicircum{}/g;
s/\~/\\textasciitilde{}/g;
s/¬/\\textlnot{}/g;  s/±/\\textpm{}/g;  s/²/\\texttwosuperior{}/g;
s/³/\\textthreesuperior{}/g;  s/¹/\\textonesuperior{}/g;
s/µ/\\textmu{}/g;  s/×/\\texttimes{}/g;  s/÷/\\textdiv{}/g;
s/<</<\\null</g;  
s/>>/>\\null>/g;
s/---/-\\null-\\null-/g;  
s/--/-\\null-/g;
s/!`/!\\null`/g;  s/\?`/\?\\null`/g;
s/``/`\\null`/g;  s/''/'\\null'/g;  s/,,/,\\null,/g;
s/ /~/g unless $break_spaces;
    return $_;
}
sub Error {
    &Message(@_);  
    &Tidy_up if defined &Tidy_up;
    exit 1;
}
sub Message {
    print STDERR "$Prog: ", shift, "\n";
    while (@_) {
        print STDERR " "x(2+length $Prog), shift, "\n";
    }
}
