On Fri, Jan 20, 2017 at 11:16:15AM -0800, Jacob Keller wrote:

> > I recently taught urxvt to recognize sha1s and grab them via keyboard
> > hints, and I'm finding it quite useful. Here's what it looks like if
> > you're interested:
> >
> >   http://peff.net/git-hints.gif
> >
> > The hints technique is taken from pentadactyl (which I also use), but
> > the urxvt port is mine. I'm happy to share the code.
> [...]
> 
> I would be interested in the code for this.. I'm curious if I can
> adapt it to my use of tmux.

See below. You can drop it into ~/.urxvt/ext/urlmatch and put something
like this into your Xresources:

  URxvt.keysym.C-b: urlmatch:list
  URxvt.keysym.C-semicolon: urlmatch:hint

I think the interesting bits if you're adapting it to another system
will be the regexes in find_commits(), and the key-at-a-time state
machine in handle_select_key().

Note that there's a sort-of bug in find_commits(). If you have:

  1234abcd..5678abcd

it finds three matches: one for each sha1, and one for the whole range.
But the range hint is covered up by the first sha1's hint.

And probably other bugs, too. I've only been using it for about a week,
and I did a bunch of cleanups this morning (after foolishly offering to
let other people see it ;) ).

-- >8 --
#!/usr/bin/perl

use warnings qw(all FATAL);
use strict;

sub on_action {
        my ($self, $action) = @_;
        ($action, my @args) = split /:/, $action;
        if ($action eq 'list') {
                $self->matchlist(@args);
        } elsif ($action eq 'hint') {
                $self->open_hints(@args);
        }
        ();
}

sub d { print STDERR "debug: " . join(' ', @_) . "\n"; }

sub handle_select_key {
        my ($self, $event, $keysym, $octets) = @_;

        my $input = $self->{input};

        my $escape;
        if (48 <= $keysym && $keysym <= 57) {
                $input->{number} .= ($keysym - 48);
        } elsif (97 <= $keysym && $keysym <= 122) {
                $input->{text} .= chr($keysym);
        } elsif ($self->XKeysymToString($keysym) eq 'Return') {
                $input->{number} .= '$';
        } elsif ($keysym == 59) {
                $input->{action} = 'yank';
                return 1;
        } else {
                $escape = 1;
        }

        if (!$escape) {
                my $min = 0;
                my $max = scalar(@{$input->{array}});

                my $nr_re = qr/^$input->{number}/;
                my $text_re = qr/$input->{text}/;
                my @matches;
                for (my $i = $min; $i < $max; $i++) {
                        my $item = $input->{array}->[$i];
                        if ($i =~ /$nr_re/ && $item->{text} =~ /$text_re/) {
                                push @matches, $i;
                        } elsif ($input->{unmatch}) {
                                my $item = $input->{array}->[$i];
                                $input->{unmatch}->($self, $item);
                        }
                }
                if (@matches > 1) {
                        # not enough data yet
                        return 1;
                }
                if (@matches == 1) {
                        my $item = $input->{array}->[$matches[0]];
                        my $action = $input->{action} ||
                                     $item->{action} ||
                                     'activate';
                        if ($action eq 'activate') {
                                $self->exec_async(qw(webview), $item->{text});
                        } elsif ($action eq 'yank') {
                                $self->selection($item->{text});
                                $self->selection_grab(urxvt::CurrentTime);
                        }
                }
        }

        delete $self->{input};
        $self->disable('key_press');
        1;
}

sub enable_select {
        my $self = shift;
        $self->{input} = {text => '', number => '', @_};
        $self->enable(key_press => \&handle_select_key);
}

sub matchlist {
        my $self = shift;

        my @items = $self->find_matches(@_)
                or return;

        my $max_width = 0;
        for (my $i = 0; $i < @items; $i++) {
                my $item = $items[$i];

                $item->{number} = $i;
                $item->{menu} = "$i. $item->{text}";

                my $width = $self->strwidth($item->{menu});
                $max_width = $width if $width > $max_width;
        }

        my $rend = urxvt::SET_COLOR(urxvt::OVERLAY_RSTYLE, 0, 3);

        my $o = $self->overlay(0, 0, $max_width, scalar(@items), $rend, 0);
        for (my $i = 0; $i < @items; $i++) {
                $o->set(0, $i, $items[$i]->{menu});
        }
        $self->enable_select(
                array => \@items,
                overlay => $o,
                unmatch => sub {
                        my ($self, $item) = @_;
                        my $o = $self->{input}->{overlay};
                        $o->set(0, $item->{number}, ' ' x 
length($item->{menu}));
                },
        );
}

sub open_hints {
        my $self = shift;

        my @items = $self->find_matches(@_)
                or return;

        for (my $i = 0; $i < @items; $i++) {
                my $item = $items[$i];

                $item->{overlay} = $self->overlay($item->{col}, $item->{row},
                                                  length($i), 1,
                                                  urxvt::OVERLAY_RSTYLE, 0);
                $item->{overlay}->set(0, 0, $i);
        }

        $self->enable_select(
                array => \@items,
                unmatch => sub {
                        my ($self, $item) = @_;
                        $item->{overlay} = undef;
                },
        );
}

my $URLCHAR = qr![-a-zA-Z:0-9./\#%+~_?=&()@;,]!;
my $URLEND = qr![a-zA-Z0-9/]!;
#my $URLLINE = qr!$URLCHAR{60,}$URLEND\n|$URLCHAR*$URLEND!;
my $URL = qr!$URLCHAR*$URLEND!;

sub find_urls {
        local $_ = shift;
        my @urls;

        while (m!(http|https|ftp|file)://$URL!g) {
                push @urls, [$-[0], $&];
        }
        while (m!^ *([a-zA-Z0-9]$URL\.(?:com|net|org)/$URL)!mg) {
                push @urls, [$-[0], "http://$&";];
        }
        while (m!(?:^|(?<=\s))(www|ftp)\.$URL!g) {
                push @urls, [$-[0], ($1 eq 'www' ? 'http://' : 'ftp://') . $&];
        }

        return map { {
                offset => $_->[0],
                text => $_->[1],
        } } @urls;
}

sub find_commits {
        local $_ = shift;

        my @items;
        while (m/(?:^|[^0-9a-f])
                 ([0-9a-f]{7,40})
                 (?![0-9a-f])/gx) {
                push @items, { offset => $-[1], text => $1, action => 'yank' };
        }
        while (m/(?:^|\s)
                 ([0-9a-f]{7,} \.{2,3} [0-9a-f]{7,})
                 (?:$|\s)/gx) {
                push @items, { offset => $-[1], text => $1, action => 'yank' };
        }
        return @items;
}

sub find_matches {
        my $self = shift;

        my @ret;
        my $row = 0;
        while ($row < $self->nrow) {
                my $line = $self->line($row);
                for my $item (find_line_matches($line->t)) {
                        @$item{qw(row col)} = $line->coord_of($item->{offset});
                        push @ret, $item;
                }
                $row = 1 + $line->end;
        }
        return @ret;
}

sub find_line_matches {
        my $buf = shift;
        return map {
                if ($_ eq 'url') { find_urls($buf) }
                elsif ($_ eq 'commit') { find_commits($buf) }
                else { d("unknown type: $_"); () }
        } @_ ? @_ : qw(url commit);
}

Reply via email to