/usr/lib/urxvt/perl/selection is in rxvt-unicode 9.21-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | #! perl
#:META:RESOURCE:%.pattern-0:string:first selection pattern
=head1 NAME
selection - more intelligent selection (enabled by default)
=head1 DESCRIPTION
This extension tries to be more intelligent when the user extends
selections (double-click and further clicks). Right now, it tries to
select words, urls and complete shell-quoted arguments, which is very
convenient, too, if your F<ls> supports C<--quoting-style=shell>.
A double-click usually selects the word under the cursor, further clicks
will enlarge the selection.
The selection works by trying to match a number of regexes and displaying
them in increasing order of length. You can add your own regexes by
specifying resources of the form:
URxvt.selection.pattern-0: perl-regex
URxvt.selection.pattern-1: perl-regex
...
The index number (0, 1...) must not have any holes, and each regex must
contain at least one pair of capturing parentheses, which will be used for
the match. For example, the following adds a regex that matches everything
between two vertical bars:
URxvt.selection.pattern-0: \\|([^|]+)\\|
Another example: Programs I use often output "absolute path: " at the
beginning of a line when they process multiple files. The following
pattern matches the filename (note, there is a single space at the very
end):
URxvt.selection.pattern-0: ^(/[^:]+):\
You can look at the source of the selection extension to see more
interesting uses, such as parsing a line from beginning to end.
This extension also offers the following actions:
=over 4
=item rot13
Rot-13 the selection when activated.
Example:
URxvt.keysym.C-M-r: selection:rot13
=back
=cut
sub on_user_command {
my ($self, $cmd) = @_;
$cmd eq "selection:rot13"
and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection);
()
}
sub on_action {
my ($self, $action) = @_;
$action eq "rot13"
and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection);
()
}
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;
}
()
}
|