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