#! perl

# Author: Chip Camden <sterling@camdensoftware.com>

my @hintchars = split //,'jfkdlsahgiroemcx';

my $re_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;

my $re_git_hash = qr{\b[0-9a-f]{7,40}\b}x;

my $re_message_id = qr{<\S+?@\S+?>}x;

sub hint_iterator {
    # we map successive integers to hints by successive modulo / divide against
    # the number of hint chars
    # this makes for simple code, but is not very efficient
    # should not matter unless we have thousands of hints
    my $state = 0;
    return sub {
        my $idx = $state;
        my @retval;
        while (1) {
            use integer;
            unshift @retval, ($hintchars[$idx % @hintchars]);
            if ($idx < @hintchars) {
                last;
            }
            $idx /= @hintchars;
        }

        $state++;

        return join '',@retval;
    }
}

sub find_matches {
    my ($pattern, $text, $rowmap) = @_;

    my @matches;
    while ($text =~ /$pattern/g) {
        my $ndx  = $-[0];
        my $href = $&;
        my $col  = 0;
        my $row  = 0;

        for my $key (keys %$rowmap) {
            my $value = $rowmap->{$key};
            my ($start, $end) = @$value;
            if (($start <= $ndx) && ($end >= $ndx)) {
                $row = $key;
                $col = $ndx - $start;
                last;
            }
        }
        if ($row >= 0) {
            push(@matches, [$col, $row, $href]);
        }
    }

    return @matches;
}

sub build_overlays {
    my ($self, $pattern, $text, $rowmap) = @_;

    my $label_rend = $self->get_rend("label", urxvt::OVERLAY_RSTYLE);

    my @overlays = find_matches($pattern, $text, $rowmap);
    @overlays    = reverse @overlays if ($self->{descending});

    my $results = {};
    my $hints = hint_iterator();

    for my $ov (@overlays) {
        my ($col, $row, $href) = @$ov;
        my $hint = $hints->();

        my $overlay = $self->overlay($col, $row, $self->strwidth($hint),
                                     1, $label_rend, 0);
        $overlay->set(0, 0, $hint);

        $results->{$hint} = {label => $overlay, match => $href};
    }

    return $results;
};

sub on_action {
    my ($self, $cmd) = @_;

    my $pattern;
    if ($cmd eq 'url') {
        $pattern = $re_url;
    } elsif ($cmd eq 'git_hash') {
        $pattern = $re_git_hash;
    } elsif ($cmd eq 'message_id') {
        $pattern = $re_message_id;
    } else {
        return;
    }

    my $rowmap      = {};
    my $row         = 0;
    my $base_col    = 0;
    my $text        = '';

    my ($brow, $bcol) = $self->selection_beg();
    my ($erow, $ecol) = $self->selection_end();
    my $issel = ($ecol > $bcol) || ($erow > $brow);
    if ($issel) {         # restrict to selection if one exists
        ($row, $base_col) = ($brow - $self->view_start, $bcol);
        for (split(/\n/, $self->selection())) {
            my $start = length($text) - $base_col;
            $text .= $_;
            $rowmap->{$row} = [$start, (length($text)-1)];
            $base_col = 0;
            $row++;
        }
    } else {            # no selection, use visible terminal
        for (0..($self->nrow - 1)) {
            $row = $_;
            my $start = length($text);
            $text .= $self->ROW_t($row + $self->view_start);
            $rowmap->{$row} = [$start, (length($text)-1)];
        }
    }

    my $results = $self->build_overlays($pattern, $text, $rowmap);

    if (keys %{$results} < 1) {
        my $desc = $issel ? "in visible selected text" : "on visible screen";
        $self->status_msg("no matches found $desc");
    } else {
        my $url_picker = {};

        my $prompt = "Select match:";
        $url_picker->{prompt} = $self->overlay(0, -1, length $prompt, 1,
                                               $self->get_rend("prompt", urxvt::OVERLAY_RSTYLE), 0);
        $url_picker->{prompt}->set(0, 0, $prompt);

        $url_picker->{prompt_len} = length $prompt;

        $url_picker->{results} = $results;
        $url_picker->{buffer} = '';
        my ($crow,$ccol) = $self->screen_cur;
        $url_picker->{crow} = $crow;
        $url_picker->{ccol} = $ccol;
        $self->{url_picker} = $url_picker;
        $self->update($url_picker);
    }
}

sub on_key_press {
    my ($self, $event, $keysym) = @_;
    if ($self->{url_picker_msg}) {
        $self->{url_picker_msg} = ();
    }
    my $p = $self->{url_picker};
    if ($p) {
        my $keyname = $self->XKeysymToString($keysym);

        if ($keyname eq 'Escape') {
            $self->screen_cur($p->{crow},$p->{ccol});
            $self->{url_picker} = ();
        } elsif ($keyname eq 'BackSpace') {
            if (length($p->{buffer}) > 0) {
                $p->{buffer} = substr($p->{buffer},0,-1);
                $self->update($p);
            }
        } elsif ($keyname eq 'Return' || $keyname eq 'KP_Enter') {
            my $num = $p->{buffer};
            my $results = $p->{results};
            if (exists $results->{$num}) {
                my $match = $results->{$num}->{match};
                $self->launch($match);
            }
        } elsif (grep { $_ eq $keyname } @hintchars) {
            $p->{buffer} = $p->{buffer} . $keyname;
            $self->update($p);
        }

        return 1;
    }
  ()
}

sub update {
    my ($self, $p) = @_;
    $p->{typing} = $self->overlay($p->{prompt_len}, -1, length($p->{buffer}), 1,
                                  $self->get_rend("input", urxvt::OVERLAY_RSTYLE), 0);
    $p->{typing}->set(0,0,$p->{buffer});

    my $results = $p->{results};
    my $len = length($p->{buffer});
    my @matches;

    foreach (keys %{$results}) {
        my $result  = $results->{$_};
        my $overlay = $result->{label};

        if ($len == 0 || index($_, $p->{buffer}) == 0) {
            $overlay->show;
            unshift @matches, $result->{match};
        } else {
            $overlay->hide;
        }
    }
    # Auto-launch a single url only if the launchsingle resource is true
    # (default), or if some digits were input
    if (scalar(@matches) == 1 && ($self->{launchsingle} || $len > 0)) {
        $self->launch(@matches[0]);
    } else {
        $self->screen_cur($self->nrow,8+$len);
    }
}

sub launch {
    my ($self, $href) = @_;
    my $p = $self->{url_picker};
    $self->screen_cur($p->{crow},$p->{ccol});
    $self->{url_picker} = ();

    $self->status_msg($href);

    $self->selection($href, 1);
    $self->selection_grab(urxvt::CurrentTime, 1);
}

sub status_msg {
    my ($self, $msg) = @_;

    $msg = $self->{name} . ":" . $msg;
    $self->{url_picker_msg} = $self->overlay(0, -1, length($msg), 1,
                                             $self->get_rend("status",urxvt::OVERLAY_RSTYLE), 0);
    $self->{url_picker_msg}->set(0, 0, $msg);
    $self->{url_picker_timer} = urxvt::timer
                                ->new
                                ->after (5)
                                ->cb (sub {
                                         $self->{url_picker_msg} = ();
                                         $self->{url_pickertimer} = ();
                                       });
}

sub get_rend {
    my ($self, $name, $default) = @_;
    urxvt::SET_COLOR $default,
       $self->my_resource("$name.foregroundColor") || urxvt::GET_BASEFG $default,
       $self->my_resource("$name.backgroundColor") || urxvt::GET_BASEBG $default;
}

sub on_key_release {
    my ($self, $event, $keysym) = @_;
    $self->{url_picker};
}

sub my_resource {
    my ($self, $name) = @_;
    $self->x_resource ("$self->{name}.$name");
}

sub on_start {
    my ($self) = @_;

    ($self->{name} = __PACKAGE__) =~ s/.*:://;
    $self->{name}  =~ tr/_/-/;
    $self->{launchsingle} = ($self->my_resource("launchsingle") ne "false");
    $self->{descending}   = ($self->my_resource("order") eq "descending");
    $self->{url_picker}   = ();
}