ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/matcher
Revision: 1.32
Committed: Wed Jul 30 15:22:51 2014 UTC (9 years, 9 months ago) by sf-exg
Branch: MAIN
Changes since 1.31: +5 -2 lines
Log Message:
Do not needlessly scan the same line multiple times in matcher:most_recent.

File Contents

# Content
1 #! perl
2
3 # Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.org>
4 # Bob Farrell <robertanthonyfarrell@gmail.com>
5
6 #:META:RESOURCE:%.launcher:string:default launcher command
7 #:META:RESOURCE:%.button:string:the button, yeah
8 #:META:RESOURCE:%.pattern.:string:extra pattern to match
9 #:META:RESOURCE:%.launcher.:string:custom launcher for pattern
10 #:META:RESOURCE:%.rend.:string:custom rendition for pattern
11
12 =head1 NAME
13
14 matcher - match strings in terminal output and change their rendition
15
16 =head1 DESCRIPTION
17
18 Uses per-line display filtering (C<on_line_update>) to underline text
19 matching a certain pattern and make it clickable. When clicked with the
20 mouse button specified in the C<matcher.button> resource (default 2, or
21 middle), the program specified in the C<matcher.launcher> resource
22 (default, the C<url-launcher> resource, C<sensible-browser>) will be started
23 with the matched text as first argument. The default configuration is
24 suitable for matching URLs and launching a web browser, like the
25 former "mark-urls" extension.
26
27 The default pattern to match URLs can be overridden with the
28 C<matcher.pattern.0> resource, and additional patterns can be specified
29 with numbered patterns, in a manner similar to the "selection" extension.
30 The launcher can also be overridden on a per-pattern basis.
31
32 It is possible to activate the most recently seen match or a list of matches
33 from the keyboard. Simply bind a keysym to "matcher:last" or
34 "matcher:list" as seen in the example below.
35
36 The 'matcher:select' action enables a mode in which it is possible to
37 iterate over the matches using the keyboard and either activate them
38 or copy them to the clipboard. While the mode is active, normal terminal
39 input/output is suspended and the following bindings are recognized:
40
41 =over 4
42
43 =item C<Up>
44
45 Search for a match upwards.
46
47 =item C<Down>
48
49 Search for a match downwards.
50
51 =item C<Home>
52
53 Jump to the topmost match.
54
55 =item C<End>
56
57 Jump to the bottommost match.
58
59 =item C<Escape>
60
61 Leave the mode and return to the point where search was started.
62
63 =item C<Enter>
64
65 Activate the current match.
66
67 =item C<y>
68
69 Copy the current match to the clipboard.
70
71 =back
72
73 Example: load and use the matcher extension with defaults.
74
75 URxvt.perl-ext: default,matcher
76
77 Example: use a custom configuration.
78
79 URxvt.url-launcher: sensible-browser
80 URxvt.keysym.C-Delete: matcher:last
81 URxvt.keysym.M-Delete: matcher:list
82 URxvt.matcher.button: 1
83 URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
84 URxvt.matcher.pattern.2: \\B(/\\S+?):(\\d+)(?=:|$)
85 URxvt.matcher.launcher.2: gvim +$2 $1
86
87 =cut
88
89 my $url =
90 qr{
91 (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
92 [\w\-\@;\/?:&=%\$.+!*\x27,~#]*
93 (
94 \([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched parentheses
95 [\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic)
96 )+
97 }x;
98
99 sub matchlist_key_press {
100 my ($self, $event, $keysym, $octets) = @_;
101
102 delete $self->{overlay};
103 $self->disable ("key_press");
104
105 my $i = ($keysym == 96 ? 0 : $keysym - 48);
106 if ($i >= 0 && $i < @{ $self->{matches} }) {
107 my @exec = @{ $self->{matches}[$i] };
108 $self->exec_async (@exec[5 .. $#exec]);
109 }
110
111 1
112 }
113
114 # backwards compat
115 sub on_user_command {
116 my ($self, $cmd) = @_;
117
118 if ($cmd =~ s/^matcher:list\b//) {
119 $self->matchlist;
120 } else {
121 if ($cmd =~ s/^matcher:last\b//) {
122 $self->most_recent;
123 } elsif ($cmd =~ s/^matcher\b//) {
124 # for backward compatibility
125 $self->most_recent;
126 }
127 }
128
129 ()
130 }
131
132 sub on_action {
133 my ($self, $action) = @_;
134
135 if ($action eq "list") {
136 $self->matchlist;
137 } elsif ($action eq "last") {
138 $self->most_recent;
139 } elsif ($action eq "select") {
140 $self->select_enter;
141 }
142
143 ()
144 }
145
146 sub matchlist {
147 my ($self) = @_;
148
149 $self->{matches} = [];
150 my $row = $self->nrow - 1;
151 while ($row >= 0 && @{ $self->{matches} } < 10) {
152 my $line = $self->line ($row);
153 my @matches = $self->find_matches ($row);
154
155 for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) {
156 push @{ $self->{matches} }, $_;
157 last if @{ $self->{matches} } == 10;
158 }
159
160 $row = $line->beg - 1;
161 }
162
163 return unless @{ $self->{matches} };
164
165 my $width = 0;
166
167 my $i = 0;
168 for my $match (@{ $self->{matches} }) {
169 my $text = $match->[4];
170 my $w = $self->strwidth ("$i-$text");
171
172 $width = $w if $w > $width;
173 $i++;
174 }
175
176 $width = $self->ncol - 2 if $width > $self->ncol - 2;
177
178 $self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
179 my $i = 0;
180 for my $match (@{ $self->{matches} }) {
181 my $text = $match->[4];
182
183 $self->{overlay}->set (0, $i, "$i-$text");
184 $i++;
185 }
186
187 $self->enable (key_press => \&matchlist_key_press);
188 }
189
190 sub most_recent {
191 my ($self) = shift;
192 my $row = $self->nrow - 1;
193 my @exec;
194 while ($row >= $self->top_row) {
195 my $line = $self->line ($row);
196 @exec = $self->command_for($row);
197 last if(@exec);
198
199 $row = $line->beg - 1;
200 }
201 if(@exec) {
202 return $self->exec_async (@exec);
203 }
204 ()
205 }
206
207 sub my_resource {
208 $_[0]->x_resource ("%.$_[1]")
209 }
210
211 # turn a rendition spec in the resource into a sub that implements it on $_
212 sub parse_rend {
213 my ($self, $str) = @_;
214 my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
215 : (urxvt::RS_Uline, undef, undef, []);
216 warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
217 my @rend;
218 push @rend, sub { $_ |= $mask } if $mask;
219 push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
220 push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
221 sub {
222 for my $s ( @rend ) { &$s };
223 }
224 }
225
226 sub on_start {
227 my ($self) = @_;
228
229 $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser";
230
231 $self->{button} = 2;
232 $self->{state} = 0;
233 if($self->{argv}[0] || $self->my_resource ("button")) {
234 my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
235 for my $mod (@mods) {
236 if($mod =~ /^\d+$/) {
237 $self->{button} = $mod;
238 } elsif($mod eq "C") {
239 $self->{state} |= urxvt::ControlMask;
240 } elsif($mod eq "S") {
241 $self->{state} |= urxvt::ShiftMask;
242 } elsif($mod eq "M") {
243 $self->{state} |= $self->ModMetaMask;
244 } elsif($mod ne "-" && $mod ne " ") {
245 warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
246 }
247 }
248 }
249
250 my @defaults = ($url);
251 my @matchers;
252 for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") || $defaults[$idx]); $idx++) {
253 $res = $self->locale_decode ($res);
254 utf8::encode $res;
255 my $launcher = $self->my_resource ("launcher.$idx");
256 $launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher;
257 my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
258 unshift @matchers, [qr($res)x,$launcher,$rend];
259 }
260 $self->{matchers} = \@matchers;
261
262 ()
263 }
264
265 sub on_line_update {
266 my ($self, $row) = @_;
267
268 # fetch the line that has changed
269 my $line = $self->line ($row);
270 my $text = $line->t;
271
272 # find all urls (if any)
273 for my $matcher (@{$self->{matchers}}) {
274 while ($text =~ /$matcher->[0]/g) {
275 #print "$&\n";
276 my $rend = $line->r;
277
278 # mark all characters as underlined. we _must_ not toggle underline,
279 # as we might get called on an already-marked url.
280 &{$matcher->[2]}
281 for @{$rend}[$-[0] .. $+[0] - 1];
282
283 $line->r ($rend);
284 }
285 }
286
287 ()
288 }
289
290 sub valid_button {
291 my ($self, $event) = @_;
292 my $mask = $self->ModLevel3Mask | $self->ModMetaMask
293 | urxvt::ShiftMask | urxvt::ControlMask;
294 return ($event->{button} == $self->{button} &&
295 ($event->{state} & $mask) == $self->{state});
296 }
297
298 sub find_matches {
299 my ($self, $row, $col) = @_;
300 my $line = $self->line ($row);
301 my $text = $line->t;
302 my $off = $line->offset_of ($row, $col) if defined $col;
303
304 my @matches;
305 for my $matcher (@{$self->{matchers}}) {
306 my $launcher = $matcher->[1] || $self->{launcher};
307 while ($text =~ /$matcher->[0]/g) {
308 my $match = substr $text, $-[0], $+[0] - $-[0];
309 my @begin = @-;
310 my @end = @+;
311 my @exec;
312
313 if (!defined($off) || ($-[0] <= $off && $+[0] >= $off)) {
314 if ($launcher !~ /\$/) {
315 @exec = ($launcher, $match);
316 } else {
317 # It'd be nice to just access a list like ($&,$1,$2...),
318 # but alas, m//g behaves differently in list context.
319 @exec = map { s/\$(\d+)|\$\{(\d+)\}/
320 substr $text, $begin[$1 || $2], $end[$1 || $2] - $begin[$1 || $2]
321 /egx; $_ } split /\s+/, $launcher;
322 }
323
324 push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
325 }
326 }
327 }
328
329 @matches;
330 }
331
332 sub command_for {
333 my ($self, $row, $col) = @_;
334
335 my @matches = $self->find_matches ($row, $col);
336 if (@matches) {
337 my @match = @{ $matches[0] };
338 return @match[5 .. $#match];
339 }
340
341 ()
342 }
343
344 sub on_button_press {
345 my ($self, $event) = @_;
346 if($self->valid_button($event)
347 && (my @exec = $self->command_for($event->{row},$event->{col}))) {
348 $self->{row} = $event->{row};
349 $self->{col} = $event->{col};
350 $self->{cmd} = \@exec;
351 return 1;
352 } else {
353 delete $self->{row};
354 delete $self->{col};
355 delete $self->{cmd};
356 }
357
358 ()
359 }
360
361 sub on_button_release {
362 my ($self, $event) = @_;
363
364 my $row = delete $self->{row};
365 my $col = delete $self->{col};
366 my $cmd = delete $self->{cmd};
367
368 return if !defined $row;
369
370 if($row == $event->{row} && abs($col-$event->{col}) < 2
371 && join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
372 if($self->valid_button($event)) {
373
374 $self->exec_async (@$cmd);
375
376 }
377 }
378
379 1;
380 }
381
382 sub select_enter {
383 my ($self) = @_;
384
385 $self->{view_start} = $self->view_start;
386 $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
387 $self->{cur_row} = $self->nrow - 1;
388
389 $self->enable (
390 key_press => \&select_key_press,
391 refresh_begin => \&select_refresh,
392 refresh_end => \&select_refresh,
393 );
394
395 $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
396 $self->{overlay}->set (0, 0, "match-select");
397 }
398
399 sub select_leave {
400 my ($self) = @_;
401
402 $self->disable ("key_press", "refresh_begin", "refresh_end");
403 $self->pty_ev_events ($self->{pty_ev_events});
404
405 delete $self->{overlay};
406 delete $self->{matches};
407 delete $self->{id};
408 }
409
410 sub select_search {
411 my ($self, $dir, $row) = @_;
412
413 while ($self->nrow > $row && $row >= $self->top_row) {
414 my $line = $self->line ($row)
415 or last;
416
417 my @matches = $self->find_matches ($row);
418 if (@matches) {
419 @matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
420 $self->{matches} = \@matches;
421 $self->{cur_row} = $row;
422 $self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
423 $self->view_start (List::Util::min 0, $row - ($self->nrow >> 1));
424 $self->want_refresh;
425 return;
426 }
427
428 $row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
429 }
430
431 $self->scr_bell;
432 }
433
434 sub select_refresh {
435 my ($self) = @_;
436
437 return unless $self->{matches};
438
439 my $cur = $self->{matches}[$self->{id}];
440 $self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
441
442 ()
443 }
444
445 sub select_key_press {
446 my ($self, $event, $keysym, $string) = @_;
447
448 if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter
449 if ($self->{matches}) {
450 my @match = @{ $self->{matches}[$self->{id}] };
451 $self->exec_async (@match[5 .. $#match]);
452 }
453 $self->select_leave;
454 } elsif ($keysym == 0x79) { # y
455 if ($self->{matches}) {
456 $self->selection ($self->{matches}[$self->{id}][4], 1);
457 $self->selection_grab (urxvt::CurrentTime, 1);
458 }
459 $self->select_leave;
460 } elsif ($keysym == 0xff1b) { # escape
461 $self->view_start ($self->{view_start});
462 $self->select_leave;
463 } elsif ($keysym == 0xff50) { # home
464 $self->select_search (+1, $self->top_row)
465 } elsif ($keysym == 0xff57) { # end
466 $self->select_search (-1, $self->nrow - 1)
467 } elsif ($keysym == 0xff52) { # up
468 if ($self->{id} > 0) {
469 $self->{id}--;
470 $self->want_refresh;
471 } else {
472 my $line = $self->line ($self->{cur_row});
473 $self->select_search (-1, $line->beg - 1)
474 if $line->beg > $self->top_row;
475 }
476 } elsif ($keysym == 0xff54) { # down
477 if ($self->{id} < @{ $self->{matches} } - 1) {
478 $self->{id}++;
479 $self->want_refresh;
480 } else {
481 my $line = $self->line ($self->{cur_row});
482 $self->select_search (+1, $line->end + 1)
483 if $line->end < $self->nrow;
484 }
485 }
486
487 1
488 }
489
490 # vim:set sw=3 sts=3 et: