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 use strict;
  25
  26 # normalize($block)
  27 # -----------------
  28 # Remove Texinfo mark up.
  29 sub normalize($)
  30 {
  31   local ($_) = @_;
  32
  33   s/^\@(c |comment|dots|end (ignore|group)|ignore|group).*//mg;
  34   s/\@value\{VERSION\}/$ENV{VERSION}/g;
  35   s/^\@(error|result)\{\}//mg;
  36   s/\@([{}@])/$1/g;
  37   s/\@comment.*//;
  38   $_;
  39 }
  40
  41 # Print messages only once.
  42 my %msg;
  43 sub message($)
  44 {
  45   my ($msg) = @_;
  46   if (! $msg{$msg})
  47     {
  48       print STDERR "extexi: $msg\n";
  49       $msg{$msg} = 1;
  50     }
  51 }
  52
  53 # basename => full file name for files we should extract.
  54 my %file_wanted;
  55 # Whether we already say that file (in which case, append instead of
  56 # create).
  57 my %file_output;
  58
  59 sub process ($)
  60 {
  61   my ($in) = @_;
  62   use IO::File;
  63   my $f = new IO::File($in)
  64     or die "$in: cannot open: $?";
  65   # The latest "@comment file: " argument.
  66   my $file;
  67   # The @example block currently read.
  68   my $input;
  69   local $_;
  70   while (<$f>)
  71     {
  72       if (/^\@comment file: (.*)/)
  73         {
  74           my $f = $1;
  75           if ($file_wanted{$f})
  76             {
  77               $file = $file_wanted{$f};
  78               message(" GEN $file");
  79             }
  80           else
  81             {
  82               message("SKIP $f");
  83             }
  84         }
  85       elsif ($file && /^\@(small)?example$/ .. /^\@end (small)?example$/)
  86         {
  87           if (/^\@(small)?example$/)
  88             {
  89               $input = $file_output{$file} ? "\n" : "";
  90               # Bison supports synclines, but not Flex.
  91               $input .= sprintf ("#line %s \"$in\"\n", $. + 1)
  92                 if $file =~ /\.[chy]*$/;
  93               next;
  94             }
  95           elsif (/^\@end (small)?example$/)
  96             {
  97               die "no contents: $file"
  98                 if $input eq "";
  99
 100               $input = normalize($input);
 101               # No spurious end of line: use printf.
 102               my $o =
 103                 ($file_output{$file}
 104                  ? new IO::File(">>$file")
 105                  : new IO::File(">$file"));
 106               print $o $input;
 107               $file_output{$file} = 1;
 108               $file = $input = undef;
 109             }
 110           else
 111             {
 112               $input .= $_;
 113             }
 114         }
 115
 116     }
 117 }
 118
 119 my @input;
 120 my $seen_dash = 0;
 121 for my $arg (@ARGV)
 122 {
 123   if ($arg eq '--')
 124     {
 125       $seen_dash = 1;
 126     }
 127   elsif ($seen_dash)
 128     {
 129       use File::Basename;
 130       $file_wanted{basename($arg)} = $arg;
 131     }
 132   else
 133     {
 134       push @input, $arg;
 135     }
 136 }
 137 process $_
 138   foreach @input;
 139
 140
 141 ### Setup "GNU" style for perl-mode and cperl-mode.
 142 ## Local Variables:
 143 ## perl-indent-level: 2
 144 ## perl-continued-statement-offset: 2
 145 ## perl-continued-brace-offset: 0
 146 ## perl-brace-offset: 0
 147 ## perl-brace-imaginary-offset: 0
 148 ## perl-label-offset: -2
 149 ## cperl-indent-level: 2
 150 ## cperl-brace-offset: 0
 151 ## cperl-continued-brace-offset: 0
 152 ## cperl-label-offset: -2
 153 ## cperl-extra-newline-before-brace: t
 154 ## cperl-merge-trailing-else: nil
 155 ## cperl-continued-statement-offset: 2
 156 ## End: