st-autocomplete

#!/usr/bin/perl
#########################################################################
# Copyright (C) 2012-2017  Wojciech Siewierski                          #
#                                                                       #
# 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;

my $lines = [];
my $lines1 = [];

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

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

	s/[^[:print:]]/?/g;

	if ($last_line < $cursor_row)
	{
		unshift @{$lines1}, $_;
		$lines_before_cursor++;
	}
	else
	{
		unshift @{$lines}, $_;
	}
}

foreach (@{$lines1})
{
	unshift @{$lines}, $_;
}

my $cursor_row_in = $cursor_row;

$cursor_row = $last_line;


$self = {};

# 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';
}


# use the last used word or read the word behind the cursor
my $word_to_complete = read_word_at_coord($self, $cursor_row, $cursor_column,
										  $char_class_to_complete);

print stdout "$word_to_complete\n";

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

		# continue the last search or start from the current row
		my $completion = find_match($self,
									$word_to_complete,
									$self->{next_row} // $cursor_row,
									$matcher->($word_to_complete),
									$char_class_before,
									$char_class_at_end);
		if ($completion) {
			print stdout $completion."\n".join ("\n", @{$self->{highlight}})."\n";
		}
		else {
			last;
		}
	}
}

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

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

    # clear_highlight($self);

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

    $line =~ /$re/;

    my $beg = $-[0];
    my $end = $+[0];

	if ($linenum >= $lines_before_cursor)
	{
		$lline = $last_line - $lines_before_cursor;
		$linenum -= $lines_before_cursor;
		$linenum = $lline - $linenum;
		$linenum += $lines_before_cursor;
	}


    $self->{highlight} = [$linenum, $beg, $end];
}

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

sub read_word_at_coord {
    my ($self, $row, $col, $char_class) = @_;

    $_ = substr(@{$lines} [$row], 0, $col); # get the current line up to the cursor...
    s/.*?($char_class*)$/$1/;               # ...and read the last word from it
    return $_;
}

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

# 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 //)))
    }
}

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

# 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, $word_to_match, $current_row, $regexp, $char_class_before, $char_class_at_end) = @_;
    my $completion;

	if ($current_row <= $lines_before_cursor)
	{
		$completion = shift @{$self->{matches_in_row}}; # get the leftmost one
	}
	else
	{
		$completion = pop @{$self->{matches_in_row}}; # get the leftmost one
	}

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

		highlight_match($self,
						$self->{next_row}+1,
						$completion);

        return $completion;
    }
}

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

# 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
    # undo_completion($self) if $i < 0;

    return undef;
}