ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/matcher
Revision: 1.40
Committed: Fri Dec 9 05:06:46 2022 UTC (17 months ago) by root
Branch: MAIN
Changes since 1.39: +27 -17 lines
Log Message:
*** empty log message ***

File Contents

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