st-autocomplete (10070B)
1 #!/usr/bin/perl 2 ######################################################################### 3 # Copyright (C) 2012-2017 Wojciech Siewierski # 4 # # 5 # This program is free software: you can redistribute it and/or modify # 6 # it under the terms of the GNU General Public License as published by # 7 # the Free Software Foundation, either version 3 of the License, or # 8 # (at your option) any later version. # 9 # # 10 # This program is distributed in the hope that it will be useful, # 11 # but WITHOUT ANY WARRANTY; without even the implied warranty of # 12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # 13 # GNU General Public License for more details. # 14 # # 15 # You should have received a copy of the GNU General Public License # 16 # along with this program. If not, see <http://www.gnu.org/licenses/>. # 17 ######################################################################### 18 19 my ($cmd, $cursor_row, $cursor_column) = @ARGV; 20 21 my $lines = []; 22 my $lines1 = []; 23 24 my $last_line = -1; 25 my $lines_before_cursor = 0; 26 27 while (<stdin>) 28 { 29 $last_line++; 30 31 s/[^[:print:]]/?/g; 32 33 if ($last_line < $cursor_row) 34 { 35 unshift @{$lines1}, $_; 36 $lines_before_cursor++; 37 } 38 else 39 { 40 unshift @{$lines}, $_; 41 } 42 } 43 44 foreach (@{$lines1}) 45 { 46 unshift @{$lines}, $_; 47 } 48 49 my $cursor_row_in = $cursor_row; 50 51 $cursor_row = $last_line; 52 53 54 $self = {}; 55 56 # A reference to a function that transforms the completed word 57 # into a regex matching the completions. Usually generated by 58 # generate_matcher(). 59 # 60 # For example 61 # $fun = generate_matcher(".*"); 62 # $fun->("foo"); 63 # would return "f.*o.*o" 64 # 65 # In other words, indirectly decides which characters can 66 # appear in the completion. 67 my $matcher; 68 69 # A regular expression matching a character before each match. 70 # For example, it you want to match the text after a 71 # whitespace, set it to "\s". 72 my $char_class_before; 73 74 # A regular expression matching every character in the entered 75 # text that will be used to find matching completions. Usually 76 # "\w" or similar. 77 my $char_class_to_complete; 78 79 # A regular expression matching every allowed last character 80 # of the completion (uses greedy matching). 81 my $char_class_at_end; 82 83 if ($cmd eq 'word-complete') { 84 # Basic word completion. Completes the current word 85 # without any special matching. 86 $char_class_before = '[^-\w]'; 87 $matcher = sub { quotemeta shift }; # identity 88 $char_class_at_end = '[-\w]'; 89 $char_class_to_complete = '[-\w]'; 90 } elsif ($cmd eq 'WORD-complete') { 91 # The same as above but in the Vim meaning of a "WORD" -- 92 # whitespace delimited. 93 $char_class_before = '\s'; 94 $matcher = sub { quotemeta shift }; 95 $char_class_at_end = '\S'; 96 $char_class_to_complete = '\S'; 97 } elsif ($cmd eq 'fuzzy-word-complete' || 98 $cmd eq 'skeleton-word-complete') { 99 # Fuzzy completion of the current word. 100 $char_class_before = '[^-\w]'; 101 $matcher = generate_matcher('[-\w]*'); 102 $char_class_at_end = '[-\w]'; 103 $char_class_to_complete = '[-\w]'; 104 } elsif ($cmd eq 'fuzzy-WORD-complete') { 105 # Fuzzy completion of the current WORD. 106 $char_class_before = '\s'; 107 $matcher = generate_matcher('\S*'); 108 $char_class_at_end = '\S'; 109 $char_class_to_complete = '\S'; 110 } elsif ($cmd eq 'fuzzy-complete' || 111 $cmd eq 'skeleton-complete') { 112 # Fuzzy completion of an arbitrary text. 113 $char_class_before = '\W'; 114 $matcher = generate_matcher('.*?'); 115 $char_class_at_end = '\w'; 116 $char_class_to_complete = '\S'; 117 } elsif ($cmd eq 'suffix-complete') { 118 # Fuzzy completion of an completing suffixes, like 119 # completing test=hello from /blah/hello. 120 $char_class_before = '\S'; 121 $matcher = generate_matcher('\S*'); 122 $char_class_at_end = '\S'; 123 $char_class_to_complete = '\S'; 124 } elsif ($cmd eq 'surround-complete') { 125 # Completing contents of quotes and braces. 126 127 # Here we are using three named groups: s, b, p for quotes, braces 128 # and parenthesis. 129 $char_class_before = '((?<q>["\'`])|(?<b>\[)|(?<p>\())'; 130 131 $matcher = generate_matcher('.*?'); 132 133 # Here we match text till enclosing pair, using perl conditionals in 134 # regexps (?(condition)yes-expression|no-expression). 135 # \0 is used to hack concatenation with '*' later in the code. 136 $char_class_at_end = '.*?(.(?=(?(<b>)\]|((?(<p>)\)|\g{q})))))\0'; 137 $char_class_to_complete = '\S'; 138 } 139 140 141 # use the last used word or read the word behind the cursor 142 my $word_to_complete = read_word_at_coord($self, $cursor_row, $cursor_column, 143 $char_class_to_complete); 144 145 print stdout "$word_to_complete\n"; 146 147 if ($word_to_complete) { 148 while (1) { 149 # ignore the completed word itself 150 $self->{already_completed}{$word_to_complete} = 1; 151 152 # continue the last search or start from the current row 153 my $completion = find_match($self, 154 $word_to_complete, 155 $self->{next_row} // $cursor_row, 156 $matcher->($word_to_complete), 157 $char_class_before, 158 $char_class_at_end); 159 if ($completion) { 160 print stdout $completion."\n".join ("\n", @{$self->{highlight}})."\n"; 161 } 162 else { 163 last; 164 } 165 } 166 } 167 168 ###################################################################### 169 170 sub highlight_match { 171 my ($self, $linenum, $completion) = @_; 172 173 # clear_highlight($self); 174 175 my $line = @{$lines}[$linenum]; 176 my $re = quotemeta $completion; 177 178 $line =~ /$re/; 179 180 my $beg = $-[0]; 181 my $end = $+[0]; 182 183 if ($linenum >= $lines_before_cursor) 184 { 185 $lline = $last_line - $lines_before_cursor; 186 $linenum -= $lines_before_cursor; 187 $linenum = $lline - $linenum; 188 $linenum += $lines_before_cursor; 189 } 190 191 192 $self->{highlight} = [$linenum, $beg, $end]; 193 } 194 195 ###################################################################### 196 197 sub read_word_at_coord { 198 my ($self, $row, $col, $char_class) = @_; 199 200 $_ = substr(@{$lines} [$row], 0, $col); # get the current line up to the cursor... 201 s/.*?($char_class*)$/$1/; # ...and read the last word from it 202 return $_; 203 } 204 205 ###################################################################### 206 207 # Returns a function that takes a string and returns that string with 208 # this function's argument inserted between its every two characters. 209 # The resulting string is used as a regular expression matching the 210 # completion candidates. 211 sub generate_matcher { 212 my $regex_between = shift; 213 214 sub { 215 $_ = shift; 216 217 # sorry for this lispy code, I couldn't resist ;) 218 (join "$regex_between", 219 (map quotemeta, 220 (split //))) 221 } 222 } 223 224 ###################################################################### 225 226 # Checks whether the completion found by find_match() was already 227 # found and if it was, calls find_match() again to find the next 228 # completion. 229 # 230 # Takes all the arguments that find_match() would take, to make a 231 # mutually recursive call. 232 sub skip_duplicates { 233 my ($self, $word_to_match, $current_row, $regexp, $char_class_before, $char_class_at_end) = @_; 234 my $completion; 235 236 if ($current_row <= $lines_before_cursor) 237 { 238 $completion = shift @{$self->{matches_in_row}}; # get the leftmost one 239 } 240 else 241 { 242 $completion = pop @{$self->{matches_in_row}}; # get the leftmost one 243 } 244 245 # check for duplicates 246 if (exists $self->{already_completed}{$completion}) { 247 # skip this completion 248 return find_match(@_); 249 } else { 250 $self->{already_completed}{$completion} = 1; 251 252 highlight_match($self, 253 $self->{next_row}+1, 254 $completion); 255 256 return $completion; 257 } 258 } 259 260 ###################################################################### 261 262 # Finds the next matching completion in the row current row or above 263 # while skipping duplicates using skip_duplicates(). 264 sub find_match { 265 my ($self, $word_to_match, $current_row, $regexp, $char_class_before, $char_class_at_end) = @_; 266 $self->{matches_in_row} //= []; 267 268 # cycle through all the matches in the current row if not starting a new search 269 if (@{$self->{matches_in_row}}) { 270 return skip_duplicates($self, $word_to_match, $current_row, $regexp, $char_class_before, $char_class_at_end); 271 } 272 273 274 my $i; 275 # search through all the rows starting with current one or one above the last checked 276 for ($i = $current_row; $i >= 0; --$i) { 277 my $line = @{$lines}[$i]; # get the line of text from the row 278 279 # if ($i == $cursor_row) { 280 # $line = substr $line, 0, $cursor_column; 281 # } 282 283 $_ = $line; 284 285 # find all the matches in the current line 286 my $match; 287 push @{$self->{matches_in_row}}, $+{match} while ($_, $match) = / 288 (.*${char_class_before}) 289 (?<match> 290 ${regexp} 291 ${char_class_at_end}* 292 ) 293 /ix; 294 # corner case: match at the very beginning of line 295 push @{$self->{matches_in_row}}, $+{match} if $line =~ /^(${char_class_before}){0}(?<match>$regexp$char_class_at_end*)/i; 296 297 if (@{$self->{matches_in_row}}) { 298 # remember which row should be searched next 299 $self->{next_row} = --$i; 300 301 # arguments needed for find_match() mutual recursion 302 return skip_duplicates($self, $word_to_match, $i, $regexp, $char_class_before, $char_class_at_end); 303 } 304 } 305 306 # # no more possible completions, revert to the original word 307 # undo_completion($self) if $i < 0; 308 309 return undef; 310 }