Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Last modification | View Log | RSS feed

  1. #! /usr/bin/perl
  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, 51 Franklin Street, Fifth Floor,
  20. # Boston, MA 02110-1301 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. use warnings;
  27.  
  28. $output = 0;
  29. $skipping = 0;
  30. %chapters = ();
  31. @chapters_sequence = ();
  32. $chapter = "";
  33. @icstack = ();
  34. @endwstack = ();
  35. @skstack = ();
  36. @instack = ();
  37. $shift = "";
  38. %defs = ();
  39. $fnno = 1;
  40. $inf = "";
  41. @ibase = ();
  42.  
  43. while ($_ = shift) {
  44.     if (/^-D(.*)$/) {
  45.         if ($1 ne "") {
  46.             $flag = $1;
  47.         } else {
  48.             $flag = shift;
  49.         }
  50.         $value = "";
  51.         ($flag, $value) = ($flag =~ /^([^=]+)(?:=(.+))?/);
  52.         die "no flag specified for -D\n"
  53.             unless $flag ne "";
  54.         die "flags may only contain letters, digits, hyphens, dashes and underscores\n"
  55.             unless $flag =~ /^[a-zA-Z0-9_-]+$/;
  56.         $defs{$flag} = $value;
  57.     } elsif (/^-I(.*)$/) {
  58.         push @ibase, $1 ne "" ? $1 : shift;
  59.     } elsif (/^-/) {
  60.         usage();
  61.     } else {
  62.         $in = $_, next unless defined $in;
  63.         $out = $_, next unless defined $out;
  64.         usage();
  65.     }
  66. }
  67.  
  68. push @ibase, ".";
  69.  
  70. if (defined $in) {
  71.     $inf = gensym();
  72.     open($inf, "<$in") or die "opening \"$in\": $!\n";
  73.     push @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. INF: 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.     /^\@include\s+(.+)$/ and do {
  110.         push @instack, $inf;
  111.         $inf = gensym();
  112.  
  113.         for (@ibase) {
  114.             open($inf, "<" . $_ . "/" . $1) and next INF;
  115.         }
  116.         die "cannot open $1: $!\n";
  117.     };
  118.  
  119.     /^\@chapter\s+([A-Za-z ]+)/ and do {
  120.         # close old chapter
  121.         $chapters{$chapter_name} .= postprocess($chapter) if ($chapter_name);
  122.  
  123.         # start new chapter
  124.         $chapter_name = $1, push (@chapters_sequence, $chapter_name) unless $skipping;
  125.         $chapters{$chapter_name} = "" unless exists $chapters{$chapter_name};
  126.         $chapter = "";
  127.         $output = 1;
  128.         next;
  129.     };
  130.  
  131.     /^\@bye/ and do {
  132.         # close old chapter
  133.         $chapters{$chapter_name} .= postprocess($chapter) if ($chapter_name);
  134.         last INF;
  135.     };
  136.  
  137.     # handle variables
  138.     /^\@set\s+([a-zA-Z0-9_-]+)\s*(.*)$/ and do {
  139.         $defs{$1} = $2;
  140.         next;
  141.     };
  142.     /^\@clear\s+([a-zA-Z0-9_-]+)/ and do {
  143.         delete $defs{$1};
  144.         next;
  145.     };
  146.  
  147.     next unless $output;
  148.  
  149.     # Discard comments.  (Can't do it above, because then we'd never see
  150.     # @c man lines.)
  151.     /^\@c\b/ and next;
  152.  
  153.     # End-block handler goes up here because it needs to operate even
  154.     # if we are skipping.
  155.     /^\@end\s+([a-z]+)/ and do {
  156.         # Ignore @end foo, where foo is not an operation which may
  157.         # cause us to skip, if we are presently skipping.
  158.         my $ended = $1;
  159.         next if $skipping && $ended !~ /^(?:ifset|ifclear|ignore|menu|iftex|ifhtml|ifnothtml)$/;
  160.  
  161.         die "\@end $ended without \@$ended at line $.\n" unless defined $endw;
  162.         die "\@$endw ended by \@end $ended at line $.\n" unless $ended eq $endw;
  163.  
  164.         $endw = pop @endwstack;
  165.  
  166.         if ($ended =~ /^(?:ifset|ifclear|ignore|menu|iftex|ifhtml|ifnothtml)$/) {
  167.             $skipping = pop @skstack;
  168.             next;
  169.         } elsif ($ended =~ /^(?:example|smallexample|display)$/) {
  170.             $shift = "";
  171.             $_ = "";        # need a paragraph break
  172.         } elsif ($ended =~ /^(?:itemize|enumerate|(?:multi|[fv])?table)$/) {
  173.             $_ = "\n=back\n";
  174.             $ic = pop @icstack;
  175.         } else {
  176.             die "unknown command \@end $ended at line $.\n";
  177.         }
  178.     };
  179.  
  180.     # We must handle commands which can cause skipping even while we
  181.     # are skipping, otherwise we will not process nested conditionals
  182.     # correctly.
  183.     /^\@ifset\s+([a-zA-Z0-9_-]+)/ and do {
  184.         push @endwstack, $endw;
  185.         push @skstack, $skipping;
  186.         $endw = "ifset";
  187.         $skipping = 1 unless exists $defs{$1};
  188.         next;
  189.     };
  190.  
  191.     /^\@ifclear\s+([a-zA-Z0-9_-]+)/ and do {
  192.         push @endwstack, $endw;
  193.         push @skstack, $skipping;
  194.         $endw = "ifclear";
  195.         $skipping = 1 if exists $defs{$1};
  196.         next;
  197.     };
  198.  
  199.     /^\@(ignore|menu|iftex|ifhtml|ifnothtml)\b/ and do {
  200.         push @endwstack, $endw;
  201.         push @skstack, $skipping;
  202.         $endw = $1;
  203.         $skipping = $endw !~ /ifnothtml/;
  204.         next;
  205.     };
  206.  
  207.     next if $skipping;
  208.  
  209.     # Character entities.  First the ones that can be replaced by raw text
  210.     # or discarded outright:
  211.     s/\@copyright\{\}/(c)/g;
  212.     s/\@dots\{\}/.../g;
  213.     s/\@enddots\{\}/..../g;
  214.     s/\@([.!? ])/$1/g;
  215.     s/\@[:-]//g;
  216.     s/\@bullet(?:\{\})?/*/g;
  217.     s/\@TeX\{\}/TeX/g;
  218.     s/\@pounds\{\}/\#/g;
  219.     s/\@minus(?:\{\})?/-/g;
  220.  
  221.     # Now the ones that have to be replaced by special escapes
  222.     # (which will be turned back into text by unmunge())
  223.     s/&/&amp;/g;
  224.     s/\@\{/&lbrace;/g;
  225.     s/\@\}/&rbrace;/g;
  226.     s/\@\@/&at;/g;
  227.  
  228.     # Inside a verbatim block, handle @var specially.
  229.     if ($shift ne "") {
  230.         s/\@var\{([^\}]*)\}/<$1>/g;
  231.     }
  232.  
  233.     # POD doesn't interpret E<> inside a verbatim block.
  234.     if ($shift eq "") {
  235.         s/</&lt;/g;
  236.         s/>/&gt;/g;
  237.     } else {
  238.         s/</&LT;/g;
  239.         s/>/&GT;/g;
  240.     }
  241.  
  242.     # Single line command handlers.
  243.  
  244.     /^\@(?:section|unnumbered|unnumberedsec|center|heading)\s+(.+)$/
  245.         and $_ = "\n=head2 $1\n";
  246.     /^\@(?:subsection|subheading)\s+(.+)$/
  247.         and $_ = "\n=head3 $1\n";
  248.     /^\@(?:subsubsection|subsubheading)\s+(.+)$/
  249.         and $_ = "\n=head4 $1\n";
  250.  
  251.     # Block command handlers:
  252.     /^\@itemize\s*(\@[a-z]+|\*|-)?/ and do {
  253.         push @endwstack, $endw;
  254.         push @icstack, $ic;
  255.         $ic = $1 ? $1 : "*";
  256.         $_ = "\n=over 4\n";
  257.         $endw = "itemize";
  258.     };
  259.  
  260.     /^\@enumerate(?:\s+([a-zA-Z0-9]+))?/ and do {
  261.         push @endwstack, $endw;
  262.         push @icstack, $ic;
  263.         if (defined $1) {
  264.             $ic = $1 . ".";
  265.         } else {
  266.             $ic = "1.";
  267.         }
  268.         $_ = "\n=over 4\n";
  269.         $endw = "enumerate";
  270.     };
  271.  
  272.     /^\@((?:multi|[fv])?table)\s+(\@[a-z]+)/ and do {
  273.         push @endwstack, $endw;
  274.         push @icstack, $ic;
  275.         $endw = $1;
  276.         $ic = $2;
  277.         $ic =~ s/\@(?:samp|strong|key|gcctabopt|option|env|command)/B/;
  278.         $ic =~ s/\@(?:code|kbd)/C/;
  279.         $ic =~ s/\@(?:dfn|var|emph|cite|i)/I/;
  280.         $ic =~ s/\@(?:file)/F/;
  281.         $ic =~ s/\@(?:columnfractions)//;
  282.         $_ = "\n=over 4\n";
  283.     };
  284.  
  285.     /^\@((?:small)?example|display)/ and do {
  286.         push @endwstack, $endw;
  287.         $endw = $1;
  288.         $shift = "\t";
  289.         $_ = "";        # need a paragraph break
  290.     };
  291.  
  292.     /^\@item\s+(.*\S)\s*$/ and $endw eq "multitable" and do {
  293.         my $columns = $1;
  294.         $columns =~ s/\@tab/ : /;
  295.  
  296.         $_ = "\n=item B&LT;". $columns ."&GT;\n";
  297.     };
  298.  
  299.     /^\@tab\s+(.*\S)\s*$/ and $endw eq "multitable" and do {
  300.         my $columns = $1;
  301.         $columns =~ s/\@tab/ : /;
  302.  
  303.         $_ = " : ". $columns;
  304.         $chapter =~ s/\n+\s+$//;
  305.     };
  306.  
  307.     /^\@itemx?\s*(.+)?$/ and do {
  308.         if (defined $1) {
  309.             # Entity escapes prevent munging by the <> processing below.
  310.             $_ = "\n=item $ic\&LT;$1\&GT;\n";
  311.         } else {
  312.             $_ = "\n=item $ic\n";
  313.             $ic =~ y/A-Ya-y/B-Zb-z/;
  314.             $ic =~ s/(\d+)/$1 + 1/eg;
  315.         }
  316.     };
  317.  
  318.     $chapter .= $shift.$_."\n";
  319. }
  320. # End of current file.
  321. close($inf);
  322. $inf = pop @instack;
  323. }
  324.  
  325. die "No filename or title\n" unless defined $fn && defined $tl;
  326.  
  327. $chapters{NAME} = "$fn \- $tl\n";
  328. $chapters{FOOTNOTES} .= "=back\n" if exists $chapters{FOOTNOTES};
  329.  
  330. unshift @chapters_sequence, "NAME";
  331. for $chapter (@chapters_sequence) {
  332.     if (exists $chapters{$chapter}) {
  333.         $head = uc($chapter);
  334.         print "=head1 $head\n\n";
  335.         print scalar unmunge ($chapters{$chapter});
  336.         print "\n";
  337.     }
  338. }
  339.  
  340. sub usage
  341. {
  342.     die "usage: $0 [-D toggle...] [infile [outfile]]\n";
  343. }
  344.  
  345. sub postprocess
  346. {
  347.     local $_ = $_[0];
  348.  
  349.     # @value{foo} is replaced by whatever 'foo' is defined as.
  350.     while (m/(\@value\{([a-zA-Z0-9_-]+)\})/g) {
  351.         if (! exists $defs{$2}) {
  352.             print STDERR "Option $2 not defined\n";
  353.             s/\Q$1\E//;
  354.         } else {
  355.             $value = $defs{$2};
  356.             s/\Q$1\E/$value/;
  357.         }
  358.     }
  359.  
  360.     # Formatting commands.
  361.     # Temporary escape for @r.
  362.     s/\@r\{([^\}]*)\}/R<$1>/g;
  363.     s/\@(?:dfn|var|emph|cite|i)\{([^\}]*)\}/I<$1>/g;
  364.     s/\@(?:code|kbd)\{([^\}]*)\}/C<$1>/g;
  365.     s/\@(?:gccoptlist|samp|strong|key|option|env|command|b)\{([^\}]*)\}/B<$1>/g;
  366.     s/\@sc\{([^\}]*)\}/\U$1/g;
  367.     s/\@file\{([^\}]*)\}/F<$1>/g;
  368.     s/\@w\{([^\}]*)\}/S<$1>/g;
  369.     s/\@(?:dmn|math)\{([^\}]*)\}/$1/g;
  370.  
  371.     # Cross references are thrown away, as are @noindent and @refill.
  372.     # (@noindent is impossible in .pod, and @refill is unnecessary.)
  373.     # @* is also impossible in .pod; we discard it and any newline that
  374.     # follows it.  Similarly, our macro @gol must be discarded.
  375.  
  376.     s/\@anchor{(?:[^\}]*)\}//g;
  377.     s/\(?\@xref\{(?:[^\}]*)\}(?:[^.<]|(?:<[^<>]*>))*\.\)?//g;
  378.     s/\s+\(\@pxref\{(?:[^\}]*)\}\)//g;
  379.     s/;\s+\@pxref\{(?:[^\}]*)\}//g;
  380.     s/\@ref\{(?:[^,\}]*,)(?:[^,\}]*,)([^,\}]*).*\}/$1/g;
  381.     s/\@ref\{([^\}]*)\}/$1/g;
  382.     s/\@noindent\s*//g;
  383.     s/\@refill//g;
  384.     s/\@gol//g;
  385.     s/\@\*\s*\n?//g;
  386.  
  387.     # @uref can take one, two, or three arguments, with different
  388.     # semantics each time.  @url and @email are just like @uref with
  389.     # one argument, for our purposes.
  390.     s/\@(?:uref|url|email)\{([^\},]*),?[^\}]*\}/&lt;B<$1>&gt;/g;
  391.     s/\@uref\{([^\},]*),([^\},]*)\}/$2 (C<$1>)/g;
  392.     s/\@uref\{([^\},]*),([^\},]*),([^\},]*)\}/$3/g;
  393.  
  394.     # Turn B<blah I<blah> blah> into B<blah> I<blah> B<blah> to
  395.     # match Texinfo semantics of @emph inside @samp.  Also handle @r
  396.     # inside bold.
  397.     s/&LT;/</g;
  398.     s/&GT;/>/g;
  399.     1 while s/B<((?:[^<>]|I<[^<>]*>)*)R<([^>]*)>/B<$1>${2}B</g;
  400.     1 while (s/B<([^<>]*)I<([^>]+)>/B<$1>I<$2>B</g);
  401.     1 while (s/I<([^<>]*)B<([^>]+)>/I<$1>B<$2>I</g);
  402.     s/[BI]<>//g;
  403.     s/([BI])<(\s+)([^>]+)>/$2$1<$3>/g;
  404.     s/([BI])<([^>]+?)(\s+)>/$1<$2>$3/g;
  405.  
  406.     # Extract footnotes.  This has to be done after all other
  407.     # processing because otherwise the regexp will choke on formatting
  408.     # inside @footnote.
  409.     while (/\@footnote/g) {
  410.         s/\@footnote\{([^\}]+)\}/[$fnno]/;
  411.         add_footnote($1, $fnno);
  412.         $fnno++;
  413.     }
  414.  
  415.     return $_;
  416. }
  417.  
  418. sub unmunge
  419. {
  420.     # Replace escaped symbols with their equivalents.
  421.     local $_ = $_[0];
  422.  
  423.     s/&lt;/E<lt>/g;
  424.     s/&gt;/E<gt>/g;
  425.     s/&lbrace;/\{/g;
  426.     s/&rbrace;/\}/g;
  427.     s/&at;/\@/g;
  428.     s/&amp;/&/g;
  429.     return $_;
  430. }
  431.  
  432. sub add_footnote
  433. {
  434.     unless (exists $chapters{FOOTNOTES}) {
  435.         $chapters{FOOTNOTES} = "\n=over 4\n\n";
  436.     }
  437.  
  438.     $chapters{FOOTNOTES} .= "=item $fnno.\n\n"; $fnno++;
  439.     $chapters{FOOTNOTES} .= $_[0];
  440.     $chapters{FOOTNOTES} .= "\n\n";
  441. }
  442.  
  443. # stolen from Symbol.pm
  444. {
  445.     my $genseq = 0;
  446.     sub gensym
  447.     {
  448.         my $name = "GEN" . $genseq++;
  449.         my $ref = \*{$name};
  450.         delete $::{$name};
  451.         return $ref;
  452.     }
  453. }
  454.