examples/extexi

   1 #! /usr/bin/perl -w
   2 # Extract all examples from the manual source.
   3
   4 # This file is part of GNU Bison
   5
   6 # Copyright (C) 1992, 2000-2001, 2005-2006, 2009-2012 Free Software
   7 # Foundation, Inc.
   8 #
   9 # This program is free software: you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation, either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 # Usage: extexi input-file.texi ... -- [FILES to extract]
  23
  24 # Look for @example environments preceded with lines such as:
  25 #
  26 #      @comment file calc.y
  27 # or
  28 #      @comment file calc.y: 3
  29 #
  30 # and output their content in that file (calc.y).  When numbers are
  31 # provided, use them to decide the output order (block numbered 1 is
  32 # output before block 2, even if the latter appears before).  The same
  33 # number may be used several time, in which case the order of
  34 # appearance is used.
  35
  36 use strict;
  37
  38 # normalize($block)
  39 # -----------------
  40 # Remove Texinfo mark up.
  41 sub normalize($)
  42 {
  43   local ($_) = @_;
  44
  45   s/^\@(c |comment|dots|end (ignore|group)|ignore|group).*//mg;
  46   s/\@value\{VERSION\}/$ENV{VERSION}/g;
  47   s/^\@(error|result)\{\}//mg;
  48   s/\@([{}@])/$1/g;
  49   s/\@comment.*//;
  50   $_;
  51 }
  52
  53 # Print messages only once.
  54 my %msg;
  55 sub message($)
  56 {
  57   my ($msg) = @_;
  58   if (! $msg{$msg})
  59     {
  60       print STDERR "extexi: $msg\n";
  61       $msg{$msg} = 1;
  62     }
  63 }
  64
  65 # basename => full file name for files we should extract.
  66 my %file_wanted;
  67
  68 sub process ($)
  69 {
  70   my ($in) = @_;
  71   use IO::File;
  72   my $f = new IO::File($in)
  73     or die "$in: cannot open: $?";
  74   # FILE-NAME => { BLOCK-NUM => CODE }
  75   my %file;
  76
  77   # The latest "@comment file: FILE [BLOCK-NUM]" arguments.
  78   my $file;
  79   my $block;
  80   # The @example block currently read.
  81   my $input;
  82   local $_;
  83   while (<$f>)
  84     {
  85       if (/^\@comment file: ([^:\n]+)(?::\s*(\d+))?$/)
  86         {
  87           my $f = $1;
  88           $block = $2 || 1;
  89           if ($file_wanted{$f})
  90             {
  91               $file = $file_wanted{$f};
  92               message(" GEN $file");
  93             }
  94           else
  95             {
  96               message("SKIP $f");
  97             }
  98         }
  99       elsif ($file && /^\@(small)?example$/ .. /^\@end (small)?example$/)
 100         {
 101           if (/^\@(small)?example$/)
 102             {
 103               # Bison supports synclines, but not Flex.
 104               $input .= sprintf ("#line %s \"$in\"\n", $. + 1)
 105                 if $file =~ /\.[chy]*$/;
 106               next;
 107             }
 108           elsif (/^\@end (small)?example$/)
 109             {
 110               die "no contents: $file"
 111                 if $input eq "";
 112
 113               $file{$file}{$block} .= normalize($input);
 114               $file = $input = undef;
 115               ++$block;
 116             }
 117           else
 118             {
 119               $input .= $_;
 120             }
 121         }
 122     }
 123
 124   # Output the files.
 125   for my $file (keys %file)
 126     {
 127       # No spurious end of line: use printf.
 128       my $o = new IO::File(">$file")
 129         or die "$file: cannot create: $?";
 130       print $o $file{$file}{$_}
 131         for sort keys %{$file{$file}};
 132     }
 133 }
 134
 135 my @input;
 136 my $seen_dash = 0;
 137 for my $arg (@ARGV)
 138 {
 139   if ($arg eq '--')
 140     {
 141       $seen_dash = 1;
 142     }
 143   elsif ($seen_dash)
 144     {
 145       use File::Basename;
 146       $file_wanted{basename($arg)} = $arg;
 147     }
 148   else
 149     {
 150       push @input, $arg;
 151     }
 152 }
 153 process $_
 154   foreach @input;
 155
 156
 157 ### Setup "GNU" style for perl-mode and cperl-mode.
 158 ## Local Variables:
 159 ## perl-indent-level: 2
 160 ## perl-continued-statement-offset: 2
 161 ## perl-continued-brace-offset: 0
 162 ## perl-brace-offset: 0
 163 ## perl-brace-imaginary-offset: 0
 164 ## perl-label-offset: -2
 165 ## cperl-indent-level: 2
 166 ## cperl-brace-offset: 0
 167 ## cperl-continued-brace-offset: 0
 168 ## cperl-label-offset: -2
 169 ## cperl-extra-newline-before-brace: t
 170 ## cperl-merge-trailing-else: nil
 171 ## cperl-continued-statement-offset: 2
 172 ## End: