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
|
package LXRng::Markup::File;
use strict;
use HTML::Entities;
sub new {
my ($class, %args) = @_;
return bless(\%args, $class);
}
sub context {
my ($self) = @_;
return $$self{'context'};
}
sub safe_html {
my ($str) = @_;
return encode_entities($str, '^\n\r\t !\#\$\(-;=?-~\200-\377');
}
sub make_format_newline {
my ($self, $node) = @_;
my $line = 0;
my $tree = $self->context->vtree();
my $name = $node->name;
sub {
my ($nl) = @_;
$line++;
$nl = safe_html($nl);
# id="<num>" is not valid XHTML 1.0, but it is an extremely
# handy shorthand for generating line numbers that don't
# affect cut-n-paste.
return qq{$nl<a id="L$line" name="L$line"></a>}.
qq{<a href="$name#L$line" id="$line" class="line"></a>};
}
}
sub format_comment {
my ($self, $com) = @_;
$com = safe_html($com);
return qq{<span class="comment">$com</span>};
}
sub format_string {
my ($self, $str) = @_;
$str = safe_html($str);
return qq{<span class="string">$str</span>}
}
sub format_include {
my ($self, $paths, $all, $pre, $inc, $suf) = @_;
my $tree = $self->context->vtree();
if (@$paths > 1) {
$pre = safe_html($pre);
$inc = safe_html($inc);
$suf = safe_html($suf);
my $alts = join("|", map { $_ } @$paths);
return qq{$pre<a href="+ambig=$alts" class="falt">$inc</a>$suf};
}
elsif (@$paths > 0) {
$pre = safe_html($pre);
$inc = safe_html($inc);
$suf = safe_html($suf);
return qq{$pre<a href="$$paths[0]" class="fref">$inc</a>$suf};
}
else {
return safe_html($all);
}
}
sub format_code {
my ($self, $idre, $syms, $frag) = @_;
my $tree = $self->context->vtree();
my $path = $self->context->path();
Subst::Complex::s($frag,
$idre => sub {
my $sym = $_[1];
if (exists($$syms{$sym})) {
$sym = safe_html($sym);
return qq{<a href="+code=$sym" class="sref">$sym</a>}
}
else {
return safe_html($sym);
}
},
qr/(.*?)/ => sub { return safe_html($_[0]) },
);
}
sub format_raw {
my ($self, $str) = @_;
return safe_html($str);
}
sub markupfile {
my ($self, $subst, $parse) = @_;
my ($btype, $frag) = $parse->nextfrag;
return () unless defined $frag;
$btype ||= 'code';
if ($btype and exists $$subst{$btype}) {
return $$subst{$btype}->s($frag);
}
else {
return $frag;
}
}
1;
|
