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
|
#!/usr/bin/env perl
sub on_init {
my ($self) = @_;
if (defined (my $res = $self->resource ("cutchars"))) {
$res = $self->locale_decode ($res);
push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x;
}
for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) {
$res = $self->locale_decode ($res);
push @{ $self->{patterns} }, qr/$res/;
}
$self->{enabled} = 1;
push @{ $self->{term}{option_popup_hook} }, sub {
("new selection" => $self->{enabled}, sub { $self->{enabled} = shift })
};
()
}
sub on_sel_extend {
my ($self, $time) = @_;
$self->{enabled}
or return;
my ($row, $col) = $self->selection_mark;
my $line = $self->line ($row);
my $text = $line->t;
my $markofs = $line->offset_of ($row, $col);
my $curlen = $line->offset_of ($self->selection_end)
- $line->offset_of ($self->selection_beg);
my @matches;
if ($markofs < $line->l) {
study $text; # _really_ helps, too :)
for my $regex ( @{ $self->{patterns} }) {
while ($text =~ /$regex/g) {
if ($-[1] <= $markofs and $markofs <= $+[1]) {
my $ofs = $-[1];
my $match = $1;
push @matches, [$ofs, length $match];
}
}
}
}
# whole line
push @matches, [0, ($line->end - $line->beg + 1) * $self->ncol];
for (sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches) {
my ($ofs, $len) = @$_;
next if $len <= $curlen;
$self->selection_beg ($line->coord_of ($ofs));
$self->selection_end ($line->coord_of ($ofs + $len));
return 1;
}
()
}
|