]> git.saurik.com Git - bison.git/blob - examples/extexi
Merge branch 'maint'
[bison.git] / 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-2012 Free Software
7 # 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 <http://www.gnu.org/licenses/>.
21
22 # Usage: extexi 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 strict;
37
38 # normalize($block)
39 # -----------------
40 # Remove Texinfo mark up.
41 sub normalize($)
42 {
43 local ($_) = @_;
44
45 s/^\@(c |comment|dots|end (ignore|group)|ignore|group).*//mg;
46 s/\@value\{VERSION\}/$ENV{VERSION}/g;
47 s/^\@(error|result)\{\}//mg;
48 s/\@([{}@])/$1/g;
49 s/\@comment.*//;
50 $_;
51 }
52
53 # Print messages only once.
54 my %msg;
55 sub message($)
56 {
57 my ($msg) = @_;
58 if (! $msg{$msg})
59 {
60 print STDERR "extexi: $msg\n";
61 $msg{$msg} = 1;
62 }
63 }
64
65 # basename => full file name for files we should extract.
66 my %file_wanted;
67
68 sub process ($)
69 {
70 my ($in) = @_;
71 use IO::File;
72 my $f = new IO::File($in)
73 or die "$in: cannot open: $?";
74 # FILE-NAME => { BLOCK-NUM => CODE }
75 my %file;
76
77 # The latest "@comment file: FILE [BLOCK-NUM]" arguments.
78 my $file;
79 my $block;
80 # The @example block currently read.
81 my $input;
82 local $_;
83 while (<$f>)
84 {
85 if (/^\@comment file: ([^:\n]+)(?::\s*(\d+))?$/)
86 {
87 my $f = $1;
88 $block = $2 || 1;
89 if ($file_wanted{$f})
90 {
91 $file = $file_wanted{$f};
92 message(" GEN $file");
93 }
94 else
95 {
96 message("SKIP $f");
97 }
98 }
99 elsif ($file && /^\@(small)?example$/ .. /^\@end (small)?example$/)
100 {
101 if (/^\@(small)?example$/)
102 {
103 # Bison supports synclines, but not Flex.
104 $input .= sprintf ("#line %s \"$in\"\n", $. + 1)
105 if $file =~ /\.[chy]*$/;
106 next;
107 }
108 elsif (/^\@end (small)?example$/)
109 {
110 die "no contents: $file"
111 if $input eq "";
112
113 $file{$file}{$block} .= normalize($input);
114 $file = $input = undef;
115 ++$block;
116 }
117 else
118 {
119 $input .= $_;
120 }
121 }
122 }
123
124 # Output the files.
125 for my $file (keys %file)
126 {
127 # No spurious end of line: use printf.
128 my $o = new IO::File(">$file")
129 or die "$file: cannot create: $?";
130 print $o $file{$file}{$_}
131 for sort keys %{$file{$file}};
132 }
133 }
134
135 my @input;
136 my $seen_dash = 0;
137 for my $arg (@ARGV)
138 {
139 if ($arg eq '--')
140 {
141 $seen_dash = 1;
142 }
143 elsif ($seen_dash)
144 {
145 use File::Basename;
146 $file_wanted{basename($arg)} = $arg;
147 }
148 else
149 {
150 push @input, $arg;
151 }
152 }
153 process $_
154 foreach @input;
155
156
157 ### Setup "GNU" style for perl-mode and cperl-mode.
158 ## Local Variables:
159 ## perl-indent-level: 2
160 ## perl-continued-statement-offset: 2
161 ## perl-continued-brace-offset: 0
162 ## perl-brace-offset: 0
163 ## perl-brace-imaginary-offset: 0
164 ## perl-label-offset: -2
165 ## cperl-indent-level: 2
166 ## cperl-brace-offset: 0
167 ## cperl-continued-brace-offset: 0
168 ## cperl-label-offset: -2
169 ## cperl-extra-newline-before-brace: t
170 ## cperl-merge-trailing-else: nil
171 ## cperl-continued-statement-offset: 2
172 ## End: