301 lines
9.9 KiB
Perl
301 lines
9.9 KiB
Perl
#!/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 = quotemeta;
|
|
|
|
# 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;
|
|
}
|
|
|
|
# ACMPL_ISSUE: multi-line completions don't work
|
|
# $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};
|
|
}
|