multi-line URL support

frederik at ofb.net frederik at ofb.net
Tue Sep 8 21:09:47 CEST 2015


Hi Alex,

Thanks for the script. I realized after I sent my query that I
actually use 'url-select' and not 'matcher' although 'matcher' looks
more versatile.

What urxvt version should I diff against to see your changes?

I ended up creating a patch to 'url-select' which was pretty
straightforward. It effectively modifies 'sub line' in
rxvt-unicode-9.21/src/urxvt.pm to compare line length to terminal
ncols rather than using the builtin ROW_is_longer. This routine is
copied into url-select with the appropriate changes and renamed
'multiline', then all calls to 'line' in url-select are changed to
'multiline'.

https://github.com/muennich/urxvt-perls/issues/6#issuecomment-138446817

I imagine this would work for 'matcher' as well, and would be simpler
than your version with the custom 'enlarge'. I'm not sure if they do
the same thing, however.

It would also be nice to be able to recognize lines that are wrapped
with a backslash, which is how Emacs wraps them. Just so I have the
same interface every time I see a URL in my terminal.

Frederick

On Tue, Sep 08, 2015 at 01:43:35PM +0300, Alex Efros wrote:
> Hi!
> 
> On Mon, Sep 07, 2015 at 07:11:40PM -0700, frederik at ofb.net 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 <rxvt-unicodeNOSPAM at tpope.org>
> #          Bob Farrell <robertanthonyfarrell at gmail.com>
> 
> #: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, at 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
> rxvt-unicode at lists.schmorp.de
> http://lists.schmorp.de/mailman/listinfo/rxvt-unicode




More information about the rxvt-unicode mailing list