#!/usr/bin/perl --

@outputs=('ascii','lout','info');

while ($ARGV[0] =~ m/^\-/) {
    $_= shift(@ARGV);
    if (m/^-only/) {
        @outputs= (shift(@ARGV));
    } else {
        warn "unknown option `$_' ignored";
    }
}

$prefix= $ARGV[0];
$prefix= 'stdin' unless length($prefix);
$prefix =~ s/\.bfnn$//;

if (open(O,"$prefix.xrefdb")) {
    @xrefdb= <O>;
    close(O);
} else {
    warn "no $prefix.xrefdb ($!)";
}

$section= -1;
for $thisxr (@xrefdb) {
    $_= $thisxr;
    chop;
    if (m/^Q (\w+) ((\d+)\.(\d+)) (.*)$/) {
        $qrefn{$1}= $2;
        $qreft{$1}= $5;
        $maxsection= $3;
        $maxquestion[$3]= $4;
    } elsif (m/^S (\d+)/) {
        $maxsection= $1;
    }
}

open(U,">$prefix.xrefdb-new");

for $x (@outputs) { require("m-$x.pl"); }

&call('init');

while (<>) {
    chop;
    next if m/^\\comment\b/;
    if (!m/\S/) {
        &call('endpara');
        next;
    }
    if (s/^\\section +//) {
        $line= $_;
        $section++; $question=0;
        print U "S $section $line\n";
        $|=1; print "S$section",' 'x10,"\r"; $|=0;
        &call('endpara');
        &call('startmajorheading',"s_$section",
              "Section $section",
              $section<$maxsection ? "Section ".($section+1) : '',
              $section>1 ? 'Section '.($section-1) : 'Top',
              'Top');
        &text(($section ? "Section $section.  " : '') . $line);
        &call('endheading');
        if ($section) {
            &call('endpara');
            &call('startindex');
            for $thisxr (@xrefdb) {
                $_= $thisxr;
                chop;
                if (m/^Q (\w+) (\d+)\.(\d+) (.*)$/) {
                    $ref= $1; $num1= $2; $num2= $3; $text= $4;
                    next unless $num1 == $section;
                    &call('startindexitem',$ref,"Q$num1.$num2","Question $num1.$num2");
                    &text($text);
                    &call('endindexitem');
                }
            }
            &call('endindex');
        }
    } elsif (s/^\\question \d{2}[a-z]{3}((:\w+)?) +//) {
        $line= $_;
        $question++;
        $qrefstring= $1;
        $qrefstring= "q_${section}_$question" unless $qrefstring =~ s/^://;
        print U "Q $qrefstring $section.$question $line\n";
        $|=1; print "Q$section.$question",' 'x10,"\r"; $|=0;
        &call('endpara');
        &call('startminorheading',$qrefstring,
              "Question $section.$question",
              $question < $maxquestion[$section] ? "Question $section.".($question+1) :
              $section < $maxsection ? "Question ".($section+1).".1" : '',
              $question > 1 ? "Question $section.".($question-1) :
              $section > 1 ? "Question ".($section-1).'.'.($maxquestion[$section-1]) :
              'Top',
              "Section $section");
        &text("Question $section.$question.  $line");
        &call('endheading');
    } elsif (s/^\\only +//) {
        @saveoutputs= @outputs;
        @outputs=();
        for $x (split(/\s+/,$_)) {
            push(@outputs,$x) if grep($x eq $_, @saveoutputs);
        }
    } elsif (s/^\\endonly$//) {
        @outputs= @saveoutputs;
    } elsif (s/^\\copyto +//) {
        $fh= $';
        while(<>) {
            last if m/^\\endcopy$/;
            while (s/^([^\`]*)\`//) {
                print $fh $1;
                m/([^\\])\`/ || warn "`$_'";
                $_= $';
                $cmd= $`.$1;
                $it= `$cmd`; chop $it;
                print $fh $it;
            }
            print $fh $_;
        }
    } elsif (m/\\index$/) {
        &call('startindex');
        for $thisxr (@xrefdb) {
            $_= $thisxr;
            chop;
            if (m/^Q (\w+) (\d+\.\d+) (.*)$/) {
                $ref= $1; $num= $2; $text= $3;
                &call('startindexitem',$ref,"Q$num","Question $num");
                &text($text);
                &call('endindexitem');
            } elsif (m/^S (\d+) (.*)$/) {
                $num= $1; $text= $2;
                next unless $num;
                &call('startindexmainitem',"s_$num",
                      "Section $num.","Section $num");
                &text($text);
                &call('endindexitem');
            } else {
                warn $_;
            }
        }
        &call('endindex');
    } elsif (m/^\\call-(\w+) +(\w+)\s*(.*)$/) {
        $fn= $1.'_'.$2;
        eval { &$fn($3); };
        warn $@ if length($@);
    } elsif (m/^\\call +(\w+)\s*(.*)$/) {
        eval { &call($1,$2); };
        warn $@ if length($@);
    } elsif (m/^\\verbatim$/) {
        &call('startverbatim');
        while (<>) {
            chop;
            last if m/^\\endverbatim$/;
            &call('verbatim',$_);
        }
        &call('endverbatim');
    } else {
        s/\.$/\. /;
        &text($_." ");
    }
}

print ' 'x25,"\r";
&call('finish');
rename("$prefix.xrefdb-new","$prefix.xrefdb") || warn "rename xrefdb: $!";
exit 0;


sub text {
    $in= "$holdover$_[0]";
    $holdover= '';
    while ($in =~ m/\\/) {
# print STDERR ">$`##$'\n";
        &call('text',$`);
        $_= $';
        if (m/^\w+ $/) {
            $holdover= "\\$&";
            $in= '';
        } elsif (s/^fn\s+([^\s\\]*\w)//) {
            $in= $_;
            $word= $1;
            &call('courier');
            &call('text',$word);
            &call('endcourier');
        } elsif (s/^tab\s+(\d+)\s+//) {
            $in= $_; &call('tab',$1);
        } elsif (s/^nl\s+//) {
            $in= $_; &call('newline');
        } elsif (s/^qref\s+(\w+)//) {
            $refn= $qrefn{$1};
            $reft= $qreft{$1};
            if (!length($refn)) {
                warn "unknown question `$1'";
            }
            $in= "$`\\pageref:$1:$refn:`$reft'$_";
        } elsif (s/^pageref:(\w+):([^:\n]+)://) {
            $in= $_;
            &call('pageref',$1,$2);
        } elsif (s/^(\w+)\{//) {
            $in= $_; $fn= $1;
            eval { &call("$fn"); };
            if (length($@)) { warn $@; $fn= 'x'; }
            push(@styles,$fn);
        } elsif (s/^\}//) {
            $in= $_;
            $fn= pop(@styles);
            if ($fn ne 'x') { &call("end$fn"); }
        } else {
            warn "unknown control `\\$_'";
            $in= $_;
        }
    }
    &call('text',$in);
}


sub call {
    local ($fnbase, @callargs) = @_;
    for $op (@outputs) {
        $fntc= $op.'_'.$fnbase;
        &$fntc(@callargs);
    }
}
