diff options
Diffstat (limited to 'web/noweb/contrib/ydirson/inheritlang')
-rwxr-xr-x | web/noweb/contrib/ydirson/inheritlang | 76 |
1 files changed, 76 insertions, 0 deletions
diff --git a/web/noweb/contrib/ydirson/inheritlang b/web/noweb/contrib/ydirson/inheritlang new file mode 100755 index 0000000000..f71cce0a61 --- /dev/null +++ b/web/noweb/contrib/ydirson/inheritlang @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +# Noweb filter to propagate @language directive from a chunk to used +# chunks. Assumes that root chunks already have a @language directive +# (see guesslang filter). Takes no argument. + +# Copyright (c) 2003 by Yann Dirson <ydirson@altern.org> + +# Distribute under the terms of the GNU General Public Licence, +# version 2. + +use strict; + +my (%chunklangs, %chunkchildren); + +# FIXME: we could bufferize as needed, if we want to grow more complex +my @data = <STDIN>; + +# register the chunk hierarchy +{ + my $thischunk = undef; + foreach (@data) { + if (m/^\@end code/) { # this one first to limit to code chunks + $thischunk = undef; + } elsif (m/^\@use (.*)$/) { + push @{$chunkchildren{$thischunk}}, $1 if defined $thischunk; + } elsif (m/^\@defn (.*)$/) { + $thischunk = $1; + } elsif (m/^\@language (.*)$/) { + die "\@language without a \@defn: $_" unless defined $thischunk; + $chunklangs{$thischunk} = $1; + } + } +} + +# propagate to argument's children +sub propagate { + my ($thischunk) = @_; + if (defined $chunklangs{$thischunk}) { + foreach my $child (@{$chunkchildren{$thischunk}}) { + if (defined $chunklangs{$child}) { + if ($chunklangs{$child} eq $chunklangs{$thischunk}) { + print STDERR "Notice: chunk used more than once: \`$child'\n"; + } else { + die "Chunk cannot inherits languages \`$chunklangs{$child}' and " . + "\`$chunklangs{$thischunk}': \`$child'\n"; + } + } else { + $chunklangs{$child} = $chunklangs{$thischunk}; + } + + # recurse + propagate($child); + } + } else { + print STDERR "Warning: could not infer language for \`$thischunk'\n"; + } +} + +# propagate from all known chunks +foreach my $chunk (keys %chunklangs) { + propagate($chunk); +} + +# output +foreach (@data) { + if (m/^\@defn (.*)$/) { + print $_; + print "\@language $chunklangs{$1}\n" if (defined $chunklangs{$1}) + } elsif (m/^\@language /) { + # Do not output twice. Since we already asserted consistency we can + # simply ignore this one. + } else { + print $_; + } +} |