contrib/texi2pod.pl

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