head	1.2;
access;
symbols;
locks; strict;
comment	@# @;


1.2
date	97.05.31.14.31.42;	author leutloff;	state Exp;
branches;
next	1.1;

1.1
date	97.01.15.00.05.31;	author leutloff;	state Exp;
branches;
next	;


desc
@@


1.2
log
@*** empty log message ***
@
text
@# 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;
@


1.1
log
@Initial revision
@
text
@d116 1
a116 1
        startheading('',zeronum()); odata("Copyright Hinweis"); endheading();
@
