diff options
Diffstat (limited to 'Misc/lete2ctl')
| -rwxr-xr-x | Misc/lete2ctl | 301 |
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__ |