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

unix.superglobalmegacorp.com