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 # Copyright © 1996 Free Software Foundation, Inc.
   7 # François Pinard <pinard@iro.umontreal.ca>, 1996.
   8
   9 $_ = <>;
  10 while ($_)
  11 {
  12     if (/^\@c()$/ || /^\@c (.*)/ || /^\@(include .*)/)
  13     {
  14         if ($topseen)
  15         {
  16             print "\@format\n";
  17             print "\@strong{\@\@c} $1\n";
  18             $_ = <>;
  19             while (/\@c (.*)/)
  20             {
  21                 print "\@strong{\@\@c} $1\n";
  22                 $_ = <>;
  23             }
  24             print "\@end format\n";
  25         }
  26         else
  27         {
  28             $delay .= "\@format\n";
  29             $delay .= "\@strong{\@\@c} $1\n";
  30             $_ = <>;
  31             while (/\@c (.*)/)
  32             {
  33                 $delay .= "\@strong{\@\@c} $1\n";
  34                 $_ = <>;
  35             }
  36             $delay .= "\@end format\n";
  37         }
  38     }
  39     elsif (/^\@chapter /)
  40     {
  41         print;
  42 #       print $delay;
  43         $delay = '';
  44         $topseen = 1;
  45         $_ = <>;
  46     }
  47     elsif (/^\@macro /)
  48     {
  49         $_ = <> while ($_ && ! /^\@end macro/);
  50         $_ = <>;
  51     }
  52     elsif (/^\@set ([^ ]+) (.*)/)
  53     {
  54         $set{$1} = $2;
  55         $_ = <>;
  56     }
  57     elsif (/^\@UNREVISED/)
  58     {
  59         print "\@quotation\n";
  60         print "\@emph{(This message will disappear, once this node is revised.)}\n";
  61         print "\@end quotation\n";
  62         $_ = <>;
  63     }
  64     else
  65     {
  66         while (/\@value{([^\}]*)}/)
  67         {
  68             if (defined $set{$1})
  69             {
  70                 $_ = "$`$set{$1}$'";
  71             }
  72             else
  73             {
  74                 $_ = "$`\@strong{<UNDEFINED>}$1\@strong{</UNDEFINED>}$'";
  75             }
  76         }
  77         while (/\@FIXME-?([a-z]*)\{/)
  78         {
  79             $tag = $1 eq '' ? 'fixme' : $1;
  80             $tag =~ y/a-z/A-Z/;
  81             print "$`\@strong{<$tag>}";
  82             $_ = $';
  83             $level = 1;
  84             while ($level > 0)
  85             {
  86                 if (/([{}])/)
  87                 {
  88                     if ($1 eq '{')
  89                     {
  90                         $level++;
  91                         print "$`\{";
  92                         $_ = $';
  93                     }
  94                     elsif ($level > 1)
  95                     {
  96                         $level--;
  97                         print "$`\}";
  98                         $_ = $';
  99                     }
 100                     else
 101                     {
 102                         $level = 0;
 103                         print "$`\@strong{</$tag>}";
 104                         $_ = $';
 105                     }
 106                 }
 107                 else
 108                 {
 109                     print;
 110                     $_ = <>;
 111                 }
 112             }
 113         }
 114         print;
 115         $_ = <>;
 116     }
 117 }
 118 exit 0;