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.60 by sf-exg, Sat May 31 08:33:47 2014 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines