Hi!
On Wed, Oct 24, 2012 at 06:09:03AM +0300, Alex Efros wrote:
> Looks like mark-urls was removed and replaced by matcher in current urxvt
> version. Anyway, both doesn't support urls wrapped in several lines.
> Chip Camden already mention this in previous email, but I've just tested
> both and confirm this. Probably matcher can be modified (as Chip Camden
> suggest) to support wrapped lines, but right now it doesn't work in this way.
I've implemented this feature in matcher plugin. Modified version and
patch attached (I'm using rxvt-unicode-9.15).
I've implemented only url-highlighting and clicking support. It looks like
matcher also support some "list" feature, but I've no idea what is it for
and thus I didn't tried to add multiline match support for it.
It would be nice to have some notification when url clicked and opened in
browser, because this happens in background and inside mutt I didn't know
is it was successfully opened or I clicked on wrong place and nothing
happens - probably some status bar notification pop-up for 1 sec is the
best. Is it possible to implement this in urxvt?
Is it possible to somehow install modified version of matcher in my home
dir instead of replacing system-wide version?
If there is recommended way to send patches to urxvt please let me know.
Now, I have to figure out how to configure urxvt in same way as my xterm
was configured…
--
WBR, Alex.
--- matcher.orig 2012-10-24 05:38:42.747463293 +0300
+++ matcher 2012-10-24 20:36:13.653745332 +0300
@@ -202,24 +202,22 @@
sub on_line_update {
my ($self, $row) = @_;
- # fetch the line that has changed
- my $line = $self->line ($row);
- my $text = $line->t;
- my $i = 0;
+ # 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}}) {
- while ($text =~ /$matcher->[0]/g) {
- #print "$&\n";
- 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}[ $-[0] .. $+[0] - 1];
-
- $line->r ($rend);
- }
+ $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);
+ }
+ });
}
()
@@ -235,28 +233,45 @@
sub command_for {
my ($self, $row, $col) = @_;
- my $line = $self->line ($row);
- my $text = $line->t;
+
+ # 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};
- while (($text =~ /$matcher->[0]/g)) {
- my $match = $&;
- my @begin = @-;
- my @end = @+;
- if (!defined($col) || ($-[0] <= $col && $+[0] >= $col)) {
+ my @exec;
+ $self->match($matcher->[0], $text, $prev_cols, $next_cols, \@lines, sub {
+ 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) {
+ $hit ||= !defined $col;
+ if ($row < $line->end) {
+ $hit ||= 1;
+ } else {
+ $hit ||= $from <= $col && $col < $to;
+ }
+ }
+ }
+ if ($hit) {
if ($launcher !~ /\$/) {
- return ($launcher,$match);
+ @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.
- my @exec = map { s/\$(\d+)|\$\{(\d+)\}/
+ @exec = map { s/\$(\d+)|\$\{(\d+)\}/
substr($text,$begin[$1||$2],$end[$1||$2]-$begin[$1||$2])
/egx; $_ } split(/\s+/, $launcher);
- return @exec;
}
- }
- }
+ }
+ });
+ return @exec if @exec;
}
()
@@ -300,4 +315,63 @@
1;
}
+sub enlarge {
+ my ($self, $row) = @_;
+
+ my $line = $self->line($row);
+ my $text = $line->t;
+
+ # 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->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;
+ 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:
#! perl
# Author: Tim Pope <rxvt-unicodenos...@tpope.org>
# Bob Farrell <robertanthonyfarr...@gmail.com>
my $url =
qr{
(?:https?://|ftp://|news://|mailto:|file://|\bwww\.)
[a-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27,~#]*
(
\([a-zA-Z0-9\-\@;\/?:&=%\$_.+!*\x27,~#]*\)| # Allow a pair of matched
parentheses
[a-zA-Z0-9\-\@;\/?:&=%\$_+*~] # 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 {
my $self = shift;
$self->x_resource ("$self->{name}.$_[0]");
}
# 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->{name} = __PACKAGE__) =~ s/.*:://;
$self->{name} =~ tr/_/-/;
$self->{launcher} = $self->my_resource("launcher") ||
$self->x_resource("urlLauncher") ||
"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 {
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) {
$hit ||= !defined $col;
if ($row < $line->end) {
$hit ||= 1;
} else {
$hit ||= $from <= $col && $col < $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;
return 1;
} 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} && abs($col-$event->{col}) < 2
&& join("\x00", @$cmd) eq join("\x00", $self->command_for($row,$col))) {
if($self->valid_button($event)) {
$self->exec_async (@$cmd);
}
}
1;
}
sub enlarge {
my ($self, $row) = @_;
my $line = $self->line($row);
my $text = $line->t;
# 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->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;
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:
