| #! /usr/bin/perl -w |
| # Extract all examples from the manual source. |
| |
| # This file is part of GNU Bison |
| |
| # Copyright (C) 1992, 2000-2001, 2005-2006, 2009-2015, 2018-2019 Free |
| # Software Foundation, Inc. |
| # |
| # This program is free software: you can redistribute it and/or modify |
| # it under the terms of the GNU General Public License as published by |
| # the Free Software Foundation, either version 3 of the License, or |
| # (at your option) any later version. |
| # |
| # This program is distributed in the hope that it will be useful, |
| # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| # GNU General Public License for more details. |
| # |
| # You should have received a copy of the GNU General Public License |
| # along with this program. If not, see <http://www.gnu.org/licenses/>. |
| |
| # Usage: extexi [OPTION...] input-file.texi ... -- [FILES to extract] |
| |
| # Look for @example environments preceded with lines such as: |
| # |
| # @comment file calc.y |
| # or |
| # @comment file calc.y: 3 |
| # |
| # and output their content in that file (calc.y). When numbers are |
| # provided, use them to decide the output order (block numbered 1 is |
| # output before block 2, even if the latter appears before). The same |
| # number may be used several time, in which case the order of |
| # appearance is used. |
| # |
| # Use @ignore for code to extract that must not be part of the |
| # documentation. For instance: |
| # |
| # @ignore |
| # @comment file: calc++/scanner.ll |
| # @example |
| # // Work around an incompatibility in Flex. |
| # # undef yywrap |
| # # define yywrap() 1 |
| # @end example |
| # @end ignore |
| |
| use strict; |
| |
| use File::Basename qw(dirname); |
| use File::Path qw(make_path); |
| |
| # Whether we generate synclines. |
| my $synclines = 0; |
| |
| # normalize($block) |
| # ----------------- |
| # Remove Texinfo mark up. |
| sub normalize($) |
| { |
| local ($_) = @_; |
| |
| # If we just remove this lines, then the compiler's tracking of |
| # #lines is broken. Leave lines that that accepted by all our tools |
| # (including flex, hence the leading space), and that will be easy |
| # to remove (see the Make examples-unline recipe). |
| s{^\@(c |comment|dots|end (ignore|group)|ignore|group).*}{ /**/}mg; |
| s/\@value\{VERSION\}/$ENV{VERSION}/g; |
| s/^\@(error|result)\{\}//mg; |
| s/\@([{}@])/$1/g; |
| s/\@comment.*//; |
| $_; |
| } |
| |
| # Print messages only once. |
| my %msg; |
| sub message($) |
| { |
| my ($msg) = @_; |
| if (! $msg{$msg}) |
| { |
| print STDERR "extexi: $msg\n"; |
| $msg{$msg} = 1; |
| } |
| } |
| |
| # The list of files we should extract. |
| my @file_wanted; |
| |
| # Whether we should extract that file, and then under which path. |
| sub file_wanted ($) |
| { |
| my ($f) = @_; |
| for my $file (@file_wanted) |
| { |
| # No endswith in Perl 5... |
| return $file if $f eq substr($file, -length($f)); |
| } |
| undef |
| } |
| |
| # process ($in) |
| # ------------- |
| # Read input file $in, and generate the outputs. |
| sub process ($) |
| { |
| my ($in) = @_; |
| use IO::File; |
| my $f = new IO::File($in) |
| or die "$in: cannot open: $?"; |
| # FILE-NAME => { BLOCK-NUM => CODE } |
| my %file; |
| |
| # The latest "@comment file: FILE [BLOCK-NUM]" arguments. |
| my $file; |
| my $block; |
| # The @example block currently read. |
| my $input; |
| local $_; |
| while (<$f>) |
| { |
| if (/^\@comment file: ([^:\n]+)(?::\s*(\d+))?$/) |
| { |
| my $f = $1; |
| $block = $2 || 1; |
| if (file_wanted($f)) |
| { |
| $file = file_wanted($f); |
| message(" GEN $file"); |
| } |
| else |
| { |
| message("SKIP $f"); |
| } |
| } |
| elsif ($file && /^\@(small)?example$/ .. /^\@end (small)?example$/) |
| { |
| if (/^\@(small)?example$/) |
| { |
| # Bison supports synclines, but not Flex. |
| $input .= sprintf ("#line %s \"$in\"\n", $. + 1) |
| if $synclines && $file =~ /\.[chy]*$/; |
| } |
| elsif (/^\@end (small)?example$/) |
| { |
| die "no contents: $file" |
| if $input eq ""; |
| |
| $file{$file}{$block} .= "\n" if defined $file{$file}{$block}; |
| $file{$file}{$block} .= normalize($input); |
| $file = $input = undef; |
| ++$block; |
| } |
| else |
| { |
| $input .= $_; |
| } |
| } |
| } |
| |
| # Output the files. |
| for my $file (keys %file) |
| { |
| make_path (dirname ($file)); |
| my $o = new IO::File(">$file") |
| or die "$file: cannot create: $?"; |
| print $o $file{$file}{$_} |
| for sort keys %{$file{$file}}; |
| } |
| } |
| |
| my @input; |
| my $seen_dash = 0; |
| for my $arg (@ARGV) |
| { |
| if ($seen_dash) |
| { |
| push @file_wanted, $arg; |
| } |
| elsif ($arg eq '--') |
| { |
| $seen_dash = 1; |
| } |
| elsif ($arg eq '--synclines') |
| { |
| $synclines = 1; |
| } |
| else |
| { |
| push @input, $arg; |
| } |
| } |
| process $_ |
| foreach @input; |
| |
| |
| ### Setup "GNU" style for perl-mode and cperl-mode. |
| ## Local Variables: |
| ## perl-indent-level: 2 |
| ## perl-continued-statement-offset: 2 |
| ## perl-continued-brace-offset: 0 |
| ## perl-brace-offset: 0 |
| ## perl-brace-imaginary-offset: 0 |
| ## perl-label-offset: -2 |
| ## cperl-indent-level: 2 |
| ## cperl-brace-offset: 0 |
| ## cperl-continued-brace-offset: 0 |
| ## cperl-label-offset: -2 |
| ## cperl-extra-newline-before-brace: t |
| ## cperl-merge-trailing-else: nil |
| ## cperl-continued-statement-offset: 2 |
| ## End: |