ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/matcher
(Generate patch)

Comparing rxvt-unicode/src/perl/matcher (file contents):
Revision 1.3 by root, Sun Jun 10 23:10:01 2007 UTC vs.
Revision 1.31 by sf-exg, Sun Jun 22 07:51:21 2014 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines