1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
#!/usr/bin/perl -w
# Noweb filter which calls enscript to prettyprint according to
# @language directives (see guesslang and inheritlang filters to have
# those directive automatically generated).
# Copyright (c) 2003 by Yann Dirson <ydirson@altern.org>
# Distribute under the terms of the GNU General Public Licence,
# version 2.
# FIXME:
# - @use in code chunks is not supported for all @language's yet
# => find a way to plug external data ?
# - when a perl chunk ends with comment lines, we get enscript
# trailers in woven output
use strict;
use File::Temp qw(tempfile);
my $mangledID='__NOWEB__mangled__use__';
sub mangle_use {
my ($usedchunk, $lang) = @_;
if (grep { $lang eq $_ } ('perl', 'c', 'c++') ) {
return "$mangledID (\"$usedchunk\")\n";
} else {
die "Don't know how to mangle \@use for language $lang";
}
}
sub demangle_use {
my ($mangled, $lang) = @_;
if (grep { $lang eq $_ } ('perl', 'c', 'c++') ) {
$mangled =~ m|^(.*)$mangledID \((?:<B>)?(?:<FONT.*>)?\"(.*)\"(?:</FONT>)?(?:</B>)?\)(.*)$|;
return ($1, $2, $3);
} else {
die "Don't know how to demangle \@use for language $lang";
}
}
# Find out languages supported by the available version of enscript
my @knownlangs;
open (LANGS, 'enscript --help-highlight | grep ^Name: |') or
die "enscript --help-highlight failed: $!";
while (<LANGS>) {
chomp;
@_ = split /\s+/;
push @knownlangs, $_[1];
}
while (<STDIN>) {
if (m/^\@begin code/) {
# we found a code chunk, now bufferize its contents until
# @language, or until @end if no @language is there. Store in
# $event which of these 2 events just occured
my (@buffer, $event);
push @buffer, $_;
while (defined($_ = <STDIN>) and
not ((m/^\@end code / and $event = [1]) or
(m/^\@language (.*)/ and $event = [2, $1])) ) {
push @buffer, $_;
}
die "$0 hit EOF before seing \@end code or \@language" unless defined $event;
if ($event->[0] == 1) {
# we got @end first, everything read goes through unmodified
push @buffer, $_; # the @end line
# no declared language: dump @buffer
foreach (@buffer) { print; }
} else {
# we found @language...
# check that language is supported
my $lang = $event->[1];
if (grep { $_ eq $lang } @knownlangs ) {
# language is supported
# (implicitely) drop @language from output, read remainder
my $chunknum;
while (defined($_ = <STDIN>) and not (m/^\@end code (.*)/ and $chunknum = $1)) {
push @buffer, $_;
}
# we don't want "@end code" in the buffer, delay its output
my $endcode = $_;
# transform the code chunk to be accepted by enscript, and
# store it into an auto-unlinked temporary file
my $tmp = new File::Temp();
# demangle @-directives into something suitable for enscript
foreach (@buffer) {
if (m/^\@text (.*)/ ) {
print $tmp $1;
} elsif (m/^\@nl$/) {
print $tmp "\n";
} elsif (m/^\@use (.*)/) {
print $tmp mangle_use ($1, $lang);
} else {
print;
}
}
# pipe, remangle
open PRETTY, "enscript --highlight=$lang --language=html " .
join (' ', @ARGV) .
" --silent -o - $tmp |" or
die "enscript failed: $!";
{
my $started = undef;
while (<PRETTY>) {
if (m|^<PRE>$|) {
$started = 1;
next;
}
if (m|^</PRE>$|) {
last;
}
if (m/$mangledID/) {
my ($prefix, $use, $suffix) = demangle_use ($_, $lang);
print "\@literal $prefix\n" if $prefix ne '';
print "\@use $use\n" ;
print "\@literal $suffix\n" if $suffix ne '';
next;
}
print "\@literal $_\@nl\n" if defined $started;
}
}
close PRETTY;
close $tmp; # auto-unlinked
print $endcode;
} else {
push @buffer, $_; # the @language line
# unsupported language: dump @buffer
foreach (@buffer) { print; }
}
}
} else {
print $_;
}
}
|
