File:  [Qemu by Fabrice Bellard] / qemu / texi2pod.pl
Revision 1.1.1.3 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 16:50:57 2018 UTC (2 years, 4 months ago) by root
Branches: qemu, MAIN
CVS tags: qemu0105, qemu0104, qemu0103, qemu0102, qemu0101, qemu0100, HEAD
qemu 0.10.0

    1: #! /usr/bin/perl -w
    2: 
    3: #   Copyright (C) 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
    4: 
    5: # This file is part of GCC.
    6: 
    7: # GCC is free software; you can redistribute it and/or modify
    8: # it under the terms of the GNU General Public License as published by
    9: # the Free Software Foundation; either version 2, or (at your option)
   10: # any later version.
   11: 
   12: # GCC is distributed in the hope that it will be useful,
   13: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: # GNU General Public License for more details.
   16: 
   17: # You should have received a copy of the GNU General Public License
   18: # along with GCC; see the file COPYING.  If not, write to
   19: # the Free Software Foundation, 51 Franklin Street, Fifth Floor,
   20: # Boston MA 02110-1301, USA.
   21: 
   22: # This does trivial (and I mean _trivial_) conversion of Texinfo
   23: # markup to Perl POD format.  It's intended to be used to extract
   24: # something suitable for a manpage from a Texinfo document.
   25: 
   26: $output = 0;
   27: $skipping = 0;
   28: %sects = ();
   29: $section = "";
   30: @icstack = ();
   31: @endwstack = ();
   32: @skstack = ();
   33: @instack = ();
   34: $shift = "";
   35: %defs = ();
   36: $fnno = 1;
   37: $inf = "";
   38: $ibase = "";
   39: @ipath = ();
   40: 
   41: while ($_ = shift) {
   42:     if (/^-D(.*)$/) {
   43: 	if ($1 ne "") {
   44: 	    $flag = $1;
   45: 	} else {
   46: 	    $flag = shift;
   47: 	}
   48: 	$value = "";
   49: 	($flag, $value) = ($flag =~ /^([^=]+)(?:=(.+))?/);
   50: 	die "no flag specified for -D\n"
   51: 	    unless $flag ne "";
   52: 	die "flags may only contain letters, digits, hyphens, dashes and underscores\n"
   53: 	    unless $flag =~ /^[a-zA-Z0-9_-]+$/;
   54: 	$defs{$flag} = $value;
   55:     } elsif (/^-I(.*)$/) {
   56: 	if ($1 ne "") {
   57: 	    $flag = $1;
   58: 	} else {
   59: 	    $flag = shift;
   60: 	}
   61:         push (@ipath, $flag);
   62:     } elsif (/^-/) {
   63: 	usage();
   64:     } else {
   65: 	$in = $_, next unless defined $in;
   66: 	$out = $_, next unless defined $out;
   67: 	usage();
   68:     }
   69: }
   70: 
   71: if (defined $in) {
   72:     $inf = gensym();
   73:     open($inf, "<$in") or die "opening \"$in\": $!\n";
   74:     $ibase = $1 if $in =~ m|^(.+)/[^/]+$|;
   75: } else {
   76:     $inf = \*STDIN;
   77: }
   78: 
   79: if (defined $out) {
   80:     open(STDOUT, ">$out") or die "opening \"$out\": $!\n";
   81: }
   82: 
   83: while(defined $inf) {
   84: while(<$inf>) {
   85:     # Certain commands are discarded without further processing.
   86:     /^\@(?:
   87: 	 [a-z]+index		# @*index: useful only in complete manual
   88: 	 |need			# @need: useful only in printed manual
   89: 	 |(?:end\s+)?group	# @group .. @end group: ditto
   90: 	 |page			# @page: ditto
   91: 	 |node			# @node: useful only in .info file
   92: 	 |(?:end\s+)?ifnottex   # @ifnottex .. @end ifnottex: use contents
   93: 	)\b/x and next;
   94: 
   95:     chomp;
   96: 
   97:     # Look for filename and title markers.
   98:     /^\@setfilename\s+([^.]+)/ and $fn = $1, next;
   99:     /^\@settitle\s+([^.]+)/ and $tl = postprocess($1), next;
  100: 
  101:     # Identify a man title but keep only the one we are interested in.
  102:     /^\@c\s+man\s+title\s+([A-Za-z0-9-]+)\s+(.+)/ and do {
  103: 	if (exists $defs{$1}) {
  104: 	    $fn = $1;
  105: 	    $tl = postprocess($2);
  106: 	}
  107: 	next;
  108:     };
  109: 
  110:     # Look for blocks surrounded by @c man begin SECTION ... @c man end.
  111:     # This really oughta be @ifman ... @end ifman and the like, but such
  112:     # would require rev'ing all other Texinfo translators.
  113:     /^\@c\s+man\s+begin\s+([A-Z]+)\s+([A-Za-z0-9-]+)/ and do {
  114: 	$output = 1 if exists $defs{$2};
  115:         $sect = $1;
  116: 	next;
  117:     };
  118:     /^\@c\s+man\s+begin\s+([A-Z]+)/ and $sect = $1, $output = 1, next;
  119:     /^\@c\s+man\s+end/ and do {
  120: 	$sects{$sect} = "" unless exists $sects{$sect};
  121: 	$sects{$sect} .= postprocess($section);
  122: 	$section = "";
  123: 	$output = 0;
  124: 	next;
  125:     };
  126: 
  127:     # handle variables
  128:     /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and do {
  129: 	$defs{$1} = $2;
  130: 	next;
  131:     };
  132:     /^\@clear\s+([a-zA-Z0-9_-]+)/ and do {
  133: 	delete $defs{$1};
  134: 	next;
  135:     };
  136: 
  137:     next unless $output;
  138: 
  139:     # Discard comments.  (Can't do it above, because then we'd never see
  140:     # @c man lines.)
  141:     /^\@c\b/ and next;
  142: 
  143:     # End-block handler goes up here because it needs to operate even
  144:     # if we are skipping.
  145:     /^\@end\s+([a-z]+)/ and do {
  146: 	# Ignore @end foo, where foo is not an operation which may
  147: 	# cause us to skip, if we are presently skipping.
  148: 	my $ended = $1;
  149: 	next if $skipping && $ended !~ /^(?:ifset|ifclear|ignore|menu|iftex|copying)$/;
  150: 
  151: 	die "\@end $ended without \@$ended at line $.\n" unless defined $endw;
  152: 	die "\@$endw ended by \@end $ended at line $.\n" unless $ended eq $endw;
  153: 
  154: 	$endw = pop @endwstack;
  155: 
  156: 	if ($ended =~ /^(?:ifset|ifclear|ignore|menu|iftex)$/) {
  157: 	    $skipping = pop @skstack;
  158: 	    next;
  159: 	} elsif ($ended =~ /^(?:example|smallexample|display)$/) {
  160: 	    $shift = "";
  161: 	    $_ = "";	# need a paragraph break
  162: 	} elsif ($ended =~ /^(?:itemize|enumerate|[fv]?table)$/) {
  163: 	    $_ = "\n=back\n";
  164: 	    $ic = pop @icstack;
  165: 	} elsif ($ended eq "multitable") {
  166: 	    $_ = "\n=back\n";
  167: 	} else {
  168: 	    die "unknown command \@end $ended at line $.\n";
  169: 	}
  170:     };
  171: 
  172:     # We must handle commands which can cause skipping even while we
  173:     # are skipping, otherwise we will not process nested conditionals
  174:     # correctly.
  175:     /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
  176: 	push @endwstack, $endw;
  177: 	push @skstack, $skipping;
  178: 	$endw = "ifset";
  179: 	$skipping = 1 unless exists $defs{$1};
  180: 	next;
  181:     };
  182: 
  183:     /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
  184: 	push @endwstack, $endw;
  185: 	push @skstack, $skipping;
  186: 	$endw = "ifclear";
  187: 	$skipping = 1 if exists $defs{$1};
  188: 	next;
  189:     };
  190: 
  191:     /^\@(ignore|menu|iftex|copying)\b/ and do {
  192: 	push @endwstack, $endw;
  193: 	push @skstack, $skipping;
  194: 	$endw = $1;
  195: 	$skipping = 1;
  196: 	next;
  197:     };
  198: 
  199:     next if $skipping;
  200: 
  201:     # Character entities.  First the ones that can be replaced by raw text
  202:     # or discarded outright:
  203:     s/\@copyright\{\}/(c)/g;
  204:     s/\@dots\{\}/.../g;
  205:     s/\@enddots\{\}/..../g;
  206:     s/\@([.!? ])/$1/g;
  207:     s/\@[:-]//g;
  208:     s/\@bullet(?:\{\})?/*/g;
  209:     s/\@TeX\{\}/TeX/g;
  210:     s/\@pounds\{\}/\#/g;
  211:     s/\@minus(?:\{\})?/-/g;
  212:     s/\\,/,/g;
  213: 
  214:     # Now the ones that have to be replaced by special escapes
  215:     # (which will be turned back into text by unmunge())
  216:     s/&/&amp;/g;
  217:     s/\@\{/&lbrace;/g;
  218:     s/\@\}/&rbrace;/g;
  219:     s/\@\@/&at;/g;
  220: 
  221:     # Inside a verbatim block, handle @var specially.
  222:     if ($shift ne "") {
  223: 	s/\@var\{([^\}]*)\}/<$1>/g;
  224:     }
  225: 
  226:     # POD doesn't interpret E<> inside a verbatim block.
  227:     if ($shift eq "") {
  228: 	s/</&lt;/g;
  229: 	s/>/&gt;/g;
  230:     } else {
  231: 	s/</&LT;/g;
  232: 	s/>/&GT;/g;
  233:     }
  234: 
  235:     # Single line command handlers.
  236: 
  237:     /^\@include\s+(.+)$/ and do {
  238: 	push @instack, $inf;
  239: 	$inf = gensym();
  240: 	$file = postprocess($1);
  241: 
  242: 	# Try cwd and $ibase, then explicit -I paths.
  243: 	$done = 0;
  244: 	foreach $path ("", $ibase, @ipath) {
  245: 	    $mypath = $file;
  246: 	    $mypath = $path . "/" . $mypath if ($path ne "");
  247: 	    open($inf, "<" . $mypath) and ($done = 1, last);
  248: 	}
  249: 	die "cannot find $file" if !$done;
  250: 	next;
  251:     };
  252: 
  253:     /^\@(?:section|unnumbered|unnumberedsec|center)\s+(.+)$/
  254: 	and $_ = "\n=head2 $1\n";
  255:     /^\@subsection\s+(.+)$/
  256: 	and $_ = "\n=head3 $1\n";
  257:     /^\@subsubsection\s+(.+)$/
  258: 	and $_ = "\n=head4 $1\n";
  259: 
  260:     # Block command handlers:
  261:     /^\@itemize(?:\s+(\@[a-z]+|\*|-))?/ and do {
  262: 	push @endwstack, $endw;
  263: 	push @icstack, $ic;
  264: 	if (defined $1) {
  265: 	    $ic = $1;
  266: 	} else {
  267: 	    $ic = '*';
  268: 	}
  269: 	$_ = "\n=over 4\n";
  270: 	$endw = "itemize";
  271:     };
  272: 
  273:     /^\@enumerate(?:\s+([a-zA-Z0-9]+))?/ and do {
  274: 	push @endwstack, $endw;
  275: 	push @icstack, $ic;
  276: 	if (defined $1) {
  277: 	    $ic = $1 . ".";
  278: 	} else {
  279: 	    $ic = "1.";
  280: 	}
  281: 	$_ = "\n=over 4\n";
  282: 	$endw = "enumerate";
  283:     };
  284: 
  285:     /^\@multitable\s.*/ and do {
  286: 	push @endwstack, $endw;
  287: 	$endw = "multitable";
  288: 	$_ = "\n=over 4\n";
  289:     };
  290: 
  291:     /^\@([fv]?table)\s+(\@[a-z]+)/ and do {
  292: 	push @endwstack, $endw;
  293: 	push @icstack, $ic;
  294: 	$endw = $1;
  295: 	$ic = $2;
  296: 	$ic =~ s/\@(?:samp|strong|key|gcctabopt|option|env)/B/;
  297: 	$ic =~ s/\@(?:code|kbd)/C/;
  298: 	$ic =~ s/\@(?:dfn|var|emph|cite|i)/I/;
  299: 	$ic =~ s/\@(?:file)/F/;
  300: 	$_ = "\n=over 4\n";
  301:     };
  302: 
  303:     /^\@((?:small)?example|display)/ and do {
  304: 	push @endwstack, $endw;
  305: 	$endw = $1;
  306: 	$shift = "\t";
  307: 	$_ = "";	# need a paragraph break
  308:     };
  309: 
  310:     /^\@item\s+(.*\S)\s*$/ and $endw eq "multitable" and do {
  311: 	@columns = ();
  312: 	for $column (split (/\s*\@tab\s*/, $1)) {
  313: 	    # @strong{...} is used a @headitem work-alike
  314: 	    $column =~ s/^\@strong{(.*)}$/$1/;
  315: 	    push @columns, $column;
  316: 	}
  317: 	$_ = "\n=item ".join (" : ", @columns)."\n";
  318:     };
  319: 
  320:     /^\@itemx?\s*(.+)?$/ and do {
  321: 	if (defined $1) {
  322: 	    # Entity escapes prevent munging by the <> processing below.
  323: 	    $_ = "\n=item $ic\&LT;$1\&GT;\n";
  324: 	} else {
  325: 	    $_ = "\n=item $ic\n";
  326: 	    $ic =~ y/A-Ya-y/B-Zb-z/;
  327: 	    $ic =~ s/(\d+)/$1 + 1/eg;
  328: 	}
  329:     };
  330: 
  331:     $section .= $shift.$_."\n";
  332: }
  333: # End of current file.
  334: close($inf);
  335: $inf = pop @instack;
  336: }
  337: 
  338: die "No filename or title\n" unless defined $fn && defined $tl;
  339: 
  340: $sects{NAME} = "$fn \- $tl\n";
  341: $sects{FOOTNOTES} .= "=back\n" if exists $sects{FOOTNOTES};
  342: 
  343: for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
  344: 	      BUGS NOTES FOOTNOTES SEEALSO AUTHOR COPYRIGHT)) {
  345:     if(exists $sects{$sect}) {
  346: 	$head = $sect;
  347: 	$head =~ s/SEEALSO/SEE ALSO/;
  348: 	print "=head1 $head\n\n";
  349: 	print scalar unmunge ($sects{$sect});
  350: 	print "\n";
  351:     }
  352: }
  353: 
  354: sub usage
  355: {
  356:     die "usage: $0 [-D toggle...] [infile [outfile]]\n";
  357: }
  358: 
  359: sub postprocess
  360: {
  361:     local $_ = $_[0];
  362: 
  363:     # @value{foo} is replaced by whatever 'foo' is defined as.
  364:     while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) {
  365: 	if (! exists $defs{$2}) {
  366: 	    print STDERR "Option $2 not defined\n";
  367: 	    s/\Q$1\E//;
  368: 	} else {
  369: 	    $value = $defs{$2};
  370: 	    s/\Q$1\E/$value/;
  371: 	}
  372:     }
  373: 
  374:     # Formatting commands.
  375:     # Temporary escape for @r.
  376:     s/\@r\{([^\}]*)\}/R<$1>/g;
  377:     s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g;
  378:     s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
  379:     s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g;
  380:     s/\@sc\{([^\}]*)\}/\U$1/g;
  381:     s/\@file\{([^\}]*)\}/F<$1>/g;
  382:     s/\@w\{([^\}]*)\}/S<$1>/g;
  383:     s/\@(?:dmn|math)\{([^\}]*)\}/$1/g;
  384: 
  385:     # keep references of the form @ref{...}, print them bold
  386:     s/\@(?:ref)\{([^\}]*)\}/B<$1>/g;
  387: 
  388:     # Change double single quotes to double quotes.
  389:     s/''/"/g;
  390:     s/``/"/g;
  391: 
  392:     # Cross references are thrown away, as are @noindent and @refill.
  393:     # (@noindent is impossible in .pod, and @refill is unnecessary.)
  394:     # @* is also impossible in .pod; we discard it and any newline that
  395:     # follows it.  Similarly, our macro @gol must be discarded.
  396: 
  397:     s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g;
  398:     s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g;
  399:     s/;\s+\@pxref\{(?:[^\}]*)\}//g;
  400:     s/\@noindent\s*//g;
  401:     s/\@refill//g;
  402:     s/\@gol//g;
  403:     s/\@\*\s*\n?//g;
  404: 
  405:     # Anchors are thrown away
  406:     s/\@anchor\{(?:[^\}]*)\}//g;
  407: 
  408:     # @uref can take one, two, or three arguments, with different
  409:     # semantics each time.  @url and @email are just like @uref with
  410:     # one argument, for our purposes.
  411:     s/\@(?:uref|url|email)\{([^\},]*)\}/&lt;B<$1>&gt;/g;
  412:     s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g;
  413:     s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g;
  414: 
  415:     # Un-escape <> at this point.
  416:     s/&LT;/</g;
  417:     s/&GT;/>/g;
  418: 
  419:     # Now un-nest all B<>, I<>, R<>.  Theoretically we could have
  420:     # indefinitely deep nesting; in practice, one level suffices.
  421:     1 while s/([BIR])<([^<>]*)([BIR])<([^<>]*)>/$1<$2>$3<$4>$1</g;
  422: 
  423:     # Replace R<...> with bare ...; eliminate empty markup, B<>;
  424:     # shift white space at the ends of [BI]<...> expressions outside
  425:     # the expression.
  426:     s/R<([^<>]*)>/$1/g;
  427:     s/[BI]<>//g;
  428:     s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
  429:     s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
  430: 
  431:     # Extract footnotes.  This has to be done after all other
  432:     # processing because otherwise the regexp will choke on formatting
  433:     # inside @footnote.
  434:     while (/\@footnote/g) {
  435: 	s/\@footnote\{([^\}]+)\}/[$fnno]/;
  436: 	add_footnote($1, $fnno);
  437: 	$fnno++;
  438:     }
  439: 
  440:     return $_;
  441: }
  442: 
  443: sub unmunge
  444: {
  445:     # Replace escaped symbols with their equivalents.
  446:     local $_ = $_[0];
  447: 
  448:     s/&lt;/E<lt>/g;
  449:     s/&gt;/E<gt>/g;
  450:     s/&lbrace;/\{/g;
  451:     s/&rbrace;/\}/g;
  452:     s/&at;/\@/g;
  453:     s/&amp;/&/g;
  454:     return $_;
  455: }
  456: 
  457: sub add_footnote
  458: {
  459:     unless (exists $sects{FOOTNOTES}) {
  460: 	$sects{FOOTNOTES} = "\n=over 4\n\n";
  461:     }
  462: 
  463:     $sects{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++;
  464:     $sects{FOOTNOTES} .= $_[0];
  465:     $sects{FOOTNOTES} .= "\n\n";
  466: }
  467: 
  468: # stolen from Symbol.pm
  469: {
  470:     my $genseq = 0;
  471:     sub gensym
  472:     {
  473: 	my $name = "GEN" . $genseq++;
  474: 	my $ref = \*{$name};
  475: 	delete $::{$name};
  476: 	return $ref;
  477:     }
  478: }

unix.superglobalmegacorp.com