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

# User Rev Content
1 root 1.1 #! perl
2    
3 sf-tpope 1.7 # Author: Tim Pope <rxvt-unicodeNOSPAM@tpope.org>
4 root 1.14 # Bob Farrell <robertanthonyfarrell@gmail.com>
5 root 1.1
6 root 1.15 #: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 root 1.8
12 root 1.10 =head1 NAME
13    
14 root 1.13 matcher - match strings in terminal output and change their rendition
15 root 1.10
16 root 1.11 =head1 DESCRIPTION
17 root 1.10
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 sf-exg 1.16 (default, the C<url-launcher> resource, C<sensible-browser>) will be started
23 root 1.10 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 sf-exg 1.20 from the keyboard. Simply bind a keysym to "matcher:last" or
34     "matcher:list" as seen in the example below.
35 root 1.10
36 root 1.14 Example: load and use the matcher extension with defaults.
37 root 1.10
38     URxvt.perl-ext: default,matcher
39 root 1.14
40     Example: use a custom configuration.
41    
42 root 1.10 URxvt.url-launcher: sensible-browser
43 sf-exg 1.20 URxvt.keysym.C-Delete: matcher:last
44     URxvt.keysym.M-Delete: matcher:list
45 root 1.10 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 root 1.1 my $url =
53     qr{
54 tpope 1.2 (?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
55 sf-tpope 1.12 [\w\-\@;\/?:&=%\$.+!*\x27,~#]*
56 tpope 1.2 (
57 sf-tpope 1.12 \([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched parentheses
58     [\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic)
59 tpope 1.2 )+
60 root 1.1 }x;
61    
62 sf-tpope 1.6 sub on_key_press {
63     my ($self, $event, $keysym, $octets) = @_;
64    
65 sf-exg 1.18 return unless $self->{overlay};
66    
67     delete $self->{overlay};
68 sf-tpope 1.6
69     my $i = ($keysym == 96 ? 0 : $keysym - 48);
70 sf-exg 1.18 if ($i >= 0 && $i < @{ $self->{matches} }) {
71     my @exec = @{ $self->{matches}[$i] };
72     shift @exec;
73     $self->exec_async (@exec);
74 sf-tpope 1.6 }
75    
76 sf-exg 1.18 1
77 sf-tpope 1.6 }
78    
79 root 1.14 # backwards compat
80 tpope 1.4 sub on_user_command {
81     my ($self, $cmd) = @_;
82 sf-tpope 1.6
83 root 1.14 if ($cmd =~ s/^matcher:list\b//) {
84     $self->matchlist;
85 sf-tpope 1.6 } else {
86 root 1.14 if ($cmd =~ s/^matcher:last\b//) {
87 sf-tpope 1.6 $self->most_recent;
88 root 1.14 } elsif ($cmd =~ s/^matcher\b//) {
89     # for backward compatibility
90 sf-tpope 1.6 $self->most_recent;
91     }
92 tpope 1.4 }
93 root 1.14
94 tpope 1.4 ()
95     }
96    
97 sf-exg 1.20 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 sf-tpope 1.6 sub matchlist {
110     my ($self) = @_;
111 sf-exg 1.17
112 sf-exg 1.18 @{ $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 sf-exg 1.19 my @matches;
120 sf-exg 1.18 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 sf-exg 1.17
128 sf-exg 1.18 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 sf-exg 1.17
136 sf-exg 1.19 push @matches, [ $beg[0], $match, @exec ];
137 sf-exg 1.18 }
138     }
139 sf-exg 1.17
140 sf-exg 1.19 for (sort { $b->[0] <=> $a->[0] } @matches) {
141     shift @$_;
142     push @{ $self->{matches} }, $_;
143     last if @{ $self->{matches} } == 10;
144     }
145    
146 sf-exg 1.18 $row = $line->beg - 1;
147     }
148 sf-exg 1.17
149 sf-exg 1.18 return unless @{ $self->{matches} };
150 sf-exg 1.17
151 sf-exg 1.18 my $width = 0;
152 sf-exg 1.17
153 sf-exg 1.18 my $i = 0;
154     for my $match (@{ $self->{matches} }) {
155     my $text = $match->[0];
156     my $w = $self->strwidth ("$i-$text");
157 sf-exg 1.17
158 sf-exg 1.18 $width = $w if $w > $width;
159     $i++;
160 sf-exg 1.17 }
161    
162 sf-exg 1.18 $width = $self->ncol - 2 if $width > $self->ncol - 2;
163 sf-exg 1.17
164 sf-exg 1.18 $self->{overlay} = $self->overlay (0, 0, $width, scalar (@{ $self->{matches} }), urxvt::OVERLAY_RSTYLE, 2);
165 sf-exg 1.17 my $i = 0;
166 sf-exg 1.18 for my $match (@{ $self->{matches} }) {
167     my $text = $match->[0];
168    
169     $self->{overlay}->set (0, $i, "$i-$text");
170 sf-exg 1.17 $i++;
171     }
172 sf-tpope 1.6
173     }
174    
175 tpope 1.4 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 tpope 1.2
189 root 1.1 sub my_resource {
190 root 1.9 $_[0]->x_resource ("%.$_[1]")
191 root 1.1 }
192    
193 tpope 1.2 # turn a rendition spec in the resource into a sub that implements it on $_
194     sub parse_rend {
195     my ($self, $str) = @_;
196 sf-tpope 1.6 my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
197 tpope 1.2 : (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 root 1.1 sub on_start {
209     my ($self) = @_;
210    
211 root 1.8 $self->{launcher} = $self->my_resource ("launcher") || $self->x_resource("url-launcher") || "sensible-browser";
212 root 1.1
213 sf-exg 1.18 $self->{matches} = [];
214 root 1.1 $self->{button} = 2;
215     $self->{state} = 0;
216 root 1.8 if($self->{argv}[0] || $self->my_resource ("button")) {
217     my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
218 root 1.1 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 root 1.9 warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
229 root 1.1 }
230     }
231     }
232    
233     my @defaults = ($url);
234     my @matchers;
235 root 1.8 for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") || $defaults[$idx]); $idx++) {
236 root 1.1 $res = $self->locale_decode ($res);
237     utf8::encode $res;
238 root 1.8 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 tpope 1.2 unshift @matchers, [qr($res)x,$launcher,$rend];
242 root 1.1 }
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 tpope 1.2 #print "$&\n";
260 root 1.1 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 tpope 1.2 &{$matcher->[2]}
265 root 1.1 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 tpope 1.2 if (!defined($col) || ($-[0] <= $col && $+[0] >= $col)) {
294 root 1.1 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 sf-tpope 1.5 if($self->valid_button($event)
314     && (my @exec = $self->command_for($event->{row},$event->{col}))) {
315 root 1.1 $self->{row} = $event->{row};
316     $self->{col} = $event->{col};
317 sf-tpope 1.5 $self->{cmd} = \@exec;
318     return 1;
319 root 1.1 } else {
320     delete $self->{row};
321     delete $self->{col};
322 sf-tpope 1.5 delete $self->{cmd};
323 root 1.1 }
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 sf-tpope 1.5 my $cmd = delete $self->{cmd};
334 root 1.1
335 sf-tpope 1.5 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 root 1.1 if($self->valid_button($event)) {
340    
341 sf-exg 1.17 $self->exec_async (@$cmd);
342 root 1.1
343     }
344     }
345    
346 sf-tpope 1.5 1;
347 root 1.1 }
348    
349     # vim:set sw=3 sts=3 et: