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 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 @ignore for code to extract that must not be part of the
  37 # documentation.  For instance:
  38 #
  39 #      @ignore
  40 #      @comment file: 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.
  91 sub file_wanted ($)
  92 {
  93   my ($f) = @_;
  94   for my $file (@file_wanted)
  95     {
  96       # No endswith in Perl 5...
  97       return $file if $f eq substr($file, -length($f));
  98     }
  99   undef
 100 }
 101
 102 # process ($in)
 103 # -------------
 104 # Read input file $in, and generate the outputs.
 105 sub process ($)
 106 {
 107   my ($in) = @_;
 108   use IO::File;
 109   my $f = new IO::File($in)
 110     or die "$in: cannot open: $?";
 111   # FILE-NAME => { BLOCK-NUM => CODE }
 112   my %file;
 113
 114   # The latest "@comment file: FILE [BLOCK-NUM]" arguments.
 115   my $file;
 116   my $block;
 117   # The @example block currently read.
 118   my $input;
 119   local $_;
 120   while (<$f>)
 121     {
 122       if (/^\@comment file: ([^:\n]+)(?::\s*(\d+))?$/)
 123         {
 124           my $f = $1;
 125           $block = $2 || 1;
 126           if (file_wanted($f))
 127             {
 128               $file = file_wanted($f);
 129               message(" GEN $file");
 130             }
 131           else
 132             {
 133               message("SKIP $f");
 134             }
 135         }
 136       elsif ($file && /^\@(small)?example$/ .. /^\@end (small)?example$/)
 137         {
 138           if (/^\@(small)?example$/)
 139             {
 140               # Bison supports synclines, but not Flex.
 141               $input .= sprintf ("#line %s \"$in\"\n", $. + 1)
 142                 if $synclines && $file =~ /\.[chy]*$/;
 143             }
 144           elsif (/^\@end (small)?example$/)
 145             {
 146               die "no contents: $file"
 147                 if $input eq "";
 148
 149               $file{$file}{$block} .= "\n" if defined $file{$file}{$block};
 150               $file{$file}{$block} .= normalize($input);
 151               $file = $input = undef;
 152               ++$block;
 153             }
 154           else
 155             {
 156               $input .= $_;
 157             }
 158         }
 159     }
 160
 161   # Output the files.
 162   for my $file (keys %file)
 163     {
 164       make_path (dirname ($file));
 165       my $o = new IO::File(">$file")
 166         or die "$file: cannot create: $?";
 167       print $o $file{$file}{$_}
 168         for sort keys %{$file{$file}};
 169     }
 170 }
 171
 172 my @input;
 173 my $seen_dash = 0;
 174 for my $arg (@ARGV)
 175 {
 176   if ($seen_dash)
 177     {
 178       push @file_wanted, $arg;
 179     }
 180   elsif ($arg eq '--')
 181     {
 182       $seen_dash = 1;
 183     }
 184   elsif ($arg eq '--synclines')
 185     {
 186       $synclines = 1;
 187     }
 188   else
 189     {
 190       push @input, $arg;
 191     }
 192 }
 193 process $_
 194   foreach @input;
 195
 196
 197 ### Setup "GNU" style for perl-mode and cperl-mode.
 198 ## Local Variables:
 199 ## perl-indent-level: 2
 200 ## perl-continued-statement-offset: 2
 201 ## perl-continued-brace-offset: 0
 202 ## perl-brace-offset: 0
 203 ## perl-brace-imaginary-offset: 0
 204 ## perl-label-offset: -2
 205 ## cperl-indent-level: 2
 206 ## cperl-brace-offset: 0
 207 ## cperl-continued-brace-offset: 0
 208 ## cperl-label-offset: -2
 209 ## cperl-extra-newline-before-brace: t
 210 ## cperl-merge-trailing-else: nil
 211 ## cperl-continued-statement-offset: 2
 212 ## End: