#!/usr/bin/perl
# vim:sw=4 sta showmatch

use strict;

package texixml;

use XML::Parser::PerlSAX;
use XML::SGMLSpl;

my $sgmlspl = new XML::SGMLSpl;

##################################################
#
# Output routines
#
##################################################

sub output {
    my $text = shift;

    if($text =~ s/^\n//) {
	# Force newline if needed
	print OUT "\n" unless $texixml::newline_last++;
    }
    return if $text eq '';
    
    print OUT $text;

    $texixml::newline_last = ($text =~ /\n$/);
}

sub attribute_trim
{
    my $name = shift;
    for ($name) {
	tr/ \t\n/ /s;
	s/^ +//mg;
	s/ +$//mg;
    }
    return $name;
}

sub texi_escape
{
    my $s = shift;
    for ($s) {
	# Escape Texinfo syntax chars
	$s =~ s/\@/\@\@/g;
	$s =~ s/\{/\@\{/g;
	$s =~ s/\}/\@\}/g;
    }
    return $s;
}


    
##################################################
#
# A clean solution to the extra-newlines problem
#
##################################################

# texi_xml keeps track of what type of element (block, inline 
# or neither) it just processed, then makes line breaks for
# the next element only if necessary

sub block_break
{
    my $lastchild = shift->ext->{'lastchild'};
    output "\n\n" if $lastchild eq 'inline' || $lastchild eq 'block';
}

sub inline_break
{
    my $lastchild = shift->ext->{'lastchild'};

    # Example:
    # <para>Warning<para>Some text</para>Do not indent this text
    # since it's part of the same paragraph</para>

    output "\n\@noindent\n" if $lastchild eq 'block';
}



##################################################
#
# Main document
#
##################################################

$sgmlspl->sethandler('<texinfo>', sub {
    my ($elem, $sgmlspl) = @_;

    if(defined $elem->attribute('file')) {
	$texixml::file = $elem->attribute('file');
    } elsif($texixml::inputfile ne '-') {
	$texixml::file = $texixml::inputfile;
	$texixml::file =~ s/\.txml$//;
    } else {
	$texixml::file = 'noname';
    }

    open(OUT, ">${texixml::file}.texi");

    $texixml::newline_last = 1;
    output "\\input texinfo\n";
    output "\n\@setfilename ${texixml::file}.info\n";
});

$sgmlspl->sethandler('</texinfo>', sub {
    output "\n\@bye\n";
    close(OUT);
});


##################################################
#
# Menus, nodes
#
##################################################

$sgmlspl->sethandler('<node>', sub {
    my ($elem, $sgmlspl) = @_;
    my $node = node_escape(texi_escape($elem->attribute('name')));
    output "\n\n\@node $node\n";
});

$sgmlspl->sethandler('<menu>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\n\@menu\n";
});
$sgmlspl->sethandler('</menu>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\@end menu\n";
});
$sgmlspl->sethandler('<detailmenu>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\n\@detailmenu\n";
});
$sgmlspl->sethandler('</detailmenu>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\@end detailmenu\n";
});

$sgmlspl->sethandler('<menuitem>', sub {
    my ($elem, $sgmlspl) = @_;
    $elem->ext->{'outputmode'} = 'strip-newline-save';
});

$sgmlspl->sethandler('</menuitem>', sub {
    my ($elem, $sgmlspl) = @_;
    my $entry = node_escape($elem->ext->{'outputsave'});
    
    my $node = node_escape(texi_escape($elem->attribute('node')));
    if($entry eq $node) {
	output "\n* ${entry}::\n";
    } else {
	output "\n* ${entry}: ${node}.\n";
    }
});

# Do escaping:
# Note: stylesheets should do this if possible
# since there can be rare name clashes.
sub node_escape
{
    my $name = shift;
    for ($name) {
	tr/().,:'/[];;;_/;
	tr/ \t\n/ /s;
	s/^ +//mg;
	s/ +$//mg;
    }
    return $name;
}
 




##################################################
#
# Paragraph
#
##################################################

$sgmlspl->sethandler('<para>', sub {
    &block_start_common_handler;
});
$sgmlspl->sethandler('</para>', sub {
    &block_end_common_handler;
});
    
sub block_start_common_handler {
    my ($elem) = @_;
    block_break($elem->parent);
    $elem->parent->ext->{'lastchild'} = 'block';
}
sub block_end_common_handler {
    my ($elem) = @_;
    output "\n";
}


##################################################
#
# Example/format/etc.
#
##################################################

sub verbatim_block_start_handler 
{
    &block_start_common_handler;
    my ($elem, $sgmlspl) = @_;
    output '@' . $elem->name . "\n";
    $elem->ext->{'outputmode'} = 'preserve';
}
sub verbatim_block_end_handler
{
    &block_end_common_handler;
    my ($elem, $sgmlspl) = @_;
    output "\n\@end " . $elem->name . "\n";
}

foreach my $gi
    (qw(example display format)) {
    $sgmlspl->sethandler("<$gi>", \&verbatim_block_start_handler);
    $sgmlspl->sethandler("</$gi>", \&verbatim_block_end_handler);
}

$sgmlspl->sethandler('<quotation>', sub {
    &block_start_common_handler;
    my ($elem, $sgmlspl) = @_;
    output "\@quotation\n";
});

$sgmlspl->sethandler('</quotation>', sub {
    &block_end_common_handler;
    output "\n\@end quotation\n";
});



##################################################
#
# Lists
#
##################################################

$sgmlspl->sethandler('<enumerate>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\n\@enumerate " . $elem->attribute('begin') . "\n";
});

$sgmlspl->sethandler('</enumerate>', sub {
    output "\n\@end enumerate\n";
});

$sgmlspl->sethandler('<itemize>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\n\@itemize \@" . $elem->attribute('mark') . "\n";
});

$sgmlspl->sethandler('</itemize>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\@end itemize\n";
});

$sgmlspl->sethandler('<table>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\n\@table \@asis\n";
});
$sgmlspl->sethandler('</table>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\@end table\n";
});

$sgmlspl->sethandler('<item>', sub {
    my ($elem, $sgmlspl) = @_;
    
    block_break($elem->parent);
    $elem->parent->ext->{'lastchild'} = '';
    output "\n\@item ";
    
    $elem->ext->{'outputmode'} = 'strip-newline';
});
$sgmlspl->sethandler('</item>', sub {
    output "\n";
});
$sgmlspl->sethandler('<itemx>', sub {
    my ($elem, $sgmlspl) = @_;
    
    $elem->parent->ext->{'lastchild'} = '';
    output "\n\@itemx ";
    
    $elem->ext->{'outputmode'} = 'strip-newline';
});
$sgmlspl->sethandler('</itemx>', sub {
    output "\n";
});

$sgmlspl->sethandler('<multitable>', sub {
    my ($elem, $sgmlspl) = @_;
    # FIXME Support prototype attr
    output "\n\n\@multitable \@columnfractions " . 
	attribute_trim($elem->attribute('distribution')) . "\n";
});
$sgmlspl->sethandler('</multitable>', sub {
    output "\n\@end multitable\n";
});

$sgmlspl->sethandler('<tab>', sub {
    output "\n\@tab ";
});
    

##################################################
#
# Spacing
#
##################################################

$sgmlspl->sethandler('<sp>', sub {
    my ($elem, $sgmlspl) = @_;
    output "\n\@sp " . $elem->attribute('n') . "\n";
});



##################################################
#
# Inline elements
#
##################################################

sub inline_start_handler {
    my ($elem, $sgmlspl) = @_;
    inline_break($elem->parent);
    output '@'. $elem->name . '{'
        unless $elem->parent->parent->ext->{'lastchild'} eq 'inline';
    $elem->parent->ext->{'lastchild'} = 'inline';
}
sub inline_end_handler {
    my ($elem, $sgmlspl) = @_;
    output "}"
        unless $elem->parent->parent->ext->{'lastchild'} eq 'inline';
}

foreach my $gi
    (qw(code samp cite email dfn file sc acronym emph strong key kbd var i b r t)) {
    $sgmlspl->sethandler("<$gi>", \&inline_start_handler);
    $sgmlspl->sethandler("</$gi>", \&inline_end_handler);
}

#FIXME
# Anchor may appear anywhere
$sgmlspl->sethandler('<anchor>', sub {
    my ($elem, $sgmlspl) = @_;
    output '@anchor{' . node_escape(texi_escape($elem->attribute('node'))) . '}';
});
    
##################################################
#
# Cross references, links
#
##################################################

$sgmlspl->sethandler('<ref>', sub {
    my ($elem, $sgmlspl) = @_;
    inline_break($elem->parent);
    $elem->ext->{'outputmode'} = 'strip-newline-save'
        unless $elem->parent->parent->ext->{'lastchild'} eq 'inline';
    $elem->parent->ext->{'lastchild'} = 'inline';
});

$sgmlspl->sethandler('</ref>', sub {
    my ($elem, $sgmlspl) = @_;
    
    # FIXME use node_escape for $entry ?
    my $entry = node_escape($elem->ext->{'outputsave'});

    my $node = node_escape(texi_escape($elem->attribute('node')));
    my $file = $elem->attribute('file');
    
    if(defined $file and $file ne $texixml::file) {
	if(defined $elem->attribute('crossrefname')) {
	    output "\@ref{$node" . $elem->attribute('crossrefname') . 
		    ",$entry,$file,$entry}.";
	} else {
	    output "\@ref{$node,$node,$entry,$file,$entry}.";
	}
    } else {
	if($entry eq $node) {
	    output "\@ref{${node}}.";
	} else {
	    output "\@ref{${node}, ${entry}}.";
	}
    }
});

##################################################
#
# Sectioning elements
#
##################################################

sub section_start_handler {
    my ($elem, $sgmlspl) = @_;
    
    $elem->parent->ext->{'lastchild'} = '';
    output "\n\@" . $elem->name . ' ';
    
    $elem->ext->{'outputmode'} = 'strip-newline';
}

sub section_end_handler {
    output "\n";
}

foreach my $gi
    (qw(top chapter section subsection subsubsection
       majorheading heading subheading subsubheading)) {
    $sgmlspl->sethandler("<$gi>", \&section_start_handler);
    $sgmlspl->sethandler("</$gi>", \&section_end_handler);
}


##################################################
#
# Character data
#
##################################################

$sgmlspl->sethandler('characters', sub {
    my ($s, $elem, $sgmlspl) = @_;
    
    # Escape Texinfo syntax chars
    $s =~ s/\@/\@\@/g;
    $s =~ s/\{/\@\{/g;
    $s =~ s/\}/\@\}/g;

    my $outputmode = $elem->ext->{'outputmode'};

    if($outputmode eq '') {
	# Weed out extra whitespace
        $s =~ tr/ \t/ /s;
	
	# Collapse newlines
	$s =~ tr/\n//s;

        # No spaces at beginning of lines
        $s =~ s/^ +// if $texixml::newline_last;

	inline_break($elem) if $s =~ /[^\s]/;

	output $s;
    }
     
    elsif($outputmode =~ /^strip-newline/) {
	# Newlines, die!
        $s =~ tr/ \t\n/ /s;

	if($outputmode eq 'strip-newline-save') {
	    $elem->ext->{'outputsave'} .= $s;
	} else {
	    # No spaces at beginning of lines
	    $s =~ s/^ +// if $texixml::newline_last;
	    
	    inline_break($elem) unless $s eq '';
	    output $s;
	}
    
    } elsif($outputmode eq 'preserve') {
	if($texixml::newline_last and $s =~ /^\n/) {
	    # Make another line anyway
	    output "\n\n";
	}

	inline_break($elem);
	output $s;
    
    } else {
	die("Unknown output mode $outputmode\n");
    }

});
			     

unshift(@ARGV, '-') unless @ARGV;
my $parser = XML::Parser::PerlSAX->new(Handler => $sgmlspl);

foreach $texixml::inputfile (@ARGV)
{
    $parser->parse(Source => { SystemId => $texixml::inputfile });
}

