st-config/st-autocomplete

311 lines
9.8 KiB
Plaintext
Raw Permalink Normal View History

2022-07-10 14:19:06 +02:00
#!/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;
}