ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/matcher
Revision: 1.38
Committed: Sun Nov 21 17:08:57 2021 UTC (2 years, 5 months ago) by sf-exg
Branch: MAIN
Changes since 1.37: +3 -5 lines
Log Message:
matcher: match urls with double-width chars

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 =cut
92
93 my $url =
94 qr{
95 (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
96 [\w\-\@;\/?:&=%\$.+!*\x27,~#$urxvt::NOCHAR]*
97 (
98 \([\w\-\@;\/?:&=%\$.+!*\x27,~#$urxvt::NOCHAR]*\)| # Allow a pair of matched parentheses
99 [\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic)
100 )+
101 }x;
102
103 sub matchlist_key_press {
104 my ($self, $event, $keysym, $octets) = @_;
105
106 delete $self->{overlay};
107 $self->disable ("key_press");
108
109 my $i = ($keysym == 96 ? 0 : $keysym - 48);
110 if ($i >= 0 && $i < @{ $self->{matches} }) {
111 my @exec = @{ $self->{matches}[$i] };
112 $self->exec_async (@exec[5 .. $#exec]);
113 }
114
115 1
116 }
117
118 # backwards compat
119 sub on_user_command {
120 my ($self, $cmd) = @_;
121
122 if ($cmd eq "matcher:list") {
123 $self->matchlist;
124 } elsif ($cmd eq "matcher:last") {
125 $self->most_recent;
126 } elsif ($cmd eq "matcher:select") {
127 $self->select_enter;
128 } elsif ($cmd eq "matcher") {
129 # for backward compatibility
130 $self->most_recent;
131 }
132
133 ()
134 }
135
136 sub on_action {
137 my ($self, $action) = @_;
138
139 if ($action eq "list") {
140 $self->matchlist;
141 } elsif ($action eq "last") {
142 $self->most_recent;
143 } elsif ($action eq "select") {
144 $self->select_enter;
145 }
146
147 ()
148 }
149
150 sub matchlist {
151 my ($self) = @_;
152
153 $self->{matches} = [];
154 my $row = $self->nrow - 1;
155 while ($row >= 0 && @{ $self->{matches} } < 10) {
156 my $line = $self->line ($row);
157 my @matches = $self->find_matches ($row);
158
159 for (sort { $b->[0] <=> $a->[0] or $b->[1] <=> $a->[1] } @matches) {
160 push @{ $self->{matches} }, $_;
161 last if @{ $self->{matches} } == 10;
162 }
163
164 $row = $line->beg - 1;
165 }
166
167 return unless @{ $self->{matches} };
168
169 my $width = 0;
170
171 my $i = 0;
172 for my $match (@{ $self->{matches} }) {
173 my $text = $match->[4];
174 my $w = $self->strwidth ("$i-$text");
175
176 $width = $w if $w > $width;
177 $i++;
178 }
179
180 $width = $self->ncol - 2 if $width > $self->ncol - 2;
181
182 $self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
183 my $i = 0;
184 for my $match (@{ $self->{matches} }) {
185 my $text = $match->[4];
186
187 $self->{overlay}->set (0, $i, "$i-$text");
188 $i++;
189 }
190
191 $self->enable (key_press => \&matchlist_key_press);
192 }
193
194 sub most_recent {
195 my ($self) = shift;
196 my $row = $self->nrow - 1;
197 my @exec;
198 while ($row >= $self->top_row) {
199 my $line = $self->line ($row);
200 @exec = $self->command_for($row);
201 last if(@exec);
202
203 $row = $line->beg - 1;
204 }
205 if(@exec) {
206 return $self->exec_async (@exec);
207 }
208 ()
209 }
210
211 sub my_resource {
212 $_[0]->x_resource ("%.$_[1]")
213 }
214
215 # turn a rendition spec in the resource into a sub that implements it on $_
216 sub parse_rend {
217 my ($self, $str) = @_;
218 my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
219 : (urxvt::RS_Uline, undef, undef, []);
220 warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
221 my @rend;
222 push @rend, sub { $_ |= $mask } if $mask;
223 push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
224 push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
225 sub {
226 for my $s ( @rend ) { &$s };
227 }
228 }
229
230 sub on_start {
231 my ($self) = @_;
232
233 $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser";
234
235 $self->{button} = 2;
236 $self->{state} = 0;
237 if($self->{argv}[0] || $self->my_resource ("button")) {
238 my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
239 for my $mod (@mods) {
240 if($mod =~ /^\d+$/) {
241 $self->{button} = $mod;
242 } elsif($mod eq "C") {
243 $self->{state} |= urxvt::ControlMask;
244 } elsif($mod eq "S") {
245 $self->{state} |= urxvt::ShiftMask;
246 } elsif($mod eq "M") {
247 $self->{state} |= $self->ModMetaMask;
248 } elsif($mod ne "-" && $mod ne " ") {
249 warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
250 }
251 }
252 }
253
254 my @defaults = ($url);
255 my @matchers;
256 for (my $idx = 0; defined (my $res = $self->locale_decode ($self->my_resource ("pattern.$idx")) || $defaults[$idx]); $idx++) {
257 my $launcher = $self->my_resource ("launcher.$idx");
258 $launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher;
259 my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
260 unshift @matchers, [qr($res)x,$launcher,$rend];
261 }
262 $self->{matchers} = \@matchers;
263
264 ()
265 }
266
267 sub on_line_update {
268 my ($self, $row) = @_;
269
270 # fetch the line that has changed
271 my $line = $self->line ($row);
272 my $text = $line->t;
273 my $rend;
274
275 # find all urls (if any)
276 for my $matcher (@{$self->{matchers}}) {
277 while ($text =~ /$matcher->[0]/g) {
278 #print "$&\n";
279 $rend ||= $line->r;
280
281 # mark all characters as underlined. we _must_ not toggle underline,
282 # as we might get called on an already-marked url.
283 &{$matcher->[2]}
284 for @{$rend}[$-[0] .. $+[0] - 1];
285 }
286 }
287
288 $line->r ($rend) if $rend;
289
290 ()
291 }
292
293 sub valid_button {
294 my ($self, $event) = @_;
295 my $mask = $self->ModLevel3Mask | $self->ModMetaMask
296 | urxvt::ShiftMask | urxvt::ControlMask;
297 return ($event->{button} == $self->{button} &&
298 ($event->{state} & $mask) == $self->{state});
299 }
300
301 sub find_matches {
302 my ($self, $row, $col) = @_;
303 my $line = $self->line ($row);
304 my $text = $line->t;
305 my $off = $line->offset_of ($row, $col) if defined $col;
306
307 my @matches;
308 for my $matcher (@{$self->{matchers}}) {
309 my $launcher = $matcher->[1] || $self->{launcher};
310 while ($text =~ /$matcher->[0]/g) {
311 my $match = substr $text, $-[0], $+[0] - $-[0];
312 my @begin = @-;
313 my @end = @+;
314 my @exec;
315
316 if (!defined($off) || ($-[0] <= $off && $+[0] >= $off)) {
317 if ($launcher !~ /\$/) {
318 @exec = ($launcher, $match);
319 } else {
320 # It'd be nice to just access a list like ($&,$1,$2...),
321 # but alas, m//g behaves differently in list context.
322 @exec = map { s/\$(\d+)|\$\{(\d+)\}/
323 substr $text, $begin[$1 || $2], $end[$1 || $2] - $begin[$1 || $2]
324 /egx; $_ } split /\s+/, $launcher;
325 }
326
327 push @matches, [ $line->coord_of ($begin[0]), $line->coord_of ($end[0]), $match, @exec ];
328 }
329 }
330 }
331
332 @matches;
333 }
334
335 sub command_for {
336 my ($self, $row, $col) = @_;
337
338 my @matches = $self->find_matches ($row, $col);
339 if (@matches) {
340 my @match = @{ $matches[0] };
341 return @match[5 .. $#match];
342 }
343
344 ()
345 }
346
347 sub on_button_press {
348 my ($self, $event) = @_;
349 if($self->valid_button($event)
350 && (my @exec = $self->command_for($event->{row},$event->{col}))) {
351 $self->{row} = $event->{row};
352 $self->{col} = $event->{col};
353 $self->{cmd} = \@exec;
354 return 1;
355 } else {
356 delete $self->{row};
357 delete $self->{col};
358 delete $self->{cmd};
359 }
360
361 ()
362 }
363
364 sub on_button_release {
365 my ($self, $event) = @_;
366
367 my $row = delete $self->{row};
368 my $col = delete $self->{col};
369 my $cmd = delete $self->{cmd};
370
371 return if !defined $row;
372
373 if($row == $event->{row} && abs($col-$event->{col}) < 2
374 && join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
375 if($self->valid_button($event)) {
376
377 $self->exec_async (@$cmd);
378
379 }
380 }
381
382 1;
383 }
384
385 sub select_enter {
386 my ($self) = @_;
387
388 $self->{view_start} = $self->view_start;
389 $self->{pty_ev_events} = $self->pty_ev_events (urxvt::EV_NONE);
390 $self->{cur_row} = $self->nrow - 1;
391
392 $self->enable (
393 key_press => \&select_key_press,
394 refresh_begin => \&select_refresh,
395 refresh_end => \&select_refresh,
396 );
397
398 $self->{overlay} = $self->overlay (0, -1, $self->ncol, 1, urxvt::OVERLAY_RSTYLE, 0);
399 $self->{overlay}->set (0, 0, "match-select");
400 }
401
402 sub select_leave {
403 my ($self) = @_;
404
405 $self->disable ("key_press", "refresh_begin", "refresh_end");
406 $self->pty_ev_events ($self->{pty_ev_events});
407
408 delete $self->{overlay};
409 delete $self->{matches};
410 delete $self->{id};
411 }
412
413 sub select_search {
414 my ($self, $dir, $row) = @_;
415
416 while ($self->nrow > $row && $row >= $self->top_row) {
417 my $line = $self->line ($row)
418 or last;
419
420 my @matches = $self->find_matches ($row);
421 if (@matches) {
422 @matches = sort { $a->[0] <=> $b->[0] or $a->[1] <=> $b->[1] } @matches;
423 $self->{matches} = \@matches;
424 $self->{cur_row} = $row;
425 $self->{id} = $dir < 0 ? @{ $self->{matches} } - 1 : 0;
426 $self->view_start ($row - ($self->nrow >> 1));
427 $self->want_refresh;
428 return 1;
429 }
430
431 $row = $dir < 0 ? $line->beg - 1 : $line->end + 1;
432 }
433
434 $self->scr_bell;
435
436 ()
437 }
438
439 sub select_refresh {
440 my ($self) = @_;
441
442 return unless $self->{matches};
443
444 my $cur = $self->{matches}[$self->{id}];
445 $self->scr_xor_span (@$cur[0 .. 3], urxvt::RS_RVid);
446
447 ()
448 }
449
450 sub select_key_press {
451 my ($self, $event, $keysym, $string) = @_;
452
453 if ($keysym == 0xff0d || $keysym == 0xff8d) { # enter
454 if ($self->{matches}) {
455 my @match = @{ $self->{matches}[$self->{id}] };
456 $self->exec_async (@match[5 .. $#match]);
457 }
458 $self->select_leave;
459 } elsif ($keysym == 0x79) { # y
460 if ($self->{matches}) {
461 $self->selection ($self->{matches}[$self->{id}][4], 1);
462 $self->selection_grab (urxvt::CurrentTime, 1);
463 }
464 $self->select_leave;
465 } elsif ($keysym == 0xff1b) { # escape
466 $self->view_start ($self->{view_start});
467 $self->select_leave;
468 } elsif ($keysym == 0xff50) { # home
469 $self->select_search (+1, $self->top_row)
470 } elsif ($keysym == 0xff57) { # end
471 $self->select_search (-1, $self->nrow - 1)
472 } elsif ($keysym == 0xff52) { # up
473 if ($self->{id} > 0) {
474 $self->{id}--;
475 $self->want_refresh;
476 } else {
477 my $line = $self->line ($self->{cur_row});
478 $self->select_search (-1, $line->beg - 1)
479 if $line->beg > $self->top_row;
480 }
481 } elsif ($keysym == 0xff54) { # down
482 if ($self->{id} < @{ $self->{matches} } - 1) {
483 $self->{id}++;
484 $self->want_refresh;
485 } else {
486 my $line = $self->line ($self->{cur_row});
487 $self->select_search (+1, $line->end + 1)
488 if $line->end < $self->nrow;
489 }
490 } elsif ($self->lookup_keysym ($keysym, $event->{state}) eq "matcher:select") {
491 if ($self->{id} > 0) {
492 $self->{id}--;
493 $self->want_refresh;
494 } else {
495 my $line = $self->line ($self->{cur_row});
496 $self->select_search (-1, $self->nrow - 1)
497 unless $self->select_search (-1, $line->beg - 1);
498 }
499 }
500
501 1
502 }
503
504 # vim:set sw=3 sts=3 et: