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

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

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

## ----------------------------------------------------------------------
## language definitions
%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'
	     );
}

## ----------------------------------------------------------------------
## 
%htmlsani= (
	    '<', 'lt',
	    '>', 'gt',
	    '&', 'amp',
	    '"', 'quot'
	    );

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

## ----------------------------------------------------------------------
sub start
{
    $basename = @ARGV ? $ARGV[0] : ".";
    if ( $basename =~ s,/+$,, )
    {
        $rootfile = 'index';
        $prefix = '';
        $writesubdir = "$basename/";
        -d "$writesubdir" || mkdir( "$basename",0777 ) ||
            die "cannot make subdir \`$basename': $!\n";
    }
    else
    {
        $rootfile = '';
        $prefix = "$basename-";
        $writesubdir = '';
    }
}
sub end
{
}

## ----------------------------------------------------------------------
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
{
}

## ----------------------------------------------------------------------
sub start_titlepag
{
    _start_file( '' );
}
sub end_titlepag
{
    _html_head( $title );
    output( "<h1>"._squash_markup( $title )."</h1>\n\n" );
    output( "<h2><A name=\"abstract\">\n".
           _zero_num().$lang{'Abstract'}."\n</A></h2>\n\n".
           $abstract."\n<hr>\n" ) if defined( $abstract );
}

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

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

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

## ----------------------------------------------------------------------
sub start_email
{
    push_output( 'string' );
    $verbatim++;
}
sub end_email
{
    my $tt = pop_output;
    $verbatim--;
    $authoremail = $tt if $inauthor && ! defined( $authoremail );
    output( '<A href="mailto:'._sani_url( $tt ).'">'._sani_html( $tt ).'</A>' );
}

## ----------------------------------------------------------------------
sub start_version
{
    push_output( 'string' );
}
sub end_version
{
    $version = pop_output.'';
}

## ----------------------------------------------------------------------
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' );
}
sub end_abstract
{
    $abstract = pop_output;
}

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

## ----------------------------------------------------------------------
sub start_copyrightsummary
{
    push_output( 'string' );
}
sub end_copyrightsummary
{
    $copyrightsummary = pop_output;
    $needpara = 1;
}

## ----------------------------------------------------------------------
sub start_toc
{
    ( $element, $event ) = @_;
    output( "<h2><A name=\"toc\">\n".
           _zero_num().$lang{'toc'}.
           "</A></h2>\n".
           "<ul>\n" );
    $tocdetail = _num_level( _a( 'DETAIL' ) );
    $toclevel = 0;
    undef $chainchapt;
}
sub end_toc
{
    output( "</ul>\n" x ( $toclevel + 1 ) );
    if ( defined( $copyright ) )
    {
        output( "<hr><h2><A name=\"copyright\">".
	       _zero_num().$lang{'Copyright'}.
	       "</A></h2>\n".
               "$copyrightsummary".
               "$copyright" );
    }
    _finish_file();
}

## ----------------------------------------------------------------------
sub start_tocentry
{
    ( $element, $event ) = @_;
    my $level = _num_level( _a( 'LEVEL' ) );
    my $string = _a( 'CHAPT' )._a( 'SECT' );
    if ( $level>$tocdetail )
    {
        push_output( 'nul' );
	$tocignore++;
    }
    else
    {
        if ( $toclevel>$level )
	{
	    output( "</ul>\n" x ( $toclevel - $level ) );
	}
        elsif ( $toclevel<$level )
	{
	    output( "<ul>\n" x ( $level - $toclevel ) );
	}
        output( '<li>' );
        if ( ! $level )
	{
            $chaptsrid = _a( 'SRID' );
            if ( length( $chainchapt ) )
	    {
                $fchainsrid{$chainchapt} = $chaptsrid;
                $bchainsrid{$chaptsrid} = $chainchapt;
            }
            $chainchapt = $chaptsrid;
            _href_open( $chaptsrid );
            output( $string.' ' );
        }
	else
	{
            _href_open( $chaptsrid, _a( 'SRID' ) );
            output( $string.'</A> ' );
        }
        $toclevel = $level;
    }
}
sub end_tocentry
{
    if ( $tocignore )
    {
        pop_output;
	$tocignore--;
    }
    elsif ( $toclevel )
    {
        output( "\n" );
    }
    else
    {
        output( "</A>\n" );
    }
}

## ----------------------------------------------------------------------
sub start_chapt
{
    ( $element, $event ) = @_;
    _start_file( _a( 'SRID' ) );
    $chaptheadnum = _a( 'CHAPT' );
    $chapthname = _a( 'HNAME' );
}
sub end_chapt
{
    _finish_file();
}

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

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

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

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

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

## ----------------------------------------------------------------------
sub start_heading
{
    if ( defined( $chaptheadnum ) )
    {
	push_output( 'string' );
    }
}
sub end_heading
{
    if ( defined( $chaptheadnum ) )
    {
        my $chaptitle = pop_output();
        _html_head( $title.' - '._squash_markup( $chaptitle ) );
        output( "<h1>\n"._squash_markup( $title.' - '.$lang{'chapter'}.
				      ' '.$chaptheadnum ).
               "<br>\n"._squash_markup( $chaptitle )."\n</h1>\n" );
    }
    else
    {
        output( $headclose."\n" );
    }
    $needpara = 0;
}

## ----------------------------------------------------------------------
sub start_p
{
    ( $element, $event ) = @_;
    output( "<P>\n" ) if $needpara;
    $needpara = 0;
}
sub end_p
{
    $needpara = 1;
}

## ----------------------------------------------------------------------
sub start_example
{
    output( '<pre>' );
}
sub end_example
{
    output( '</pre>' );
}

## ----------------------------------------------------------------------
sub start_footnotes
{
    ( $element, $event ) = @_;
    _start_file( 'footnotes' );
    my $subdoctitle = $title." - ".$lang{'footnotes'};
    _html_head( $subdoctitle );
    output( "<h1>"._squash_markup( $subdoctitle )."</h1>\n" );
}
sub end_footnotes
{
    _finish_file();
}

## ----------------------------------------------------------------------
sub start_footnote
{
}
sub end_footnote
{
}

## ----------------------------------------------------------------------
sub start_footnotebody
{
    ( $element, $event ) = @_;
    my $num = _a( 'NUMBER' );
    output( '<h2>' );
    _href_open( _a( 'CSRID' ), "fr$num", 'name="'.$num.'"' );
    output( _a( 'NUMBER' )."</A></h2>\n" );
}
sub end_footnotebody
{
}

## ----------------------------------------------------------------------
sub start_footnoteref
{
    ( $element, $event ) = @_;
    my $num = _a( 'NUMBER' );
    _href_open( 'footnotes', $num, 'name="fr'.$num.'"' );
    output( "[$num]</A>" );
}
sub end_footnoteref
{
}

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

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

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

## ----------------------------------------------------------------------
sub start_tag
{
    output( '<dt>' );
}
sub end_tag
{
}

## ----------------------------------------------------------------------
sub start_item
{
    output( "<$itemtag>" );
    $needpara = 0;
}
sub end_item
{
    output( '<p>' ) if ! $lcompact;
}

## ----------------------------------------------------------------------
sub start_em
{
    output( '<em>' );
}
sub end_em
{
    output( '</em>' );
}

## ----------------------------------------------------------------------
sub start_strong
{
    output( '<strong>' );
}
sub end_strong
{
    output( '</strong>' );
}

## ----------------------------------------------------------------------
sub start_var
{
    output( $intt ? '</code><var>' : '<var>' );
}
sub end_var
{
    output( $intt ? '</var><code>' : '</var>' );
}

## ----------------------------------------------------------------------
sub start_prgn
{
    output( '<kbd>' );
}
sub end_prgn
{
    output( '</kbd>' );
}

## ----------------------------------------------------------------------
sub start_tt
{
    output( '<code>' );
    $intt++;
}
sub end_tt
{
    output( '</code>' );
    $intt--;
}

## ----------------------------------------------------------------------
sub start_qref
{
    ( $element, $event ) = @_;
    if ( _a( 'LEVEL' ) eq 'CHAPT' )
    {
	_href_open( _a( 'SRID' ), '' );
    }
    else
    {
	_href_open( _a( 'CSRID' ), _a( 'SRID' ) );
    }
}
sub end_qref
{
    output( '</A>' );
}

## ----------------------------------------------------------------------
sub start_ref
{
    ( $element, $event ) = @_;
    my $level = _a( 'LEVEL' );
    if ( $level eq 'CHAPT' )
    {
	_href_open( _a( 'SRID' ), '' );
    }
    else
    {
	_href_open( _a( 'CSRID' ), _a( 'SRID' ) );
    }
    $refhname = _a( 'HNAME' );
}
sub end_ref
{
    output( ", $refhname</A>" );
}

## ----------------------------------------------------------------------
sub start_manref
{
    ( $element, $event ) = @_;
    output( '<code>'._a( 'NAME' ).'('._a( 'SECTION' ).')</code>' );
}
sub end_manref
{
}

## ----------------------------------------------------------------------
sub start_ftpsite
{
    push_output( 'string' );
    $verbatim++;
}
sub end_ftpsite
{
    $ftpsite = pop_output;
    $verbatim--;
    output( '<code>'._sani_html( $ftpsite ).'</code>' );
}

## ----------------------------------------------------------------------
sub start_ftppath
{
    push_output( 'string' );
    $verbatim++;
}
sub end_ftppath
{
    my $ftppath = pop_output;
    $verbatim--;
    defined( $ftpsite ) ||
        print( STDERR "FTPPATH \`$ftppath' without preceding FTPSITE\n" );
    output( '<A href="ftp://'._sani_url( $ftpsite )._sani_url( $ftppath ).
	   '"><code>'. _sani_html( $ftppath ).'</code></A>' );
}

## ----------------------------------------------------------------------
sub cdata
{
    &_odata;
}

## ----------------------------------------------------------------------
sub sdata
{
    &_odata;
}

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

## ----------------------------------------------------------------------
sub _html_head
{
    my ( $pagetitle ) = @_;
    output( "<title>"._squash_markup( $pagetitle )."</title>\n" );
    output( '<link rev=made href="mailto:'._sani_url( $authoremail )."\">\n" )
        if defined( $authoremail );
    output( "</head><body>\n" );
}

## ----------------------------------------------------------------------
sub _sect
{
    ( $hlevel, $element, $event ) = @_;
    output( "<hr>\n<h$hlevel><A name=\""._a( 'SRID' )."\">\n".
	   _a( 'CHAPT' )._a( 'SECT' ).' ' );
    $headclose = "\n</A></h$hlevel>";
    undef $chaptheadnum;
}

## ----------------------------------------------------------------------
sub _href_open
{
    output( '<A href="' );
    my $rfn = length( $_[0] ) ? "$prefix$_[0]" : $rootfile;
    $rfn .= ".html";
    output( $rfn ) if $rfn ne $currentfile;
    output( '#'.$_[1] ) if length( $_[1] );
    output( '"' );
    output( " $_[2]" ) if length( $_[2] );
    output( '>' );
}

## ----------------------------------------------------------------------
sub _start_file
{
    $cfilesrid = $_[0];
    $currentfile = length( $cfilesrid ) ? "$prefix$cfilesrid" : $rootfile;
    $currentfile .= ".html";
    push_output( 'file',"$writesubdir$currentfile" );
    output( "<html><head>\n" );
}
sub _finish_file
{
    output( "<hr>\n" );
    output( "$title\n" );
    if ( defined( $copyrightsummary ) )
    {
        output( "- " );
        _href_open( '', "copyright" );
        output( $copyrightsummary );
        output( "</A>\n" );
    }
    output( "<br>\n" );
    _href_open( '', 'toc' );
    output( $lang{'Contents'}.'</A>' );
    if ( defined( $abstract ) )
    {
        output( '; ' );
	_href_open( '', 'abstract' );
	output( $lang{'abstract'}.'</A>' );
    }
    if ( defined( $fchainsrid{$cfilesrid} ) )
    {
        output( '; ' );
	_href_open( $fchainsrid{$cfilesrid}, '' );
	output( $lang{'next'}.'</A>' );
    }
    if ( defined( $bchainsrid{$cfilesrid} ) )
    {
        output( '; ' );
	_href_open( $bchainsrid{$cfilesrid}, '' );
	output( $lang{'back'}.'</A>' );
    }
    output( ".\n<br>\n" );
    output( "<address>" );
    output( "$version<br>\n" ) if length( $version );
    output( join( "<br>\n", @authors ), "</address>\n</body></html>\n" );
    pop_output;
    $cfilesrid = $chaptsrid;
    undef $ftpsite;
}

## ----------------------------------------------------------------------
sub _start_list
{
    push( @listtag, $listtag );
    push( @itemtag, $itemtag );
    push( @lcompact, $lcompact );
    ( $listtag, $itemtag, $element, $event ) = @_;
    $lcompact = $element->attribute( 'COMPACT' )->type eq 'TOKEN';
    output( "<$listtag" );
    output( " compact" ) if $lcompact;
    output( ">\n" );
}
sub _end_list
{
    output( "</$listtag>\n" );
    $listtag = pop( @listtag );
    $itemtag = pop( @itemtag );
}

## ----------------------------------------------------------------------
sub _odata
{
    ( $data, $event ) = @_;
    output( $verbatim ? $data: _sani_html( $data ) );
}

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

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

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

## ----------------------------------------------------------------------
sub _squash_markup
{
    my ( $in ) = @_;
    $in =~ s/\<[^<>]*\>//g;
    $in;
}

## ----------------------------------------------------------------------
sub _sani_url
{
    my ( $in ) = @_;
    my $out = '';
    while ( $in =~ m,[^-0-9a-zA-Z./\@], )
    {
        $out .= $`.sprintf( "%%%02x", unpack( "C", $& ) );
        $in = $';
    }
    $out .= $in;
    $out;
}

## ----------------------------------------------------------------------
sub _sani_html
{
    my ( $in ) = @_;
    my $out = '';
    while ( $in =~ m/[<>&\"]/ )
    {
        $out .= $`.'&'.$htmlsani{$&}.';';
        $in = $';
    }
    $out .= $in;
    $out;
}

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

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

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

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

## ----------------------------------------------------------------------
sgml( '<BOOK>', '' );
sgml( '</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>', \&start_copyrightsummary );
sgml( '</COPYRIGHTSUMMARY>', \&end_copyrightsummary );

## ----------------------------------------------------------------------
sgml( '<TOC>', \&start_toc );
sgml( '</TOC>', \&end_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>', \&end_p );

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

## ----------------------------------------------------------------------
sgml( '<FOOTNOTES>', \&start_footnotes );
sgml( '</FOOTNOTES>', \&end_footnotes );

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

## ----------------------------------------------------------------------
sgml( '<FOOTNOTEBODY>', \&start_footnotebody );
sgml( '</FOOTNOTEBODY>', '' );

## ----------------------------------------------------------------------
sgml( '<FOOTNOTEREF>', \&start_footnoteref );
sgml( '</FOOTNOTEREF>', '' );

## ----------------------------------------------------------------------
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>', '' );

## ----------------------------------------------------------------------
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>', \&start_qref );
sgml( '</QREF>', \&end_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 );

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