## -*- perl -*-
## ----------------------------------------------------------------------
## spec/texinfo: SGML conversion specification for Texinfo output
## ----------------------------------------------------------------------
## Copyright (C) 1998 Ardo van Rangelrooij
##
## This is free software; see the GNU General Public Licence
## version 2 or later for copying conditions.  There is NO warranty.
## ----------------------------------------------------------------------

## ----------------------------------------------------------------------
use POSIX;

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

## ----------------------------------------------------------------------
## paper size definition
my @paper = split( /\s/, `2>/dev/null paperconf -N` );
if ( $#paper >= 0 )
{
    if ( $paper[0] =~ m/[ABC][0-9]/ )
    {
	$pagespec = $paper[0];
    }
    elsif ( $paper[0] =~ m/[letter|legal|executive]/ )
    {
	$paper[0] =~ tr/A-Z/a-z/;
	$pagespec = "US" . $paper[0];
    }
    else
    {
	$pagespec = "A4";
    }
}
else
{
    $pagespec = "A4";
}

## ----------------------------------------------------------------------
## global variables
%nodes = ();
@main_menu = ();
@detailed_menu = ();
%sub_menus = ();
%sub_counters = ();
$mmi = 0;
$dmi = 0;
$current_chapt = "Top";

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

## ----------------------------------------------------------------------
sub start_chapt
{
    _sect( -1, @_ );
}
sub end_chapt
{
}

## ----------------------------------------------------------------------
sub start_appendix
{
    _sect( -2, @_ );
}
sub end_appendix
{
}

## ----------------------------------------------------------------------
sub start_heading
{
    push( @elements, $element );
    push_output( 'string' );
}
sub end_heading
{
    my $heading = pop_output;
    $heading =~ s/^\s+//;
    $heading =~ s/\s+$//;
    $heading =~ s/\s+/ /g;

    $element = pop( @elements );
    my $number = _a( 'CHAPT' ) . _a( 'SECT' );

    my $section = "";
    my $menu = 0;
    if ( $headinglevel == -1 )
    {
	$current = "Chapter";
	$section = "\@chapter";
    }
    elsif ( $headinglevel == -2 )
    {
	$current = "Appendix";
	$section = "\@appendix";
    }
    elsif ( $headinglevel == 0 )
    {
	if ( $current =~ m/Chapter|Appendix/ )
	{
	    $menu = 1;
	}
	$current = "Section";
	$section = "\@section";
    }
    elsif ( $headinglevel == 1 )
    {
	if ( $current =~ m/Section/ )
	{
	    $menu = 1;
	}
	$current = "Subsection";
	$section = "\@subsection";
    }
    elsif ( $headinglevel == 2 )
    {
	if ( $current =~ m/Subsection/ )
	{
	    $menu = 1;
	}
	$current = "Subsubsection";
	$section = "\@subsubsection";
    }
    elsif ( $headinglevel == 3 )
    {
	$current = "Paragraph";
	$section = "\@unnumberedsubsubsec";
    }
    else
    {
	$current = "Subparagraph";
	$section = "\@subsubheading";
    }
    if ( $menu )
    {
	if ( $#{ $sub_menus{ $node } } > -1 )
	{
	    output( "\@menu\n" );
	    for ( $i = 0; $i <= $#{ $sub_menus{ $node } }; $i++ )
	    {
		my $menu_level = $sub_menus{ $node }[ $i ];
		my $menu_entry = $nodes{ $menu_level };
		output( "* $menu_level\:\: $menu_entry\n" );
	    }
	    output( "\@end menu\n" );
	    output( "\n" );
	}
    }
    if ( ! ( $current =~ m/graph/ ) )
    {
	$node = $current . " " . $number;
	output( "\@node $node\n" );
    }
    output( "$section $heading\n" );
    output( "\n" );
}

## ----------------------------------------------------------------------
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_item
{
    if ( $ltype ne 'Tagged' )
    {
        output( "\@item\n" );
    }
}
sub end_item
{
    output( "\n" ) unless $compact;
}

## ----------------------------------------------------------------------
## output definitions
## ----------------------------------------------------------------------

## ----------------------------------------------------------------------
sub _output_start_book
{
    output( "\\input texinfo \@c -*- texinfo -*-\n" );
    output( "\n" );
}
sub _output_end_book
{
    output( "\@shortcontents\n" );
    output( "\@contents\n" );
    output( "\n" );
    output( "\@bye\n");
    output( "\n" );
}

## ----------------------------------------------------------------------
sub _output_titlepag
{
    output( "\@c %**start of header\n" );
    output( "\@settitle $title\n" );
    output( "\@setchapternewpage on\n" );
    output( "\@paragraphindent 0\n" );
    output( "\@c %**end of header\n" );
    output( "\n" );
    output( "\@ifinfo\n" );
    output( "\n" );
    if ( length( $abstract ) )
    {
	output( "$abstract\n" );
	output( "\n" );
    }
    if ( length($copyright ) )
    {
	output( "$copyright\n" );
	output( "\n" );
    }
    output( "\@end ifinfo\n" );
    output( "\n" );
    output( "\@titlepage\n" );
    output( "\n" );
    output( "\@title $title\n" );
    output( "\n" );
    if ( length( $version ) )
    {
	output( "\@subtitle $version\n" );
	output( "\n" );
    }
    if ( length( $date ) )
    {
	output( "\@subtitle $date \n" );
	output( "\n" );
    }
    grep( output( "\@author $_\n" ), @authors );
    output( "\n" );
    output( "\@page\n" );
    output( "\n" );
    if ( length ($copyright ) )
    {
	output( "\@vskip 0pt plus 1filll\n" );
	output( "$copyright\n" );
	output( "\n" );
    }
    output( "\@end titlepage\n" );
    output( "\n" );
}

## ----------------------------------------------------------------------
sub _output_copyrightsummaries
{
    my ( @copyrightsummaries ) = @_;
    output( join( " \@*\n", @copyrightsummaries ), "\n" );
    output( "\n" );
}

## ----------------------------------------------------------------------
sub _output_toc
{
    my $toc_level = "";
    my $toc_entry = "";
    my $i = 0;
    output( "\@ifinfo\n" );
    output( "\n" );
    output( "\@node Top\n" );
    output( "\@top $title\n" );
    output( "\n" );
    if ( length( $abstract ) )
    {
	output( "$abstract\n" );
	output( "\n" );
    }
    output( "\@end ifinfo\n" );
    output( "\n" );
    output( "\@menu\n" );
    for ( $i = 0; $i <= $#main_menu; $i++ )
    {
	
	$toc_level = $main_menu[ $i ];
	$toc_entry = $nodes{ $toc_level };
	output( "* $toc_level\:\:\t\t\t$toc_entry\n" );
    }
    if ( $#detailed_menu > $#main_menu )
    {
	output( "\@detailmenu\n" );
	output( "\n" );
	output( " --- The Detailed Node Listing ---\n" );
	for ( $i = 0; $i <= $#detailed_menu; $i++ )
	{
	    $toc_level = $detailed_menu[ $i ];
	    $toc_entry = $nodes{ $toc_level };
	    if ( $toc_level =~ m/Chapter|Appendix/ )
	    {
		if ( ( ! ( $detailed_menu[ $i + 1 ] =~ m/Chapter|Appendix/ ) )
		     && ( $i < $#detailed_menu ) )
		{
		    output( "\n" );
		    output( "$toc_entry\n" );
		    output( "\n" );
		}
	    }
	    else
	    {
		if ( $toc_level =~ m/Section/ )
		{
		    output( "* $toc_level\:\: \t\t$toc_entry\n" );
		}
		elsif ( $toc_level =~ m/Subsection/ )
		{
		    output( "* $toc_level\:\:\t\t$toc_entry\n" );
		}
		else
		{
		    output( "* $toc_level\:\:\t$toc_entry\n" );
		}
	    }
	}
	output( "\@end detailmenu\n" );
    }
    output( "\@end menu\n" );
    output( "\n" );
}

## ----------------------------------------------------------------------
sub _output_tocentry
{
    my ( $toc_entry ) = @_;
    my $toc_entry_level = _a( 'LEVEL' );
    my $toc_string = _a( 'CHAPT' ) . _a( 'SECT' );
    if ( $toc_entry_level eq 'CHAPT' )
    {
	if ( $toc_string =~ m/^[A-Z]/ )
	{
	    $current_chapt = "Appendix";
	}
	else
	{
	    $current_chapt = "Chapter";
	}
	$current_chapt .= " " . $toc_string;
	$nodes{ $current_chapt } = $toc_entry;
	$main_menu[ $mmi++ ] = $current_chapt;
	$detailed_menu[ $dmi++ ] = $current_chapt;
	@{$sub_menus{ $current_chapt }} = ();
	$sub_counters{ $current_chapt } = 0;
    }
    elsif ( $toc_entry_level eq 'SECT' )
    {
	$current_sect = "Section" . " " . $toc_string;
	$nodes{ $current_sect } = $toc_entry;
	$detailed_menu[ $dmi++ ] = $current_sect;
	$sub_menus{ $current_chapt }[ $sub_counters{ $current_chapt }++ ]
	    = $current_sect;
	@{$sub_menus{ $current_sect }} = ();
	$sub_counters{ $current_sect } = 0;
    }
    elsif ( $toc_entry_level eq 'SECT1' )
    {
	$current_sect1 = "Subsection" . " " . $toc_string;
	$nodes{ $current_sect1 } = $toc_entry;
	$detailed_menu[ $dmi++ ] = $current_sect1;
	$sub_menus{ $current_sect }[ $sub_counters{ $current_sect }++ ]
	    = $current_sect1;
	@{$sub_menus{ $current_sect1 }} = ();
	$sub_counters{ $current_sect1 } = 0;
    }
    elsif ( $toc_entry_level eq 'SECT2' )
    {
	$current_sect2 = "Subsubsection" . " " . $toc_string;
	$nodes{ $current_sect2 } = $toc_entry;
	$detailed_menu[ $dmi++ ] = $current_sect2;
	$sub_menus{ $current_sect1 }[ $sub_counters{ $current_sect1 }++ ]
	    = $current_sect2;
	@{$sub_menus{ $current_sect2 }} = ();
	$sub_counters{ $current_sect2 } = 0;
    }
    elsif ( $toc_entry_level eq 'SECT3' )
    {
	$current_sect3 = "Paragraph" . " " . $toc_string;
	$nodes{ $current_sect3 } = $toc_entry;
	$detailed_menu[ $dmi++ ] = $current_sect3;
	$sub_menus{ $current_sect2 }[ $sub_counters{ $current_sect2 }++ ]
	    = $current_sect3;
	@{$sub_menus{ $current_sect3 }} = ();
	$sub_counters{ $current_sect3 } = 0;
    }
    elsif ( $toc_entry_level eq 'SECT4' )
    {
	$current_sect4 = "Subparagraph" . " " . $toc_string;
	$nodes{ $current_sect4 } = $toc_entry;
	$detailed_menu[ $dmi++ ] = $current_sect4;
	$sub_menus{ $current_sect3 }[ $sub_counters{ $current_sect3 }++ ]
	    = $current_sect4;
    }
}

## ----------------------------------------------------------------------
sub _output_p
{
    my ( $paragraph ) = @_;
    output( "$paragraph\n" );
    if ( ( ! $compact ) && $was_compact )
    {
	$was_compact = 0;
    }
    output( "\n" ) unless $compact;
}

## ----------------------------------------------------------------------
sub _output_example
{
    my ( $example ) = @_;
    output( "\@example\n" );
    output( "$example\n" );
    output( "\@end example\n" );
}

## ----------------------------------------------------------------------
sub _output_footnotes
{
}

## ----------------------------------------------------------------------
sub _output_footnote
{
    my ( $footnote ) = @_;
    output( "\@footnote{" );
    output( "$footnote" );
    output( "}" );
}

## ----------------------------------------------------------------------
sub _output_footnotebody
{
}

## ----------------------------------------------------------------------
sub _output_footnoteref
{
}

## ----------------------------------------------------------------------
sub _output_tag
{
    my ( $tag ) = @_;
    output( "\@item " );
    output( $tag );
    output( "\n" );
}

## ----------------------------------------------------------------------
sub _output_em
{
    my ( $em ) = @_;
    output( "\@emph{" );
    output( "$em" );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_strong
{
    my ( $strong ) = @_;
    output( "\@strong{" );
    output( "$strong" );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_var
{
    my ( $var ) = @_;
    output( "\@var{" );
    output( "$var" );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_package
{
    my ( $package ) = @_;
    output( "\@code{" );
    output( "$package" );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_prgn
{
    my ( $prgn ) = @_;
    output( "\@code{" );
    output( "$prgn" );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_file
{
    my ( $file ) = @_;
    output( "\@file{" );
    output( "$file" );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_tt
{
    my ( $tt ) = @_;
    output( "\@samp{" );
    output( "$tt" );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_qref
{
    my ( $qref ) = @_;
    output( $qref );
}

## ----------------------------------------------------------------------
sub _output_ref
{
    ( my $ref ) = @_;
    my $refname = ucfirst _a( 'HNAME' );
    output( "\@ref{$refname}, " );
    _odata( '`' );
    output( $ref );
    _odata( "'" );
}

## ----------------------------------------------------------------------
sub _output_manref
{
    my ( $name, $section ) = @_;
    output( "\@code{" );
    _odata( $name . '(' . $section . ')' );
    output( "}" );
}

## ----------------------------------------------------------------------
sub _output_email
{
    my ( $email ) = @_;
    output( " " ) if ( $in_author );
    output( "\@email{" );
    output( "$email" );
    output( "}" );
}

## ----------------------------------------------------------------------
sub _output_ftpsite
{
    my ( $ftpsite ) = @_;
    output( "\@url{" );
    output( $ftpsite );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_ftppath
{
    my ( $ftpsite, $ftppath ) = @_;
    output( "\@file{" );
    output( $ftppath );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_httpsite
{
    my ( $httpsite ) = @_;
    output( "\@url{" );
    output( $httpsite );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_httppath
{
    my ( $httpsite, $httppath ) = @_;
    output( "\@file{" );
    output( $httppath );
    output( '}' );
}

## ----------------------------------------------------------------------
sub _output_url
{
    my ( $id, $name ) = @_;
    _odata( $name ) if $name ne "";
    output( " (" ) if $name ne "";
    output( "\@url{" );
    _odata( $id );
    output( "}" );
    output( ")" ) if $name ne "";
}

## ----------------------------------------------------------------------
sub _odata
{
    ( $data, $event ) = @_;
    $stat =~ s/f$//;
    $_ = $data;
    if ( $stat =~ m/x/ )
    {
        output( _sani( $_, 1 ) );
    }
    else
    {
        s/\s+/ /g;
        output( _sani( $_, ( $stat =~ m/c[^R]*$/ ) ) );
    }
}

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

## ----------------------------------------------------------------------
sub _sect
{
    ( $headinglevel, $element, $event ) = @_;
    $toc_string = _a( 'CHAPT' ) . _a( 'SECT' );
}

## ----------------------------------------------------------------------
sub _start_list
{
    $stat =~ s/f$//;
    push( @stats, $stat );
    push( @ltypes, $ltype );
    ( $ltype, $element, $event ) = @_;
    $compact++ if ( $compact 
		    || $element->attribute( 'COMPACT' )->type eq 'TOKEN' );
    if ( $compact )
    {
	$was_compact = 1;
    }
    if ( $ltype ne 'Tagged' )
    {
	if ( $ltype eq 'Enum' )
	{
	    output( "\@enumerate\n" );
	}
	else
	{
	    output( "\@itemize \@bullet\n" );
	}
    }
    else
    {
	output( "\@table \@strong\n" );
    }
    output( "\n" ) unless $compact;
}
sub _end_list
{
    if ( $ltype ne 'Tagged' )
    {
	if ( $ltype eq 'Enum' )
	{
	    output( "\@end enumerate\n" );
	}
	else
	{
	    output( "\@end itemize\n" );
	}
    }
    else
    {
	output( "\@end table\n" );
    }
    $compact-- if $compact;
    $ltype = pop( @ltypes );
    $stat = pop( @stats );
}

## ----------------------------------------------------------------------
sub _sani
{
    ( $_, $hyphens ) = @_;

    # escape command characters
    s/\@/\@\@/g;
    s/{/\@{/g;
    s/}/\@}/g;

    # no further replacement in examples
    return $_ if $stat =~ m/x/;

    # special symbols
    s/\.\.\./\@dots{} /g;
    s/\xa9/\@copyright{}/g;

    $_;
}

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

use DebianDoc_SGML;

## ----------------------------------------------------------------------
