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

# $Id: docbook2manxml,v 1.6 2001/02/25 21:50:12 stevecheng Exp $

use strict;

package docbook2man;

use XML::Parser::PerlSAX;
use XML::SGMLSpl;
use XML::Writer;
use Data::Dumper;
use Getopt::Long;

##################################################
#
# Option parsing
#
##################################################

%docbook2man::options = ( 
    'refs-file' => 'manpage.refs',
    'header-3' => '',
    'header-4' => '',
    'header-5' => '',
    'default-section' => '1',
    'default-lang' => 'en',
    'uppercase-headings' => '1',
    'cite-numeral-only' => '1',
);
    
sub options_help {
    print "Usage: $0 [OPTION]... [XML-DOCUMENT]\n";
    print <<'end';
Convert XML DocBook documents to Man-XML.
     
The result is 

  --refs-file=FILE      Read and write man page ID references to specified
                        file.  Default is the file 'manpage.refs'.
  --header-3[=STR]      Specifies the third header on top of man page.
                        If empty, uses date markup.
  --header-4[=STR]      Specifies the fourth header on top of man page.
                        If empty, uses refmiscinfo markup.
  --header-5[=STR]      Specifies the fifth header on top of man page.
                        If empty, uses the manual name.
  --default-section=STR If the source refentry has no manvolnum markup,
                        use the specified default man page section.
  --default-lang=LANG   Default language for output if the source does
                        not indicate the language to use. (Default='en')
  --[no]uppercase-headings
                        Headings in man page content should be uppercased
			The default is yes.
  --[no]cite-numeral-only
                        When citing other man pages, use only the numeric
                        part of the section.  The default is yes.
  --help                Display this help and exit.
  --version             Output version information and exit.

The XML-DOCUMENT is converted and written to standard output. If it is
not given, then the document to convert is read from standard input.

See accompanying documentation for more details.
end
    exit 0;
}

sub options_version
{
    print <<'end';
docbook2manxml (part of docbook2X)
$Revision: 1.6 $ $Date: 2001/02/25 21:50:12 $
<URL:http://docbook2x.sourceforge.net/>

Copyright (C) 2000-2001 Steve Cheng 
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
end
    exit 0;
}

$SIG{__WARN__} = sub { print STDERR "$0: " . $_[0]; };
if(!GetOptions(\%docbook2man::options,
    'refs-file|r=s',
    'header-3:s',
    'header-4:s',
    'header-5:s',
    'default-section=s',
    'default-lang=s',
    'uppercase-headings!',
    'cite-numeral-only!',
    'help', \&options_help,
    'version', \&options_version))
{
    print STDERR "Try \"$0 --help\" for more information.\n";
    exit 1;
}
$SIG{__WARN__} = undef;


##################################################
#
# Init
#
##################################################

my $sgmlspl = new XML::SGMLSpl;
my $xw = new XML::Writer;

# We set the handlers indirectly on these hashes
# so that we can switch them on and off when
# entering and exiting a refentry.
my $start_element = {};
my $end_element = {};
my $empty_start_element = {};
my $empty_end_element = {};

$sgmlspl->{start_element} = $empty_start_element;
$sgmlspl->{end_element} = $empty_end_element;

if(open(REFS, $docbook2man::options{'refs-file'})) {
    my $VAR1;
    eval(join('', <REFS>));
    $sgmlspl->{db_refs} = $VAR1;
    close(REFS);
} else {
    $sgmlspl->{db_refs} = {};
}


##################################################
#
# Localized strings
#
##################################################

%docbook2man::user_str = (
    en => { 
        'refnamediv-title' => 'Name',
	'refsynopsisdiv-title' => 'Synopsis',

	'keycombo-separator' => '+',
	'member-separator' => ', ',

	'note-title' => 'Note: ',
	'warning-title' => 'Warning: ',
	'tip-title' => 'Tip: ',
	'caution-title' => 'Caution: ',
	'important-title' => 'Important: ',

	'link-prefix' => ' [see ',
	'link-suffix' => ']',
	'xref-prefix' => '[',
	'xref-suffix' => ']',
	'remark-prefix' => '[Remark: ',
	'remark-suffix' => ']',
	'ulink-prefix' => '<URL:',
	'ulink-suffix' => '>',
	'quote-prefix' => '"',
	'quote-suffix' => '"',
	'literal-prefix' => '"',
	'literal-suffix' => '"',
    },
    
    pl => {
	'refnamediv-title' => 'NAZWA',
	'refsynopsisdiv-title' => 'SKŁADNIA',
    }
);

##################################################
#
# Utility functions
#
##################################################

sub node_warn
{
    my $sgmlspl = shift;
    my $elem = shift;
    my $location = $sgmlspl->{Locator}->location();
    warn "$0:", $location->{SystemId}, ':', 
		$location->{LineNumber}, ':', 
		'<' . $elem . '>', 
		@_;
}

# Get the localized string in the language specified in
# the 'nearest' lang attribute.
#
sub get_user_str
{
    my ($elem, $spec) = @_;

    my $lang;
    for(my $this = $elem; $this; $this = $this->parent) {
	$lang = ($this->attribute('lang') ||
		 $this->attribute('xml:lang')) and
		 last;
    }
    if($lang eq '') { 
	$lang = $docbook2man::options{'default-lang'};
    }

    return $docbook2man::user_str{lc($lang)}->{$spec} ||
	    $docbook2man::user_str{'en'}->{$spec};
}

sub get_listitem_mark
{
    my $spec = shift;
    # FIXME
    return '-';
}

sub get_numeration
{
    my ($numeration, $seq) = @_;
    if($numeration eq 'arabic') {
	return $seq;

    } elsif($numeration =~ /alpha$/) {

	# CHECKME: Do other locales always use roman letters?
	# If not, localize.
	my $seqset = 'abcdefghijklmnopqrstuvwxyz';
	if($seq > 26) {
	    warn "alpha numeration sequence exceeds sequence set available!\n";
	    $seq = 26;
	}

	return $numeration eq 'upperalpha' ?
	    uc(substr($seqset, $seq, 1)) :
	       substr($seqset, $seq, 1);

    } elsif($numeration =~ /roman$/) {

	my @digits = split(//, $seq);
	my $digit;
	my $result;

	$digit = pop(@digits);
	if($digit <= 3) 	{ $result = 'i' x $digit }
	elsif($digit == 4)	{ $result = 'iv' }
	elsif($digit <= 8)	{ $result = 'v' . ('i' x ($digit-5)) }
	elsif($digit == 9)	{ $result = 'ix' }

	$digit = pop(@digits);
	if($digit <= 3) 	{ $result = 'x' x $digit . $result }
	elsif($digit == 4)	{ $result = 'xl' . $result }
	elsif($digit <= 8)	{ $result = 'l'. ('x' x ($digit-5)) . $result }
	elsif($digit == 9)	{ $result = 'xc' . $result }

	$digit = pop(@digits);
	if($digit <= 3) 	{ $result = 'c' x $digit . $result }
	elsif($digit == 4)	{ $result = 'cd' . $result }
	elsif($digit <= 8)	{ $result = 'd' . ('c' x ($digit-5)) . $result }
	elsif($digit == 9)	{ $result = 'cm' . $result }

	$digit = pop(@digits);
	if($digit <= 3) 	{ $result .= 'm' x $digit }
	else {
	    # Romans have overflow here
	    warn "roman numeration sequence exceeds sequence set available!\n";
	}

	return $numeration eq 'upperroman' ?
	    uc($result) : $result;
    
    } else {
	die("Unknown numeration type ${numeration}!\n");
    }
}


##################################################
#
# Manual name markup
#
##################################################

$empty_start_element->{'title'} = sub {
    my ($elem, $sgmlspl) = @_;
    if($elem->in('reference') or $elem->in('book') or 
	$elem->in('article') or $elem->in('articleinfo') or $elem->in('artheader'))
    {
	$sgmlspl->{characters} = sub {
	    my ($s, $elem) = @_;
	    for (my $this = $elem; $this; $this = $this->parent) {
		if($this->name eq 'reference' || $this->name eq 'book' || $this->name eq 'article') {
	            $this->ext->{'title'} .= $s;
		    last;
		}
	    }
	};
    }
};
$empty_end_element->{'title'} = sub {
    my ($elem, $sgmlspl) = @_;
    $sgmlspl->{characters} = undef;
};


##################################################
#
# RefEntry markup
#
##################################################

$empty_start_element->{'refentry'} = sub {
    $sgmlspl->{start_element} = $start_element;
    $sgmlspl->{end_element} = $end_element;
    $sgmlspl->{characters} = \&manpage_characters;
};

$end_element->{'refentry'} = sub {
    my ($elem, $sgmlspl) = @_;
    $xw->endTag('manpage'); 
    $sgmlspl->{start_element} = $empty_start_element;
    $sgmlspl->{end_element} = $empty_end_element;
    $sgmlspl->{characters} = undef;
};

$start_element->{'refmeta'} = sub {
    my ($elem, $sgmlspl) = @_;
    $elem->parent->ext->{'refmetaseen'} = 1;
};

$end_element->{'refmeta'} = sub {
    my ($elem, $sgmlspl) = @_;

    my $h5;	# Select the manual name as title.
    if($docbook2man::options{'header-5'} ne '') {
	 $h5 = $docbook2man::options{'header-5'};
    } else {
        for (my $this = $elem; $this; $this = $this->parent) {
	    if($this->name eq 'reference' || $this->name eq 'book' || $this->name eq 'article') {
		$h5 = $this->ext->{'title'};
		last;
	    }
	}
    }

    $xw->startTag('manpage', 
	title => $elem->ext->{'refentrytitle'},
	sect  => $elem->ext->{'manvolnum'},
	h1    => $elem->ext->{'refentrytitle'},
	h2    => $elem->ext->{'manvolnum'},
	h4    => $docbook2man::options{'header-4'} ne '' ?
	         $docbook2man::options{'header-4'} :
		 $elem->ext->{'refmiscinfo'},
	h3    => $docbook2man::options{'header-3'},
	h5    => $h5);

    $xw->comment('auto-generated from ' . $docbook2man::inputfile . 
	        ' by docbook2manxml $Revision: 1.6 $');

    my $id = $elem->parent->attribute('id'); 
    if($id) {
        $sgmlspl->{db_refs}->{"refentry:$id"} =
	    [$elem->ext->{'refentrytitle'}, $elem->ext->{'manvolnum'}];
    }
};

$start_element->{'refentrytitle'} = sub {
    my ($elem, $sgmlspl) = @_;

    if($elem->in('refmeta')) {
	$elem->ext->{'outputmode'} = 'save';
    }
    else {
	# Manpage citations are in bold.
	$xw->startTag('fB');
    }
};
$end_element->{'refentrytitle'} = sub {
    my ($elem, $sgmlspl) = @_;

    if($elem->in('refmeta')) {
	$elem->parent->ext->{'refentrytitle'} = $elem->ext->{'outputsave'};
    }
    else {
	$xw->endTag('fB');
    }
};

$start_element->{'manvolnum'} = sub {
    my ($elem, $sgmlspl) = @_;

    if($elem->in('refmeta')) {
	$elem->ext->{'outputmode'} = 'save';
    }
    else {
	$xw->characters('(');
    }
};
$end_element->{'manvolnum'} = sub {
    my ($elem, $sgmlspl) = @_;

    if($elem->in('refmeta')) {
	$elem->parent->ext->{'manvolnum'} = $elem->ext->{'outputsave'};
    }
    else {
	$xw->characters(')');
    }
};

$start_element->{'refmiscinfo'} = sub {
    my ($elem, $sgmlspl) = @_;
    if($elem->in('refmeta')) {
	$elem->ext->{'outputmode'} = 'save';
    }
};
$end_element->{'refmiscinfo'} = sub {
    my ($elem, $sgmlspl) = @_;
    if($elem->in('refmeta')) {
	$elem->parent->ext->{'refmiscinfo'} = $elem->ext->{'outputsave'};
    }
};

#
# NAME section
#
$start_element->{'refnamediv'} = sub {
    my ($elem) = @_;
    
    # refmeta was omitted, output minimal man page
    if(!$elem->parent->ext->{'refmetaseen'}) {
        $xw->startTag('manpage');
    }

    $xw->startTag('SH');
    
    my $name = get_user_str($elem, 'refnamediv-title');
    # FIXME does not work with non-ASCII charsets!
    $xw->characters($docbook2man::options{'uppercase-headings'} ?
	uc($name) : $name);
    $xw->endTag('SH');

    $xw->startTag('refnameline');

    $elem->ext->{suppresswhitespace} = 1;
};
$end_element->{'refnamediv'} = sub {
    $xw->endTag('refnameline');
};

$start_element->{'refdescriptor'} = sub {
    my ($elem) = @_;
    $elem->parent->ext->{'refnameseen'}++;
    # Same as refname but not used as a sort name
};

$start_element->{'refname'} = sub {
    my ($elem) = @_;
    if($elem->parent->ext->{'refnameseen'}++) {
	$xw->characters(', ');
    }
    $xw->startTag('refname');
};
$end_element->{'refname'} = sub {
    $xw->endTag('refname');
};

$start_element->{'refpurpose'} = sub {
    my ($elem) = @_;
    $xw->emptyTag('refpurposeminus');
};
$start_element->{'refclass'} = sub {
    $xw->emptyTag('sp');
};

$start_element->{'refsynopsisdiv'} = sub {
    my ($elem, $sgmlspl) = @_;

    $xw->startTag('SH');
    # FIXME This ignores what the document specifies!
    my $name = get_user_str($elem, 'refsynopsisdiv-title');
    $xw->characters($docbook2man::options{'uppercase-headings'} ?
	uc($name) : $name);
    $xw->endTag('SH');
};



##################################################
#
# Cross-references
#
##################################################

$start_element->{'xref'} = sub {
    my ($elem, $sgmlspl) = @_;

    my $id = $elem->attribute('linkend');
    my $manref = $sgmlspl->{db_refs}->{"refentry:$id"};

    if(defined $manref) {
	my ($title, $sect) = @$manref;
	if($docbook2man::options{'cite-numeral-only'}) {
	    $sect = $1 if ($sect =~ /([0-9]+)/);
	}
	$xw->startTag('fB');
	$xw->characters($title);
	$xw->endTag('fB');
	$xw->characters('(');
	$xw->characters($sect);
	$xw->characters(')');
    }

    else {
    	$sgmlspl->{db_unresolved_xrefs}++;
       	$xw->characters(get_user_str($elem, 'xref-prefix') . $id .
			get_user_str($elem, 'xref-suffix'));
    }
};

$end_element->{'link'} = sub {
    my ($elem, $sgmlspl) = @_;

    my $id = $elem->attribute('linkend');
    my $manref = $sgmlspl->{db_refs}->{"refentry:$id"};

    $xw->characters(get_user_str($elem, 'link-prefix'));

    if(defined $manref) {
	my ($title, $sect) = @$manref;
	if($docbook2man::options{'cite-numeral-only'}) {
	    $sect = $1 if ($sect =~ /([0-9]*)/);
	}
	$xw->startTag('fB');
	$xw->characters($title);
	$xw->endTag('fB');
	$xw->characters('(');
	$xw->characters($sect);
	$xw->characters(')');
    }

    else {
    	$sgmlspl->{db_unresolved_xrefs}++;
	$xw->characters($id);
    }
    
    $xw->characters(get_user_str($elem, 'link-suffix'));
};

# FIXME anchor ?


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

sub inline_bold_start { $xw->startTag('fB'); }
sub inline_bold_end { $xw->endTag('fB'); }
sub inline_italic_start { $xw->startTag('fI'); }
sub inline_italic_end { $xw->endTag('fI'); }

foreach my $gi (qw(
    application classname structname structfield symbol type
    envar function emphasis errorname command guibutton guiicon
    accel userinput systemitem))
{
    $start_element->{$gi} = \&inline_bold_start;
    $end_element->{$gi} = \&inline_bold_end;
}

foreach my $gi (qw(
    firstterm filename parameter property 
    citetitle foreignphrase lineannotation))
{
    $start_element->{$gi} = \&inline_italic_start;
    $end_element->{$gi} = \&inline_italic_end;
}

$start_element->{'option'} = sub {
    &inline_group_member_start;
    $xw->startTag('fB');
};
$end_element->{'option'} = \&inline_bold_end;

$start_element->{'replaceable'} = sub {
    &inline_group_member_start;
    $xw->startTag('fI');
};
$end_element->{'replaceable'} = \&inline_italic_end;


#
# Keycombo stuff
#
$start_element->{'keycombo'} = sub {
    my ($elem) = @_;
    $xw->startTag('fB');
    $elem->ext->{suppresswhitespace} = 1;
};
$end_element->{'keycombo'} = sub {
    $xw->endTag('fB');
};
sub inline_key_start {
    my ($elem) = @_;
    if($elem->in('keycombo')) {
	if($elem->parent->ext->{'contentseen'}++) {
	    $xw->characters(get_user_str($elem, 'keycombo-separator'));
	}
    }
    else {
	$xw->startTag('fB');
    }
}
sub inline_key_end { 
    my ($elem) = @_;
    if(!$elem->in('keycombo')) {
	$xw->endTag('fB'); 
    }
}

foreach my $gi (qw(keycap keysym mousebutton))
{
    $start_element->{$gi} = \&inline_key_start;
    $end_element->{$gi} = \&inline_key_end;
}

# FIXME get_user_str ?
$start_element->{'email'} = sub { $xw->characters('<'); };
$end_element->{'email'} = sub { $xw->characters('>'); };
$start_element->{'optional'} = sub { $xw->characters('['); };
$end_element->{'optional'} = sub { $xw->characters(']'); };

$start_element->{'quote'} =
    sub { my ($elem) = @_; $xw->characters(get_user_str($elem, 'quote-prefix')) };
$end_element->{'quote'} = 
    sub { my ($elem) = @_; $xw->characters(get_user_str($elem, 'quote-suffix')) };
$start_element->{'literal'} =
    sub { my ($elem) = @_; $xw->characters(get_user_str($elem, 'literal-prefix')) };
$end_element->{'literal'} = 
    sub { my ($elem) = @_; $xw->characters(get_user_str($elem, 'literal-suffix')) };

$start_element->{'trademark'} = sub { $xw->characters('TM') }; # FIXME trademark char 

$start_element->{'remark'} = $start_element->{'comment'} =
    sub { my ($elem) = @_; $xw->characters(get_user_str($elem, 'remark-prefix')) };
$end_element->{'remark'} = $end_element->{'remark'} =
    sub { my ($elem) = @_; $xw->characters(get_user_str($elem, 'remark-suffix')) };

$end_element->{'ulink'} = sub {
    my ($elem) = @_;
    $xw->characters(get_user_str($elem, 'ulink-prefix') .
	$elem->attribute('url') . get_user_str($elem, 'ulink-suffix'));
};

$start_element->{'citerefentry'} = sub {
    my ($elem) = @_;
    $elem->ext->{suppresswhitespace} = 1;
};

# FIXME the author, affiliation stuff



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

@docbook2man::title_elements = qw(
    example note warning tip caution important);

$start_element->{'title'} = sub {
    my ($elem, $sgmlspl) = @_;

    if($elem->in('refsect1')) {
        $xw->startTag('SH');
    }
    elsif($elem->in('refsect2')) {
        $xw->startTag('SS');
    }
    elsif($elem->in('refsect3')) {
	# pod2man does something like this
	$xw->startTag('para');
	$xw->startTag('fB');
    }

    elsif($elem->in('example') ||
	  $elem->in('note') || $elem->in('warning') || $elem->in('tip') ||
	  $elem->in('caution') || $elem->in('important')) {

	$elem->parent->ext->{'titleseen'}++;

	# Not really sectioning stuff, but we need to embolden the
	# title.
	$xw->startTag('para');
	$xw->startTag('fB');
    }

};
$end_element->{'title'} = sub {
    my ($elem, $sgmlspl) = @_;

    if($elem->in('refsect1')) {
        $xw->endTag('SH');
    }
    elsif($elem->in('refsect2')) {
        $xw->endTag('SS');
    }
    elsif($elem->in('refsect3')) {
	# pod2man does something like this
	$xw->endTag('fB');
	$xw->endTag('para');
    }
    
    elsif($elem->in('example') ||
	  $elem->in('note') || $elem->in('warning') || $elem->in('tip') ||
	  $elem->in('caution') || $elem->in('important')) {

	# Not really sectioning stuff, but we need to embolden the
	# title.
	$xw->endTag('fB');
	$xw->endTag('para');
    }
    
};

# FIXME abstract highlights figure address blockquote



##################################################
#
# Admonitions 
#
##################################################

sub admonition_start { $xw->startTag('RS'); }
sub admonition_end { $xw->endTag('RS'); }

foreach my $gi (qw(note warning tip caution important))
{
    $start_element->{$gi} = \&admonition_start;
    $end_element->{$gi} = \&admonition_end;
}

    
    

    

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

sub para_start { 
    my ($elem) = @_;

    # If this is a beginning of a 'block', we may have to
    # provide default titles (because we can't look ahead
    # when we encounter the sectioning element).
    my $par = $elem->parent->name;
    if($par eq 'note' || $par eq 'warning' || $par eq 'tip' ||
       $par eq 'caution' || $par eq 'important') {
       
	if(!$elem->parent->ext->{'titleseen'}) {
	    $xw->startTag('para');
	    $xw->startTag('fB');
	    $xw->characters(get_user_str($elem, "${par}-title"));
	    $xw->endTag('fB');
	    $xw->endTag('para');
	}
    }
    
    $xw->startTag('para'); 
}
sub para_end   { $xw->endTag('para'); }

$start_element->{'para'} = \&para_start;
$end_element->{'para'} = \&para_end;
$start_element->{'simpara'} = \&para_start;
$end_element->{'simpara'} = \&para_end;






##################################################
#
# Block elements
#
##################################################

sub verbatim_start
{
    $xw->startTag('verbatim');
}
sub verbatim_end
{
    $xw->endTag('verbatim');
}

foreach my $gi (qw(address literallayout programlisting
		screen synopsis))
{
    $start_element->{$gi} = \&verbatim_start;
    $end_element->{$gi} = \&verbatim_end;
}





##################################################
#
# Command synopsis
#
##################################################

$start_element->{'cmdsynopsis'} = \&para_start;
$end_element->{'cmdsynopsis'} = \&para_end;

# You know, it's kind of comforting that The Definitive Guide is
# saying reference pages are complex yet this code could do it
#
$start_element->{'arg'} = sub
{
    my ($elem) = @_;

    my $this; my $sepchar;
    for($this = $elem->parent; $this; $this = $this->parent)
    {
	$sepchar = $this->attribute('sepchar') and last;
    }
    if($sepchar eq '') { $sepchar = ' ' };

    $xw->characters($sepchar);
    
    if($elem->in('group')) {
	if($elem->parent->ext->{'args'}++) {
	    $xw->characters($sepchar . '|' . $sepchar);
	}
    }
    
    my $choice = $elem->attribute('choice');
    if($choice eq '' || $choice eq 'opt') {
        $xw->characters('[');
    } elsif($choice eq 'req') {
        $xw->characters('{');
    }
    
    $xw->startTag('fB');
};

$end_element->{'arg'} = sub {
    my ($elem) = @_;

    $xw->endTag('fB');

    my $choice = $elem->attribute('choice');
    my $rep = $elem->attribute('rep');
    if($choice eq '' || $choice eq 'opt') {
        $xw->characters(']');
    } elsif($choice eq 'req') {
        $xw->characters('}');
    }

    if($rep eq 'repeat') {
	# FIXME Use Unicode
	$xw->characters('...');
    }
};

$start_element->{'group'} = sub {
    my ($elem) = @_;

    my $choice = $elem->attribute('choice');
    if($choice eq '' || $choice =~ /^opt/) {
	$xw->characters('[');
    } elsif($choice =~ /^req/) {
	$xw->characters('{');
    }
};
				       
$end_element->{'group'} = sub {
    my ($elem) = @_;

    my $choice = $elem->attribute('choice');
    my $rep = $elem->attribute('rep');
    if($choice eq '' || $choice =~ /^opt/) {
	$xw->characters(']');
    } elsif($choice =~ /^req/) {
	$xw->characters('}');
    }
    
    if($choice =~ /mult$/ || $rep eq 'repeat') {
	# FIXME Use Unicode
	$xw->characters('...');
    }
};

# Used for replaceable and option, which can occur in group.
# We need to add the separators if there is more than one...
sub inline_group_member_start
{
    my ($elem) = @_;
    if($elem->in('group')) {
	my $this; my $sepchar;
	for($this = $elem->parent; $this; $this = $this->parent)
	{
	    $sepchar = $this->attribute('sepchar') and last;
	}
	if($sepchar eq '') { $sepchar = ' ' };
	
	if($elem->parent->ext->{'argseen'}++) {
	    $xw->characters($sepchar . '|' . $sepchar);
	}
    } 
}

$start_element->{'sbr'} = sub { $xw->emptyTag('sp'); };
    





##################################################
#
# Func synopsis
#
##################################################

$start_element->{'funcsynopsis'} = \&para_start;
$end_element->{'funcsynopsis'} = \&para_end;
$start_element->{'funcsynopsisinfo'} = \&verbatim_start;
$end_element->{'funcsynopsisinfo'} = \&verbatim_end;

$start_element->{'funcprototype'} = sub {
    my ($elem) = @_;
    if($elem->parent->ext->{'funcprototypes'}++) {
	$xw->emptyTag('sp');
    }
};
$end_element->{'funcprototype'} = sub {
    my ($elem) = @_;
    if($elem->ext->{'paramdefs'}) {
	$xw->characters(');');
    }
};

$start_element->{'paramdef'} = sub {
    my ($elem) = @_;
    if($elem->parent->ext->{'paramdefs'}++) {
	# FIXME customizable in get_user_str?
	$xw->characters(', ');
    } else {
	# Beginning of C-style function arguments.
	# Closed at /funcprototype
	$xw->characters('(');
    }
};
$start_element->{'void'} = sub {
    $xw->characters('(void);');
};




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

sub list_start
{
    my ($elem, $sgmlspl) = @_;
    if($sgmlspl->{db_list_level}++) {
	$xw->startTag('RS');
    }
}
sub list_end
{
    my ($elem, $sgmlspl) = @_;
    if(--$sgmlspl->{db_list_level}) {
	$xw->endTag('RS');
    }
}

for my $gi (qw(glosslist itemizedlist orderedlist 
		segmentedlist variablelist))
{
    $start_element->{$gi} = \&list_start;
    $end_element->{$gi} = \&list_end;
}

$start_element->{'varlistentry'} = sub {
    $xw->startTag('TPentry');
};
$end_element->{'varlistentry'} = sub {
    $xw->endTag('TPentry');
};

$start_element->{'term'} = sub {
    $xw->startTag('TP');
};
$end_element->{'term'} = sub {
    $xw->endTag('TP');
};

$start_element->{'listitem'} = sub {
    my ($elem) = @_;

    if($elem->in('itemizedlist')) {
	$xw->startTag('TPentry');
	$xw->startTag('TP');

	my $mark = $elem->attribute('override') ||
		    $elem->parent->attribute('mark') ||
		    'bullet';

	$xw->characters(get_listitem_mark($mark));

	$xw->endTag('TP');
    }

    elsif($elem->in('orderedlist')) {
	$xw->startTag('TPentry');
	$xw->startTag('TP');

	$xw->characters(
	    get_numeration(
		($elem->parent->attribute('numeration') || 'arabic'),
		++$elem->parent->ext->{'sequence'}));

	$xw->endTag('TP');
    }
};
   
$end_element->{'listitem'} = sub {
    my ($elem) = @_;
    if($elem->in('itemizedlist') || $elem->in('orderedlist')) {
	$xw->endTag('TPentry');
    }
};

$start_element->{'simplelist'} = sub {
    my ($elem, $sgmlspl) = @_;
    if($elem->attribute('type') ne 'inline') {
	my $cols = $elem->attribute('columns') || 1;
	if($cols > 1) {
	    node_warn($sgmlspl, $elem, "Multiple columns in simplelist not supported\n");
	}
	&list_start;
    }
    else {
	$elem->ext->{suppresswhitespace} = 1;
    }
};

$end_element->{'simplelist'} = sub {
    my ($elem) = @_;
    if($elem->attribute('type') ne 'inline') {
	&list_end;
    }
};

$start_element->{'member'} = sub {
    my ($elem) = @_;
    if($elem->parent->attribute('type') eq 'inline') {
	# Stop stripping whitespace
	$elem->parent->ext->{outputmode} = undef;

	if($elem->parent->ext->{'members'}++) {
            $xw->characters(get_user_str($elem, 'member-separator'));
	}
    }
    else {
	$xw->startTag('para');
    }
};

$end_element->{'member'} = sub {
    my ($elem) = @_;
    if($elem->parent->attribute('type') ne 'inline') {
	$xw->endTag('para');
    }
};


##################################################
#
# Procedure lists (if anyone uses these...) 
#
##################################################

# FIXME also glosslist, seglist, table, graphics, messages
	


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

sub manpage_characters {
    my ($s, $elem, $sgmlspl) = @_;

    if($elem->ext->{'suppresswhitespace'}) { 
	node_warn($sgmlspl, $elem, "Non-whitespace characters not expected\n")
	    if $s =~ /[^\s]/;
	return;
    }

    # More outputsave crap (see texi_xml/man_xml for details)
    for (my $this = $elem; $this; $this = $this->parent) {
	if($this->ext->{'outputmode'} eq 'save') {
	    $this->ext->{'outputsave'} .= $s;
	    last;
	}
    }

    if($docbook2man::options{'uppercase-headings'} 
	and $elem->name eq 'title'
	and ($elem->in('refsect1') ||
	    $elem->in('refsect2') ||
	    $elem->in('refsect3')))
    {
          $s = uc($s);
    }

    $xw->characters($s);
};

##################################################
#
# Main
#
##################################################

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

$xw->startTag('manpageset');

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

$xw->endTag('manpageset');
$xw->end();

open(REFS, '> ' . $docbook2man::options{'refs-file'})
    or die("$0: cannot write to refs-file: $!");
print REFS Dumper($sgmlspl->{db_refs});
close(REFS);

if($sgmlspl->{db_unresolved_xrefs}) {
    print STDERR "$0: Some cross-references are unresolved.\n";
    exit 2;
}

