Initial revision

1 files changed, 301 insertions, 0 deletions

diff --git a/Misc/lete2ctl b/Misc/lete2ctl
new file mode 100755
index 000000000..ca00b8aee
--- /dev/null
+++ b/Misc/lete2ctl
@@ -0,0 +1,301 @@
+#!/usr/local/bin/perl -w
+#
+#   ``Wee have also Shelles, thee Lyke of whych you knowe not, wherein
+#     thee User may with thee merest Presse of thee Tabbe-Keye expande
+#     or compleat al Maner of Wordes and such-like Diversities.''
+#            - Francis Bacon, `New Atlantis' (or not).
+#
+# Convert tcsh "complete" statements to zsh "compctl" statements.
+# Runs as a filter.  Should ignore anything which isn't a "complete".
+# It expects each "complete" statement to be the first thing on a line.
+# All the examples in the tcsh manual give sensible results.
+#
+# Option:
+# -x (exact): only applies in the case of command disambiguation (is
+#    that really a word?)  If you have lines like
+#       complete '-co*' 'p/0/(compress)'
+#    (which makes co<TAB> always complete to `compress') then the
+#    resulting "compctl" statements will produce one of two behaviours:
+#    (1) By default (like tcsh), com<TAB> etc. will also complete to
+#        "compress" and nothing else.
+#    (2) With -x, com<TAB> does ordinary command completion: this is
+#        more flexible.
+#    I don't understand what the hyphen in complete does and I've ignored it.
+#
+# Notes:
+# (1) The -s option is the way to do backquote expansion.  In zsh,
+#     "compctl -s '`users`' talk" works (duplicates are removed).
+# (2) Complicated backquote completions should definitely be rewritten as
+#     shell functions (compctl's "-K func" option).  Although most of
+#     these will be translated correctly, differences in shell syntax
+#     are not handled.
+# (3) Replacement of $:n with the n'th word on the current line with
+#     backquote expansion now works; it is not necessarily the most
+#     efficient way of doing it in any given case, however.
+# (4) I have made use of zsh's more sophisticated globbing to change
+#     things like ^foo.{a,b,c,d} to ^foo.(a|b|c|d), which works better.
+#     It's just possible in some cases you may want to change it back.
+# (5) Make sure all command names with wildcards are processed together --
+#     they need to be lumped into one "compctl -C" or "compctl -D"
+#     statement for zsh.
+
+# Handle options
+if (@ARGV) {
+    ($ARGV[0] eq '-x') && shift && ($opt_x = 1);
+    ($ARGV[0] =~ /^-+$/) && shift;
+}
+
+# Function names used (via magic autoincrement) when cmdline words are needed
+$funcnam = 'compfn001';
+
+# Read next word on command line
+sub getword {
+    local($word, $word2, $ret);
+    ($_) = /^\s*(.*)$/;
+    while ($_ =~ /^\S/) {
+	if (/^[\']/) {
+	    ($word, $_) = /^\'([^\']*).(.*)$/;
+	} elsif (/^[\"]/) {
+	    ($word, $_) = /^\"([^\"]*).(.*)$/;
+	    while ($word =~ /\\$/) {
+		chop($word);
+		($word2, $_) = /^([^\"]*).(.*)$/;
+		$word .= '"' . $word2;
+	    }
+	} elsif (/\S/) {
+	    ($word, $_) = /^([^\s\\\'\"\#;]*)(.*)$/;
+	    # Backslash: literal next character
+	    /^\\(.)/ && (($word .= substr($_,1,1)),
+			 ($_ = substr($_,2)));
+	    # Rest of line quoted or end of command
+	    /^[\#;]/ && ($_ = '');
+	} else {
+	    return undef;
+	}
+	length($word) && ($ret = defined($ret) ? $ret . $word : $word);
+    }
+    $ret;
+}
+
+# Interpret the x and arg in 'x/arg/type/'
+sub getpat {
+    local($pat,$arg) = @_;
+    local($ret,$i);
+    if ($pat eq 'p') {
+	$ret = "p[$arg]";
+    } elsif ($pat eq 'n' || $pat eq 'N') {
+	$let = ($arg =~ /[*?|]/) ? 'C' : 'c';
+	$num = ($pat eq 'N') ? 2 : 1;
+	$ret = "${let}[-${num},$arg]";
+    } elsif ($pat eq 'c' || $pat eq 'C') {
+	# A few tricks to get zsh to ignore up to the end of
+	# any matched pattern.
+	if (($pat eq 'c' && $arg =~ /^\*([^*?]*)$/)) {
+	    $ret = "n[-1,$1]";
+	} elsif ($arg =~ /[*?]([^*?]*)$/) {
+	    length($1) && ($ret = " n[-1,$1]");
+	    $ret = "C[0,$arg] $ret";
+	} else {
+	    $let = ($pat eq 'c') ? 's' : 'S';
+	    $ret = "${let}[$arg]";
+	}
+    }
+    $ret =~ s/'/'\\''/g;
+    $ret;
+}
+
+# Interpret the type in 'x/arg/type/'
+sub gettype {
+    local ($_) = @_;
+    local($qual,$c,$glob,$ret,$b,$m,$e,@m);
+    $c = substr($_,0,1);
+    ($c =~ /\w/) && (substr($_,1,1) eq ':') && ($glob = substr($_,2));
+# Nothing (n) can be handled by returning nothing.  (C.f. King Lear, I.i.)
+    if ($c =~ /[abcjuv]/) {
+	$ret = "-$c";
+    } elsif ($c eq 'S') {
+	$ret = '-k signals';
+    } elsif ($c eq 'd') {
+	if (defined($glob)) {
+	    $qual = '-/';
+	} else {
+	    $ret = '-/';
+	}
+    } elsif ($c eq 'e') {
+	$ret = '-E';
+    } elsif ($c eq 'f' && !$glob) {
+	$ret = '-f';
+    } elsif ($c eq 'l') {
+	$ret = q!-k "(`limit | awk '{print $1}'`)"!;
+    } elsif ($c eq 'p') {
+	$ret = "-W $glob -f", undef($glob) if defined($glob);
+    } elsif ($c eq 's') {
+	$ret = '-p';
+    } elsif ($c eq 't') {
+	$qual = '.';
+    } elsif ($c eq 'x') {
+	$glob =~ s/'/'\\''/g;
+	$ret = "-X '$glob'";
+	undef($glob);
+    } elsif ($c eq '$') {     # '){
+	$ret = "-k " . substr($_,1);
+    } elsif ($c eq '(') {
+	s/'/'\\''/g;
+	$ret = "-k '$_'";
+    } elsif ($c eq '`') {
+	# this took some working out...
+	if (s/\$:(\d+)/$foo=$1+1,"\${word[$foo]}"/ge) {
+	    $ret = "-K $funcnam";
+	    $genfunc .= <<"HERE";
+function $funcnam {
+    local word
+    read -cA word
+    reply=($_)
+}
+HERE
+	    $funcnam++;
+	} else {
+	    s/'/'\\''/g;
+	    $ret = "-s '$_'";
+	}
+    }
+
+    # foo{bar,ba,blak,sheap} -> foo(bar|ba|blak|sheap).
+    # This saves a lot of mess, since in zsh brace expansion occurs
+    # before globbing.  I'm sorry, but I don't trust $` and $'.
+    while (defined($glob) && (($b,$m,$e) = ($glob =~ /^(.*)\{(.*)\}(.*)$/))
+	   && $m =~ /,/) {
+	@m = split(/,/, $m);
+	for ($i = 0; $i < @m; $i++) {
+	    while ($m[$i] =~ /\\$/) {
+		substr($m[$i],-1,1) = "";
+		splice(@m,$i,2,"$m[$i]\\,$m[$i+1]");
+	    }
+	}
+	$glob = $b . "(" . join('|',@m) . ")" . $e;
+    }
+
+    if ($qual) {
+	$glob || ($glob = '*');
+	$glob .= "($qual)";
+    }
+    $glob && (($glob =~ s/'/'\\''/g),($glob = "-g '$glob'"));
+
+    defined($ret) && defined($glob) && ($ret .= " $glob");
+    defined($ret) ? $ret : $glob;
+}
+
+# Quoted array separator for extended completions
+$" = " - ";
+
+while (<>) {
+    if (/^\s*complete\s/) {
+	undef(@stuff); 
+	$default = '';
+	$_ = $';
+	while (/\\$/) {
+	    # Remove backslashed newlines: in principle these should become
+	    # real newlines inside quotes, but what the hell.
+	    ($_) = /^(.*)\\$/;
+	    $_ .= <>;
+	}
+	$command = &getword;
+	if ($command =~ /^-/ || $command =~ /[*?]/) {
+	    # E.g. complete -co* ...
+	    $defmatch = $command;
+	    ($defmatch =~ /^-/) && ($defmatch = substr($defmatch,1));
+	} else {
+	    undef($defmatch);
+	}
+	while (defined($word = &getword)) {
+	    # Loop over remaining arguments to "complete".
+	    $sep = substr($word,1,1);
+	    $sep =~ s/(\W)/\\$1/g;
+	    @split = split(/$sep/,$word);
+	    for ($i = 0; $i < 3; $i++) {
+		while ($split[$i] =~ /\\$/) {
+		    substr($split[$i],-1,1) = "";
+		    splice(@split,$i,2,"$split[$i]\\$sep$split[$i+1]");
+		}
+	    }
+	    ($pat,$arg,$type,$suffix) = @split;
+	    defined($suffix) && ($suffix =~ /^\s*$/) && undef($suffix);
+	    if (($word =~ /^n$sep\*$sep/) &&
+		 (!defined($defmatch))) {
+		 # The "complete" catch-all:  treat this as compctl\'s
+		 # default (requiring no pattern matching).
+		$default .= &gettype($type) . ' ';
+		defined($suffix) && ($defsuf .= $suffix);
+	    } else {
+		$pat = &getpat($pat,$arg);
+		$type = &gettype($type);
+		if (defined($defmatch)) {
+		    # The command is a pattern: use either -C or -D option.
+		    if ($pat eq 'p[0]') {
+			# Command word (-C): 'p[0]' is redundant.
+			if ($defmatch eq '*') {
+			    $defcommand = $type;
+			} else {
+			    ($defmatch =~ /\*$/) && chop($defmatch);
+			    if ($opt_x) {
+				$c = ($defmatch =~ /[*?]/) ? 'C' : 'c';
+				$pat = $c . "[0,${defmatch}]";
+			    } else {
+				$pat = ($defmatch =~ /[*?]/) ?
+				    "C[0,${defmatch}]" : "S[${defmatch}]";
+			    }
+			    push(@commandword,defined($suffix) ?
+				 "'$pat' $type -S '$suffix'" : "'$pat' $type");
+			}
+		    } elsif ($pat eq "C[-1,*]") {
+			# Not command word completion, but match
+			# command word (only)
+			if ($defmatch eq "*") {
+			    # any word of any command
+			    $defaultdefault .= " $type";
+			} else {
+			    $pat = "W[0,$defmatch]";
+			    push(@defaultword,defined($suffix) ?
+				 "'$pat' $type -S '$suffix'" : "'$pat' $type");
+			}
+		    } else {
+		        # Not command word completion, but still command
+			# word with pattern
+			($defmatch eq '*') || ($pat = "W[0,$defmatch] $pat");
+			push(@defaultword,defined($suffix) ?
+			     "'$pat' $type -S '$suffix'" : "'$pat' $type");
+		    }
+		} else {
+		    # Ordinary command
+		    push(@stuff,defined($suffix) ?
+			 "'$pat' $type -S '$suffix'" : "'$pat' $type");
+		}
+	    }
+	}
+        if (!defined($defmatch)) {
+	    # Ordinary commands with no pattern
+	    print("compctl $default");
+	    defined($defsuf) && print("-S '$defsuf' ") && undef($defsuf);
+	    defined(@stuff) && print("-x @stuff -- ");
+	    print("$command\n");
+	}
+	if (defined($genfunc)) {
+	    print $genfunc;
+	    undef($genfunc);
+	}
+    }
+}
+
+(defined(@commandword) || defined($defcommand)) &&
+    print("compctl -C ",
+	  defined($defcommand) ? $defcommand : '-c',
+	  defined(@commandword) ? " -x @commandword\n" : "\n");
+
+if (defined($defaultdefault) || defined(@defaultword)) {
+    defined($defaultdefault) || ($defaultdefault = "-f");
+    print "compctl -D $defaultdefault";
+    defined(@defaultword) && print(" -x @defaultword");
+    print "\n";
+}
+
+__END__