ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection
(Generate patch)

Comparing rxvt-unicode/src/perl/selection (file contents):
Revision 1.50 by root, Sat Jan 12 22:13:47 2008 UTC vs.
Revision 1.57 by root, Sat Apr 26 20:51:12 2014 UTC

1#! perl 1#! perl
2
3#:META:X_RESOURCE:%.pattern-0:string:first selection pattern
4
5=head1 NAME
6
7selection - more intelligent selection (enabled by default)
8
9=head1 DESCRIPTION
10
11This extension tries to be more intelligent when the user extends
12selections (double-click and further clicks). Right now, it tries to
13select words, urls and complete shell-quoted arguments, which is very
14convenient, too, if your F<ls> supports C<--quoting-style=shell>.
15
16A double-click usually selects the word under the cursor, further clicks
17will enlarge the selection.
18
19The selection works by trying to match a number of regexes and displaying
20them in increasing order of length. You can add your own regexes by
21specifying resources of the form:
22
23 URxvt.selection.pattern-0: perl-regex
24 URxvt.selection.pattern-1: perl-regex
25 ...
26
27The index number (0, 1...) must not have any holes, and each regex must
28contain at least one pair of capturing parentheses, which will be used for
29the match. For example, the following adds a regex that matches everything
30between two vertical bars:
31
32 URxvt.selection.pattern-0: \\|([^|]+)\\|
33
34Another example: Programs I use often output "absolute path: " at the
35beginning of a line when they process multiple files. The following
36pattern matches the filename (note, there is a single space at the very
37end):
38
39 URxvt.selection.pattern-0: ^(/[^:]+):\
40
41You can look at the source of the selection extension to see more
42interesting uses, such as parsing a line from beginning to end.
43
44This extension also offers following bindable keyboard commands:
45
46=over 4
47
48=item rot13
49
50Rot-13 the selection when activated. Used via keyboard trigger:
51
52 URxvt.keysym.C-M-r: perl:selection:rot13
53
54=back
55
56=cut
2 57
3sub on_user_command { 58sub on_user_command {
4 my ($self, $cmd) = @_; 59 my ($self, $cmd) = @_;
5 60
6 $cmd eq "selection:rot13" 61 $cmd eq "selection:rot13"
7 and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection); 62 and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection);
8 63
9 () 64 ()
65}
66
67sub on_keyboard_dispatch {
68 &on_user_command;
10} 69}
11 70
12sub on_init { 71sub on_init {
13 my ($self) = @_; 72 my ($self) = @_;
14 73
… …
17 push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x; 76 push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x;
18 } 77 }
19 78
20 for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) { 79 for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) {
21 $res = $self->locale_decode ($res); 80 $res = $self->locale_decode ($res);
22 utf8::encode $res;
23 push @{ $self->{patterns} }, qr/$res/; 81 push @{ $self->{patterns} }, qr/$res/;
24 } 82 }
25 83
26 $self->{enabled} = 1; 84 $self->{enabled} = 1;
27 85
… …
42 qr{ (?<![^[:space:]]) ‘ ([^‘’]+) ’ (?![^[:space:]]) }x, 100 qr{ (?<![^[:space:]]) ‘ ([^‘’]+) ’ (?![^[:space:]]) }x,
43 qr{ (?<![^[:space:]]) “ ([^“”]+) ” (?![^[:space:]]) }x, 101 qr{ (?<![^[:space:]]) “ ([^“”]+) ” (?![^[:space:]]) }x,
44 102
45 qr{ (?<![^[:space:]]) (' [^[:space:]] [^']* ') }x, 103 qr{ (?<![^[:space:]]) (' [^[:space:]] [^']* ') }x,
46 qr{ (' [^']* [^[:space:]] ') (?![^[:space:]]) }x, 104 qr{ (' [^']* [^[:space:]] ') (?![^[:space:]]) }x,
105 qr{ (?<![^[:space:]]) (` [^[:space:]] [^']* ') }x,
106 qr{ (` [^']* [^[:space:]] ') (?![^[:space:]]) }x,
47 qr{ (?<![^[:space:]]) (" [^[:space:]] [^"]* ") }x, 107 qr{ (?<![^[:space:]]) (" [^[:space:]] [^"]* ") }x,
48 qr{ (" [^"]* [^[:space:]] ") (?![^[:space:]]) }x, 108 qr{ (" [^"]* [^[:space:]] ") (?![^[:space:]]) }x,
49 109
50 qr{ \{ ([^\{\}]+) \} }x, 110 qr{ \{ ([^\{\}]+) \} }x,
51 qr{ \( ([^\(\)]+) \) }x, 111 qr{ \( ([^\(\)]+) \) }x,
… …
89 - $line->offset_of ($self->selection_beg); 149 - $line->offset_of ($self->selection_beg);
90 150
91 my @matches; 151 my @matches;
92 152
93 if ($markofs < $line->l) { 153 if ($markofs < $line->l) {
94 # convert markofs from character to UTF-8 offset space
95 {
96 my $prefix = substr $text, 0, $markofs;
97 utf8::encode $prefix;
98 $markofs = length $prefix;
99 }
100
101 # not doing matches in unicode mode helps speed
102 # enourmously here. working in utf-8 should be
103 # equivalent due to the magic of utf-8 encoding.
104 utf8::encode $text;
105 study $text; # _really_ helps, too :) 154 study $text; # _really_ helps, too :)
106 155
107 for my $regex (@mark_patterns, @{ $self->{patterns} }) { 156 for my $regex (@mark_patterns, @{ $self->{patterns} }) {
108 while ($text =~ /$regex/g) { 157 while ($text =~ /$regex/g) {
109 if ($-[1] <= $markofs and $markofs <= $+[1]) { 158 if ($-[1] <= $markofs and $markofs <= $+[1]) {
… …
129 for (sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches) { 178 for (sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches) {
130 my ($ofs, $len) = @$_; 179 my ($ofs, $len) = @$_;
131 180
132 next if $len <= $curlen; 181 next if $len <= $curlen;
133 182
134 # convert back from UTF-8 offset space to character space
135 {
136 my $length = substr "$text ", $ofs, $len;
137 utf8::decode $length;
138 $len = length $length;
139 }
140 {
141 my $prefix = substr $text, 0, $ofs;
142 utf8::decode $prefix;
143 $ofs = length $prefix;
144 }
145
146 $self->selection_beg ($line->coord_of ($ofs)); 183 $self->selection_beg ($line->coord_of ($ofs));
147 $self->selection_end ($line->coord_of ($ofs + $len)); 184 $self->selection_end ($line->coord_of ($ofs + $len));
148 return 1; 185 return 1;
149 } 186 }
150 187

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines