Hi!
On Mon, Sep 07, 2015 at 07:11:40PM -0700, [email protected] wrote:
> However, the 'matcher' script on my system (with urxvt v9.21) has
> changed so that the patch no longer applies.
>
> Is there a more recent one available?
I've give up patching it. I just put my version (attached) into
~/.urxvt/ext/matcher_multiline and add this into ~/.Xdefaults:
URxvt*perl-ext:
default,-searchable-scrollback,matcher_multiline,readline
URxvt.perl-ext-common:
default,-searchable-scrollback,matcher_multiline,readline
--
WBR, Alex.
#! perl
# Author: Tim Pope <[email protected]>
# Bob Farrell <[email protected]>
#:META:X_RESOURCE:%.launcher:string:default launcher command
#:META:X_RESOURCE:%.button:string:the button, yeah
#:META:X_RESOURCE:%.pattern.:string:extra pattern to match
#:META:X_RESOURCE:%.launcher.:string:custom launcher for pattern
#:META:X_RESOURCE:%.rend.:string:custom rednition for pattern
=head1 NAME
matcher - match strings in terminal output and change their rendition
=head1 DESCRIPTION
Uses per-line display filtering (C<on_line_update>) to underline text
matching a certain pattern and make it clickable. When clicked with the
mouse button specified in the C<matcher.button> resource (default 2, or
middle), the program specified in the C<matcher.launcher> resource
(default, the C<urlLauncher> resource, C<sensible-browser>) will be started
with the matched text as first argument. The default configuration is
suitable for matching URLs and launching a web browser, like the
former "mark-urls" extension.
The default pattern to match URLs can be overridden with the
C<matcher.pattern.0> resource, and additional patterns can be specified
with numbered patterns, in a manner similar to the "selection" extension.
The launcher can also be overridden on a per-pattern basis.
It is possible to activate the most recently seen match or a list of matches
from the keyboard. Simply bind a keysym to "perl:matcher:last" or
"perl:matcher:list" as seen in the example below.
Example configuration:
URxvt.perl-ext: default,matcher
URxvt.url-launcher: sensible-browser
URxvt.keysym.C-Delete: perl:matcher:last
URxvt.keysym.M-Delete: perl:matcher:list
URxvt.matcher.button: 1
URxvt.matcher.pattern.1: \\bwww\\.[\\w-]+\\.[\\w./?&@#-]*[\\w/-]
URxvt.matcher.pattern.2: \\B(/\\S+?):(\\d+)(?=:|$)
URxvt.matcher.launcher.2: gvim +$2 $1
=cut
my $url =
qr{
(?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
[\w\-\@;\/?:&=%\$.+!*\x27,~#]*
(
\([\w\-\@;\/?:&=%\$.+!*\x27,~#]*\)| # Allow a pair of matched
parentheses
[\w\-\@;\/?:&=%\$+*~] # exclude some trailing characters (heuristic)
)+
}x;
sub on_key_press {
my ($self, $event, $keysym, $octets) = @_;
if (! $self->{showing} ) {
return;
}
my $i = ($keysym == 96 ? 0 : $keysym - 48);
if (($i > scalar(@{$self->{urls}})) || ($i < 0)) {
$self->matchlist();
return;
}
my @args = ($self->{urls}[ -$i-1 ]);
$self->matchlist();
$self->exec_async( $self->{launcher}, @args );
}
sub on_user_command {
my ($self, $cmd) = @_;
if($cmd =~ s/^matcher:list\b//) {
$self->matchlist();
} else {
if($cmd =~ s/^matcher:last\b//) {
$self->most_recent;
}
# For backward compatibility
else {
if($cmd =~ s/^matcher\b//) {
$self->most_recent;
}
}
}
()
}
sub matchlist {
my ($self) = @_;
if ( $self->{showing} ) {
$self->{url_overlay}->hide();
$self->{showing} = 0;
return;
}
@{$self->{urls}} = ();
my $line;
for (my $i = 0; $i < $self->nrow; $i ++) {
$line = $self->line($i);
next if ($line->beg != $i);
for my $url ($self->get_urls_from_line($line->t)) {
if (scalar(@{$self->{urls}}) == 10) {
shift @{$self->{urls}};
}
push @{$self->{urls}}, $url;
}
}
if (! scalar(@{$self->{urls}})) {
return;
}
my $max = 0;
my $i = scalar( @{$self->{urls}} ) - 1 ;;
my @temp = ();
for my $url (@{$self->{urls}}) {
my $url = "$i-$url";
my $xpos = 0;
if ($self->ncol + (length $url) >= $self->ncol) {
$url = substr( $url, 0, $self->ncol );
}
push @temp, $url;
if( length $url > $max ) {
$max = length $url;
}
$i--;
}
@temp = reverse @temp;
$self->{url_overlay} = $self->overlay(0, 0, $max, scalar( @temp ),
urxvt::OVERLAY_RSTYLE, 2);
my $i = 0;
for my $url (@temp) {
$self->{url_overlay}->set( 0, $i, $url, [(urxvt::OVERLAY_RSTYLE) x length
$url]);
$self->{showing} = 1;
$i++;
}
}
sub most_recent {
my ($self) = shift;
my $row = $self->nrow;
my @exec;
while($row-- > $self->top_row) {
@exec = $self->command_for($row);
last if(@exec);
}
if(@exec) {
return $self->exec_async (@exec);
}
()
}
sub my_resource {
$_[0]->x_resource ("%.$_[1]")
}
# turn a rendition spec in the resource into a sub that implements it on $_
sub parse_rend {
my ($self, $str) = @_;
my ($mask, $fg, $bg, $failed) = $str ? urxvt::rend2mask($str)
: (urxvt::RS_Uline, undef, undef, []);
warn "Failed to parse rendition string: " . join(',', @$failed) if @$failed;
my @rend;
push @rend, sub { $_ |= $mask } if $mask;
push @rend, sub { $_ = urxvt::SET_FGCOLOR($_, $fg) } if defined $fg;
push @rend, sub { $_ = urxvt::SET_BGCOLOR($_, $bg) } if defined $bg;
sub {
for my $s ( @rend ) { &$s };
}
}
sub on_start {
my ($self) = @_;
$self->{launcher} = $self->my_resource ("launcher") ||
$self->x_resource("url-launcher") || "sensible-browser";
$self->{urls} = [];
$self->{showing} = 0;
$self->{button} = 2;
$self->{state} = 0;
if($self->{argv}[0] || $self->my_resource ("button")) {
my @mods = split '', $self->{argv}[0] || $self->my_resource ("button");
for my $mod (@mods) {
if($mod =~ /^\d+$/) {
$self->{button} = $mod;
} elsif($mod eq "C") {
$self->{state} |= urxvt::ControlMask;
} elsif($mod eq "S") {
$self->{state} |= urxvt::ShiftMask;
} elsif($mod eq "M") {
$self->{state} |= $self->ModMetaMask;
} elsif($mod ne "-" && $mod ne " ") {
warn("$mod is invalid in $self->{_name}<$self->{argv}[0]>\n");
}
}
}
my @defaults = ($url);
my @matchers;
for (my $idx = 0; defined (my $res = $self->my_resource ("pattern.$idx") ||
$defaults[$idx]); $idx++) {
$res = $self->locale_decode ($res);
utf8::encode $res;
my $launcher = $self->my_resource ("launcher.$idx");
$launcher =~ s/\$&|\$\{&\}/\${0}/g if $launcher;
my $rend = $self->parse_rend($self->my_resource ("rend.$idx"));
unshift @matchers, [qr($res)x,$launcher,$rend];
}
$self->{matchers} = \@matchers;
()
}
sub get_urls_from_line {
my ($self, $line) = @_;
my @urls;
for my $matcher (@{$self->{matchers}}) {
while ($line =~ /$matcher->[0]/g) {
push @urls, substr( $line, $-[0], $+[0] - $-[0] );
}
}
return @urls;
}
sub on_line_update {
my ($self, $row) = @_;
# fetch the line (enlarged to adjoining lines) that has changed
my ($text, $prev_cols, $next_cols, @lines) = $self->enlarge($row);
# find all urls (if any)
for my $matcher (@{$self->{matchers}}) {
$self->match($matcher->[0], $text, $prev_cols, $next_cols, \@lines, sub {
for (@_) {
my ($line, $from, $to) = @$_;
my $rend = $line->r;
# mark all characters as underlined. we _must_ not toggle underline,
# as we might get called on an already-marked url.
&{$matcher->[2]}
for @{$rend}[ $from .. $to - 1];
$line->r($rend);
}
});
}
()
}
sub valid_button {
my ($self, $event) = @_;
my $mask = $self->ModLevel3Mask | $self->ModMetaMask
| urxvt::ShiftMask | urxvt::ControlMask;
return ($event->{button} == $self->{button} &&
($event->{state} & $mask) == $self->{state});
}
sub command_for {
my ($self, $row, $col) = @_;
# fetch the line (enlarged to adjoining lines) that has changed
my ($text, $prev_cols, $next_cols, @lines) = $self->enlarge($row);
for my $matcher (@{$self->{matchers}}) {
my $launcher = $matcher->[1] || $self->{launcher};
my @exec;
$self->match($matcher->[0], $text, $prev_cols, $next_cols, \@lines, sub {
return if @exec;
my $hit = 0;
my $match = q{};
for (@_) {
my ($line, $from, $to) = @$_;
my $text = $line->t;
$match .= substr $text, $from, $to-$from;
if ($line->beg <= $row && $row <= $line->end) {
if (!defined $col) {
$hit = 1;
}
else {
my $pos = ($row - $line->beg) * $self->ncol + $col;
$hit = $from <= $pos && $pos < $to;
}
}
}
if ($hit) {
if ($launcher !~ /\$/) {
@exec = ($launcher,$match);
} else {
$match =~ /$matcher->[0]/;
my @begin = @-;
my @end = @+;
# It'd be nice to just access a list like ($&,$1,$2...),
# but alas, m//g behaves differently in list context.
@exec = map { s/\$(\d+)|\$\{(\d+)\}/
substr($text,$begin[$1||$2],$end[$1||$2]-$begin[$1||$2])
/egx; $_ } split(/\s+/, $launcher);
}
}
});
return @exec if @exec;
}
()
}
sub on_button_press {
my ($self, $event) = @_;
if($self->valid_button($event)
&& (my @exec = $self->command_for($event->{row},$event->{col}))) {
$self->{row} = $event->{row};
$self->{col} = $event->{col};
$self->{cmd} = \@exec;
} else {
delete $self->{row};
delete $self->{col};
delete $self->{cmd};
}
()
}
sub on_button_release {
my ($self, $event) = @_;
my $row = delete $self->{row};
my $col = delete $self->{col};
my $cmd = delete $self->{cmd};
return if !defined $row;
if($row == $event->{row} && $col == $event->{col}) {
if($self->valid_button($event)) {
$self->exec_async (@$cmd);
return 1;
}
}
return;
}
sub enlarge {
my ($self, $row) = @_;
my $line = $self->line($row);
my $text = $line->t;
# don't enlarge multirow lines
if ($line->beg != $line->end) {
return ($text, 0, 0, $line);
}
# enlarge this line with prev&next lines up to nearest line with space char
my ($prev_cols, $next_cols) = (0, 0);
my (@prev_lines,@next_lines);
if ($line->l && $text !~ /\A\s/ms) {
for my $prev_row (reverse 0 .. $row-1) {
my $l = $self->line($prev_row);
my $t = $l->t;
last if $l->beg != $l->end;
last if $l->l < $self->ncol;
unshift @prev_lines, $l;
$prev_cols += $l->l;
$text = $t . $text;
last if $t =~ /\s/ms;
}
}
if ($line->l == $self->ncol && $text !~ /\s\z/ms) {
for my $next_row ($row+1 .. $self->nrow-1) {
my $l = $self->line($next_row);
my $t = $l->t;
last if $l->beg != $l->end;
push @next_lines, $l;
$next_cols += $l->l;
$text .= $t;
last if $l->l < $self->ncol;
last if $t =~ /\s/ms;
}
}
my @lines = (@prev_lines, $line, @next_lines);
return ($text, $prev_cols, $next_cols, @lines);
}
sub match {
my ($self, $re, $text, $prev_cols, $next_cols, $lines, $cb) = @_;
while ($text =~ /$re/g) {
my ($beg, $end) = ($-[0], $+[0]);
# skip matches outside this line
next if $end <= $prev_cols;
next if $beg >= (length $text) - $next_cols;
# detect match boundaries over lines and send them to user's callback
my @parts;
for my $line (@$lines) {
if ($beg < $line->l && 0 < $end) {
my $from = $beg < 0 ? 0 : $beg;
my $to = $line->l < $end ? $line->l : $end;
push @parts, [$line, $from, $to];
}
$beg -= $line->l;
$end -= $line->l;
}
$cb->(@parts);
}
return;
}
# vim:set sw=3 sts=3 et:
_______________________________________________
rxvt-unicode mailing list
[email protected]
http://lists.schmorp.de/mailman/listinfo/rxvt-unicode
