Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  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.             $_ = "\n=item $ic\&LT;$1\&GT;\n";
  287.         } else {
  288.             $_ = "\n=item $ic\n";
  289.             $ic =~ y/A-Ya-y/B-Zb-z/;
  290.             $ic =~ s/(\d+)/$1 + 1/eg;
  291.         }
  292.     };
  293.  
  294.     $section .= $shift.$_."\n";
  295. }
  296. # End of current file.
  297. close($inf);
  298. $inf = pop @instack;
  299. }
  300.  
  301. die "No filename or title\n" unless defined $fn && defined $tl;
  302.  
  303. $sects{NAME} = "$fn \- $tl\n";
  304. $sects{FOOTNOTES} .= "=back\n" if exists $sects{FOOTNOTES};
  305.  
  306. for $sect (qw(NAME SYNOPSIS DESCRIPTION OPTIONS ENVIRONMENT FILES
  307.               BUGS NOTES FOOTNOTES SEEALSO AUTHOR COPYRIGHT)) {
  308.     if(exists $sects{$sect}) {
  309.         $head = $sect;
  310.         $head =~ s/SEEALSO/SEE ALSO/;
  311.         print "=head1 $head\n\n";
  312.         print scalar unmunge ($sects{$sect});
  313.         print "\n";
  314.     }
  315. }
  316.  
  317. sub usage
  318. {
  319.     die "usage: $0 [-D toggle...] [infile [outfile]]\n";
  320. }
  321.  
  322. sub postprocess
  323. {
  324.     local $_ = $_[0];
  325.  
  326.     # @value{foo} is replaced by whatever 'foo' is defined as.
  327.     while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) {
  328.         if (! exists $defs{$2}) {
  329.             print STDERR "Option $2 not defined\n";
  330.             s/\Q$1\E//;
  331.         } else {
  332.             $value = $defs{$2};
  333.             s/\Q$1\E/$value/;
  334.         }
  335.     }
  336.  
  337.     # Formatting commands.
  338.     # Temporary escape for @r.
  339.     s/\@r\{([^\}]*)\}/R<$1>/g;
  340.     s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g;
  341.     s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
  342.     s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g;
  343.     s/\@sc\{([^\}]*)\}/\U$1/g;
  344.     s/\@file\{([^\}]*)\}/F<$1>/g;
  345.     s/\@w\{([^\}]*)\}/S<$1>/g;
  346.     s/\@(?:dmn|math)\{([^\}]*)\}/$1/g;
  347.  
  348.     # Cross references are thrown away, as are @noindent and @refill.
  349.     # (@noindent is impossible in .pod, and @refill is unnecessary.)
  350.     # @* is also impossible in .pod; we discard it and any newline that
  351.     # follows it.  Similarly, our macro @gol must be discarded.
  352.  
  353.     s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g;
  354.     s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g;
  355.     s/;\s+\@pxref\{(?:[^\}]*)\}//g;
  356.     s/\@noindent\s*//g;
  357.     s/\@refill//g;
  358.     s/\@gol//g;
  359.     s/\@\*\s*\n?//g;
  360.  
  361.     # @uref can take one, two, or three arguments, with different
  362.     # semantics each time.  @url and @email are just like @uref with
  363.     # one argument, for our purposes.
  364.     s/\@(?:uref|url|email)\{([^\},]*)\}/&lt;B<$1>&gt;/g;
  365.     s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g;
  366.     s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g;
  367.  
  368.     # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to
  369.     # match Texinfo semantics of @emph inside @samp.  Also handle @r
  370.     # inside bold.
  371.     s/&LT;/</g;
  372.     s/&GT;/>/g;
  373.     1 while s/B<((?:[^<>]|I<[^<>]*>)*)R<([^>]*)>/B<$1>${2}B</g;
  374.     1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g);
  375.     1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g);
  376.     s/[BI]<>//g;
  377.     s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
  378.     s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
  379.  
  380.     # Extract footnotes.  This has to be done after all other
  381.     # processing because otherwise the regexp will choke on formatting
  382.     # inside @footnote.
  383.     while (/\@footnote/g) {
  384.         s/\@footnote\{([^\}]+)\}/[$fnno]/;
  385.         add_footnote($1, $fnno);
  386.         $fnno++;
  387.     }
  388.  
  389.     return $_;
  390. }
  391.  
  392. sub unmunge
  393. {
  394.     # Replace escaped symbols with their equivalents.
  395.     local $_ = $_[0];
  396.  
  397.     s/&lt;/E<lt>/g;
  398.     s/&gt;/E<gt>/g;
  399.     s/&lbrace;/\{/g;
  400.     s/&rbrace;/\}/g;
  401.     s/&at;/\@/g;
  402.     s/&amp;/&/g;
  403.     return $_;
  404. }
  405.  
  406. sub add_footnote
  407. {
  408.     unless (exists $sects{FOOTNOTES}) {
  409.         $sects{FOOTNOTES} = "\n=over 4\n\n";
  410.     }
  411.  
  412.     $sects{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++;
  413.     $sects{FOOTNOTES} .= $_[0];
  414.     $sects{FOOTNOTES} .= "\n\n";
  415. }
  416.  
  417. # stolen from Symbol.pm
  418. {
  419.     my $genseq = 0;
  420.     sub gensym
  421.     {
  422.         my $name = "GEN" . $genseq++;
  423.         my $ref = \*{$name};
  424.         delete $::{$name};
  425.         return $ref;
  426.     }
  427. }
  428.