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, [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 _______________________________________________ rxvt-unicode mailing list [email protected] http://lists.schmorp.de/mailman/listinfo/rxvt-unicode
