rlwrap: tclsh multi-word autocompletion

Question

How do I get multi-word autocompletion with rlwrap for tclsh?

Example: I type file <space> then pressing <tab> <tab> I only want to see the sub-commands to file, such as exists isdirectory or isfile.

I tried adding file\ isfile (i.e. escaping the space) to the completion file, but this did not help. It just caused isfile to appear as another autocomplete command.

I guess I could accomplish multi-word autocompletion with an rlwrap filter, but there were no obvious examples in /usr/share/rlwarp/filters/ for me to hook on.

Answer 1

As a bare minimum, a sample tclsh_filter for the rlwrap filters directory (make sure you chmod +x it):

#!/usr/bin/env perl
use strict;
use warnings;
use lib $ENV{RLWRAP_FILTERDIR};
use RlwrapFilter;

# log to some other terminal, so rlwrap terminal not cluttered up
# by any debug output - FIXME
my $DEBUG_TERMINAL = '/dev/pts/2';
open my $logfh, '>', $DEBUG_TERMINAL or die "aaaaaarrgh: $!\n";

my $filter = RlwrapFilter->new;
$filter->completion_handler(\&completion);
$filter->run;

sub completion {
  my ($input, $prefix, @completions) = @_;

  print $logfh "I,$input, P,$prefix, C,@completions\n";

  # more complicated would be to use a lex-like scanner or Parser::MGC
  # instead of this dumb regex against the input line, and even more
  # complicated would be to return "exists" if the user has typed
  # "file e" and is mashing tab, but that's more work
  if ($input =~ m/file\s+$/) {
    @completions = qw/exists isdirectory isfile/;
  }

  return @completions;
}

And then run it via rlwrap -z tclsh_filter tclsh

Answer 2

With the help from the excellent answer from thrig I cooked the following tclsh multi-word completion filter for tclsh. The script below should be stored in tclsh_filter and executed with rlwrap -z tclsh_filter tclsh. Remember to chmod +x tclsh_filter.

#!/usr/bin/env perl
use strict;
use warnings;
use lib $ENV{RLWRAP_FILTERDIR};
use RlwrapFilter;

my @tcl_cmds = qw/encoding if pid tcl_endOfWord eof incr pkg::create tcl_findLibrary after error info pkg_mkIndex tcl_startOfNextWord append eval interp proc tcl_startOfPreviousWord array exec join puts tcl_wordBreakAfter auto_execok exit lappend pwd tcl_wordBreakBefore auto_import expr lindex re_syntax tcltest auto_load fblocked linsert read tclvars auto_mkindex fconfigure list regexp tell auto_mkindex_old fcopy llength registry time auto_qualify file load regsub trace auto_reset fileevent lrange rename unknown bgerror filename lreplace return unset binary flush lsearch scan update break for lset seek uplevel catch foreach lsort set upvar cd format memory socket variable clock gets msgcat source vwait close glob namespace split while concat global open string continue history package subst dde http parray switch/;

# Below is copy paste from tcl.tk web pages.
my $tcl_txt = <<END;
file atime name ?time?
file attributes name
file attributes name ?option?
file attributes name ?option value option value...?
file channels ?pattern?
file copy ?-force? ?--? source target
file copy ?-force? ?--? source ?source ...? targetDir
file delete ?-force? ?--? pathname ?pathname ... ?
file dirname name
file executable name
file exists name
file extension name
file isdirectory name
file isfile name
file join name ?name ...?
file link ?-linktype? linkName ?target?
file lstat name varName
file mkdir dir ?dir ...?
file mtime name ?time?
file nativename name
file normalize name
file owned name
file pathtype name
file readable name
file readlink name
file rename ?-force? ?--? source target
file rename ?-force? ?--? source ?source ...? targetDir
file rootname name
file separator ?name?
file size name
file split name
file stat name varName
file system name
file tail name
file type name
file volumes
file writable name
string compare ?-nocase? ?-length int? string1 string2
string equal ?-nocase? ?-length int? string1 string2
string first needleString haystackString ?startIndex?
string index string charIndex
string is alnum  ?-strict? ?-failindex varname? string
string is alpha
string is ascii
string is boolean
string is control
string is digit
string is double
string is false
string is graph
string is integer
string is lower
string is print
string is punct
string is space
string is true
string is upper
string is wordchar
string is xdigit
string last needleString haystackString ?lastIndex?
string length string
string map ?-nocase? mapping string
string match ?-nocase? pattern string
string range string first last
string repeat string count
string replace string first last ?newstring?
string tolower string ?first? ?last?
string totitle string ?first? ?last?
string toupper string ?first? ?last?
string trim string ?chars?
string trimleft string ?chars?
string trimright string ?chars?
lsort -ascii
lsort -dictionary
lsort -integer
lsort -real
lsort -command command
lsort -increasing
lsort -decreasing
lsort -index index
lsort -unique
regexp -about
regexp -expanded
regexp -indices
regexp -line
regexp -linestop
regexp -lineanchor
regexp -nocase
regexp -all
regexp -inline
regexp -start index
regexp --
END

my @multi;
foreach my $line (split /\n/, $tcl_txt) {
  $line =~ s/\?//g;
  $line =~ s/ - -/ --/g;
  $line =~ s/ \.\.\.//g;
  $line =~ s/\s{2,}/ /g;
  $line =~ s/\s+$//;
  push @multi, $line;
  if ($line =~ /^(.*\s)(-\w+)\s(-\w+)(.*)$/) {
    push @multi, "$1$3 $2$4";
  }
}

my $filter = RlwrapFilter->new;
$filter->completion_handler(\&completion);
$filter->run;

sub completion {
  my ($input, $prefix, @completions) = @_;
  $input =~ s/\s+/ /g;
  # Support completion on composite expressions. Hacky, limited syntax support.
  $input =~ s/^[^[]+\[//;
  $input =~ s/^.*;\s*//;
  # If last complete words were options, remove these so we can restart option 
  # matching.
  $input =~ s/(?:\s-\w+)+\s((?:-\w+)?)$/ $1/;
  my $word_cnt = () = $input =~ m/\b\s+/g;
  if ($word_cnt == 0) {
    @completions = grep /^\Q$input\E/, @tcl_cmds;
  } else {
    my @mmatch = grep /^\Q$input\E/, @multi;
    @completions = map {my @F = split /\s/, $_;
                        $F[$word_cnt]} @mmatch;
    # rlwrap seem to have a 'feature' where words beginning with '-' are 
    # prepended with '-', forcing us to remove the dash. Downside is that 
    #  will list the options without '-'.
    @completions = map {s/^-//; $_} @completions;
  }

  return @completions;
}