]> git.saurik.com Git - bison.git/blobdiff - examples/extexi
Merge remote-tracking branch 'origin/master'
[bison.git] / examples / extexi
old mode 100644 (file)
new mode 100755 (executable)
index 15fb278..8f27a3b
@@ -1,7 +1,9 @@
-# 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 (C) 1992, 2000, 2001, 2005, 2006, 2009 Free Software
+
+# Copyright (C) 1992, 2000-2001, 2005-2006, 2009-2012 Free Software
 # Foundation, Inc.
 #
 # This program is free software: you can redistribute it and/or modify
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-# 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;
-}
 
-/^@node / {
-  if (seq > 0)
-    print "AT_CLEANUP";
-
-  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;
+
+# 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 $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])
-       # The parens around the output file seem to be required
-        # by awk on Mac OS X Tiger (darwin 8.4.6).
-        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 ($arg eq '--')
     {
-      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 (/"@value\{VERSION\}"/, "\"" VERSION "\"", line)
-      gsub (/^@result\{\}/, "", line);
-      gsub (/^@error\{\}/,  "", line);
-      gsub ("@[{]", "{", line);
-      gsub ("@}", "}", line);
-      gsub ("@@", "@", line);
-      gsub ("@comment.*", "", line);
-
-      res = res line "\n";
+      $seen_dash = 1;
     }
-  return res;
-}
-
-
-function message(msg) {
-  if (! message_printed[msg])
+  elsif ($seen_dash)
     {
-      print "extexi: " msg > "/dev/stderr";
-      message_printed[msg] = 1;
+      use File::Basename;
+      $file_wanted{basename($arg)} = $arg;
+    }
+  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: