X-Git-Url: https://git.saurik.com/bison.git/blobdiff_plain/f938a7e7b80eacb7c66777a20b81db87b67f3bd6..671850a1c3e1aaac93a89fabc6d810be6a4a77fe:/examples/extexi diff --git a/examples/extexi b/examples/extexi old mode 100644 new mode 100755 index 4bd48979..f7c443f2 --- a/examples/extexi +++ b/examples/extexi @@ -1,11 +1,14 @@ -# Extract all examples from the manual source. -*- AWK -*- +#! /usr/bin/perl -w +# Extract all examples from the manual source. # This file is part of GNU Bison -# Copyright 1992, 2000, 2001, 2005 Free Software Foundation, Inc. + +# Copyright (C) 1992, 2000-2001, 2005-2006, 2009-2015 Free Software +# Foundation, Inc. # -# This program is free software; you can redistribute it and/or modify +# 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 2 of the License, or +# 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, @@ -14,123 +17,163 @@ # 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, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -# 02111-1307 USA - -# This script is for use with any Awk that conforms to POSIX. -# It was derived from a similar script tests/generate.awk in GNU m4. -# -# Usage: extexi input-file.texi ... -- [FILES to extract] -BEGIN { - if (!output_dir) - output_dir = "."; - for (argc = 1; argc < ARGC; ++argc) - if (ARGV[argc] == "--") - break; - for (i = argc + 1; i < ARGC; ++i) - file_wanted[ARGV[i]] = 1; - ARGC = argc; -} +# along with this program. If not, see . -/^@node / { - if (seq > 0) - print "AT_CLEANUP"; +# Usage: extexi [OPTION...] input-file.texi ... -- [FILES to extract] - split ($0, tmp, ","); - node = substr(tmp[1], 7); - seq = 0; +# 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 strict; + +# Whether we generate synclines. +my $synclines = 0; + +# normalize($block) +# ----------------- +# Remove Texinfo mark up. +sub normalize($) +{ + local ($_) = @_; + + 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.*//; + $_; } -/^@comment file: / { - if (!file_wanted[$3]) - message("ignoring " $3); - else +# Print messages only once. +my %msg; +sub message($) +{ + my ($msg) = @_; + if (! $msg{$msg}) { - message("extracting " $3); - file = $3; + print STDERR "extexi: $msg\n"; + $msg{$msg} = 1; } } -/^@example$/, /^@end example$/ { - if (!file) - next; - - if ($0 ~ /^@example$/) +# basename => full file name for files we should extract. +my %file_wanted; + +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>) { - input = files_output[file] ? "\n" : ""; - - # FNR is starting at 0 instead of 1, and - # #line report the line number of the *next* line. - # => + 2. - # Note that recent Bison support it, but not Flex. - if (file ~ /\.[chy]*$/) - input = "#line " (FNR + 1) " \"" FILENAME "\"\n"; - next; + 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]*$/; + next; + } + elsif (/^\@end (small)?example$/) + { + die "no contents: $file" + if $input eq ""; + + $file{$file}{$block} .= normalize($input); + $file = $input = undef; + ++$block; + } + else + { + $input .= $_; + } + } } - if ($0 ~ /^@end example$/) + # Output the files. + for my $file (keys %file) { - if (input == "") - fatal("no contents: " file); - - input = normalize(input); # No spurious end of line: use printf. - if (files_output[file]) - printf ("%s", input) >> output_dir "/" file; - else - printf ("%s", input) > output_dir "/" file; - close (output_dir "/" file); - files_output[file] = 1; - - file = input = ""; - next; + my $o = new IO::File(">$file") + or die "$file: cannot create: $?"; + print $o $file{$file}{$_} + for sort keys %{$file{$file}}; } - - input = input $0 "\n"; } - -# We have to handle CONTENTS line per line, since anchors in AWK are -# referring to the whole string, not the lines. -function normalize(contents, i, lines, n, line, res) { - # Remove the Texinfo tags. - n = split (contents, lines, "\n"); - # We don't want the last field which empty: it's behind the last \n. - for (i = 1; i < n; ++i) +my @input; +my $seen_dash = 0; +for my $arg (@ARGV) +{ + if ($seen_dash) { - line = lines[i]; - - # Whole line commands. - if (line ~ /^@(c |comment|dots|end (ignore|group)|ignore|group)/) - # Gperf accepts empty lines as valid input!!! - if (file ~ /\.gperf$/) - continue; - else - line = ""; - - gsub (/^@result\{\}/, "", line); - gsub (/^@error\{\}/, "", line); - gsub ("@[{]", "{", line); - gsub ("@}", "}", line); - gsub ("@@", "@", line); - gsub ("@comment.*", "", line); - - res = res line "\n"; + use File::Basename; + $file_wanted{basename($arg)} = $arg; } - return res; -} - - -function message(msg) { - if (! message_printed[msg]) + elsif ($arg eq '--') { - print "extexi: " msg > "/dev/stderr"; - message_printed[msg] = 1; + $seen_dash = 1; + } + elsif ($arg eq '--synclines') + { + $synclines = 1; + } + else + { + push @input, $arg; } } - -function fatal(msg) { - message(msg); - exit 1 -} +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: