File:  [Qemu by Fabrice Bellard] / qemu / texi2pod.pl
Revision 1.1.1.2 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 16:47:34 2018 UTC (2 years, 3 months ago) by root
Branches: qemu, MAIN
CVS tags: qemu0091, HEAD
qemu 0.9.1

    1: #! /usr/bin/perl -w
    2: 
    3: #   Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
    4: 
    5: # This file is part of GNU CC.
    6: 
    7: # GNU CC 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: # GNU CC 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 GNU CC; see the file COPYING.  If not, write to
   19: # the Free Software Foundation, 59 Temple Place - Suite 330,
   20: # Boston MA 02111-1307, 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: 
   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 (/^-/) {
   55: 	usage();
   56:     } else {
   57: 	$in = $_, next unless defined $in;
   58: 	$out = $_, next unless defined $out;
   59: 	usage();
   60:     }
   61: }
   62: 
   63: if (defined $in) {
   64:     $inf = gensym();
   65:     open($inf, "<$in") or die "opening \"$in\": $!\n";
   66:     $ibase = $1 if $in =~ m|^(.+)/[^/]+$|;
   67: } else {
   68:     $inf = \*STDIN;
   69: }
   70: 
   71: if (defined $out) {
   72:     open(STDOUT, ">$out") or die "opening \"$out\": $!\n";
   73: }
   74: 
   75: while(defined $inf) {
   76: while(<$inf>) {
   77:     # Certain commands are discarded without further processing.
   78:     /^\@(?:
   79: 	 [a-z]+index		# @*index: useful only in complete manual
   80: 	 |need			# @need: useful only in printed manual
   81: 	 |(?:end\s+)?group	# @group .. @end group: ditto
   82: 	 |page			# @page: ditto
   83: 	 |node			# @node: useful only in .info file
   84: 	 |(?:end\s+)?ifnottex   # @ifnottex .. @end ifnottex: use contents
   85: 	)\b/x and next;
   86: 
   87:     chomp;
   88: 
   89:     # Look for filename and title markers.
   90:     /^\@setfilename\s+([^.]+)/ and $fn = $1, next;
   91:     /^\@settitle\s+([^.]+)/ and $tl = postprocess($1), next;
   92: 
   93:     # Identify a man title but keep only the one we are interested in.
   94:     /^\@c\s+man\s+title\s+([A-Za-z0-9-]+)\s+(.+)/ and do {
   95: 	if (exists $defs{$1}) {
   96: 	    $fn = $1;
   97: 	    $tl = postprocess($2);
   98: 	}
   99: 	next;
  100:     };
  101: 
  102:     # Look for blocks surrounded by @c man begin SECTION ... @c man end.
  103:     # This really oughta be @ifman ... @end ifman and the like, but such
  104:     # would require rev'ing all other Texinfo translators.
  105:     /^\@c\s+man\s+begin\s+([A-Z]+)\s+([A-Za-z0-9-]+)/ and do {
  106: 	$output = 1 if exists $defs{$2};
  107:         $sect = $1;
  108: 	next;
  109:     };
  110:     /^\@c\s+man\s+begin\s+([A-Z]+)/ and $sect = $1, $output = 1, next;
  111:     /^\@c\s+man\s+end/ and do {
  112: 	$sects{$sect} = "" unless exists $sects{$sect};
  113: 	$sects{$sect} .= postprocess($section);
  114: 	$section = "";
  115: 	$output = 0;
  116: 	next;
  117:     };
  118: 
  119:     # handle variables
  120:     /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and do {
  121: 	$defs{$1} = $2;
  122: 	next;
  123:     };
  124:     /^\@clear\s+([a-zA-Z0-9_-]+)/ and do {
  125: 	delete $defs{$1};
  126: 	next;
  127:     };
  128: 
  129:     next unless $output;
  130: 
  131:     # Discard comments.  (Can't do it above, because then we'd never see
  132:     # @c man lines.)
  133:     /^\@c\b/ and next;
  134: 
  135:     # End-block handler goes up here because it needs to operate even
  136:     # if we are skipping.
  137:     /^\@end\s+([a-z]+)/ and do {
  138: 	# Ignore @end foo, where foo is not an operation which may
  139: 	# cause us to skip, if we are presently skipping.
  140: 	my $ended = $1;
  141: 	next if $skipping && $ended !~ /^(?:ifset|ifclear|ignore|menu|iftex)$/;
  142: 
  143: 	die "\@end $ended without \@$ended at line $.\n" unless defined $endw;
  144: 	die "\@$endw ended by \@end $ended at line $.\n" unless $ended eq $endw;
  145: 
  146: 	$endw = pop @endwstack;
  147: 
  148: 	if ($ended =~ /^(?:ifset|ifclear|ignore|menu|iftex)$/) {
  149: 	    $skipping = pop @skstack;
  150: 	    next;
  151: 	} elsif ($ended =~ /^(?:example|smallexample|display)$/) {
  152: 	    $shift = "";
  153: 	    $_ = "";	# need a paragraph break
  154: 	} elsif ($ended =~ /^(?:itemize|enumerate|[fv]?table)$/) {
  155: 	    $_ = "\n=back\n";
  156: 	    $ic = pop @icstack;
  157: 	} else {
  158: 	    die "unknown command \@end $ended at line $.\n";
  159: 	}
  160:     };
  161: 
  162:     # We must handle commands which can cause skipping even while we
  163:     # are skipping, otherwise we will not process nested conditionals
  164:     # correctly.
  165:     /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
  166: 	push @endwstack, $endw;
  167: 	push @skstack, $skipping;
  168: 	$endw = "ifset";
  169: 	$skipping = 1 unless exists $defs{$1};
  170: 	next;
  171:     };
  172: 
  173:     /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
  174: 	push @endwstack, $endw;
  175: 	push @skstack, $skipping;
  176: 	$endw = "ifclear";
  177: 	$skipping = 1 if exists $defs{$1};
  178: 	next;
  179:     };
  180: 
  181:     /^\@(ignore|menu|iftex)\b/ and do {
  182: 	push @endwstack, $endw;
  183: 	push @skstack, $skipping;
  184: 	$endw = $1;
  185: 	$skipping = 1;
  186: 	next;
  187:     };
  188: 
  189:     next if $skipping;
  190: 
  191:     # Character entities.  First the ones that can be replaced by raw text
  192:     # or discarded outright:
  193:     s/\@copyright\{\}/(c)/g;
  194:     s/\@dots\{\}/.../g;
  195:     s/\@enddots\{\}/..../g;
  196:     s/\@([.!? ])/$1/g;
  197:     s/\@[:-]//g;
  198:     s/\@bullet(?:\{\})?/*/g;
  199:     s/\@TeX\{\}/TeX/g;
  200:     s/\@pounds\{\}/\#/g;
  201:     s/\@minus(?:\{\})?/-/g;
  202:     s/\\,/,/g;
  203: 
  204:     # Now the ones that have to be replaced by special escapes
  205:     # (which will be turned back into text by unmunge())
  206:     s/&/&amp;/g;
  207:     s/\@\{/&lbrace;/g;
  208:     s/\@\}/&rbrace;/g;
  209:     s/\@\@/&at;/g;
  210: 
  211:     # Inside a verbatim block, handle @var specially.
  212:     if ($shift ne "") {
  213: 	s/\@var\{([^\}]*)\}/<$1>/g;
  214:     }
  215: 
  216:     # POD doesn't interpret E<> inside a verbatim block.
  217:     if ($shift eq "") {
  218: 	s/</&lt;/g;
  219: 	s/>/&gt;/g;
  220:     } else {
  221: 	s/</&LT;/g;
  222: 	s/>/&GT;/g;
  223:     }
  224: 
  225:     # Single line command handlers.
  226: 
  227:     /^\@include\s+(.+)$/ and do {
  228: 	push @instack, $inf;
  229: 	$inf = gensym();
  230: 
  231: 	# Try cwd and $ibase.
  232: 	open($inf, "<" . $1)
  233: 	    or open($inf, "<" . $ibase . "/" . $1)
  234: 		or die "cannot open $1 or $ibase/$1: $!\n";
  235: 	next;
  236:     };
  237: 
  238:     /^\@(?:section|unnumbered|unnumberedsec|center)\s+(.+)$/
  239: 	and $_ = "\n=head2 $1\n";
  240:     /^\@subsection\s+(.+)$/
  241: 	and $_ = "\n=head3 $1\n";
  242: 
  243:     # Block command handlers:
  244:     /^\@itemize\s+(\@[a-z]+|\*|-)/ and do {
  245: 	push @endwstack, $endw;
  246: 	push @icstack, $ic;
  247: 	$ic = $1;
  248: 	$_ = "\n=over 4\n";
  249: 	$endw = "itemize";
  250:     };
  251: 
  252:     /^\@enumerate(?:\s+([a-zA-Z0-9]+))?/ and do {
  253: 	push @endwstack, $endw;
  254: 	push @icstack, $ic;
  255: 	if (defined $1) {
  256: 	    $ic = $1 . ".";
  257: 	} else {
  258: 	    $ic = "1.";
  259: 	}
  260: 	$_ = "\n=over 4\n";
  261: 	$endw = "enumerate";
  262:     };
  263: 
  264:     /^\@([fv]?table)\s+(\@[a-z]+)/ and do {
  265: 	push @endwstack, $endw;
  266: 	push @icstack, $ic;
  267: 	$endw = $1;
  268: 	$ic = $2;
  269: 	$ic =~ s/\@(?:samp|strong|key|gcctabopt|option|env)/B/;
  270: 	$ic =~ s/\@(?:code|kbd)/C/;
  271: 	$ic =~ s/\@(?:dfn|var|emph|cite|i)/I/;
  272: 	$ic =~ s/\@(?:file)/F/;
  273: 	$_ = "\n=over 4\n";
  274:     };
  275: 
  276:     /^\@((?:small)?example|display)/ and do {
  277: 	push @endwstack, $endw;
  278: 	$endw = $1;
  279: 	$shift = "\t";
  280: 	$_ = "";	# need a paragraph break
  281:     };
  282: 
  283:     /^\@itemx?\s*(.+)?$/ and do {
  284: 	if (defined $1) {
  285: 	    # Entity escapes prevent munging by the <> processing below.
  286: #            print "$ic\n";
  287: 	    $_ = "\n=item $ic\&LT;$1\&GT;\n";
  288: 	} else {
  289: 	    $_ = "\n=item $ic\n";
  290: 	    $ic =~ y/A-Ya-y/B-Zb-z/;
  291: 	    $ic =~ s/(\d+)/$1 + 1/eg;
  292: 	}
  293:     };
  294: 
  295:     $section .= $shift.$_."\n";
  296: }
  297: # End of current file.
  298: close($inf);
  299: $inf = pop @instack;
  300: }
  301: 
  302: die "No filename or title\n" unless defined $fn && defined $tl;
  303: 
  304: $sects{NAME} = "$fn \- $tl\n";
  305: $sects{FOOTNOTES} .= "=back\n" if exists $sects{FOOTNOTES};
  306: 
  307: for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
  308: 	      BUGS NOTES FOOTNOTES SEEALSO AUTHOR COPYRIGHT)) {
  309:     if(exists $sects{$sect}) {
  310: 	$head = $sect;
  311: 	$head =~ s/SEEALSO/SEE ALSO/;
  312: 	print "=head1 $head\n\n";
  313: 	print scalar unmunge ($sects{$sect});
  314: 	print "\n";
  315:     }
  316: }
  317: 
  318: sub usage
  319: {
  320:     die "usage: $0 [-D toggle...] [infile [outfile]]\n";
  321: }
  322: 
  323: sub postprocess
  324: {
  325:     local $_ = $_[0];
  326: 
  327:     # @value{foo} is replaced by whatever 'foo' is defined as.
  328:     while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) {
  329: 	if (! exists $defs{$2}) {
  330: 	    print STDERR "Option $2 not defined\n";
  331: 	    s/\Q$1\E//;
  332: 	} else {
  333: 	    $value = $defs{$2};
  334: 	    s/\Q$1\E/$value/;
  335: 	}
  336:     }
  337: 
  338:     # Formatting commands.
  339:     # Temporary escape for @r.
  340:     s/\@r\{([^\}]*)\}/R<$1>/g;
  341:     s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g;
  342:     s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
  343:     s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g;
  344:     s/\@sc\{([^\}]*)\}/\U$1/g;
  345:     s/\@file\{([^\}]*)\}/F<$1>/g;
  346:     s/\@w\{([^\}]*)\}/S<$1>/g;
  347:     s/\@(?:dmn|math)\{([^\}]*)\}/$1/g;
  348: 
  349:     # Cross references are thrown away, as are @noindent and @refill.
  350:     # (@noindent is impossible in .pod, and @refill is unnecessary.)
  351:     # @* is also impossible in .pod; we discard it and any newline that
  352:     # follows it.  Similarly, our macro @gol must be discarded.
  353: 
  354:     s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g;
  355:     s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g;
  356:     s/;\s+\@pxref\{(?:[^\}]*)\}//g;
  357:     s/\@noindent\s*//g;
  358:     s/\@refill//g;
  359:     s/\@gol//g;
  360:     s/\@\*\s*\n?//g;
  361: 
  362:     # @uref can take one, two, or three arguments, with different
  363:     # semantics each time.  @url and @email are just like @uref with
  364:     # one argument, for our purposes.
  365:     s/\@(?:uref|url|email)\{([^\},]*)\}/&lt;B<$1>&gt;/g;
  366:     s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g;
  367:     s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g;
  368: 
  369:     # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to
  370:     # match Texinfo semantics of @emph inside @samp.  Also handle @r
  371:     # inside bold.
  372:     s/&LT;/</g;
  373:     s/&GT;/>/g;
  374:     1 while s/B<((?:[^<>]|I<[^<>]*>)*)R<([^>]*)>/B<$1>${2}B</g;
  375:     1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g);
  376:     1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g);
  377:     s/[BI]<>//g;
  378:     s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
  379:     s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
  380: 
  381:     # Extract footnotes.  This has to be done after all other
  382:     # processing because otherwise the regexp will choke on formatting
  383:     # inside @footnote.
  384:     while (/\@footnote/g) {
  385: 	s/\@footnote\{([^\}]+)\}/[$fnno]/;
  386: 	add_footnote($1, $fnno);
  387: 	$fnno++;
  388:     }
  389: 
  390:     return $_;
  391: }
  392: 
  393: sub unmunge
  394: {
  395:     # Replace escaped symbols with their equivalents.
  396:     local $_ = $_[0];
  397: 
  398:     s/&lt;/E<lt>/g;
  399:     s/&gt;/E<gt>/g;
  400:     s/&lbrace;/\{/g;
  401:     s/&rbrace;/\}/g;
  402:     s/&at;/\@/g;
  403:     s/&amp;/&/g;
  404:     return $_;
  405: }
  406: 
  407: sub add_footnote
  408: {
  409:     unless (exists $sects{FOOTNOTES}) {
  410: 	$sects{FOOTNOTES} = "\n=over 4\n\n";
  411:     }
  412: 
  413:     $sects{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++;
  414:     $sects{FOOTNOTES} .= $_[0];
  415:     $sects{FOOTNOTES} .= "\n\n";
  416: }
  417: 
  418: # stolen from Symbol.pm
  419: {
  420:     my $genseq = 0;
  421:     sub gensym
  422:     {
  423: 	my $name = "GEN" . $genseq++;
  424: 	my $ref = \*{$name};
  425: 	delete $::{$name};
  426: 	return $ref;
  427:     }
  428: }

unix.superglobalmegacorp.com