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