ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/matcher
Revision: 1.20
Committed: Thu Jun 12 06:03:49 2014 UTC (9 years, 11 months ago) by sf-exg
Branch: MAIN
Changes since 1.19: +16 -4 lines
Log Message:
Port matcher to on_action API.

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 rednition 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 Example: load and use the matcher extension with defaults.
37
38 URxvt.perl-ext: default,matcher
39
40 Example: use a custom configuration.
41
42 URxvt.url-launcher: sensible-browser
43 URxvt.keysym.C-Delete: matcher:last
44 URxvt.keysym.M-Delete: matcher:list
45 URxvt.matcher.button: 1
46 URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
47 URxvt.matcher.pattern.2: \\B(/\\S+?):(\\d+)(?=:|$)
48 URxvt.matcher.launcher.2: gvim +$2 $1
49
50 =cut
51
52 my $url =
53 qr{
54 (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
55 [\w\-\@;\/?:&=%\$.+!*\x27,~#]*
56 (
57 \([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched parentheses
58 [\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic)
59 )+
60 }x;
61
62 sub on_key_press {
63 my ($self, $event, $keysym, $octets) = @_;
64
65 return unless $self->{overlay};
66
67 delete $self->{overlay};
68
69 my $i = ($keysym == 96 ? 0 : $keysym - 48);
70 if ($i >= 0 && $i < @{ $self->{matches} }) {
71 my @exec = @{ $self->{matches}[$i] };
72 shift @exec;
73 $self->exec_async (@exec);
74 }
75
76 1
77 }
78
79 # backwards compat
80 sub on_user_command {
81 my ($self, $cmd) = @_;
82
83 if ($cmd =~ s/^matcher:list\b//) {
84 $self->matchlist;
85 } else {
86 if ($cmd =~ s/^matcher:last\b//) {
87 $self->most_recent;
88 } elsif ($cmd =~ s/^matcher\b//) {
89 # for backward compatibility
90 $self->most_recent;
91 }
92 }
93
94 ()
95 }
96
97 sub on_action {
98 my ($self, $action) = @_;
99
100 if ($action eq "list") {
101 $self->matchlist;
102 } elsif ($action eq "last") {
103 $self->most_recent;
104 }
105
106 ()
107 }
108
109 sub matchlist {
110 my ($self) = @_;
111
112 @{ $self->{matches} } = ();
113 my $row = $self->nrow - 1;
114 while ($row >= 0 && @{ $self->{matches} } < 10) {
115 my $line = $self->line ($row);
116 my $text = $line->t;
117
118 # FIXME: code duplicated from 'command_for'
119 my @matches;
120 for my $matcher (@{$self->{matchers}}) {
121 my $launcher = $matcher->[1] || $self->{launcher};
122 while ($text =~ /$matcher->[0]/g) {
123 my $match = substr ($text, $-[0], $+[0] - $-[0]);
124 my @beg = @-;
125 my @end = @+;
126 my @exec;
127
128 if ($launcher !~ /\$/) {
129 @exec = ($launcher, $match);
130 } else {
131 @exec = map { s/\$(\d+)|\$\{(\d+)\}/
132 substr ($text, $beg[$1 || $2], $end[$1 || $2] - $beg[$1 || $2])
133 /egx; $_ } split /\s+/, $launcher;
134 }
135
136 push @matches, [ $beg[0], $match, @exec ];
137 }
138 }
139
140 for (sort { $b->[0] <=> $a->[0] } @matches) {
141 shift @$_;
142 push @{ $self->{matches} }, $_;
143 last if @{ $self->{matches} } == 10;
144 }
145
146 $row = $line->beg - 1;
147 }
148
149 return unless @{ $self->{matches} };
150
151 my $width = 0;
152
153 my $i = 0;
154 for my $match (@{ $self->{matches} }) {
155 my $text = $match->[0];
156 my $w = $self->strwidth ("$i-$text");
157
158 $width = $w if $w > $width;
159 $i++;
160 }
161
162 $width = $self->ncol - 2 if $width > $self->ncol - 2;
163
164 $self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
165 my $i = 0;
166 for my $match (@{ $self->{matches} }) {
167 my $text = $match->[0];
168
169 $self->{overlay}->set (0, $i, "$i-$text");
170 $i++;
171 }
172
173 }
174
175 sub most_recent {
176 my ($self) = shift;
177 my $row = $self->nrow;
178 my @exec;
179 while($row-- > $self->top_row) {
180 @exec = $self->command_for($row);
181 last if(@exec);
182 }
183 if(@exec) {
184 return $self->exec_async (@exec);
185 }
186 ()
187 }
188
189 sub my_resource {
190 $_[0]->x_resource ("%.$_[1]")
191 }
192
193 # turn a rendition spec in the resource into a sub that implements it on $_
194 sub parse_rend {
195 my ($self, $str) = @_;
196 my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
197 : (urxvt::RS_Uline, undef, undef, []);
198 warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
199 my @rend;
200 push @rend, sub { $_ |= $mask } if $mask;
201 push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
202 push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
203 sub {
204 for my $s ( @rend ) { &$s };
205 }
206 }
207
208 sub on_start {
209 my ($self) = @_;
210
211 $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser";
212
213 $self->{matches} = [];
214 $self->{button} = 2;
215 $self->{state} = 0;
216 if($self->{argv}[0] || $self->my_resource ("button")) {
217 my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
218 for my $mod (@mods) {
219 if($mod =~ /^\d+$/) {
220 $self->{button} = $mod;
221 } elsif($mod eq "C") {
222 $self->{state} |= urxvt::ControlMask;
223 } elsif($mod eq "S") {
224 $self->{state} |= urxvt::ShiftMask;
225 } elsif($mod eq "M") {
226 $self->{state} |= $self->ModMetaMask;
227 } elsif($mod ne "-" && $mod ne " ") {
228 warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
229 }
230 }
231 }
232
233 my @defaults = ($url);
234 my @matchers;
235 for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") || $defaults[$idx]); $idx++) {
236 $res = $self->locale_decode ($res);
237 utf8::encode $res;
238 my $launcher = $self->my_resource ("launcher.$idx");
239 $launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher;
240 my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
241 unshift @matchers, [qr($res)x,$launcher,$rend];
242 }
243 $self->{matchers} = \@matchers;
244
245 ()
246 }
247
248 sub on_line_update {
249 my ($self, $row) = @_;
250
251 # fetch the line that has changed
252 my $line = $self->line ($row);
253 my $text = $line->t;
254 my $i = 0;
255
256 # find all urls (if any)
257 for my $matcher (@{$self->{matchers}}) {
258 while ($text =~ /$matcher->[0]/g) {
259 #print "$&\n";
260 my $rend = $line->r;
261
262 # mark all characters as underlined. we _must_ not toggle underline,
263 # as we might get called on an already-marked url.
264 &{$matcher->[2]}
265 for @{$rend}[ $-[0] .. $+[0] - 1];
266
267 $line->r ($rend);
268 }
269 }
270
271 ()
272 }
273
274 sub valid_button {
275 my ($self, $event) = @_;
276 my $mask = $self->ModLevel3Mask | $self->ModMetaMask
277 | urxvt::ShiftMask | urxvt::ControlMask;
278 return ($event->{button} == $self->{button} &&
279 ($event->{state} & $mask) == $self->{state});
280 }
281
282 sub command_for {
283 my ($self, $row, $col) = @_;
284 my $line = $self->line ($row);
285 my $text = $line->t;
286
287 for my $matcher (@{$self->{matchers}}) {
288 my $launcher = $matcher->[1] || $self->{launcher};
289 while (($text =~ /$matcher->[0]/g)) {
290 my $match = $&;
291 my @begin = @-;
292 my @end = @+;
293 if (!defined($col) || ($-[0] <= $col && $+[0] >= $col)) {
294 if ($launcher !~ /\$/) {
295 return ($launcher,$match);
296 } else {
297 # It'd be nice to just access a list like ($&,$1,$2...),
298 # but alas, m//g behaves differently in list context.
299 my @exec = map { s/\$(\d+)|\$\{(\d+)\}/
300 substr($text,$begin[$1||$2],$end[$1||$2]-$begin[$1||$2])
301 /egx; $_ } split(/\s+/, $launcher);
302 return @exec;
303 }
304 }
305 }
306 }
307
308 ()
309 }
310
311 sub on_button_press {
312 my ($self, $event) = @_;
313 if($self->valid_button($event)
314 && (my @exec = $self->command_for($event->{row},$event->{col}))) {
315 $self->{row} = $event->{row};
316 $self->{col} = $event->{col};
317 $self->{cmd} = \@exec;
318 return 1;
319 } else {
320 delete $self->{row};
321 delete $self->{col};
322 delete $self->{cmd};
323 }
324
325 ()
326 }
327
328 sub on_button_release {
329 my ($self, $event) = @_;
330
331 my $row = delete $self->{row};
332 my $col = delete $self->{col};
333 my $cmd = delete $self->{cmd};
334
335 return if !defined $row;
336
337 if($row == $event->{row} && abs($col-$event->{col}) < 2
338 && join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
339 if($self->valid_button($event)) {
340
341 $self->exec_async (@$cmd);
342
343 }
344 }
345
346 1;
347 }
348
349 # vim:set sw=3 sts=3 et: