Return to texi2pod.pl CVS log

Up to [Qemu by Fabrice Bellard] / qemu / scripts

Annotation of qemu/scripts/texi2pod.pl, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.