1#!/usr/local/bin/perl -w 2# 3# ``Wee have also Shelles, thee Lyke of whych you knowe not, wherein 4# thee User may with thee merest Presse of thee Tabbe-Keye expande 5# or compleat al Maner of Wordes and such-like Diversities.'' 6# - Francis Bacon, `New Atlantis' (or not). 7# 8# Convert tcsh "complete" statements to zsh "compctl" statements. 9# Runs as a filter. Should ignore anything which isn't a "complete". 10# It expects each "complete" statement to be the first thing on a line. 11# All the examples in the tcsh manual give sensible results. 12# Author: Peter Stephenson <pws@ibmth.df.unipi.it> 13# 14# Option: 15# -x (exact): only applies in the case of command disambiguation (is 16# that really a word?) If you have lines like 17# complete '-co*' 'p/0/(compress)' 18# (which makes co<TAB> always complete to `compress') then the 19# resulting "compctl" statements will produce one of two behaviours: 20# (1) By default (like tcsh), com<TAB> etc. will also complete to 21# "compress" and nothing else. 22# (2) With -x, com<TAB> does ordinary command completion: this is 23# more flexible. 24# I don't understand what the hyphen in complete does and I've ignored it. 25# 26# Notes: 27# (1) The -s option is the way to do backquote expansion. In zsh, 28# "compctl -s '`users`' talk" works (duplicates are removed). 29# (2) Complicated backquote completions should definitely be rewritten as 30# shell functions (compctl's "-K func" option). Although most of 31# these will be translated correctly, differences in shell syntax 32# are not handled. 33# (3) Replacement of $:n with the n'th word on the current line with 34# backquote expansion now works; it is not necessarily the most 35# efficient way of doing it in any given case, however. 36# (4) I have made use of zsh's more sophisticated globbing to change 37# things like ^foo.{a,b,c,d} to ^foo.(a|b|c|d), which works better. 38# It's just possible in some cases you may want to change it back. 39# (5) Make sure all command names with wildcards are processed together -- 40# they need to be lumped into one "compctl -C" or "compctl -D" 41# statement for zsh. 42# (6) Group completion (complete's g flag) is not built into zsh, so 43# you need perl to be available to generate the groups. If this 44# script is useful, I assume that's not a problem. 45# (7) I don't know what `completing completions' means, so the X 46# flag to complete is not handled. 47 48# Handle options 49if (@ARGV) { 50 ($ARGV[0] eq '-x') && shift && ($opt_x = 1); 51 ($ARGV[0] =~ /^-+$/) && shift; 52} 53 54# Function names used (via magic autoincrement) when cmdline words are needed 55$funcnam = 'compfn001'; 56 57# Read next word on command line 58sub getword { 59 local($word, $word2, $ret); 60 ($_) = /^\s*(.*)$/; 61 while ($_ =~ /^\S/) { 62 if (/^[\']/) { 63 ($word, $_) = /^\'([^\']*).(.*)$/; 64 } elsif (/^[\"]/) { 65 ($word, $_) = /^\"([^\"]*).(.*)$/; 66 while ($word =~ /\\$/) { 67 chop($word); 68 ($word2, $_) = /^([^\"]*).(.*)$/; 69 $word .= '"' . $word2; 70 } 71 } elsif (/\S/) { 72 ($word, $_) = /^([^\s\\\'\"\#;]*)(.*)$/; 73 # Backslash: literal next character 74 /^\\(.)/ && (($word .= substr($_,1,1)), 75 ($_ = substr($_,2))); 76 # Rest of line quoted or end of command 77 /^[\#;]/ && ($_ = ''); 78 } else { 79 return undef; 80 } 81 length($word) && ($ret = defined($ret) ? $ret . $word : $word); 82 } 83 $ret; 84} 85 86# Interpret the x and arg in 'x/arg/type/' 87sub getpat { 88 local($pat,$arg) = @_; 89 local($ret,$i); 90 if ($pat eq 'p') { 91 $ret = "p[$arg]"; 92 } elsif ($pat eq 'n' || $pat eq 'N') { 93 $let = ($arg =~ /[*?|]/) ? 'C' : 'c'; 94 $num = ($pat eq 'N') ? 2 : 1; 95 $ret = "${let}[-${num},$arg]"; 96 } elsif ($pat eq 'c' || $pat eq 'C') { 97 # A few tricks to get zsh to ignore up to the end of 98 # any matched pattern. 99 if (($pat eq 'c' && $arg =~ /^\*([^*?]*)$/)) { 100 $ret = "n[-1,$1]"; 101 } elsif ($arg =~ /[*?]([^*?]*)$/) { 102 length($1) && ($ret = " n[-1,$1]"); 103 $ret = "C[0,$arg] $ret"; 104 } else { 105 $let = ($pat eq 'c') ? 's' : 'S'; 106 $ret = "${let}[$arg]"; 107 } 108 } 109 $ret =~ s/'/'\\''/g; 110 $ret; 111} 112 113# Interpret the type in 'x/arg/type/' 114sub gettype { 115 local ($_) = @_; 116 local($qual,$c,$glob,$ret,$b,$m,$e,@m); 117 $c = substr($_,0,1); 118 ($c =~ /\w/) && (substr($_,1,1) eq ':') && ($glob = substr($_,2)); 119# Nothing (n) can be handled by returning nothing. (C.f. King Lear, I.i.) 120 if ($c =~ /[abcjuv]/) { 121 $ret = "-$c"; 122 } elsif ($c eq 'C') { 123 if (defined($glob)) { 124 $ret = "-W $glob -/g '*(.*)'"; 125 undef($glob); 126 } else { 127 $ret = '-c'; 128 } 129 } elsif ($c eq 'S') { 130 $ret = '-k signals'; 131 } elsif ($c eq 'd') { 132 if (defined($glob)) { 133 $qual = '-/'; 134 } else { 135 $ret = '-/'; 136 } 137 } elsif ($c eq 'D') { 138 if (defined($glob)) { 139 $ret = "-W $glob -/"; 140 undef($glob); 141 } else { 142 $ret = '-/'; 143 } 144 } elsif ($c eq 'e') { 145 $ret = '-E'; 146 } elsif ($c eq 'f' && !$glob) { 147 $ret = '-f'; 148 } elsif ($c eq 'F') { 149 if (defined($glob)) { 150 $ret = "-W $glob -f"; 151 undef($glob); 152 } else { 153 $ret = '-f'; 154 } 155 } elsif ($c eq 'g') { 156 $ret = "-s '\$(perl -e '\\''while ((\$name) = getgrent)\n" . 157 "{ print \$name, \"\\n\"; }'\\'')'"; 158 } elsif ($c eq 'l') { 159 $ret = q!-k "(`limit | awk '{print $1}'`)"!; 160 } elsif ($c eq 'p') { 161 $ret = "-W $glob -f", undef($glob) if defined($glob); 162 } elsif ($c eq 's') { 163 $ret = '-p'; 164 } elsif ($c eq 't') { 165 $qual = '.'; 166 } elsif ($c eq 'T') { 167 if (defined($glob)) { 168 $ret = "-W $glob -g '*(.)'"; 169 undef($glob); 170 } else { 171 $ret = "-g '*(.)'"; 172 } 173 } elsif ($c eq 'x') { 174 $glob =~ s/'/'\\''/g; 175 $ret = "-X '$glob'"; 176 undef($glob); 177 } elsif ($c eq '$') { # '){ 178 $ret = "-k " . substr($_,1); 179 } elsif ($c eq '(') { 180 s/'/'\\''/g; 181 $ret = "-k '$_'"; 182 } elsif ($c eq '`') { 183 # this took some working out... 184 if (s/\$:(\d+)/$foo=$1+1,"\${word[$foo]}"/ge) { 185 $ret = "-K $funcnam"; 186 $genfunc .= <<"HERE"; 187function $funcnam { 188 local word 189 read -cA word 190 reply=($_) 191} 192HERE 193 $funcnam++; 194 } else { 195 s/'/'\\''/g; 196 $ret = "-s '$_'"; 197 } 198 } 199 200 # foo{bar,ba,blak,sheap} -> foo(bar|ba|blak|sheap). 201 # This saves a lot of mess, since in zsh brace expansion occurs 202 # before globbing. I'm sorry, but I don't trust $` and $'. 203 while (defined($glob) && (($b,$m,$e) = ($glob =~ /^(.*)\{(.*)\}(.*)$/)) 204 && $m =~ /,/) { 205 @m = split(/,/, $m); 206 for ($i = 0; $i < @m; $i++) { 207 while ($m[$i] =~ /\\$/) { 208 substr($m[$i],-1,1) = ""; 209 splice(@m,$i,2,"$m[$i]\\,$m[$i+1]"); 210 } 211 } 212 $glob = $b . "(" . join('|',@m) . ")" . $e; 213 } 214 215 if ($qual) { 216 $glob || ($glob = '*'); 217 $glob .= "($qual)"; 218 } 219 $glob && (($glob =~ s/'/'\\''/g),($glob = "-g '$glob'")); 220 221 defined($ret) && defined($glob) && ($ret .= " $glob"); 222 defined($ret) ? $ret : $glob; 223} 224 225# Quoted array separator for extended completions 226$" = " - "; 227 228while (<>) { 229 if (/^\s*complete\s/) { 230 undef(@stuff); 231 $default = ''; 232 $_ = $'; 233 while (/\\$/) { 234 # Remove backslashed newlines: in principle these should become 235 # real newlines inside quotes, but what the hell. 236 ($_) = /^(.*)\\$/; 237 $_ .= <>; 238 } 239 $command = &getword; 240 if ($command =~ /^-/ || $command =~ /[*?]/) { 241 # E.g. complete -co* ... 242 $defmatch = $command; 243 ($defmatch =~ /^-/) && ($defmatch = substr($defmatch,1)); 244 } else { 245 undef($defmatch); 246 } 247 while (defined($word = &getword)) { 248 # Loop over remaining arguments to "complete". 249 $sep = substr($word,1,1); 250 $sep =~ s/(\W)/\\$1/g; 251 @split = split(/$sep/,$word,4); 252 for ($i = 0; $i < 3; $i++) { 253 while ($split[$i] =~ /\\$/) { 254 substr($split[$i],-1,1) = ""; 255 splice(@split,$i,2,"$split[$i]\\$sep$split[$i+1]"); 256 } 257 } 258 ($pat,$arg,$type,$suffix) = @split; 259 defined($suffix) && ($suffix =~ /^\s*$/) && undef($suffix); 260 if (($word =~ /^n$sep\*$sep/) && 261 (!defined($defmatch))) { 262 # The "complete" catch-all: treat this as compctl\'s 263 # default (requiring no pattern matching). 264 $default .= &gettype($type) . ' '; 265 defined($suffix) && 266 (defined($defsuf) ? ($defsuf .= $suffix) 267 : ($defsuf = $suffix)); 268 } else { 269 $pat = &getpat($pat,$arg); 270 $type = &gettype($type); 271 if (defined($defmatch)) { 272 # The command is a pattern: use either -C or -D option. 273 if ($pat eq 'p[0]') { 274 # Command word (-C): 'p[0]' is redundant. 275 if ($defmatch eq '*') { 276 $defcommand = $type; 277 } else { 278 ($defmatch =~ /\*$/) && chop($defmatch); 279 if ($opt_x) { 280 $c = ($defmatch =~ /[*?]/) ? 'C' : 'c'; 281 $pat = $c . "[0,${defmatch}]"; 282 } else { 283 $pat = ($defmatch =~ /[*?]/) ? 284 "C[0,${defmatch}]" : "S[${defmatch}]"; 285 } 286 push(@commandword,defined($suffix) ? 287 "'$pat' $type -S '$suffix'" : "'$pat' $type"); 288 } 289 } elsif ($pat eq "C[-1,*]") { 290 # Not command word completion, but match 291 # command word (only) 292 if ($defmatch eq "*") { 293 # any word of any command 294 $defaultdefault .= " $type"; 295 } else { 296 $pat = "W[0,$defmatch]"; 297 push(@defaultword,defined($suffix) ? 298 "'$pat' $type -S '$suffix'" : "'$pat' $type"); 299 } 300 } else { 301 # Not command word completion, but still command 302 # word with pattern 303 ($defmatch eq '*') || ($pat = "W[0,$defmatch] $pat"); 304 push(@defaultword,defined($suffix) ? 305 "'$pat' $type -S '$suffix'" : "'$pat' $type"); 306 } 307 } else { 308 # Ordinary command 309 push(@stuff,defined($suffix) ? 310 "'$pat' $type -S '$suffix'" : "'$pat' $type"); 311 } 312 } 313 } 314 if (!defined($defmatch)) { 315 # Ordinary commands with no pattern 316 print("compctl $default"); 317 defined($defsuf) && print("-S '$defsuf' ") && undef($defsuf); 318 defined(@stuff) && print("-x @stuff -- "); 319 print("$command\n"); 320 } 321 if (defined($genfunc)) { 322 print $genfunc; 323 undef($genfunc); 324 } 325 } 326} 327 328(defined(@commandword) || defined($defcommand)) && 329 print("compctl -C ", 330 defined($defcommand) ? $defcommand : '-c', 331 defined(@commandword) ? " -x @commandword\n" : "\n"); 332 333if (defined($defaultdefault) || defined(@defaultword)) { 334 defined($defaultdefault) || ($defaultdefault = "-f"); 335 print "compctl -D $defaultdefault"; 336 defined(@defaultword) && print(" -x @defaultword"); 337 print "\n"; 338} 339 340__END__ 341