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

use SGMLS::Refs;

$loutnsslevel=2;

sgml('start','');

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>','');
sgml('<COPYRIGHTSUMMARY>','');
sgml('<QREF>','');
sgml('<TOC>','');

my @paper = split(/\s/, `2>/dev/null paperconf -Ns`);

if ($#paper >= 0) {
    $pagespec = "
  \@PageType { $paper[0] }";

    if ($#paper > 1) {
    	$pagespec = "$pagespec \@PageWidth { $paper[1]p } \@PageHeight { $paper[2]p }";
    }
}

sgml('<TITLEPAG>', sub {
    $headinglevel= 0;
});
sgml('</TITLEPAG>', sub {
    output(
"\@SysInclude{ fontdefs }
\@SysInclude{ langdefs }
\@SysInclude{ dl }
\@SysInclude{ docf }
\@Use { \@DocumentLayout $pagespec
  \@ParaGap { 1.70vx }
  \@InitialBreak { 1.0fx ragged hyphen }
  \@PageHeaders { Titles }
  \@OptimizePages { Yes }
  \@RunningEvenTop { \@B { \@PageNum } }
  \@RunningOddTop { \@Right { \@B { \@PageNum } } }
  \@RunningEvenFoot { $version \@Right { $title } }
  \@RunningOddFoot { $title \@Right { $version } }
  \@RunningStartEvenTop { \@Null }
  \@RunningStartOddTop { \@Null }
  \@RunningStartEvenFoot { $version \@Right { $title } }
  \@RunningStartOddFoot { $title \@Right { $version } }
}
\@Use { \@OrdinaryLayout }
\@Doc \@Text \@Begin
\@CenteredDisplay {clines 1.3v} \@Break {
+5p \@Font Bold \@Font { $title }
");
    grep(output("-2p \@Font { $_ }\n"), @authors);
    output("$version\n") if length($version);
    output("}\n");
    if (defined($abstract)) {
        startheading('',zeronum()); odata("Zusammenfassung"); endheading();
        output($abstract);
    }
});
# gehrt zu @USE -- gab nachdem ersetzen Probleme durch Zeilenumbruch
# \@RunningEvenTop { \@B { \@PageNum } \@Centre {  } \@Right { \@MinorNum } }
# \@RunningOddTop { \@MinorNum \@Centre { \@MinorTitle } \@Right { \@B { \@PageNum } } }
# \@RunningEvenFoot { $version \@Right { $title } }
# \@RunningOddFoot { $title \@Right { $version } }
# \@RunningStartEvenTop { \@Null }
# \@RunningStartOddTop { \@Null }
# \@RunningStartEvenFoot { $version \@Right { $title } }
# \@RunningStartOddFoot { $title \@Right { $version } }
#}


sgml('end', "\n\@End \@Text\n");

sgml('<TOC>', sub {
    ($element,$event) = @_;
    $tocdetail= numlevel(a('DETAIL'));
    startheading('',zeronum()); odata("Inhaltsverzeichnis"); endheading();
    output("//1vx");
});
sgml('</TOC>', '');

sgml('<TOCENTRY>', sub {
    ($element,$event) = @_;
    $level= numlevel(a('LEVEL'));
    if ($level > $tocdetail) { $tocignore= 1; push_output('nul'); return; }
    $tocsrid= a('SRID');
    $number= a('CHAPT').a('SECT');
    if ($level == -1) {
        output("//0.3vx Bold \@Font \@HAdjust { \@HContract { { $number. } |5fx {");
        $iiendheight= '1.00';
    } else {
        output("\@HAdjust { \@HContract { { $number. } |5fx {");
        $iiendheight= '0.95';
    }
    $stat= 'p'; $tocignore= 0;
});
sgml('</TOCENTRY>', sub {
    if ($tocignore) { pop_output(); return; }
    output("} } |2f \@PageOf { $tocsrid } } //${iiendheight}vx\n");
});

sub endinitial {
    return if $endinitialdone;
    if (defined($copyright)) {
        startheading('',zeronum()); odata("Copyright"); endheading();
        output("$copyright");
    }
    $endinitialdone= 1;
}

sgml('<CHAPT>', sub { my @t= @_; endinitial(); sect(-1,@t); });
sgml('<SECT>', sub { sect(0,@_); });
sgml('<SECT1>', sub { sect(1,@_); });
sgml('<SECT2>', sub { sect(2,@_); });
sgml('<SECT3>', sub { sect(3,@_); });
sgml('<SECT4>', sub { sect(4,@_); });
sub sect { ($headinglevel,$element,$event)= @_; }
sgml('<HEADING>', sub { startheading(a('SRID'),a('CHAPT').a('SECT')); });
sgml('</HEADING>', sub { endheading(); });

sub startheading {
    my ($pagemark,$number)= @_;
    output("\n\@LP\n") unless $stat =~ m/p/;
    output($headinglevel < 0 ? '@NP' : '@CNP');
    output("\n");
    if ($headinglevel <= 0) {
        output("{\n".
               "  newpath   0  ysize 0.3 ft sub  moveto\n".
               "            xsize  0  rlineto\n".
               "            0  ".($headinglevel < 0 ? '0.2' : '0.1')." ft  rlineto\n".
               "            xsize neg  0  rlineto\n".
               "  closepath fill\n".
               "} \@Graphic { //1.6f \@HAdjust { \@HContract {");
        $hend= "} |0f }} //0.0fe\n";
    } else {
        $hend= "//0.2fe\n";
    }
    output('@Heading +'.(4-$headinglevel)."p \@Font { 1.2vx \@Break {");
    output(" {\@PageMark $pagemark}") if length($pagemark);
    output("\n$number.|0.5fe{ ");
    $stat= 'h';
}
sub endheading {
    output("}}}$hend\n"); $stat= '';
}

sgml('<REF>', sub {
    ($element,$event) = @_;
    $refname= a('SRID');
    odata('`');
});
sgml('</REF>', sub {
    odata("', Seite "); output("\@PageOf{$refname}");
});

sgml('<MANREF>', sub {
    ($element,$event) = @_;
    startcourier(); odata(a('NAME').'('.a('SECTION').')'); endcourier();
});

sub rescale {
    return unless $stat =~ m/[cx][^R]*$/;
    output("{{1.4285714285 1.0} \@Scale {");
    $stat .= 'R';
}
sub unrescale {
    return unless $stat =~ s/R$//;
    output("}}");
}

sub startcourier {
    rescale();
    output("{{0.7 1.0} \@Scale {Courier Bold} \@Font {");
    $stat .= 'c';
}
   
sub endcourier {
    $stat =~ s/.$//;
    output("}}");
    unrescale();
}

sgml('<AUTHOR>', sub { push_output('string'); $stat='d'; });
sgml('</AUTHOR>', sub { push(@authors,pop_output); });
sgml('<TITLE>', sub { push_output('string'); $stat='d'; });
sgml('</TITLE>', sub { $title= pop_output; });
sgml('<VERSION>', sub { push_output('string'); $stat='d'; });
sgml('</VERSION>', sub { $version= pop_output.''; $version =~ s/\s+$//; });
sgml('<ABSTRACT>', sub { push_output('string'); $stat='P'; });
sgml('</ABSTRACT>', sub { $abstract= pop_output; });
sgml('<COPYRIGHT>', sub { push_output('string'); $stat='P'; });
sgml('</COPYRIGHT>', sub { $copyright= pop_output; });
sgml('<DATE>', sub { chop($date= `date '+%d %B %Y'`); $date =~ s/^0//; odata($date); });

sgml('<EMAIL>', sub { startcourier(); odata('<'); });
sgml('</EMAIL>', sub { odata('>'); endcourier(); });
sgml('<TT>', sub { startcourier(); });
sgml('</TT>', sub { endcourier(); });
sgml('<FTPSITE>', sub { startcourier(); });
sgml('</FTPSITE>', sub { endcourier(); });
sgml('<FTPPATH>', sub { startcourier(); });
sgml('</FTPPATH>', sub { endcourier(); });
sgml('<HTTPSITE>', sub { startcourier(); });
sgml('</HTTPSITE>', sub { endcourier(); });
sgml('<HTTPPATH>', sub { startcourier(); });
sgml('</HTTPPATH>', sub { endcourier(); });
sgml('<PRGN>', sub { startcourier(); });
sgml('</PRGN>', sub { endcourier(); });
sgml('<EM>', sub { startitalic(); });
sgml('</EM>', sub { enditalic(); });
sgml('<VAR>', sub { startitalic(); });
sgml('</VAR>', sub { enditalic(); });

sub startitalic {
    rescale();
    $stat.='i';
    output("{{Times Slope} \@Font {");
}
sub enditalic {
    output("}}");
    $stat =~ s/.$//;
    unrescale();
}

sgml('<EXAMPLE>', sub {
    output("\n");
    finishline();
    output("{\@RawIndentedDisplay lines \@Break".
           " { {0.7 1.0} \@Scale {Courier Bold} \@Font {\n");
    $stat .= 'x';
});
sgml('</EXAMPLE>', sub {
    $stat =~ s/.$//;
    output("}}} //0.2fe\n");
});

sgml('<LIST>', sub { startlist('Bullet',@_); });
sgml('<ENUMLIST>', sub { startlist('Enum',@_); });
sgml('<TAGLIST>', sub { startlist('Tagged',@_); });
sgml('</LIST>', sub { endlist(); });
sgml('</TAGLIST>', sub { endlist(); });
sgml('</ENUMLIST>', sub { endlist(); });

sub startlist {
    push(@ltypes,$ltype);
    ($ltype,$element,$event) = @_;
    $incompact++ if $incompact || $element->attribute('COMPACT')->type eq 'TOKEN';
    if ($ltype eq 'Enum') {
        $ltype= (($enumlistnest++)&1) ? 'Roman' : 'Numbered';
    }
    if ($incompact) { finishline(); }
    elsif ($stat =~ m/t/) { output("\n\@LP\n"); }
    if ($ltype ne 'Tagged') {
        output("{\@Raw${ltype}List\n");
        output("  gap { 1.0vx }\n") if $incompact;
    }
    push(@stats,$stat);
    push(@lhadtags,$lhadtags);
    $lhadtags= 0;
}
sgml('<TAG>', sub {
    if (!$incompact && $lhadtags==2) {
        output("//0fe //1.2fx\n");
    } elsif ($lhadtags) {
        output("//1.0vx\n");
    }
    output("{|0.5f {");
});
sgml('</TAG>', sub {
    output("}}\n");
    $lhadtags= 1;
});
sgml('<ITEM>', sub {
    if ($ltype ne 'Tagged') {
        output("\@ListItem {\n");
    } else {
        output($incompact ? "//1.0vx\n{|2f {\n" : "//1.0vx\n\@RawIndentedDisplay {\n");
    }
    $stat= 'p';
});
sgml('</ITEM>', sub {
    if ($ltype ne 'Tagged') {
        output("\n}\n");
    } else {
        output($incompact ? "\n}}\n" : "\n}\n");
        $lhadtags= 2;
    }
});
sub endlist {
    if ($ltype ne 'Tagged') {
        output("\@RawEndList}//0ve\n");
        $enumlistnest-- if $ltype ne 'Bullet';
    } else {
        output($incompact ? "//0.2fe" : "//0fe\n");
    }
    $stat= pop(@stats);
    $lhadtags= pop(@lhadtags);
    if ($incompact) {
        $stat =~ s/^/l/;
    } else {
        $stat= 'P';
    }
    $ltype= pop(@ltypes);
    $incompact-- if $incompact;
}
    
sgml('<FOOTNOTE>', sub {
    push(@stats,$stat);
    $stat= 'p';
    output('{@FootNote{ ');
});
sgml('</FOOTNOTE>', sub {
#    endsection();
    output('}}');
    $stat= pop(@stats);
});

sgml('cdata', sub { odata($_[0]); });
sgml('sdata', sub { odata($_[0]); });

sgml('</CHAPT>', sub {
    $stat= '';
});
#sgml('</SECT>', sub { endsection(); });
#sgml('</SECT1>', sub { endsection(); });
#sgml('</SECT2>', sub { endsection(); });
#sgml('</SECT3>', sub { endsection(); });
#sgml('</SECT4>', sub { endsection(); });
#sub endsection {
#}
sub startline {
#    output("//0.2ve\n") if $stat =~ s/l//;
    output("\n\@LP\n") if $stat =~ s/P/t/;
}
sub finishline {
    startline();
    output("//1.0vx\n") unless $stat =~ s/p/t/;
}
sgml('<P>', sub {
#    output("//0.2ve\n") if $stat =~ m/l/;
    output("\n\@LP\n") unless $stat =~ m/p/;
    $stat= 'p';
});
#sgml('</P>', sub {
#    $stat= ($stat =~ m/l/) ? 'l' : '';
#});
sub odata {
    ($data) = @_;
    if (m/\S/) { startline(); $stat =~ s/p/t/; }
    $_= $data;
    if ($stat =~ m/x/) {
        s,\n, //1vx\n,g;
        output(sani($_,1));
    } else {
        s/\s+/ /g;
        output(sani($_,($stat =~ m/c[^R]*$/)));
    }
}

#sub stripws {
#    my ($in) = @_;
#print STDERR "stripws\`$in'\n";
#    $in =~ s/^\s+//; $out =~ s/\s+$//;
#}

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

sub sani {
    my ($in,$hyphens) = @_;
    my $out;
    $in= ' '.$in.' ';
    $out='';
    while ($in =~ m/(\s)(\S*[\-\@\/|\\\"\^\&\{\}\#]\S*)(\s)/) {
        $out .= $`.$1;
        $in = $3.$';
        $_= $2;
        s/[\\\"]/\\$&/g;
        s/-/"--"/g if $hyphens;
        $out .= '"'.$_.'"';
    }
    $out .= $in;
    $out =~ s/^ //;  $out =~ s/ $//;
    $out;
}


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

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

1;
