st-autocomplete

#!/usr/bin/perl
#########################################################################
# Copyright (C) 2012-2021  Wojciech Siewierski, Gaspar Vardanyan        #
#                                                                       #
# This program is free software: you can redistribute it and/or modify  #
# it under the terms of the GNU General Public License as published by  #
# the Free Software Foundation, either version 3 of the License, or     #
# (at your option) any later version.                                   #
#                                                                       #
# This program is distributed in the hope that it will be useful,       #
# but WITHOUT ANY WARRANTY; without even the implied warranty of        #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         #
# GNU General Public License for more details.                          #
#                                                                       #
# You should have received a copy of the GNU General Public License     #
# along with this program.  If not, see <http://www.gnu.org/licenses/>. #
#########################################################################

my ($cmd, $cursor_row, $cursor_column) = @ARGV;

# A reference to a function that transforms the completed word
# into a regex matching the completions. Usually generated by
# generate_matcher().
#
# For example
#   $fun = generate_matcher(".*");
#   $fun->("foo");
# would return "f.*o.*o"
#
# In other words, indirectly decides which characters can
# appear in the completion.
my $matcher;

# A regular expression matching a character before each match.
# For example, it you want to match the text after a
# whitespace, set it to "\s".
my $char_class_before;

# A regular expression matching every character in the entered
# text that will be used to find matching completions. Usually
# "\w" or similar.
my $char_class_to_complete;

# A regular expression matching every allowed last character
# of the completion (uses greedy matching).
my $char_class_at_end;

if ($cmd eq 'word-complete') {
	# Basic word completion. Completes the current word
	# without any special matching.
	$char_class_before      = '[^-\w]';
	$matcher                = sub { quotemeta shift }; # identity
	$char_class_at_end      = '[-\w]';
	$char_class_to_complete = '[-\w]';
} elsif ($cmd eq 'WORD-complete') {
	# The same as above but in the Vim meaning of a "WORD" --
	# whitespace delimited.
	$char_class_before      = '\s';
	$matcher                = sub { quotemeta shift };
	$char_class_at_end      = '\S';
	$char_class_to_complete = '\S';
} elsif ($cmd eq 'fuzzy-word-complete' ||
		 $cmd eq 'skeleton-word-complete') {
	# Fuzzy completion of the current word.
	$char_class_before      = '[^-\w]';
	$matcher                = generate_matcher('[-\w]*');
	$char_class_at_end      = '[-\w]';
	$char_class_to_complete = '[-\w]';
} elsif ($cmd eq 'fuzzy-WORD-complete') {
	# Fuzzy completion of the current WORD.
	$char_class_before      = '\s';
	$matcher                = generate_matcher('\S*');
	$char_class_at_end      = '\S';
	$char_class_to_complete = '\S';
} elsif ($cmd eq 'fuzzy-complete' ||
		 $cmd eq 'skeleton-complete') {
	# Fuzzy completion of an arbitrary text.
	$char_class_before      = '\W';
	$matcher                = generate_matcher('.*?');
	$char_class_at_end      = '\w';
	$char_class_to_complete = '\S';
} elsif ($cmd eq 'suffix-complete') {
	# Fuzzy completion of an completing suffixes, like
	# completing test=hello from /blah/hello.
	$char_class_before      = '\S';
	$matcher                = generate_matcher('\S*');
	$char_class_at_end      = '\S';
	$char_class_to_complete = '\S';
} elsif ($cmd eq 'surround-complete') {
	# Completing contents of quotes and braces.

	# Here we are using three named groups: s, b, p for quotes, braces
	# and parenthesis.
	$char_class_before      = '((?<q>["\'`])|(?<b>\[)|(?<p>\())';

	$matcher                = generate_matcher('.*?');

	# Here we match text till enclosing pair, using perl conditionals in
	# regexps (?(condition)yes-expression|no-expression).
	# \0 is used to hack concatenation with '*' later in the code.
	$char_class_at_end      = '.*?(.(?=(?(<b>)\]|((?(<p>)\)|\g{q})))))\0';
	$char_class_to_complete = '\S';
}

my $lines = [];

my $last_line = -1;
my $lines_after_cursor = 0;

while (<STDIN>)
{
	$last_line++;

	if ($last_line <= $cursor_row)
	{
		push @{$lines}, $_;
	}
	else
	{
		unshift @{$lines}, $_;
		$lines_after_cursor++;
	}
}

$cursor_row = $last_line;

# read the word behind the cursor
$_ = substr(@{$lines} [$cursor_row], 0, $cursor_column); # get the current line up to the cursor...
s/.*?($char_class_to_complete*)$/$1/;                 # ...and read the last word from it
my $word_to_complete = $_;

# ignore the completed word itself
$self->{already_completed}{$word_to_complete} = 1;

print stdout "$word_to_complete\n";

# search for matches
while (my $completion = find_match($self,
                                        $word_to_complete,
                                        $self->{next_row} // $cursor_row,
                                        $matcher->($word_to_complete),
                                        $char_class_before,
                                        $char_class_at_end)
) {
	calc_match_coords($self,
					$self->{next_row}+1,
					$completion);
	print stdout "$completion @{$self->{highlight}}\n";
}

leave($self);



######################################################################

# Finds the next matching completion in the row current row or above
# while skipping duplicates using skip_duplicates().
sub find_match {
    my ($self, $word_to_match, $current_row, $regexp, $char_class_before, $char_class_at_end) = @_;
    $self->{matches_in_row} //= [];

    # cycle through all the matches in the current row if not starting a new search
    if (@{$self->{matches_in_row}}) {
        return skip_duplicates($self, $word_to_match, $current_row, $regexp, $char_class_before, $char_class_at_end);
    }


    my $i;
    # search through all the rows starting with current one or one above the last checked
    for ($i = $current_row; $i >= 0; --$i) {
        my $line = @{$lines} [$i];   # get the line of text from the row

        if ($i == $cursor_row) {
            $line = substr $line, 0, $cursor_column;
        }

        $_ = $line;

        # find all the matches in the current line
        my $match;
        push @{$self->{matches_in_row}}, $+{match} while ($_, $match) = /
                                                                         (.*${char_class_before})
                                                                         (?<match>
                                                                             ${regexp}
                                                                             ${char_class_at_end}*
                                                                         )
                                                                     /ix;
        # corner case: match at the very beginning of line
        push @{$self->{matches_in_row}}, $+{match} if $line =~ /^(${char_class_before}){0}(?<match>$regexp$char_class_at_end*)/i;

        if (@{$self->{matches_in_row}}) {
            # remember which row should be searched next
            $self->{next_row} = --$i;

            # arguments needed for find_match() mutual recursion
            return skip_duplicates($self, $word_to_match, $i, $regexp, $char_class_before, $char_class_at_end);
        }
    }

    # no more possible completions, revert to the original word
    $self->{next_row} = -1 if $i < 0;

    return undef;
}

######################################################################

# Checks whether the completion found by find_match() was already
# found and if it was, calls find_match() again to find the next
# completion.
#
# Takes all the arguments that find_match() would take, to make a
# mutually recursive call.
sub skip_duplicates {
    my $self = $_[0];
	my $current_row = $_[2];
	my $completion;
	if ($current_row >= $lines_after_cursor)
	{
		$completion = shift @{$self->{matches_in_row}}; # get the rightmost one
	}
	else
	{
		$completion = pop @{$self->{matches_in_row}}; # get the rightmost one
	}

    # check for duplicates
    if (exists $self->{already_completed}{$completion}) {
        # skip this completion
        return find_match(@_);
    } else {
        $self->{already_completed}{$completion} = 1;
        return $completion;
    }
}

######################################################################

# Returns a function that takes a string and returns that string with
# this function's argument inserted between its every two characters.
# The resulting string is used as a regular expression matching the
# completion candidates.
sub generate_matcher {
    my $regex_between = shift;

    sub {
        $_ = shift;

        # sorry for this lispy code, I couldn't resist ;)
        (join "$regex_between",
         (map quotemeta,
          (split //)))
    }
}

######################################################################

sub calc_match_coords {
    my ($self, $linenum, $completion) = @_;

    my $line = @{$lines} [$linenum];
    my $re = quotemeta $completion;

    $line =~ /$re/;

	#my ($beg_row, $beg_col) = $line->coord_of($-[0]);
	#my ($end_row, $end_col) = $line->coord_of($+[0]);
	my $beg = $-[0];
	my $end = $+[0];

    if (exists $self->{highlight}) {
        delete $self->{highlight};
    }
    # () # TODO: what does () do in perl ????

	if ($linenum >= $lines_after_cursor)
	{
		$linenum -= $lines_after_cursor;
	}
	else
	{
		$linenum = $last_line - $linenum;
	}

    # $self->{highlight} = [$beg_row, $beg_col, $end_row, $end_col];
    $self->{highlight} = [$linenum, $beg, $end];
}

######################################################################

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

    delete $self->{next_row};
    delete $self->{matches_in_row};
    delete $self->{already_completed};
    delete $self->{highlight};
}