#!/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 . # ######################################################################### my ($cmd, $cursor_row, $cursor_column) = @ARGV; my $lines = []; my $lines1 = []; my $last_line = -1; my $lines_before_cursor = 0; while () { $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 = '((?["\'`])|(?\[)|(?

\())'; $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 = '.*?(.(?=(?()\]|((?(

)\)|\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}) (? ${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}(?$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; }