# Hey Emacs !  This is -*- perl -*- source code !

use SGMLS::Refs;

$perindent=5;
$linewidth=79;
$textwidth=75;
$unbreakbackoff=20;

sgml('start', sub {
    $type= $ARGV[0];
    $type eq 'plain' || $type eq 'overstrike' ||
        warn "want argument \`plain' or \`overstrike'\n";
    $ov=1 if $type eq 'overstrike';
    if ($ov) {
        sgml('<TT>', sub { push_style('b1') unless $noemph; });
        sgml('</TT>', sub { pop_style() unless $noemph; });
        sgml('<EM>', sub { push_style('u1') unless $noemph; });
        sgml('</EM>', sub { pop_style() unless $noemph; });
        sgml('<VAR>', sub { if (!$noemph) { push_style('u1'); push_style('b0'); } });
        sgml('</VAR>', sub { if (!$noemph) { pop_style(); pop_style(); } });
    } else {
        sgml('<TT>','`');
        sgml('</TT>',"'");
        sgml('<EM>','*');
        sgml('</EM>','*');
        sgml('<VAR>','<');
        sgml('</VAR>','>');
    }
});

sgml('end', '');

sgml('start_element', sub {
    ($element,$event) = @_;
    my $name= $element->name;
    my $file= $event->file;
    my $line= $event->line;
    warn "unknown element $name at $file:$line\n" unless $unkwarndone{$name}++;
});

sgml('<DEBIANDOC>','');
sgml('<NAME>','');
sgml('<BOOK>',"\n");
sgml('<TITLEPAG>','');
sgml('<COPYRIGHTSUMMARY>','');
sgml('<HEADING>','');
sgml('<PRGN>','');
sgml('<FOOTNOTES>','');
sgml('<FTPSITE>','');
sgml('<FTPPATH>','');
sgml('<HTTPSITE>','');
sgml('<HTTPPATH>','');
sgml('<QREF>','');

sgml('<FOOTNOTEREF>', sub {
    ($element,$event) = @_;
    my $num= a('NUMBER');
    output("[$num]");
});

sgml('<FOOTNOTEBODY>', sub {
    ($element,$event) = @_;
    my $num= a('NUMBER');
    para_lhtag("[$num]");
    $indentlevel++;
});
sgml('</FOOTNOTEBODY>', sub { $indentlevel--; });

sub para_lhtag {
    my ($ntag) = @_;
    $paralhindents++;
    $paralhtag.= $ntag;
    $paralhtag.= ' 'x($paralhindents*$perindent-length($paralhtag)-1);
    $paralhtag.= ' ';
}

sgml('<LIST>', sub { startlist('plain',@_); });
sgml('<ENUMLIST>', sub { startlist('enum',@_); });
sgml('<TAGLIST>', sub { startlist('tag',@_); });
sgml('</LIST>', sub { endlist(); });
sgml('</ENUMLIST>', sub { endlist(); });
sgml('</TAGLIST>', sub { endlist(); });

sub startlist {
    ($type,$element,$event) = @_;
    unshift(@listtypes,$type);
    unshift(@listcounters,0);
    para_end($indentlevel,'',1); $indentlevel++;
    if ($incompact || $element->attribute('COMPACT')->type eq 'TOKEN') { $incompact++; }
}
sub endlist {
    shift(@listtypes);
    shift(@listcounters);
    insertblankline();
    para_new();
    $indentlevel--;
    $incompact-- if $incompact;
}

sgml('<TAG>', sub { insertblankline(); para_new(); });
sgml('</TAG>', sub { para_end($indentlevel-1); $blanklinedone=1 });

sgml('<ITEM>', sub {
    if ($listtypes[0] eq 'enum') {
        para_lhtag(++($listcounters[0]).'.')
    } elsif ($listtypes[0] eq 'plain') {
        para_lhtag((" "x($perindent-2))."*");
    }
});

sub insertblankline {
    if (!$incompact && !$blanklinedone) { output("\n"); $blanklinedone=1; }
}

sgml('<P>', sub { insertblankline(); para_new(); });
sgml('</P>', sub { para_end($indentlevel); });
sgml('<EXAMPLE>', sub { push_output('string'); });
sgml('</EXAMPLE>', sub {
    my $example= pop_output();
    $example =~ s/[ \t]+\n/\n/g; $example =~ s/^\n+//; $example =~ s/\n+$//;
    my @el= split(/\n/,$example);
    my @ec= @el;
    grep (s/\0..\0//g,@ec);
    my @toolong= grep(length($_)+($perindent*($indentlevel+1)) > $linewidth, @ec);
    if (@toolong) {
#print(STDERR "too long $perindent $indentlevel >".join('|',@toolong)."<\n");
        output("\0=l\0");
    } else {
        output("\0=o\0");
    }
#    push_style('b1');
    output(join("\0=n\0",@el));
#    pop_style();
    output("\0=c\0");
});

sgml('<REF>', sub {
    ($element,$event) = @_;
    output(a('HNAME').', `');
});
sgml('</REF>',"'");

sgml('<MANREF>', sub {
    ($element,$event) = @_;
    push_style('b1'); output(a('NAME')); pop_style();
    push_style('u1'); output('('.a('SECTION').')'); pop_style();
});

sgml('<AUTHOR>', sub { push_output('string'); });
sgml('</AUTHOR>', sub {
    push(@authors,pop_output()); $verbatim--;
    para_new(); output($authors[$#authors]); para_end(0,'centre');
});

sgml('<TITLE>', sub { push_output('string'); });
sgml('</TITLE>', sub {
    $title= pop_output();
    para_new(); push_style('b1'); output($title); para_end(0,'centre-underdash');
});

sgml('<VERSION>', sub { push_output('string'); });
sgml('</VERSION>', sub {
    $version= pop_output();
    para_new(); output($version); para_end(0,'centre');
});
sgml('<DATE>', sub { chop($date= `date '+%d %B %Y'`); $date =~ s/^0//; output($date); });

sgml('<ABSTRACT>', sub {
    output("\n");
    para_new(); push_style('b1');
    output(zeronum().' Zusammenfassung'); endheading();
    output("\n");
    para_new();
});
sgml('</ABSTRACT>', sub {
    para_end(1);
});

sgml('<TOC>', sub {
    ($element,$event) = @_;
    $tocdetail= numlevel(a('DETAIL'));
    output("\n");
    para_new(); push_style('b1');
    output(zeronum().' Inhaltsverzeichnis'); endheading();
    $indentlevel=1;
    $noemph++;
});

sgml('</TOC>', sub {
    if (defined($copyright)) {
        $copynoticenum= zeronum();
        output("\n");
        para_lhtag("$copynoticenum."); para_lhtag(); para_new();
        push_style('u1'); output('Copyright Notice'); para_end(3);
    }
    $noemph--;
});

sgml('<TOCENTRY>', sub {
    ($element,$event) = @_;
    $toclevel= numlevel(a('LEVEL'));
    if ($toclevel <= $tocdetail) {
        output("\n") if !$toclevel;
        para_lhtag(a('CHAPT').a('SECT').'.'); para_lhtag('');
        para_lhtag('') if $toclevel>1;
        para_new(); push_style('u1') if !$toclevel;
    } else {
        push_output('nul');
    }
});
sgml('</TOCENTRY>', sub {
    if ($toclevel <= $tocdetail) {
        para_end($toclevel>1 ? 4 : 3);
    } else {
        pop_output();
    }
});

sgml('<COPYRIGHT>', sub { push_output('string'); $indentlevel=1; });
sgml('</COPYRIGHT>', sub { $copyright= pop_output; $blanklinedone=0; });
sgml('<COPYRIGHTSUMMARY>', sub { para_new(); });
sgml('</COPYRIGHTSUMMARY>', sub { para_end($indentlevel); });

sub hrule { output(("-"x$linewidth)."\n"); }
sub endheading { para_end(0, $ov ? '' : 'underdash'); }

sgml('</BOOK>', sub {
    if (defined($copyright)) {
        output("\n\n"); hrule(); output("\n\n");
        para_new(); push_style('b1');
        output($copynoticenum.' Copyright'); endheading();
        output("\n");
        output($copyright);
    }
    output("\n\n"); hrule(); output("\n\n");
    para_new();
    output($title);
    para_end(1);
    my $spare;
    my $authors= join(', ',@authors);
    if (length($version) &&
        ($spare= (($textwidth-$perindent) -
                  (length($authors)+length($version)))) >= 2) {
        output(" "x$perindent);
        output($authors);
        output(" "x$spare);
        output($version);
        output("\n");
    } else {
        para_new();
        output($authors);
        output(" - ".$version) if length($version);
        para_end(1);
    }
    output("\n");
});

sgml('<EMAIL>','<');
sgml('</EMAIL>','>');

sgml('<CHAPT>', sub {
    ($element,$event) = @_;
    output("\n\n"); hrule(); output("\n\n");
    para_new(); push_style('b1');
    output(a('CHAPT').'. ');
});

sgml('<SECT>', sub { sect(2,@_); });
sgml('<SECT1>', sub { sect(3,@_); });
sgml('<SECT2>', sub { sect(4,@_); });
sgml('<SECT3>', sub { sect(5,@_); });
sgml('<SECT4>', sub { sect(6,@_); });

sub sect {
    ($hlevel,$element,$event) = @_;
    output("\n"); output("\n") if $hlevel<=2;
    para_new(); push_style('b1');
    output(a('CHAPT').a('SECT').'. ');
}

sgml('</HEADING>', sub { endheading(); $indentlevel=1; });

sub push_style {
    return unless $ov;
    push(@stylestack,substr($_[0],0,1));
    output("\0$_[0]\0");
}
sub pop_style {
    return unless $ov;
    output("\0".pop(@stylestack)."-\0");
}
sub para_new {
    push_output('string');
    @stylestack=();
}
sub emphstring {
    my ($string) = @_;
    my $i,$here,$ar,$sv;
    for ($i=0; $i<length($string); $i++) {
        $here= substr($string,$i,1);
        if ($here eq "\0") {
            $ar= substr($string,$i+1,1); $sv= substr($string,$i+2,1);
            if ($sv eq '-') {
                $es= "shift(\@$ar);1;"; eval $es || die "$@ / $es";
            } elsif ($sv ne '=') {
                $es= "unshift(\@$ar,\$sv);1;"; eval $es || die "$@ / $es";
            }
            $i+=3; next;
        }
        if ($b[0]) { output("$here"); }
        elsif ($u[0]) { output("_"); }
        output($here);
    }
}
sub para_end {
    my ($inum,$fmt,$lhtagdefer) = @_;
    # fmt is one of undef,'centre','centre-underdash','underdash'
    # lhtagdefer is 1 if we can safely defer a paralhtag til later
    my $pd= pop_output();
    local (@b,@u);
    @b=@u=(0);
    my $here,$maxwidth,$evstr,$pis,$pil,$npis,$av,$ls_pis,$ls_pil,$lhs;
    my $nobreak,$code,$reducedwidth,$indentdone;
    my $centre= ($fmt eq 'centre' || $fmt eq 'centre-underdash');
    my $udash= ($fmt eq 'underdash' || $fmt eq 'centre-underdash');
#    $pd =~ y/\n/ /; $pd =~ s/\s+/ /g; $pd =~ s/^\s*//; $pd =~ s/\s+$//;
    $maxwidth=0;
    return if $pd !~ m/\S/ && ($lhtagdefer || !length($paralhtag));
    if (length($paralhtag)) {
        output(" "x($perindent*($inum-$paralhindents)));
        output(emphstring($paralhtag));
        $reducedwidth= length($paralhtag)-($perindent*$paralhindents);
        $reducedwidth= 0 if $reducedwidth < 0;
        $paralhtag= ''; $indentdone= 1; $paralhindents= 0;
    }
#print STDERR ">$pd<\n";
  outer:
    while (length($pd)) {
        next if !$nobreak && $pd =~ s/^\s+//;
        $pil= 0; $av= $textwidth-$perindent*$inum-$reducedwidth;
        $pis= 0; $reducedwidth= 0; $ls_pis=-1;
#print STDERR " $inum,$nobreak,$lhs,$av,$indentdone>$pd<\n";
        while ($pis < length($pd) && ($nobreak || $pil <= $av)) {
            $here= substr($pd,$pis,1);
#print STDERR " $inum,$nobreak,$pis,$pil>$here<\n";
            if ($here eq "\0") {
                $code= substr($pd,$pis+1,2);
                if ($code eq '=o') {
                    last if $pis;
                    $nobreak=1; $lhs=0;
                } elsif ($code eq '=l') {
                    last if $pis || $indentdone;
                    $nobreak=1; $lhs=1;
                } elsif ($code eq '=c') {
                    last if $pis;
                    $nobreak=0; $lhs=0;
                } elsif ($code eq '=n') {
                    $pis+=4; last;
                } else {
                    $pis+=4; next;
                }
                $pd= substr($pd,4); next outer;
            }
            if (!$nobreak && $here =~ m/^\s$/) {
                $here= substr($pd,$pis); $here =~ s/^\s+/ /;
                $pd= substr($pd,0,$pis).$here;
                $ls_pis=$pis; $ls_pil=$pil;
            }
            if ($ls_pis < 0 && $pil >= $av-$unbreakbackoff) {
                $ls_pis=$pis; $ls_pil=$pil;
            }
            $pis++; $pil++;
        }
        if (!$nobreak && $pil > $av) { $pis= $ls_pis; $ls_pil= $pil; }
        $maxwidth= $pil if $pil > $maxwidth;
        output(" "x(($centre ? ($textwidth-$pil)/2 : 0) +
                    ($lhs ? 0 : ($inum+$nobreak)*$perindent)))
            if !$indentdone;
        output(emphstring(substr($pd,0,$pis)));
        output("\n"); $indentdone= 0;
        $pd= substr($pd,$pis);
    }
    if ($udash) {
        output(" "x(($centre ? ($textwidth-$maxwidth)/2 : 0) + ($inum*$perindent)));
        output(($b[0] ? "--" : "-")x$maxwidth."\n");
    }
    $blanklinedone=0;
}

sub zeronum { '0.'.++$czeronum; }

sub a {
    my $el= $element->attribute($_[0]);
    return defined($el) ? $el->value : undef;
}

sub numlevel {
    my ($d)= @_;
    return 0 if $d =~ m/^CHAPT/;
    return $1+1 if $d =~ m/^SECT(\d*)$/;
    warn "unknown toc detail token \`$d'\n";
}
