## -*- Mode: perl -*-
## ----------------------------------------------------------------------

## ----------------------------------------------------------------------
use POSIX;
use SGMLS::Refs;

## ----------------------------------------------------------------------
$format = '.lout';

## ----------------------------------------------------------------------
## language definition
%languages = (
	      'da' => 'Danish',
	      'de' => 'German',
	      'es' => 'Spanish',
	      'fr' => 'French',
	      'it' => 'English',
	      'nl' => 'Dutch'
	      );
( $lang = POSIX::setlocale( LANG ) ) =~ s/_.*//;
if ( -r $ENV{ 'DEBIANDOCSGMLSPEC' }.'/i18n/'.$lang.$format )
{
    $language = $languages{ $lang };
    do $ENV{ 'DEBIANDOCSGMLSPEC' }.'/i18n/'.$lang.$format;
}
else
{
    $language = 'English';
    %lang = (
	     'Copyright Notice' => 'Copyright Notice',
	     'Copyright' => 'Copyright',
	     'Abstract' => 'Abstract',
	     'abstract' => 'abstract',
	     'toc' => "Table of contents\n",
	     'Contents' => 'Contents',
	     'next' => 'next',
	     'back' => 'back',
	     'footnotes' => 'footnotes',
	     'chapter' => 'chapter'
	     );
}

## ----------------------------------------------------------------------
## paper size definition
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 }";
    }
}

## ----------------------------------------------------------------------
## tag processing
## ----------------------------------------------------------------------

## ----------------------------------------------------------------------
sub start_element
{
    ( $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 }++;
}

## ----------------------------------------------------------------------
sub start_debiandoc
{
}
sub end_debiandoc
{
}

## ----------------------------------------------------------------------
sub start_book
{
}
sub end_book
{
    output( "\n\@End \@Text\n" );
}

## ----------------------------------------------------------------------
sub start_titlepag
{
    $headinglevel= 0;
}
sub end_titlepag
{
    output( "\@SysInclude{ fontdefs }\n" );
    output( "\@SysInclude{ langdefs }\n" );
    output( "\@SysInclude{ dl }\n" );
    output( "\@SysInclude{ docf }\n" );
    output( "\@Use { \@DocumentLayout\n" );
    output( "	$pagespec\n" );
    output( "	\@ParaGap { 1.70vx }\n" );
    output( "	\@InitialBreak { 1.0fx ragged hyphen }\n" );
    output( "	\@InitialLanguage { $language }\n" );
    output( "	\@PageHeaders { Titles }\n" );
    output( "	\@OptimizePages { Yes }\n" );
    output( "	\@RunningEvenTop { \@B { \@PageNum } }\n" );
    output( "	\@RunningOddTop { \@Right { \@B { \@PageNum } } }\n" );
    output( "	\@RunningEvenFoot { $version \@Right { $title } }\n" );
    output( "	\@RunningOddFoot { $title \@Right { $version } }\n" );
    output( "	\@RunningStartEvenTop { \@Null }\n" );
    output( "	\@RunningStartOddTop { \@Null }\n" );
    output( "	\@RunningStartEvenFoot { $version \@Right { $title } }\n" );
    output( "	\@RunningStartOddFoot { $title \@Right { $version } }\n" );
    output( "}\n" );
    output( "\@Use { \@OrdinaryLayout }\n" );
    output( "\@Doc \@Text \@Begin\n" );
    output( "\@CenteredDisplay {clines 1.3v} \@Break {\n" );
    output( "+5p \@Font Bold \@Font { $title }\n" );
    grep( output( "-2p \@Font { $_ }\n" ), @authors );
    output( "$version\n" ) if length( $version );
    output( "}\n" );
    if ( defined( $abstract ) )
    {
        _start_heading( '', _zero_num() );
	_odata( $lang{ 'Abstract' } );
	_end_heading();
        output( $abstract );
    }
}

## ----------------------------------------------------------------------
sub start_title
{
    push_output( 'string' );
    $stat = 'd';
}
sub end_title
{
    $title = pop_output;
}

## ----------------------------------------------------------------------
sub start_author
{
    push_output( 'string' );
    $stat = 'd';
}
sub end_author
{
    push( @authors, pop_output );
}

## ----------------------------------------------------------------------
sub start_name
{
}
sub end_name
{
}

## ----------------------------------------------------------------------
sub start_email
{
    _start_courier();
    _odata( '<' );
}
sub end_email
{
    _odata( '>' );
    _end_courier();
}

## ----------------------------------------------------------------------
sub start_version
{
    push_output( 'string' );
    $stat = 'd';
}
sub end_version
{
    $version = pop_output.'';
    $version =~ s/\s+$//;
}

## ----------------------------------------------------------------------
sub start_date
{
    @_ = gmtime();
    $date = POSIX::strftime( "%d %B %Y", 0, 0, 0, $_[3], $_[4], $_[5] );
    $date =~ s/^0//;
    _odata( $date );
}
sub end_date
{
}

## ----------------------------------------------------------------------
sub start_abstract
{
    push_output( 'string' );
    $stat = 'P';
}
sub end_abstract
{
    $abstract = pop_output;
}

## ----------------------------------------------------------------------
sub start_copyright
{
    push_output( 'string' );
    $stat = 'P';
}
sub end_copyright
{
    $copyright = pop_output;
}

## ----------------------------------------------------------------------
sub start_copyrightsummary
{
}
sub end_copyrightsummary
{
}

## ----------------------------------------------------------------------
sub start_toc
{
    ( $element, $event ) = @_;
    $tocdetail = _num_level( _a( 'DETAIL' ) );
    _start_heading( '',_zero_num() );
    _odata( $lang{ 'Contents' } );
    _end_heading();
    output( "//1vx" );
}
sub end_toc
{
}

## ----------------------------------------------------------------------
sub start_tocentry
{
    ( $element, $event ) = @_;
    $level = _num_level( _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;
}
sub end_tocentry
{
    if ( $tocignore )
    {
	pop_output();
	return;
    }
    output( "} } |2f \@PageOf { $tocsrid } } //${iiendheight}vx\n" );
}

## ----------------------------------------------------------------------
sub start_chapt
{
    my @t = @_;
    _end_initial();
    _sect( -1, @t );
}
sub end_chapt
{
    $stat = '';
}

## ----------------------------------------------------------------------
sub start_sect
{
    _sect( 0, @_ );
}
sub end_sect
{
}

## ----------------------------------------------------------------------
sub start_sect1
{
    _sect( 1, @_ );
}
sub end_sect1
{
}

## ----------------------------------------------------------------------
sub start_sect2
{
    _sect( 2, @_ );
}
sub end_sect2
{
}

## ----------------------------------------------------------------------
sub start_sect3
{
    _sect( 3, @_ );
}
sub end_sect3
{
}

## ----------------------------------------------------------------------
sub start_sect4
{
    _sect( 4, @_ );
}
sub end_sect4
{
}

## ----------------------------------------------------------------------
sub start_heading
{
    _start_heading( _a( 'SRID' ), _a( 'CHAPT' )._a( 'SECT' ) );
}
sub end_heading
{
    _end_heading();
}

## ----------------------------------------------------------------------
sub start_p
{
    output( "\n\@LP\n" ) unless $stat =~ m/p/;
    $stat = 'p';
}
sub end_p
{
}

## ----------------------------------------------------------------------
sub start_example
{
    $stat =~ s/f$//;
    output( "\n" );
    _end_line();
    output( "{\@RawIndentedDisplay lines \@Break".
	   " { {0.7 1.0} \@Scale {Courier Bold} \@Font {\n" );
    $stat .= 'x';
}
sub end_example
{
    $stat =~ s/.$//;
    output( "}}} //0.2fe\n" );
}

## ----------------------------------------------------------------------
sub start_footnote
{
    if ( $stat =~ /f$/ )
    {
	output( '{@AnotherFootNote{ ' );
    }
    else
    {
	output( '{@FootNote{ ' );
    }
    push( @stats, $stat );
    $stat = 'p';
}
sub end_footnote
{
    $stat = pop( @stats );
    $stat .= 'f' unless $stat =~ /f$/;
    output( '}}' );
}

## ----------------------------------------------------------------------
sub start_list
{
    _start_list( 'Bullet', @_ );
}
sub end_list
{
    _end_list();
}

## ----------------------------------------------------------------------
sub start_enumlist
{
    _start_list( 'Enum', @_ );
}
sub end_enumlist
{
    _end_list();
}

## ----------------------------------------------------------------------
sub start_taglist
{
    _start_list( 'Tagged', @_ );
}
sub end_taglist
{
    _end_list();
}

## ----------------------------------------------------------------------
sub start_tag
{
    if ( ( ! $incompact ) && ( $lhadtags == 2 ) )
    {
	output( "//0fe //1.2fx\n" );
    }
    elsif ( $lhadtags )
    {
	output( "//1.0vx\n" );
    }
    output( "{|0.5f {" );
}
sub end_tag
{
    output( "}}\n" );
    $lhadtags = 1;
}

## ----------------------------------------------------------------------
sub start_item
{
    if ( $ltype ne 'Tagged' )
    {
        output( "\@ListItem {\n" );
    }
    else
    {
        output( $incompact 
	       ? "//1.0vx\n{|2f {\n" 
	       : "//1.0vx\n\@RawIndentedDisplay {\n" );
    }
    $stat = 'p';
}
sub end_item
{
    if ( $ltype ne 'Tagged' )
    {
        output( "\n}\n" );
    }
    else
    {
        output( $incompact ? "\n}}\n" : "\n}\n" );
        $lhadtags = 2;
    }
}

## ----------------------------------------------------------------------
sub start_em
{
    _start_italic();
}
sub end_em
{
    _end_italic();
}

## ----------------------------------------------------------------------
sub start_strong
{
    _start_bold();
}
sub end_strong
{
    _end_bold();
}

## ----------------------------------------------------------------------
sub start_var
{
    _start_italic();
}
sub end_var
{
    _end_italic();
}

## ----------------------------------------------------------------------
sub start_prgn
{
    _start_courier();
}
sub end_prgn
{
    _end_courier();
}

## ----------------------------------------------------------------------
sub start_tt
{
    _start_courier();
}
sub end_tt
{
    _end_courier();
}

## ----------------------------------------------------------------------
sub start_qref
{
}
sub end_qref
{
}

## ----------------------------------------------------------------------
sub start_ref
{
    ( $element, $event ) = @_;
    $refname = _a( 'SRID' );
    _odata( '`' );
}
sub end_ref
{
    _odata( "', page " );
    output( "\@PageOf{$refname}" );
}

## ----------------------------------------------------------------------
sub start_manref
{
    ( $element, $event ) = @_;
    _start_courier();
    _odata( _a( 'NAME' ).'('._a( 'SECTION' ).')' );
    _end_courier();
}
sub end_manref
{
}

## ----------------------------------------------------------------------
sub start_ftpsite
{ 
    _start_courier();
}
sub end_ftpsite
{
    _end_courier();
}

## ----------------------------------------------------------------------
sub start_ftppath
{
    _start_courier();
}
sub end_ftppath
{
    _end_courier();
}

## ----------------------------------------------------------------------
sub cdata
{
    _odata( $_[0] );
}

## ----------------------------------------------------------------------
sub sdata
{
    _odata( $_[0] );
}

## ----------------------------------------------------------------------
## helper definitions
## ----------------------------------------------------------------------

## ----------------------------------------------------------------------
sub _end_initial
{
    return if $endinitialdone;
    if ( defined( $copyright ) )
    {
        _start_heading( '', _zero_num() );
	_odata( $lang{ 'Copyright Notice' } );
	_end_heading();
        output( "$copyright" );
    }
    $endinitialdone = 1;
}

## ----------------------------------------------------------------------
sub _sect
{
    ( $headinglevel, $element, $event ) = @_;
}

## ----------------------------------------------------------------------
sub _start_heading
{
    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 _end_heading
{
    output( "}}}$hend\n" );
    $stat = '';
}

## ----------------------------------------------------------------------
sub _start_list
{
    $stat =~ s/f$//;
    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 )
    {
	_end_line();
    }
    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;
}
sub _end_list
{
    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;
}

## ----------------------------------------------------------------------
sub _start_courier
{
    _rescale();
    output( "{{0.7 1.0} \@Scale {Courier Bold} \@Font {" );
    $stat .= 'c';
}
sub _end_courier
{
    $stat =~ s/.$//;
    output( "}}" );
    _unrescale();
}

## ----------------------------------------------------------------------
sub _start_italic
{
    _rescale();
    $stat .= 'i';
    output( "{{Times Slope} \@Font {" );
}
sub _end_italic
{
    output( "}}" );
    $stat =~ s/.$//;
    _unrescale();
}

## ----------------------------------------------------------------------
sub _start_bold
{
    _rescale();
    $stat .= 'b';
    output( "{{Bold} \@Font {" );
}
sub _end_bold
{
    output( "}}" );
    $stat =~ s/.$//;
    _unrescale();
}

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

## ----------------------------------------------------------------------
sub _odata
{
    ( $data ) = @_;
    $stat =~ s/f$//;
    if ( m/\S/ )
    {
	_start_line();
	$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 _start_line
{
    output( "\n\@LP\n" ) if $stat =~ s/P/t/;
}
sub _end_line
{
    _start_line();
    output( "//1.0vx\n" ) unless $stat =~ s/p/t/;
}

## ----------------------------------------------------------------------
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 _num_level
{
    my ( $d ) = @_;
    return -1 if $d =~ m/^CHAPT/;
    return $1 if $d =~ m/^SECT(\d*)$/;
    warn "unknown toc detail token \`$d'\n";
}

## ----------------------------------------------------------------------
sub _zero_num
{
    '0.'.++$c_zero_num;
}

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

## ----------------------------------------------------------------------
## SGML definitions
## ----------------------------------------------------------------------

## ----------------------------------------------------------------------
sgml( 'start', '' );
sgml( 'end', '' );

## ----------------------------------------------------------------------
sgml( 'start_element', \&start_element );

## ----------------------------------------------------------------------
sgml( '<DEBIANDOC>', '' );
sgml( '</DEBIANDOC>', '' );

## ----------------------------------------------------------------------
sgml( '<BOOK>', \&start_book );
sgml( '</BOOK>', \&end_book );

## ----------------------------------------------------------------------
sgml( '<TITLEPAG>', \&start_titlepag );
sgml( '</TITLEPAG>', \&end_titlepag );

## ----------------------------------------------------------------------
sgml( '<TITLE>', \&start_title );
sgml( '</TITLE>', \&end_title );

## ----------------------------------------------------------------------
sgml( '<AUTHOR>', \&start_author );
sgml( '</AUTHOR>', \&end_author );

## ----------------------------------------------------------------------
sgml( '<NAME>', '' );
sgml( '</NAME>', '' );

## ----------------------------------------------------------------------
sgml( '<EMAIL>', \&start_email );
sgml( '</EMAIL>', \&end_email );

## ----------------------------------------------------------------------
sgml( '<VERSION>', \&start_version );
sgml( '</VERSION>', \&end_version );

## ----------------------------------------------------------------------
sgml( '<DATE>', \&start_date );
sgml( '</DATE>', '' );

## ----------------------------------------------------------------------
sgml( '<ABSTRACT>', \&start_abstract );
sgml( '</ABSTRACT>', \&end_abstract );

## ----------------------------------------------------------------------
sgml( '<COPYRIGHT>', \&start_copyright );
sgml( '</COPYRIGHT>', \&end_copyright );

## ----------------------------------------------------------------------
sgml( '<COPYRIGHTSUMMARY>', '' );
sgml( '</COPYRIGHTSUMMARY>', '' );

## ----------------------------------------------------------------------
sgml( '<TOC>', \&start_toc );
sgml( '</TOC>', '' );

## ----------------------------------------------------------------------
sgml( '<TOCENTRY>', \&start_tocentry );
sgml( '</TOCENTRY>', \&end_tocentry );

## ----------------------------------------------------------------------
sgml( '<CHAPT>', \&start_chapt );
sgml( '</CHAPT>', \&end_chapt );

## ----------------------------------------------------------------------
sgml( '<SECT>', \&start_sect );
sgml( '</SECT>', '' );

## ----------------------------------------------------------------------
sgml( '<SECT1>', \&start_sect1 );
sgml( '</SECT1>', '' );

## ----------------------------------------------------------------------
sgml( '<SECT2>', \&start_sect2 );
sgml( '</SECT2>', '' );

## ----------------------------------------------------------------------
sgml( '<SECT3>', \&start_sect3 );
sgml( '</SECT3>', '' );

## ----------------------------------------------------------------------
sgml( '<SECT4>', \&start_sect4 );
sgml( '</SECT4>', '' );

## ----------------------------------------------------------------------
sgml( '<HEADING>', \&start_heading );
sgml( '</HEADING>', \&end_heading );

## ----------------------------------------------------------------------
sgml( '<P>' , \&start_p );
sgml( '</P>', '' );

## ----------------------------------------------------------------------
sgml( '<EXAMPLE>', \&start_example );
sgml( '</EXAMPLE>', \&end_example );

## ----------------------------------------------------------------------
sgml( '<FOOTNOTE>', \&start_footnote );
sgml( '</FOOTNOTE>', \&end_footnote );

## ----------------------------------------------------------------------
sgml( '<LIST>', \&start_list );
sgml( '</LIST>', \&end_list );

## ----------------------------------------------------------------------
sgml( '<ENUMLIST>', \&start_enumlist );
sgml( '</ENUMLIST>', \&end_enumlist );

## ----------------------------------------------------------------------
sgml( '<TAGLIST>', \&start_taglist );
sgml( '</TAGLIST>', \&end_taglist );

## ----------------------------------------------------------------------
sgml( '<TAG>', \&start_tag );
sgml( '</TAG>', \&end_tag );

## ----------------------------------------------------------------------
sgml( '<ITEM>', \&start_item );
sgml( '</ITEM>', \&end_item );

## ----------------------------------------------------------------------
sgml( '<EM>', \&start_em );
sgml( '</EM>', \&end_em );

## ----------------------------------------------------------------------
sgml( '<STRONG>', \&start_strong );
sgml( '</STRONG>', \&end_strong );

## ----------------------------------------------------------------------
sgml( '<VAR>', \&start_var );
sgml( '</VAR>', \&end_var );

## ----------------------------------------------------------------------
sgml( '<PRGN>', \&start_prgn );
sgml( '</PRGN>', \&end_prgn );

## ----------------------------------------------------------------------
sgml( '<TT>', \&start_tt );
sgml( '</TT>', \&end_tt );

## ----------------------------------------------------------------------
sgml( '<QREF>', '' );
sgml( '</QREF>', '' );

## ----------------------------------------------------------------------
sgml( '<REF>', \&start_ref );
sgml( '</REF>', \&end_ref );

## ----------------------------------------------------------------------
sgml( '<MANREF>', \&start_manref );
sgml( '</MANREF>', '' );

## ----------------------------------------------------------------------
sgml( '<FTPSITE>', \&start_ftpsite );
sgml( '</FTPSITE>', \&end_ftpsite );

## ----------------------------------------------------------------------
sgml( '<FTPPATH>', \&start_ftppath );
sgml( '</FTPPATH>', \&end_ftppath );

## ----------------------------------------------------------------------
sgml( 'cdata', \&cdata );
sgml( 'sdata', \&sdata );

## ----------------------------------------------------------------------
1;
