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

# db2x_texixml - convert Texi-XML to Texinfo
#                (See DocBook documentation for details)
#
# Copyright (C) 2000 Steve Cheng <steve@ggi-project.org>
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, please write
# to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139,
# USA.
# 

use strict;

package texixml;

use XML::Parser::PerlSAX;
use XML::Handler::Templates;

my $texixmlparser = {};
# FIXME: Bless this class and make other routines instance methods
my $templates = XML::Handler::Templates->new($texixmlparser);

##################################################
#
# 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$/);
}

# CHECKME: is this really needed?
#
sub trim_string
{
    my $name = shift;
    for ($name) {
	tr/ \t\n/ /s;
	s/^ +//mg;
	s/ +$//mg;
    }
    return $name;
}

sub texi_arg_escape
{
    my $s = shift;
    $s =~ tr/,/./;
    return $s;
}

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

# Allows output to be saved when $texixml::output_save is set,
# otherwise same as output.
#
# Savable output does not stack, unlike SGMLS::Output.
#
# When saving output, this function does not have any line-breaking 
# semantics of regular output() and will NOT work with block-level
# elements. (Saving of arbitrary output has many other complications
# which we will not attempt solve here to solve in the interests of 
# minimizing code bloat.)
#
sub savable_output
{
    if(defined $texixml::output_save) {
	$texixml::output_save .= shift;
    } else {
	&output;
    }
}
	
    
##################################################
#
# 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
#
# These functions are passed the *parent* element,
# i.e. the container element of the element possibly needing
# a break.
#
sub block_break
{
    my ($self, $elem) = @_;

    if(defined $texixml::output_save) {
	die "block_break called while saving output";
    }

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

sub inline_break
{
    my ($self, $elem) = @_;
    
    if(defined $texixml::output_save) {
	return;
    }
    
    my $lastchild = $elem->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\n\@noindent\n" if $lastchild eq 'block';
}



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

$templates->add_rule('texinfo<', sub {
    my ($self, $elem, $templates) = @_;

    # FIXME
    # For backward compatibility with docbook2texixml(!), we check 
    # for empty string rather than defined (i.e. specified not implied)
    # as we ought to.  
    if($elem->{Attributes}->{'file'} ne '') {
	$self->{file} = $elem->{Attributes}->{'file'};
    } elsif($self->{inputfile} ne '-') {
	$self->{file} = $self->{inputfile};
	$self->{file} =~ s/\.txml$//;
    } else {
	$self->{file} = 'noname';
    }

    open(OUT, '> ' . $self->{file} . '.texi');

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

    # expat feeds us utf-8, whether Texinfo likes it or not
    output "\@documentencoding utf-8\n";
});

$templates->add_rule('texinfo>', sub {
    output "\n\n\@bye\n";
    close(OUT);
});


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

$templates->add_rule('node<', sub {
    my ($self, $elem, $templates) = @_;
    my $node = node_escape(texi_escape($elem->{Attributes}->{'name'}));

    if(defined $elem->{Attributes}->{'next'} or
       defined $elem->{Attributes}->{'previous'} or
       defined $elem->{Attributes}->{'up'})
    {
	my $next = node_escape(texi_escape($elem->{Attributes}->{'next'}));
        my $previous = node_escape(texi_escape($elem->{Attributes}->{'previous'}));
	my $up = node_escape(texi_escape($elem->{Attributes}->{'up'}));

	if($node =~ /^[Tt]op$/ and !defined $elem->{Attributes}->{'up'}) {
	    $up = '(dir)';
	}

	output "\n\n\@node ${node}, ${next}, ${previous}, ${up}\n";
    } else {
	output "\n\n\@node $node\n";
    }
});

$templates->add_rule('menu<', sub {
    my ($self, $elem, $templates) = @_;
    
    $elem->ext->{'outputmode'} = 'strip-newline';
    $elem->parent->ext->{'lastchild'} = 'block';
    output "\n\n\@menu\n";
});
$templates->add_rule('menu>', sub {
    my ($self, $elem, $templates) = @_;
    output "\n\@end menu\n";
});
$templates->add_rule('detailmenu<', sub {
    my ($self, $elem, $templates) = @_;
    output "\n\n\@detailmenu\n";
});
$templates->add_rule('detailmenu>', sub {
    my ($self, $elem, $templates) = @_;
    output "\n\@end detailmenu\n";
});

$templates->add_rule('menuitem<', sub {
    my ($self, $elem, $templates) = @_;
    $elem->ext->{'outputmode'} = 'strip-newline';
    $texixml::output_save = '';
    
    $elem->parent->ext->{'lastchild'} = 'inline';
});

$templates->add_rule('menuitem>', sub {
    my ($self, $elem, $templates) = @_;

    my $entry = $texixml::output_save;
    $texixml::output_save = undef;

    # Although the menu entry is not constrained to the set
    # of characters allowed for node names, the use of ':'
    # to separate the parts of menu entry implies that it
    # is not an allowed character.
    $entry = node_escape($entry);
    
    my $node = node_escape(texi_escape($elem->{Attributes}->{'node'}));
    
    if($elem->{Attributes}->{'file'} ne '') {
	# This element is overloaded for direntry, and there
	# we need to specify the file.
	my $file = texi_escape($elem->{Attributes}->{'file'});
	output "\n* ${entry}: (${file})${node}.\t\t";
    
    } else {
        if($entry eq $node) {
	    output "\n* ${entry}::\t\t"; # FIXME not sure what to do with
					 # the description.  makeinfo
					 # formats it verbatim
        } else {
	    output "\n* ${entry}: ${node}.\t\t";
        }
    }
});

# Do escaping for nodenames:
# 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;
}

##################################################
#
# Info directory
#
##################################################

$templates->add_rule('dircategory<', sub {
    my ($self, $elem, $templates) = @_;
    output "\n\@dircategory ";
    
    $elem->ext->{'outputmode'} = 'strip-newline';
});
$templates->add_rule('dircategory>', sub {
    output "\n";
});

$templates->add_rule('direntry<', sub {
    my ($self, $elem, $templates) = @_;

    $elem->ext->{'outputmode'} = 'strip-newline';
    $elem->parent->ext->{'lastchild'} = 'block';

    if(defined $elem->{Attributes}->{'category'}) {
	output "\n\@dircategory " . 
	    texi_escape($elem->{Attributes}->{'category'}) . "\n";
    }
    
    output "\n\@direntry\n";
});
$templates->add_rule('direntry>', sub {
    output "\n\@end direntry\n";
});

 
##################################################
#
# Internationalization
#
##################################################

# Allowing a common lang attribute on all elements 
# would really help XML applications...

$templates->add_rule('documentlanguage<', sub {
    my ($self, $elem, $templates) = @_;
    output "\n\@documentlanguage " . $elem->{Attributes}->{'lang'} . "\n";
});

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

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

sub section_end_handler {
    output "\n";
}

foreach my $gi
    (qw(chapter section subsection subsubsection
       majorheading chapheading heading subheading subsubheading
       top unnumbered unnumberedsec unnumberedsubsec unnumberedsubsubsec
       appendix appendixsec appendixsubsec appendixsubsubsec)) 
{
    $templates->add_rule("${gi}<", \&section_start_handler);
    $templates->add_rule("${gi}>", \&section_end_handler);
}





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

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


##################################################
#
# Verbatim displays
#
##################################################

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

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

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

$templates->add_rule('quotation>', sub {
    &block_end_common_handler;
    output "\n\@end quotation\n";
});



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

$templates->add_rule('enumerate<', sub {
    &block_start_common_handler;
    my ($self, $elem, $templates) = @_;
    output "\@enumerate " . $elem->{Attributes}->{'begin'} . "\n";
});

$templates->add_rule('enumerate>', sub {
    &block_end_common_handler;
    output "\n\@end enumerate\n";
});

$templates->add_rule('itemize<', sub {
    &block_start_common_handler;
    my ($self, $elem, $templates) = @_;
    
    # FIXME: mark attribute is defined to take values that are the names of 
    # glyphs in Texinfo, which simplifies stylesheets for many document
    # types such as HTML and DocBook.  However, it may be generally more
    # useful if this attribute (or another one) accepted actual
    # characters for the mark instead.
    if($elem->{Attributes}->{'mark'} ne '') {
	output "\@itemize \@" . texi_escape($elem->{Attributes}->{'mark'}) . "\n";
    } else {
	output "\@itemize\n";
    }
});

$templates->add_rule('itemize>', sub {
    &block_end_common_handler;
    my ($self, $elem, $templates) = @_;
    output "\n\@end itemize\n";
});

$templates->add_rule('table<', sub {
    &block_start_common_handler;
    my ($self, $elem, $templates) = @_;
    output "\n\@table \@asis\n";
});
$templates->add_rule('table>', sub {
    &block_end_common_handler;
    output "\n\@end table\n";
});

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

$templates->add_rule('multitable<', sub {
    &block_start_common_handler;
    my ($self, $elem, $templates) = @_;
    # FIXME Support prototype attr
    output "\n\@multitable \@columnfractions " . 
	trim_string($elem->{Attributes}->{'columnfractions'}) . "\n";
});
$templates->add_rule('multitable>', sub {
    &block_end_common_handler;
    output "\n\@end multitable\n";
});

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

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

$templates->add_rule('sp<', sub {
    my ($self, $elem, $templates) = @_;
    output "\n\@sp " . $elem->{Attributes}->{'n'} . "\n";
});
$templates->add_rule('page<', sub {
    output "\n\@page\n";
});



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

sub inline_start_handler {
    my ($self, $elem, $templates) = @_;
    inline_break($self, $elem->parent);
    savable_output '@'. $elem->name . '{';

# My initial impression was that nested inlines are not allowed
# in Texinfo, but the tools actually work correctly on them. Good!
#        unless $elem->parent->parent->ext->{'lastchild'} eq 'inline';

    $elem->parent->ext->{'lastchild'} = 'inline';
}
sub inline_end_handler {
    my ($self, $elem, $templates) = @_;
    savable_output "}";
# Same reason as above.
#        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 
	env command option
	i b r t 
        math footnote)) 
{
    $templates->add_rule("${gi}<", \&inline_start_handler);
    $templates->add_rule("${gi}>", \&inline_end_handler);
}

$templates->add_rule('anchor<', sub {
    my ($self, $elem, $templates) = @_;
    savable_output '@anchor{' . node_escape(texi_escape($elem->{Attributes}->{'node'})) . '}';
    $elem->parent->ext->{'lastchild'} = 'inline';
});
    
##################################################
#
# Cross references, links
#
##################################################

sub crossref_start_handler {
    my ($self, $elem, $templates) = @_;
    inline_break($self, $elem->parent);
    
    $elem->ext->{'outputmode'} = 'strip-newline';
    $texixml::output_save = '';
    
    $elem->parent->ext->{'lastchild'} = 'inline';
}

sub crossref_end_handler {
    my ($self, $elem, $templates) = @_;

    # Syntax:
    # @ref{$node,$infoname,$printname,$file,$printmanual}
    # node - required
    # infoname, printname - optionally specified by inline content 
    #     (I don't think there is much utility in having these separate)
    # infofile, printfile - optional
    
    my $node = node_escape(texi_escape($elem->{Attributes}->{'node'}));
    
    my $printname = texi_arg_escape($texixml::output_save);
    $texixml::output_save = undef;
    my $infoname;

    # If the node and cross reference name turn out to be
    # the same, make the latter empty so info won't display it
    # twice.
    $infoname = ($node eq $printname) ? '' : $printname;
    
    my $file = texi_escape($elem->{Attributes}->{'file'});
    my $printmanual = texi_escape($elem->{Attributes}->{'printmanual'});

    # Required part
    output '@' . $elem->name . '{' . $node;

    # Reference to another file
    if($file ne '' and $file ne $self->{file}) {
	output ",$infoname,$printname,$file,$printmanual}";
    }
    else {
	# No inline content either, so use one-argument @ref
	if($printname eq '') { output "}"; }
	else { output ",$infoname,$printname}"; }
    }
    
    # Texinfo's ugly hack
    output "." unless $elem->name eq 'pxref';
}

foreach my $gi (qw(xref ref pxref)) {
    $templates->add_rule("${gi}<", \&crossref_start_handler);
    $templates->add_rule("${gi}>", \&crossref_end_handler);
}



##################################################
#
# URI references
#
##################################################

$templates->add_rule('uref<', sub {
    my ($self, $elem, $templates) = @_;
    inline_break($self, $elem->parent);
    
    $elem->ext->{'outputmode'} = 'strip-newline';
    $texixml::output_save = '';
    
    $elem->parent->ext->{'lastchild'} = 'inline';
});

$templates->add_rule('uref>', sub {
    my ($self, $elem, $templates) = @_;
    
    my $url = texi_escape($elem->{Attributes}->{'url'});
    my $text = texi_arg_escape($texixml::output_save);
    $texixml::output_save = undef;
    
    if($text eq '') {
        output "\@uref{$url}";
    } else {
	output "\@uref{$url,$text}";
    }
});


##################################################
#
# Graphics
#
##################################################

$templates->add_rule('image<', sub {
    my ($self, $elem, $templates) = @_;
    
    # FIXME Should we resolve URIs?
    my $filename = texi_escape($elem->{Attributes}->{'filename'});
    
    # Texinfo says @image can be used for inline and displayed images
    # ... I'm pleasantly surprised.
    inline_break($self, $elem->parent);

    if(defined $elem->{Attributes}->{'width'} or
       defined $elem->{Attributes}->{'height'})
    {
	savable_output '@image{' . $filename . ',' . 
	    texi_escape($elem->{Attributes}->{'width'}) .
	    ',' . 
	    texi_escape($elem->{Attributes}->{'height'}) .
	    '}';
    } 
    else {
	savable_output '@image{' . $filename . '}';
    }
    
    $elem->parent->ext->{'lastchild'} = 'inline';
});


##################################################
#
# Indices
#
##################################################

$templates->add_rule('indexterm<', sub {
    # CHECKME Texinfo does not appear to allow inline index terms.
    # Is it reasonable to disallow them from appearing inside inline
    # elements in the document type?

    my ($self, $elem, $templates) = @_;

    inline_break($self, $elem->parent);
    
    my $class = $elem->{Attributes}->{'class'};
    $class = 'c' if $class eq 'cp';
    $class = 'f' if $class eq 'fn';
    $class = 'v' if $class eq 'vr';
    $class = 'k' if $class eq 'ky';
    $class = 'p' if $class eq 'pg';
    $class = 'd' if $class eq 'tp';
    
    output "\n\@" . $class . 'index ';
    $elem->ext->{'outputmode'} = 'strip-newline';

    $elem->parent->ext->{'lastchild'} = 'inline';
});
$templates->add_rule('indexterm>', sub {
    output "\n";
});

$templates->add_rule('printindex<', sub {
    my ($self, $elem, $templates) = @_;
    block_break($self, $elem->parent);

    my $class = $elem->{Attributes}->{'class'};
    $class = 'cp' if $class eq 'c';
    $class = 'fn' if $class eq 'f';
    $class = 'vr' if $class eq 'v';
    $class = 'ky' if $class eq 'k';
    $class = 'pg' if $class eq 'p';
    $class = 'tp' if $class eq 't';
    
    output "\n\@printindex " . $class . "\n";
    $elem->parent->ext->{'lastchild'} = 'block';
});



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

$templates->add_rule('text()', sub {
    my ($self, $node, $templates) = @_;
    
    my $s = texi_escape($node->{Data});
    my $elem = $node->parent;

    # Output mode of '' does not override parent default modes
    # Since there is not much element nesting in Texi-XML, 
    # hopefully this search isn't too inefficient ...
    #
    my $outputmode;
    for (my $this = $elem; $this; $this = $this->parent) {
	$outputmode = $this->ext->{'outputmode'} and last;
    }
    
    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;
	$s =~ s/(\n \n?)+/\n/g;

	if($s =~ /[^\s]/) {
	    inline_break($self, $elem);
	    $elem->ext->{'lastchild'} = 'inline';
	}
	
	output $s;
    }
     
    elsif($outputmode eq 'strip-newline') {
	# Newlines, die!
        $s =~ tr/ \t\n/ /s;

	# NOTE: output_save only implemented for strip-newline mode.
	if(defined $texixml::output_save) {
	    # No spaces at beginning of lines
	    $s =~ s/^ +// if $texixml::output_save eq '';
	    
	    $texixml::output_save .= $s;
	} else {
	    # No spaces at beginning of lines
	    $s =~ s/^ +// if $texixml::newline_last;

	    if($s ne '') {
		inline_break($self, $elem);
		$elem->ext->{'lastchild'} = 'inline';
		output $s;
	    }
	}
    
    } elsif($outputmode eq 'preserve') {
	if($texixml::newline_last and $s =~ /^\n/) {
	    # Make another line anyway
	    output "\n\n";
	}

	inline_break($self, $elem);
	$elem->ext->{'lastchild'} = 'inline';

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

});
			     
##################################################
#
# Comments
#
##################################################

$templates->add_rule('c<', sub {
    my ($self, $elem, $templates) = @_;
    $elem->ext->{'outputmode'} = 'strip-newline';
    output '@c ';
});

$templates->add_rule('c>', sub {
    output "\n";
});
    



##################################################
#
# Texinfo processing instruction
#
##################################################

$templates->add_rule('processing-instruction()', sub {
    my ($self, $node, $templates) = @_;

    if($node->{Target} eq 'texinfo') {
	my $data = $node->{Data};
        # Allow processing instructions to use newlines(?)
	$data =~ s/\&#xA;/\n/g;
        $data =~ s/\&#10;/\n/g;

	output $data;
    }
});



##################################################
#
# Ignition
#
##################################################

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

foreach my $file (@ARGV)
{
    $texixmlparser->{inputfile} = $file;
    $parser->parse(Source => { SystemId => $file });
}

