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