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, 2018-2021 Free
   7 # Software 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 <https://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 c/mfcalc/calc.y
  27 # or
  28 #      @comment file c/mfcalc/calc.y: 3
  29 #
  30 # and output their content in that file (c/mfcalc/calc.y).  When
  31 # numbers are provided, use them to decide the output order (block 1
  32 # is output before block 2, even if the latter appears before).  The
  33 # same number may be used several time, in which case the order of
  34 # appearance is used.
  35 #
  36 # Use @ignore for code to extract that must not be part of the
  37 # documentation.  For instance:
  38 #
  39 #      @ignore
  40 #      @comment file: c++/calc++/scanner.ll
  41 #      @example
  42 #      // Work around an incompatibility in Flex.
  43 #      # undef yywrap
  44 #      # define yywrap() 1
  45 #      @end example
  46 #      @end ignore
  47
  48 use strict;
  49
  50 use File::Basename qw(dirname);
  51 use File::Path qw(make_path);
  52
  53 # Whether we generate synclines.
  54 my $synclines = 0;
  55
  56 # normalize($block)
  57 # -----------------
  58 # Remove Texinfo mark up.
  59 sub normalize($)
  60 {
  61   local ($_) = @_;
  62
  63   # If we just remove this lines, then the compiler's tracking of
  64   # #lines is broken.  Leave lines that that accepted by all our tools
  65   # (including flex, hence the leading space), and that will be easy
  66   # to remove (see the Make examples-unline recipe).
  67   s{^\@(c |comment|dots|end (ignore|group)|ignore|group).*}{ /**/}mg;
  68   s/\@value\{VERSION\}/$ENV{VERSION}/g;
  69   s/^\@(error|result)\{\}//mg;
  70   s/\@([{}@])/$1/g;
  71   s/\@comment.*//;
  72   $_;
  73 }
  74
  75 # Print messages only once.
  76 my %msg;
  77 sub message($)
  78 {
  79   my ($msg) = @_;
  80   if (! $msg{$msg})
  81     {
  82       print STDERR "extexi: $msg\n";
  83       $msg{$msg} = 1;
  84     }
  85 }
  86
  87 # The list of files we should extract.
  88 my @file_wanted;
  89
  90 # Whether we should extract that file, and then under which path.  We
  91 # check if the prefix matches.  So for instance if "foo/bar.y" is
  92 # wanted (i.e., in @FILE_WANTED), "file: bar.y" matches.
  93 sub file_wanted ($)
  94 {
  95   my ($f) = @_;
  96   for my $file (@file_wanted)
  97     {
  98       # No endswith in Perl 5...
  99       return $file if $f eq substr($file, -length($f));
 100     }
 101   undef
 102 }
 103
 104 # process ($in)
 105 # -------------
 106 # Read input file $in, and generate the outputs.
 107 sub process ($)
 108 {
 109   my ($in) = @_;
 110   use IO::File;
 111   my $f = new IO::File($in)
 112     or die "$in: cannot open: $?";
 113   # FILE-NAME => { BLOCK-NUM => CODE }
 114   my %file;
 115
 116   # The latest "@comment file: FILE [BLOCK-NUM]" arguments.
 117   my $file;
 118   my $block;
 119   # The @example block currently read.
 120   my $input;
 121   local $_;
 122   while (<$f>)
 123     {
 124       if (/^\@comment file: ([^:\n]+)(?::\s*(\d+))?$/)
 125         {
 126           my $f = $1;
 127           $block = $2 || 1;
 128           if (file_wanted($f))
 129             {
 130               $file = file_wanted($f);
 131               message(" GEN $file");
 132             }
 133           else
 134             {
 135               message("SKIP $f");
 136             }
 137         }
 138       elsif ($file && /^\@(small)?example$/ .. /^\@end (small)?example$/)
 139         {
 140           if (/^\@(small)?example$/)
 141             {
 142               # Bison supports synclines, but not Flex.
 143               $input .= sprintf ("#line %s \"$in\"\n", $. + 1)
 144                 if $synclines && $file =~ /\.[chy]*$/;
 145             }
 146           elsif (/^\@end (small)?example$/)
 147             {
 148               die "no contents: $file"
 149                 if $input eq "";
 150
 151               $file{$file}{$block} .= "\n" if defined $file{$file}{$block};
 152               $file{$file}{$block} .= normalize($input);
 153               $file = $input = undef;
 154               ++$block;
 155             }
 156           else
 157             {
 158               $input .= $_;
 159             }
 160         }
 161     }
 162
 163   # Output the files.
 164   for my $file (keys %file)
 165     {
 166       make_path (dirname ($file));
 167       my $o = new IO::File(">$file")
 168         or die "$file: cannot create: $?";
 169       print $o $file{$file}{$_}
 170         for sort keys %{$file{$file}};
 171     }
 172 }
 173
 174 my @input;
 175 my $seen_dash = 0;
 176 for my $arg (@ARGV)
 177 {
 178   if ($seen_dash)
 179     {
 180       push @file_wanted, $arg;
 181     }
 182   elsif ($arg eq '--')
 183     {
 184       $seen_dash = 1;
 185     }
 186   elsif ($arg eq '--synclines')
 187     {
 188       $synclines = 1;
 189     }
 190   else
 191     {
 192       push @input, $arg;
 193     }
 194 }
 195 process $_
 196   foreach @input;
 197
 198
 199 ### Setup "GNU" style for perl-mode and cperl-mode.
 200 ## Local Variables:
 201 ## perl-indent-level: 2
 202 ## perl-continued-statement-offset: 2
 203 ## perl-continued-brace-offset: 0
 204 ## perl-brace-offset: 0
 205 ## perl-brace-imaginary-offset: 0
 206 ## perl-label-offset: -2
 207 ## cperl-indent-level: 2
 208 ## cperl-brace-offset: 0
 209 ## cperl-continued-brace-offset: 0
 210 ## cperl-label-offset: -2
 211 ## cperl-extra-newline-before-brace: t
 212 ## cperl-merge-trailing-else: nil
 213 ## cperl-continued-statement-offset: 2
 214 ## End: