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
|
#!/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 })
};
()
}
# "find interesting things"-patterns
my @mark_patterns = (
# qr{ ([[:word:]]+) }x,
qr{ ([^[:space:]]+) }x,
# common types of "parentheses"
qr{ (?<![^[:space:]]) [`'] ([^`']+) [`'] (?![^[:space:]]) }x,
qr{ (?<![^[:space:]]) ‘ ([^‘’]+) ’ (?![^[:space:]]) }x,
qr{ (?<![^[:space:]]) “ ([^“”]+) ” (?![^[:space:]]) }x,
qr{ (?<![^[:space:]]) (' [^[:space:]] [^']* ') }x,
qr{ (' [^']* [^[:space:]] ') (?![^[:space:]]) }x,
qr{ (?<![^[:space:]]) (` [^[:space:]] [^']* ') }x,
qr{ (` [^']* [^[:space:]] ') (?![^[:space:]]) }x,
qr{ (?<![^[:space:]]) (" [^[:space:]] [^"]* ") }x,
qr{ (" [^"]* [^[:space:]] ") (?![^[:space:]]) }x,
qr{ \{ ([^\{\}]+) \} }x,
qr{ \( ([^\(\)]+) \) }x,
qr{ \[ ([^\[\]]+) \] }x,
qr{ \< ([^\<\>]+) \> }x,
# urls, just a heuristic
qr{(
(?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
[ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~] # exclude some trailing characters (heuristic)
)}x,
# shell-like argument quoting, basically always matches
qr{\G [\ \t|&;<>()]* (
(?:
[^\\"'\ \t|&;<>()]+
| \\.
| " (?: [^\\"]+ | \\. )* "
| ' [^']* '
)+
)}x,
);
# "correct obvious? crap"-patterns
my @simplify_patterns = (
qr{^"([^\\"'\ \t|&;<>()*?]+)"$}, # "simple" => simple
qr{^(.*)[,\-]$}, # strip off trailing , and -
);
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 (@mark_patterns, @{ $self->{patterns} }) {
while ($text =~ /$regex/g) {
if ($-[1] <= $markofs and $markofs <= $+[1]) {
my $ofs = $-[1];
my $match = $1;
for my $regex (@simplify_patterns) {
if ($match =~ $regex) {
$match = $1;
$ofs += $-[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;
}
()
}
|