gcc/contrib/texi2pod.pl

233 lines
4.6 KiB
Perl
Raw Normal View History

#! /usr/bin/perl -w
# This does trivial (and I mean _trivial_) conversion of Texinfo
# markup to Perl POD format. It's intended to be used to extract
# something suitable for a manpage from a Texinfo document.
$output = 0;
$ignore = 0;
$skipping = 0;
%sects = ();
$section = "";
@icstack = ();
@endwstack = ();
@skstack = ();
$shift = "";
%defs = ();
while($_ = shift)
{
if (/^-D(.*)$/) {
if ($1 ne "") {
$flag = $1;
} else {
$flag = shift;
}
die "no flag specified for -D\n"
unless $flag ne "";
die "flags may only contain letters, digits, hyphens, and underscores\n"
unless $flag =~ /^[a-zA-Z0-9_-]+$/;
$defs{$flag} = "";
} elsif (/^-/) {
usage();
} else {
$in = $_, next unless defined $in;
$out = $_, next unless defined $out;
usage();
}
}
if (defined $in) {
open(STDIN, $in) or die "opening \"$in\": $!\n";
}
if (defined $out) {
open(STDOUT, ">$out") or die "opening \"$out\": $!\n";
}
while(<STDIN>)
{
chomp;
/^\@c man begin ([A-Z]+)/ and $sect = $1, $output = 1, next;
/^\@c man end/ and do {
$_ = $section;
s/\@(?:dfn|var|emph|cite)\{([^\}]*)\}/I<$1>/g;
s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
s/\@(?:samp|strong|key)\{([^\}]*)\}/B<$1>/g;
s/\@value\{([a-zA-Z0-9_-]+)\}/$defs{$1}/g;
s/\@sc\{([^\}]*)\}/\U$1/g;
s/\@file\{([^\}]*)\}/F<$1>/g;
s/\@(?:url|email)\{([^\}]*)\}/E<lt>C<$1>E<rt>/g;
s/\@xref\{(?:[^\}]*)\}[^.]*.//g;
s/\s+\(\@p[a-z]?ref\{(?:[^\}]*)\}\)//g;
s/\@copyright\{\}//g;
s/\@noindent\s*//g;
s/\@refill//g;
s/\@\././g;
# Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to
# match Texinfo semantics of @emph inside @samp.
s/&LT;/</g;
s/&GT;/>/g;
1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g);
1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g);
s/[BI]<>//g;
s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
s/&lt;/E<lt>/g;
s/&gt;/E<gt>/g;
s/&lbrace;/\{/g;
s/&rbrace;/\}/g;
$sects{$sect} = $_;
$section = "";
$output = 0;
next;
};
/^\@(c|[a-z]+index)\b/ and next;
/^\@subsection/ and next;
/^\@need/ and next;
/^\@node/ and next;
/^\@setfilename\s+([^.]+)/ and $fn = $1, next;
/^\@settitle\s+([^.]+)/ and $tl = $1, next;
next unless $output;
/^\@end\s+([a-z]+)/ and do {
if(defined $endw)
{
die "\@$endw ended by \@end $1 at line $.\n"
unless $1 eq $endw;
if($endw =~ /example$/)
{
$shift = "";
$_ = "";
}
elsif($endw =~ /^if/)
{
$skipping = pop @skstack;
$_ = "";
}
else
{
$_ = "\n=back\n";
$ic = pop @icstack;
}
$endw = pop @endwstack;
}
};
/^\@end ignore/ and $ignore = 0, next;
next if $ignore;
next if $skipping;
/^\@ignore/ and $ignore = 1, next;
/^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and $defs{$1} = $2, next;
/^\@clear\s+([a-zA-Z0-9_-]+)/ and delete $defs{$1}, next;
/^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
push @endwstack, $endw;
push @skstack, $skipping;
$endw = "ifset";
$skipping = 1 unless exists $defs{$1};
};
/^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
push @endwstack, $endw;
push @skstack, $skipping;
$endw = "ifset";
$skipping = 1 if exists $defs{$1};
};
/^\@itemize (\@[a-z]+)/ and do {
push @endwstack, $endw;
push @icstack, $ic;
$ic = $1;
$ic =~ s/\@bullet/*/;
$ic =~ s/\@minus/-/;
$_ = "\n=over 4\n";
$endw = "itemize";
};
/^\@enumerate\s+([A-Z0-9]+)/ and do {
push @endwstack, $endw;
push @icstack, $ic;
$ic = $1 . ".";
$_ = "\n=over 4\n";
$endw = "enumerate";
};
/^\@table\s+(\@[a-z]+)/ and do {
push @endwstack, $endw;
push @icstack, $ic;
$ic = $1;
$ic =~ s/\@(?:samp|strong|key)/B/;
$ic =~ s/\@(?:code|kbd)/C/;
$ic =~ s/\@(?:dfn|var|emph|cite)/I/;
$ic =~ s/\@(?:file)/F/;
$_ = "\n=over 4\n";
$endw = "table";
};
/^\@((?:small)?example)/ and do {
push @endwstack, $endw;
$endw = $1;
$shift = "\t";
next;
};
/^\@itemx?\s*(.+)?$/ and do {
if(defined $1)
{
$_ = "=item $ic\&LT;$1\&GT;\n";
}
else
{
$_ = "=item $ic\n";
$ic =~ y/A-Ya-y1-8/B-Zb-z2-9/;
}
};
/^\@section\s+(.+)$/ and do {
$_ = "\n=head2 $1\n";
};
# POD doesn't interpret E<> inside a verbatim block.
if ($shift eq "") {
s/</&lt;/g;
s/>/&gt;/g;
} else {
s/</&LT;/g;
s/>/&GT;/g;
}
s/\@\{/&lbrace;/g;
s/\@\}/&rbrace;/g;
$section .= $shift.$_."\n";
}
$sects{NAME} = "$fn \- $tl\n";
for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
BUGS NOTES SEEALSO AUTHOR COPYRIGHT))
{
if(exists $sects{$sect})
{
$head = $sect;
$head =~ s/SEEALSO/SEE ALSO/;
print "=head1 $head\n\n";
print $sects{$sect};
print "\n";
}
}
sub usage
{
die "usage: $0 [-D toggle...] [infile [outfile]]\n";
}