#! perl

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


use English;
use POSIX;

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 {
    my ($len)    = @_;

    # generate fixed-length codes of sufficient length for all matches
    my $code_len;
    if ($len == 0) {
        $code_len = 1;
    } else {
        $code_len = POSIX::ceil(log($len) / log(@hintchars));
    }

    my $state = 0;
    return sub {
        use integer;

        my $idx = $state;
        my @retval;

        for (1..$code_len) {
            unshift @retval, $hintchars[$idx % @hintchars];
            $idx /= @hintchars;
        }

        $state++;

        return join '',@retval;
    }
}

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

    my @matches;
    my $unique_matches = {};
    while ($text =~ /$pattern/g) {
        my $ndx  = $-[0];
        my $match = $MATCH;
        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, $match]);
            $unique_matches->{$match} = 1;
        }
    }

    return { matches => \@matches, unique_count => scalar(keys %{$unique_matches})};
}

sub place_hint {
    my ($match_col, $match_row, $hint_w) = @_;

    # place the thint so it does not obscure the match, if possible
    $match_col -= $hint_w;
    if ($match_col < 0) {
        $match_col = 0;
    }

    return ($match_col, $match_row);
}

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

    my $hint_rend = $self->get_rend("hint", urxvt::OVERLAY_RSTYLE);

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

    my $match_hints = {};
    my $results     = {};
    my $hints       = hint_iterator($res->{unique_count});

    for my $m (@matches) {
        my ($col, $row, $match) = @$m;

        # create a new hint if this match was not seen before
        # reuse an existing one otherwise
        if (not exists $match_hints->{$match}) {
            $match_hints->{$match} = $hints->();
        }
        my $hint   = $match_hints->{$match};
        my $hint_w = $self->strwidth($hint);

        ($col, $row) = place_hint($col, $row, $hint_w);

        if (not exists $results->{$hint}) {
            $results->{$hint} = { match => $match, overlays => [] };
        }

        # create the overlay and add it to the list of overlays for this hint
        my $overlay = $self->overlay($col, $row, $hint_w, 1, $hint_rend, 0);
        $overlay->set(0, 0, $hint);

        push(@{$results->{$hint}->{overlays}}, $overlay);
    }

    return $results;
};

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

    my $pattern = $self->{patterns}->{$cmd};
    if (!defined($pattern)) {
        return;
    }

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

    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) {
        $self->status_msg("no $cmd matches found");
    } 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' ||
            ($keyname eq 'c' && ($event->{state} & urxvt::ControlMask))) {
            $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 (length($keyname) == 1 &&
                 grep { index($_, $p->{buffer} . $keyname) == 0} keys %{$p->{results}}) {
            # accept key only if the new buffer is a prefix of at least one hint
            $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->{$_};

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

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

    $self->status_msg($match);

    $self->selection($match, 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, $rend) = @_;
    # urxvt internal color indices are offset by 2 from the standard values
    my $color_offset = 2;

    my $fg = $self->my_resource("$name.foregroundColor");
    if ($fg) {
        $rend = urxvt::SET_FGCOLOR($rend, $color_offset + $fg);
    }
    my $bg = $self->my_resource("$name.backgroundColor");
    if ($bg) {
        $rend = urxvt::SET_BGCOLOR($rend, $color_offset + $bg);
    }

    return $rend;
}

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

    my $patterns = {
        url        => $re_url,
        git_hash   => $re_git_hash,
        message_id => $re_message_id,
    };

    for (my $idx = 0; defined (my $res = $self->my_resource("pattern.$idx")); $idx++) {
        $patterns->{"user.$idx"} = qr($res)x;
    }

    $self->{patterns} = $patterns;

}