311 lines
9.8 KiB
Plaintext
311 lines
9.8 KiB
Plaintext
|
#!/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;
|
||
|
|
}
|