SHA-1 matching

urlmatch.pl

#!/usr/bin/perl

# Save in ~/.urxvt/ext/urlmatch
# URxvt.keysym.C-b: urlmatch:list
# URxvt.keysym.C-semicolon: urlmatch:hint

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);
}