Dogcows Code - chaz/tar/blob - doc/convtexi.pl

   1 #!/usr/local/bin/perl --                                        # -*-Perl-*-
   2 eval "exec /usr/local/bin/perl -S $0 $*"
   3     if 0;
   4
   5 # Copy a Texinfo file, replacing @value's, @FIXME's and other gooddies.
   6
   7 # Copyright (C) 1996, 2001 Free Software Foundation, Inc.
   8 #
   9 # This program is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by the
  11 # Free Software Foundation; either version 2, or (at your option) any later
  12 # version.
  13 #
  14 # This program is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
  17 # Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License along
  20 # with this program.  If not, write to the Free Software Foundation, Inc.,
  21 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  22
  23 # François Pinard <pinard@iro.umontreal.ca>, 1996.
  24
  25 $_ = <>;
  26 while ($_)
  27 {
  28     if (/^\@c()$/ || /^\@c (.*)/ || /^\@(include .*)/)
  29     {
  30         if ($topseen)
  31         {
  32             print "\@format\n";
  33             print "\@strong{\@\@c} $1\n";
  34             $_ = <>;
  35             while (/\@c (.*)/)
  36             {
  37                 print "\@strong{\@\@c} $1\n";
  38                 $_ = <>;
  39             }
  40             print "\@end format\n";
  41         }
  42         else
  43         {
  44             $delay .= "\@format\n";
  45             $delay .= "\@strong{\@\@c} $1\n";
  46             $_ = <>;
  47             while (/\@c (.*)/)
  48             {
  49                 $delay .= "\@strong{\@\@c} $1\n";
  50                 $_ = <>;
  51             }
  52             $delay .= "\@end format\n";
  53         }
  54     }
  55     elsif (/^\@chapter /)
  56     {
  57         print;
  58 #       print $delay;
  59         $delay = '';
  60         $topseen = 1;
  61         $_ = <>;
  62     }
  63     elsif (/^\@macro /)
  64     {
  65         $_ = <> while ($_ && ! /^\@end macro/);
  66         $_ = <>;
  67     }
  68     elsif (/^\@set ([^ ]+) (.*)/)
  69     {
  70         $set{$1} = $2;
  71         $_ = <>;
  72     }
  73     elsif (/^\@UNREVISED/)
  74     {
  75         print "\@quotation\n";
  76         print "\@emph{(This message will disappear, once this node is revised.)}\n";
  77         print "\@end quotation\n";
  78         $_ = <>;
  79     }
  80     else
  81     {
  82         while (/\@value{([^\}]*)}/)
  83         {
  84             if (defined $set{$1})
  85             {
  86                 $_ = "$`$set{$1}$'";
  87             }
  88             else
  89             {
  90                 $_ = "$`\@strong{<UNDEFINED>}$1\@strong{</UNDEFINED>}$'";
  91             }
  92         }
  93         while (/\@FIXME-?([a-z]*)\{/)
  94         {
  95             $tag = $1 eq '' ? 'fixme' : $1;
  96             $tag =~ y/a-z/A-Z/;
  97             print "$`\@strong{<$tag>}";
  98             $_ = $';
  99             $level = 1;
 100             while ($level > 0)
 101             {
 102                 if (/([{}])/)
 103                 {
 104                     if ($1 eq '{')
 105                     {
 106                         $level++;
 107                         print "$`\{";
 108                         $_ = $';
 109                     }
 110                     elsif ($level > 1)
 111                     {
 112                         $level--;
 113                         print "$`\}";
 114                         $_ = $';
 115                     }
 116                     else
 117                     {
 118                         $level = 0;
 119                         print "$`\@strong{</$tag>}";
 120                         $_ = $';
 121                     }
 122                 }
 123                 else
 124                 {
 125                     print;
 126                     $_ = <>;
 127                 }
 128             }
 129         }
 130         print;
 131         $_ = <>;
 132     }
 133 }
 134 exit 0;