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.8 by root, Tue Jan 3 20:47:36 2006 UTC vs.
Revision 1.55 by root, Sun Jun 10 17:31:53 2012 UTC

1#! perl 1#! perl
2 2
3#:META:X_RESOURCE:%.pattern-0:string:first selection pattern
4
5=head1 NAME
6
7 selection - 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
57
3sub on_keyboard_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 ()
10} 65}
11 66
67sub on_init {
68 my ($self) = @_;
69
70 if (defined (my $res = $self->resource ("cutchars"))) {
71 $res = $self->locale_decode ($res);
72 push @{ $self->{patterns} }, qr{\G [\Q$res\E[:space:]]* ([^\Q$res\E[:space:]]+) }x;
73 }
74
75 for (my $idx = 0; defined (my $res = $self->x_resource ("selection.pattern-$idx")); $idx++) {
76 $res = $self->locale_decode ($res);
77 push @{ $self->{patterns} }, qr/$res/;
78 }
79
80 $self->{enabled} = 1;
81
82 push @{ $self->{term}{option_popup_hook} }, sub {
83 ("new selection" => $self->{enabled}, sub { $self->{enabled} = shift })
84 };
85
86 ()
87}
88
89# "find interesting things"-patterns
12my @patterns = ( 90my @mark_patterns = (
13 # urls 91# qr{ ([[:word:]]+) }x,
14 qr{ ([a-z0-9.+\-]+://[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),]+) }x, 92 qr{ ([^[:space:]]+) }x,
93
94 # common types of "parentheses"
95 qr{ (?<![^[:space:]]) [`'] ([^`']+) [`'] (?![^[:space:]]) }x,
96 qr{ (?<![^[:space:]]) ‘ ([^‘’]+) ’ (?![^[:space:]]) }x,
97 qr{ (?<![^[:space:]]) “ ([^“”]+) ” (?![^[:space:]]) }x,
98
99 qr{ (?<![^[:space:]]) (' [^[:space:]] [^']* ') }x,
100 qr{ (' [^']* [^[:space:]] ') (?![^[:space:]]) }x,
101 qr{ (?<![^[:space:]]) (` [^[:space:]] [^']* ') }x,
102 qr{ (` [^']* [^[:space:]] ') (?![^[:space:]]) }x,
103 qr{ (?<![^[:space:]]) (" [^[:space:]] [^"]* ") }x,
104 qr{ (" [^"]* [^[:space:]] ") (?![^[:space:]]) }x,
105
106 qr{ \{ ([^\{\}]+) \} }x,
107 qr{ \( ([^\(\)]+) \) }x,
108 qr{ \[ ([^\[\]]+) \] }x,
109 qr{ \< ([^\<\>]+) \> }x,
110
111 # urls, just a heuristic
112 qr{(
113 (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)[ab-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27(),~#]+
114 [ab-zA-Z0-9\-\@;\/?:&=%\$_+*()~] # exclude some trailing characters (heuristic)
115 )}x,
116
117 # shell-like argument quoting, basically always matches
118 qr{\G [\ \t|&;<>()]* (
119 (?:
120 [^\\"'\ \t|&;<>()]+
121 | \\.
122 | " (?: [^\\"]+ | \\. )* "
123 | ' [^']* '
124 )+
125 )}x,
126);
127
128# "correct obvious? crap"-patterns
129my @simplify_patterns = (
130 qr{^"([^\\"'\ \t|&;<>()*?]+)"$}, # "simple" => simple
131 qr{^(.*)[,\-]$}, # strip off trailing , and -
15); 132);
16 133
17sub on_sel_extend { 134sub on_sel_extend {
18 my ($self) = @_; 135 my ($self, $time) = @_;
136
137 $self->{enabled}
138 or return;
19 139
20 my ($row, $col) = $self->selection_mark; 140 my ($row, $col) = $self->selection_mark;
21 my $line = $self->line ($row); 141 my $line = $self->line ($row);
22 my $offset = $line->offset_of ($row, $col);
23 my $text = $line->t; 142 my $text = $line->t;
143 my $markofs = $line->offset_of ($row, $col);
144 my $curlen = $line->offset_of ($self->selection_end)
145 - $line->offset_of ($self->selection_beg);
24 146
25 for my $regex (@patterns) { 147 my @matches;
148
149 if ($markofs < $line->l) {
150 study $text; # _really_ helps, too :)
151
152 for my $regex (@mark_patterns, @{ $self->{patterns} }) {
26 while ($text =~ /$regex/g) { 153 while ($text =~ /$regex/g) {
27 if ($-[0] <= $offset and $offset <= $+[0]) { 154 if ($-[1] <= $markofs and $markofs <= $+[1]) {
28 $self->selection_beg ($line->coord_of ($-[0])); 155 my $ofs = $-[1];
29 $self->selection_end ($line->coord_of ($+[0])); 156 my $match = $1;
30 return 1; 157
158 for my $regex (@simplify_patterns) {
159 if ($match =~ $regex) {
160 $match = $1;
161 $ofs += $-[1];
162 }
163 }
164
165 push @matches, [$ofs, length $match];
166 }
31 } 167 }
32 } 168 }
33 } 169 }
34 170
171 # whole line
172 push @matches, [0, ($line->end - $line->beg + 1) * $self->ncol];
173
174 for (sort { $a->[1] <=> $b->[1] or $b->[0] <=> $a->[0] } @matches) {
175 my ($ofs, $len) = @$_;
176
177 next if $len <= $curlen;
178
179 $self->selection_beg ($line->coord_of ($ofs));
180 $self->selection_end ($line->coord_of ($ofs + $len));
181 return 1;
182 }
183
35 () 184 ()
36} 185}

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines