ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/matcher
Revision: 1.41
Committed: Sun May 28 10:40:41 2023 UTC (10 months ago) by sf-exg
Branch: MAIN
CVS Tags: HEAD
Changes since 1.40: +5 -8 lines
Log Message:
matcher: simplify

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) = @_;
226 my $row = $self->nrow - 1;
227
228 while ($row >= $self->top_row) {
229 my $line = $self->line ($row);
230 my @exec = $self->command_for ($row);
231 if (@exec) {
232 return $self->exec_async (@exec);
233 }
234
235 $row = $line->beg - 1;
236 }
237
238 ()
239 }
240
241 sub my_resource {
242 $_[0]->x_resource ("%.$_[1]")
243 }
244
245 # turn a rendition spec in the resource into a sub that implements it on $_
246 sub parse_rend {
247 my ($self, $str) = @_;
248 my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
249 : (urxvt::RS_Uline, undef, undef, []);
250 warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
251 my @rend;
252 push @rend, sub { $_ |= $mask } if $mask;
253 push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
254 push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
255 sub {
256 for my $s ( @rend ) { &$s };
257 }
258 }
259
260 sub on_start {
261 my ($self) = @_;
262
263 $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser";
264
265 $self->{button} = 2;
266 $self->{state} = 0;
267 if($self->{argv}[0] || $self->my_resource ("button")) {
268 my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
269 for my $mod (@mods) {
270 if($mod =~ /^\d+$/) {
271 $self->{button} = $mod;
272 } elsif($mod eq "C") {
273 $self->{state} |= urxvt::ControlMask;
274 } elsif($mod eq "S") {
275 $self->{state} |= urxvt::ShiftMask;
276 } elsif($mod eq "M") {
277 $self->{state} |= $self->ModMetaMask;
278 } elsif($mod ne "-" && $mod ne " ") {
279 warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
280 }
281 }
282 }
283
284 my @defaults = ($url);
285 my @matchers;
286 for (my $idx = 0; defined (my $res = $self->locale_decode ($self->my_resource ("pattern.$idx")) || $defaults[$idx]); $idx++) {
287 my $launcher = $self->my_resource ("launcher.$idx");
288 $launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher;
289 my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
290 unshift @matchers, [qr($res)x,$launcher,$rend];
291 }
292 $self->{matchers} = \@matchers;
293
294 ()
295 }
296
297 sub on_line_update {
298 my ($self, $row) = @_;
299
300 # fetch the line that has changed
301 my $line = $self->line ($row);
302 my $text = $line->t;
303 my $rend;
304
305 # find all urls (if any)
306 for my $matcher (@{$self->{matchers}}) {
307 while ($text =~ /$matcher->[0]/g) {
308 #print "$&\n";
309 $rend ||= $line->r;
310
311 # mark all characters as underlined. we _must_ not toggle underline,
312 # as we might get called on an already-marked url.
313 &{$matcher->[2]}
314 for @{$rend}[$-[0] .. $+[0] - 1];
315 }
316 }
317
318 $line->r ($rend) if $rend;
319
320 ()
321 }
322
323 sub valid_button {
324 my ($self, $event) = @_;
325 my $mask = $self->ModLevel3Mask | $self->ModMetaMask
326 | urxvt::ShiftMask | urxvt::ControlMask;
327 return ($event->{button} == $self->{button} &&
328 ($event->{state} & $mask) == $self->{state});
329 }
330
331 sub find_matches {
332 my ($self, $row, $col) = @_;
333 my $line = $self->line ($row);
334 my $text = $line->t;
335 my $off = $line->offset_of ($row, $col) if defined $col;
336
337 my @matches;
338 for my $matcher (@{$self->{matchers}}) {
339 my $launcher = $matcher->[1] || $self->{launcher};
340 while ($text =~ /$matcher->[0]/g) {
341 my $match = substr $text, $-[0], $+[0] - $-[0];
342 my @begin = @-;
343 my @end = @+;
344 my @exec;
345
346 if (!(defined $off) || ($-[0] <= $off && $+[0] >= $off)) {
347 if ($launcher !~ /\$/) {
348 @exec = ($launcher, $match);
349 } else {
350 # It'd be nice to just access a list like ($&,$1,$2...),
351 # but alas, m//g behaves differently in list context.
352 @exec = map {
353 s{\$(\d+)|\$\{(\d+)\}}{
354 substr $text, $begin[$1 || $2], $end[$1 || $2] - $begin[$1 || $2]
355 }egx;
356 $_
357 } split /\s+/, $launcher;
358 }
359
360 push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
361 }
362 }
363 }
364
365 @matches
366 }
367
368 sub command_for {
369 my ($self, $row, $col) = @_;
370
371 my @matches = $self->find_matches ($row, $col);
372 if (@matches) {
373 my @match = @{ $matches[0] };
374 return @match[5 .. $#match];
375 }
376
377 ()
378 }
379
380 sub on_button_press {
381 my ($self, $event) = @_;
382
383 if (
384 $self->valid_button ($event)
385 && (my @exec = $self->command_for ($event->{row}, $event->{col}))
386 ) {
387 $self->{row} = $event->{row};
388 $self->{col} = $event->{col};
389 $self->{cmd} = \@exec;
390 return 1;
391 } else {
392 delete $self->{row};
393 delete $self->{col};
394 delete $self->{cmd};
395 }
396
397 ()
398 }
399
400 sub on_button_release {
401 my ($self, $event) = @_;
402
403 my $row = delete $self->{row};
404 my $col = delete $self->{col};
405 my $cmd = delete $self->{cmd};
406
407 return if !defined $row;
408
409 if (
410 $row == $event->{row}
411 && (abs $col-$event->{col}) < 2
412 && (join "\x00", @$cmd) eq (join "\x00", $self->command_for ($row, $col))
413 ) {
414 if ($self->valid_button ($event)) {
415 $self->exec_async (@$cmd);
416 }
417 }
418
419 1;
420 }
421
422 sub select_enter {
423 my ($self) = @_;
424
425 $self->{view_start} = $self->view_start;
426 $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
427 $self->{cur_row} = $self->nrow - 1;
428
429 $self->enable (
430 key_press => \&select_key_press,
431 refresh_begin => \&select_refresh,
432 refresh_end => \&select_refresh,
433 );
434
435 $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
436 $self->{overlay}->set (0, 0, "match-select");
437 }
438
439 sub select_leave {
440 my ($self) = @_;
441
442 $self->disable ("key_press", "refresh_begin", "refresh_end");
443 $self->pty_ev_events ($self->{pty_ev_events});
444
445 delete $self->{overlay};
446 delete $self->{matches};
447 delete $self->{id};
448 }
449
450 sub select_search {
451 my ($self, $dir, $row) = @_;
452
453 while ($self->nrow > $row && $row >= $self->top_row) {
454 my $line = $self->line ($row)
455 or last;
456
457 my @matches = $self->find_matches ($row);
458 if (@matches) {
459 @matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
460 $self->{matches} = \@matches;
461 $self->{cur_row} = $row;
462 $self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
463 $self->view_start ($row - ($self->nrow >> 1));
464 $self->want_refresh;
465 return 1;
466 }
467
468 $row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
469 }
470
471 $self->scr_bell;
472
473 ()
474 }
475
476 sub select_refresh {
477 my ($self) = @_;
478
479 return unless $self->{matches};
480
481 my $cur = $self->{matches}[$self->{id}];
482 $self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
483
484 ()
485 }
486
487 sub select_key_press {
488 my ($self, $event, $keysym, $string) = @_;
489
490 if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter
491 if ($self->{matches}) {
492 my @match = @{ $self->{matches}[$self->{id}] };
493 $self->exec_async (@match[5 .. $#match]);
494 }
495 $self->select_leave;
496 } elsif ($keysym == 0x79) { # y
497 if ($self->{matches}) {
498 $self->selection ($self->{matches}[$self->{id}][4], 1);
499 $self->selection_grab (urxvt::CurrentTime, 1);
500 }
501 $self->select_leave;
502 } elsif ($keysym == 0xff1b) { # escape
503 $self->view_start ($self->{view_start});
504 $self->select_leave;
505 } elsif ($keysym == 0xff50) { # home
506 $self->select_search (+1, $self->top_row)
507 } elsif ($keysym == 0xff57) { # end
508 $self->select_search (-1, $self->nrow - 1)
509 } elsif ($keysym == 0xff52) { # up
510 if ($self->{id} > 0) {
511 $self->{id}--;
512 $self->want_refresh;
513 } else {
514 my $line = $self->line ($self->{cur_row});
515 $self->select_search (-1, $line->beg - 1)
516 if $line->beg > $self->top_row;
517 }
518 } elsif ($keysym == 0xff54) { # down
519 if ($self->{id} < @{ $self->{matches} } - 1) {
520 $self->{id}++;
521 $self->want_refresh;
522 } else {
523 my $line = $self->line ($self->{cur_row});
524 $self->select_search (+1, $line->end + 1)
525 if $line->end < $self->nrow;
526 }
527 } elsif ($self->lookup_keysym ($keysym, $event->{state}) eq "matcher:select") {
528 if ($self->{id} > 0) {
529 $self->{id}--;
530 $self->want_refresh;
531 } else {
532 my $line = $self->line ($self->{cur_row});
533 $self->select_search (-1, $self->nrow - 1)
534 unless $self->select_search (-1, $line->beg - 1);
535 }
536 }
537
538 1
539 }
540
541 # vim:set sw=3 sts=3 et: