aboutsummaryrefslogtreecommitdiffstats
path: root/lib/LXRng/Markup/File.pm
blob: 986f05ce16eea283a90dad8da246fcb520ba82b5 (plain)
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
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);

	return qq{</span>$nl<li>}.
	    qq{<a href="$name#L$line" class="line"><span></span></a>}.
	    qq{<a id="L$line" name="L$line"></a><span class="line">};
    }
}

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, $res, $frag) = @_;

    my $tree = $self->context->vtree();
    my $path = $self->context->path();

    $frag =~ s{(.*?)$idre|(.+)}{
	if ($2) {
	    unless (exists($$res{$2})) {
		my $pre = $1;
		my $sym = safe_html($2);
		safe_html($pre).
		    qq{<a href="+code=$sym" class="sref">$sym</a>};
	    }
	    else {
		safe_html($1.$2);
	    }
	}
	else {
	    safe_html($3);
	}
    }ge;
    return $frag;
}

sub format_raw {
    my ($self, $str) = @_;

    $str = safe_html($str);
    $str =~ s((http://[^/\"]+(/[^\s\"]*|)[^.\,\)\>\"]))
	(<a href="$1">$1</a>)g;
    return $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;