#! @PERL@
#
# Generate a man page from sections of a Texinfo manual.
#
# Copyright 2004 The Free Software Foundation,
# Derek R. Price,
# & Ximbiot <http://ximbiot.com>
#
# 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.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# Need Perl 5.005 or greater for re 'eval'.
require 5.005;
# The usual.
use strict;
use IO::File;
###
### GLOBALS
###
my $texi_num = 0; # Keep track of how many texinfo files have been encountered.
my @parent; # This needs to be global to be used inside of a regex later.
my $nk; # Ditto.
my $ret; # The RE match Type, used in debug prints.
my $debug = 0; # Debug mode?
###
### FUNCTIONS
###
sub debug_print
{
print @_ if $debug;
}
sub keyword_mode
{
my ($keyword, $file) = @_;
return "\\fR"
if $keyword =~ /^(|r|t)$/;
return "\\fB"
if $keyword =~ /^(strong|sc|code|file|samp)$/;
return "\\fI"
if $keyword =~ /^(emph|var|dfn)$/;
die "no handler for keyword \`$keyword', found at line $. of file \`$file'\n";
}
# Return replacement for \@$keyword{$content}.
sub do_keyword
{
my ($file, $parent, $keyword, $content) = @_;
return "see node \`$content\\(aq in the CVS manual"
if $keyword =~ /^(p?x)?ref$/;
return "\\fP\\fP$content"
if $keyword =~ /^splitrcskeyword$/;
my $endmode = keyword_mode $parent;
my $startmode = keyword_mode $keyword, $file;
return "$startmode$content$endmode";
}
###
### MAIN
###
for my $file (@ARGV)
{
my $fh = new IO::File "< $file"
or die "Failed to open file \`$file': $!";
if ($file !~ /\.(texinfo|texi|txi)$/)
{
print stderr "Passing \`$file' through unprocessed.\n";
# Just cat any file that doesn't look like a Texinfo source.
while (my $line = $fh->getline)
{
print $line;
}
next;
}
print stderr "Processing \`$file'.\n";
$texi_num++;
my $gotone = 0;
my $inblank = 0;
my $indent = 0;
my $inexample = 0;
my $inmenu = 0;
my $intable = 0;
my $last_header = "";
my @table_headers;
my @table_footers;
my $table_header = "";
my $table_footer = "";
my $last;
while ($_ = $fh->getline)
{
if (!$gotone && /^\@c ----- START MAN $texi_num -----$/)
{
$gotone = 1;
next;
}
# Skip ahead until our man section.
next unless $gotone;
# If we find the end tag we are done.
last if /^\@c ----- END MAN $texi_num -----$/;
# Need to do this everywhere. i.e., before we print example
# lines, since literal back slashes can appear there too.
s/\\/\\\\/g;
s/^\./\\&./;
s/([\s])\./$1\\&./;
s/'/\\(aq/g;
s/`/\\`/g;
s/(?<!-)---(?!-)/\\(em/g;
s/\@bullet({}|\b)/\\(bu/g;
s/\@dots({}|\b)/\\&.../g;
# Examples should be indented and otherwise untouched
if (/^\@example$/)
{
$indent += 2;
print qq{.SP\n.PD 0\n};
$inexample = 1;
next;
}
if ($inexample)
{
if (/^\@end example$/)
{
$indent -= 2;
print qq{\n.PD\n.IP "" $indent\n};
$inexample = 0;
next;
}
if (/^[ ]*$/)
{
print ".SP\n";
next;
}
# Preserve the newline.
$_ = qq{.IP "" $indent\n} . $_;
}
# Compress blank lines into a single line. This and its
# corresponding skip purposely bracket the @menu and comment
# removal so that blanks on either side of a menu are
# compressed after the menu is removed.
if (/^[ ]*$/)
{
$inblank = 1;
next;
}
# Not used
if (/^\@(ignore|menu)$/)
{
$inmenu++;
next;
}
# Delete menu contents.
if ($inmenu)
{
next unless /^\@end (ignore|menu)$/;
$inmenu--;
next;
}
# Remove comments
next if /^\@c(omment)?\b/;
# Ignore includes.
next if /^\@include\b/;
# It's okay to ignore this keyword - we're not using any
# first-line indent commands at all.
next if s/^\@noindent\s*$//;
# @need is only significant in printed manuals.
next if s/^\@need\s+.*$//;
# If we didn't hit the previous check and $inblank is set, then
# we just finished with some number of blanks. Print the man
# page blank symbol before continuing processing of this line.
if ($inblank)
{
print ".SP\n";
$inblank = 0;
}
# Chapter headers.
$last_header = $1 if s/^\@node\s+(.*)$/.SH "$1"/;
if (/^\@appendix\w*\s+(.*)$/)
{
my $content = $1;
$content =~ s/^$last_header(\\\(em|\s+)?//;
next if $content =~ /^\s*$/;
s/^\@appendix\w*\s+.*$/.SS "$content"/;
}
# Tables are similar to examples, except we need to handle the
# keywords.
if (/^\@(itemize|table)(\s+(.*))?$/)
{
$indent += 2;
push @table_headers, $table_header;
push @table_footers, $table_footer;
my $content = $3;
if (/^\@itemize/)
{
my $bullet = $content;
$table_header = qq{.IP "$bullet" $indent\n};
$table_footer = "";
}
else
{
my $hi = $indent - 2;
$table_header = qq{.IP "" $hi\n};
$table_footer = qq{\n.IP "" $indent};
if ($content)
{
$table_header .= "$content\{";
$table_footer = "\}$table_footer";
}
}
$intable++;
next;
}
if ($intable)
{
if (/^\@end (itemize|table)$/)
{
$table_header = pop @table_headers;
$table_footer = pop @table_footers;
$indent -= 2;
$intable--;
next;
}
s/^\@itemx?(\s+(.*))?$/$table_header$2$table_footer/;
# Fall through so the rest of the table lines are
# processed normally.
}
# Index entries.
s/^\@cindex\s+(.*)$/.IX "$1"/;
$_ = "$last$_" if $last;
undef $last;
# Trap keywords
$nk = qr/
\@(\w+)\{
(?{ debug_print "$ret MATCHED $&\nPUSHING $1\n";
push @parent, $1; }) # Keep track of the last keyword
# keyword we encountered.
((?>
[^{}]|(?<=\@)[{}] # Non-braces...
| # ...or...
(??{ $nk }) # ...nested keywords...
)*) # ...without backtracking.
\}
(?{ debug_print "$ret MATCHED $&\nPOPPING ",
pop (@parent), "\n"; }) # Lose track of the current keyword.
/x;
$ret = "m//";
if (/\@\w+\{(?:[^{}]|(?<=\@)[{}]|(??{ $nk }))*$/)
{
# If there is an opening keyword on this line without a
# close bracket, we need to find the close bracket
# before processing the line. Set $last to append the
# next line in the next pass.
$last = $_;
next;
}
# Okay, the following works somewhat counter-intuitively. $nk
# processes the whole line, so @parent gets loaded properly,
# then, since no closing brackets have been found for the
# outermost matches, the innermost matches match and get
# replaced first.
#
# For example:
#
# Processing the line:
#
# yadda yadda @code{yadda @var{foo} yadda @var{bar} yadda}
#
# Happens something like this:
#
# 1. Ignores "yadda yadda "
# 2. Sees "@code{" and pushes "code" onto @parent.
# 3. Ignores "yadda " (backtracks and ignores "yadda yadda
# @code{yadda "?)
# 4. Sees "@var{" and pushes "var" onto @parent.
# 5. Sees "foo}", pops "var", and realizes that "@var{foo}"
# matches the overall pattern ($nk).
# 6. Replaces "@var{foo}" with the result of:
#
# do_keyword $file, $parent[$#parent], $1, $2;
#
# which would be "\Ifoo\B", in this case, because "var"
# signals a request for italics, or "\I", and "code" is
# still on the stack, which means the previous style was
# bold, or "\B".
#
# Then the while loop restarts and a similar series of events
# replaces "@var{bar}" with "\Ibar\B".
#
# Then the while loop restarts and a similar series of events
# replaces "@code{yadda \Ifoo\B yadda \Ibar\B yadda}" with
# "\Byadda \Ifoo\B yadda \Ibar\B yadda\R".
#
$ret = "s///";
@parent = ("");
while (s/$nk/do_keyword $file, $parent[$#parent], $1, $2/e)
{
# Do nothing except reset our last-replacement
# tracker - the replacement regex above is handling
# everything else.
debug_print "FINAL MATCH $&\n";
@parent = ("");
}
# Finally, unprotect texinfo special characters.
s/\@://g;
s/\@([{}])/$1/g;
# Verify we haven't left commands unprocessed.
die "Unprocessed command at line $. of file \`$file': "
. ($1 ? "$1\n" : "<EOL>\n")
if /^(?>(?:[^\@]|\@\@)*)\@(\w+|.|$)/;
# Unprotect @@.
s/\@\@/\@/g;
# And print whatever's left.
print $_;
}
}