distrib/share/tcl/complete.tcl

   1 #       $LAAS: complete.tcl,v 1.2 2003/07/08 15:43:30 mallet Exp $
   2
   3 #
   4 #  Copyright (c) 2001 LAAS/CNRS                       --  Tue Oct  9 2001
   5 #  All rights reserved.                                    Anthony Mallet
   6 #
   7 #
   8 # Redistribution  and  use in source   and binary forms,  with or without
   9 # modification, are permitted provided that  the following conditions are
  10 # met:
  11 #
  12 #   1. Redistributions  of  source code must  retain  the above copyright
  13 #      notice, this list of conditions and the following disclaimer.
  14 #   2. Redistributions in binary form must  reproduce the above copyright
  15 #      notice,  this list of  conditions and  the following disclaimer in
  16 #      the  documentation   and/or  other  materials   provided with  the
  17 #      distribution.
  18 #
  19 # THIS SOFTWARE IS PROVIDED BY THE  AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  20 # ANY  EXPRESS OR IMPLIED WARRANTIES, INCLUDING,  BUT NOT LIMITED TO, THE
  21 # IMPLIED WARRANTIES   OF MERCHANTABILITY AND  FITNESS  FOR  A PARTICULAR
  22 # PURPOSE ARE DISCLAIMED.  IN NO  EVENT SHALL THE AUTHOR OR  CONTRIBUTORS
  23 # BE LIABLE FOR ANY DIRECT, INDIRECT,  INCIDENTAL, SPECIAL, EXEMPLARY, OR
  24 # CONSEQUENTIAL DAMAGES (INCLUDING,  BUT  NOT LIMITED TO, PROCUREMENT  OF
  25 # SUBSTITUTE  GOODS OR SERVICES;  LOSS   OF  USE,  DATA, OR PROFITS;   OR
  26 # BUSINESS  INTERRUPTION) HOWEVER CAUSED AND  ON ANY THEORY OF LIABILITY,
  27 # WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  28 # OTHERWISE) ARISING IN ANY WAY OUT OF THE  USE OF THIS SOFTWARE, EVEN IF
  29 # ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  30 #
  31
  32 # Completion-related procedures
  33
  34 namespace eval el {
  35
  36     # builtin default completion rules
  37     variable completionPatterns {
  38         { ^(::)?after$ {p 1 {cancel idle info}} }
  39         { ^(::)?array$
  40             {p 1 {
  41                 anymore donesearch exists get names nextelement
  42                 set size startsearch unset
  43             }}
  44             { p 2 A }
  45         }
  46         { ^(::)?after$ {p 1 {format scan}} }
  47         { ^(::)?catch$ {p 2 v} }
  48         { ^(::)?cd$ {p 1 d} }
  49         { ^(::)?clock$
  50             {p 1 {format scan seconds}}
  51             {N ^format$ {-format -gmt}}
  52             {N ^scan$ {-base -gmt}}
  53             {N ^-(format|base)$ {-gmt}}
  54             {N ^-gmt$ {-format -base}}
  55         }
  56         { ^(::)?close$ {p 1 {[file channels]}}}
  57         { ^(::)?encoding$ {p 1 {convertfrom convertto names system}}}
  58         { ^(::)?eof$ {p 1 {[file channels]}}}
  59         { ^(::)?exec$
  60             {C {@} {[file channels]}}
  61             {C {<|>|&} F}
  62             {p 1 {-keepnewline}}
  63         }
  64         { ^(::)?l?append$ {p 1 v} }
  65         { ^(::)?fblocked$ {p 1 {[file channels]}}}
  66         { ^(::)?fconfigure$
  67             {p 1 {[file channels]}}
  68             {n ^-encoding$ {[encoding names]}}
  69             {n ^-translation$ { auto binary cr crlf lf }}
  70             {n ^- v}
  71             {c {} {
  72                 -blocking -buffering -buffersize -encoding
  73                 -eofchar -translation
  74             }}
  75         }
  76         { ^(::)?fcopy$
  77             {p 1|2 {[file channels]}}
  78             {p 3|5 {-size -command}}
  79         }
  80         { ^(::)?file$
  81             {p 1 {
  82                 atime attributes channels copy delete dirname executable
  83                 exists extension isdirectory isfile join lstat mkdir
  84                 mtime nativename owned pathtype readable readlink rename
  85                 rename rootname size split stat tail type volume writable
  86             }}
  87             {n {^(copy|delete|rename)$} {-force --}}
  88             {N ^atime$ {time}}
  89             {N ^l?stat$ v}
  90             {c {} F}
  91         }
  92         { ^(::)?fileevent$
  93             {p 1 {[file channels]}}
  94             {p 2 {readable writable}}
  95         }
  96         { ^(::)?flush$ {p 1 {[file channels]}}}
  97         { ^(::)?foreach$ {p 1 v}}
  98         { ^(::)?gets$ {p 1 {[file channels]}} {p 2 v}}
  99         { ^(::)?glob$
 100             {p 1 {-directory -join -nocomplain -path -types --}}
 101             {n {^-(directory|path)$} d}
 102             {C {[bcdflpsrwx] } {b c d f l p s r w x}}
 103             {n {^-types$} {b c d f l p s r w x}}
 104         }
 105         { ^(::)?global$ {p .* v}}
 106         { ^(::)?history$
 107             {p 1 {add change clear event info keep nextid redo}}
 108         }
 109         { ^(::)?incr$ {p 1 v}}
 110         { ^(::)?info$
 111             {p 1 {
 112                 args body cmdcount commands complete default exists
 113                 globals hostname level library loaded locals
 114                 nameofexecutable patchlevel procs script
 115                 sharedlibextension tclversion vars
 116             }}
 117             {n ^args|body|default$ p}
 118         }
 119         { ^(::)?interp$
 120             {p 1 {
 121                 alias aliases create delete eval exists expose hide
 122                 hidden invokehidden issafe marktrusted share slaves
 123                 target transfer
 124             }}
 125             {p 2 i}
 126             {n ^-global$ {[interp hidden]}}
 127             {N ^invokehidden$ {-global}}
 128             {N ^share|transfer$ {[file channels]}}
 129             {N ^expose$ {[interp hidden]}}
 130             {p 3 c}
 131         }
 132         { ^(::)?load$
 133             {p 1 F}
 134             {p 3 {[interp slaves]}}
 135         }
 136         { ^(::)?lsearch$ {p 1 {-exact -glob -regexp}}}
 137         { ^(::)?lsort$
 138             {p 1 {
 139                 -ascii -dictionary -integer -real -command -increasing
 140                 -decreasing -index -unique
 141             }}
 142             {n ^-command$ c}
 143         }
 144         { ^(::)?namespace$
 145             { p 1 {
 146                 children code current delete eval export forget import
 147                 inscope origin parent qualifiers tail which
 148             }}
 149             {n ^code|origin$ c}
 150             {n ^export$ {-clear}}
 151             {n ^import$ {-force}}
 152             {n ^qualifiers|tail$ N}
 153             {n ^which$ {-command -variable}}
 154             {n ^-command$ c}
 155             {n ^-variable$ v}
 156         }
 157         { ^(::)?open$
 158             {p 1 F}
 159             {p 2 {
 160                 r r+ w w+ a a+
 161                 RDONLY WRONLY RDWR APPEND CREAT EXCL NOCTTY NONBLOCK TRUNC
 162             }}
 163         }
 164         { ^(::)?package$
 165             {p 1 {
 166                 forget ifneeded names present provide require unknown
 167                 vcompare versions vsatisfies
 168             }}
 169             {n ^present|require$ {[eval list -exact [package names]]}}
 170             {n ^forget|ifneeded|versions$ k}
 171             {n ^unknown$ c}
 172         }
 173         { ^(::)?pid$ {p 1 {[file channels]}}}
 174         { ^(::)?pkg::create$
 175             {p 1 {-name -version -load -source}}
 176             {n ^-name$ k}
 177             {n ^-(load|source)$ F}
 178         }
 179         { ^(::)?pkg_mkIndex$
 180             {c ^- {-lazy -load -verbose --}}
 181             {c {} d}
 182         }
 183         { ^(::)?puts$
 184             {c ^- {-nonewline}}
 185             {p 1|2 {[file channels]}}
 186         }
 187         { ^(::)?read$
 188             {c ^- {-nonewline}}
 189             {p 1|2 {[file channels]}}
 190         }
 191         { ^(::)?regexp$
 192             {c ^- {
 193                 -about -expanded -indices -line -linestop -lineanchor
 194                 -nocase -all -inline -start --
 195             }}
 196         }
 197         { ^(::)?regsub$ {c ^- {-nocase -all -start --}}}
 198         { ^(::)?rename$ {p 1|2 c}}
 199         { ^(::)?return$
 200             {c ^- {-code -errorinfo -errorcode}}
 201             {n ^-code$ {ok error return break continue}}
 202         }
 203         { ^(::)?scan$ {p 3 v}}
 204         { ^(::)?seek$
 205             {p 1 {[file channels]}}
 206             {p 3 {start current end}}
 207         }
 208         { ^(::)?set$ {p 1 v}}
 209         { ^(::)?signal$
 210             {p 1 {[eval list names [signal names]]}}
 211             {c {^-} {-default -ignore -block -unblock}}
 212             {c {} c}
 213         }
 214         { ^(::)?socket$ {c ^- {-myaddr -myport -async}}}
 215         { ^(::)?source$ {p 1 F}}
 216         { ^(::)?string$
 217             {p 1 {
 218                 bytelength compare equal first index is last length map
 219                 match range repeat replace tolower totitle toupper trim
 220                 trimleft trimright wordend wordstart
 221             }}
 222             {n ^is$ {
 223                 alnum alpha ascii boolean control digit double false
 224                 graph integer lower print punct space true upper wordchar
 225                 xdigit
 226             }}
 227             {n ^-failindex$ v}
 228             {c ^- {-nocase -length -strict -failindex}}
 229         }
 230         { ^(::)?subst$ {c ^- {-nobackslashes -nocommands -novariables}}}
 231         { ^(::)?switch$ {c ^- {-exat -glob -regexp --}}}
 232         { ^(::)?tell$ {p 1 {[file channels]}}}
 233         { ^(::)?trace$
 234             {p 1 {variable vdelete vinfo}}
 235             {p 2 v}
 236             {n ^variable|vdelete$ {r w u}}
 237             {p 4 c}
 238         }
 239         { ^(::)?unknown$ {p 1 c}}
 240         { ^(::)?update$ {p 1 idletasks}}
 241         { ^(::)?vwait$ {p 1 v}}
 242     }
 243
 244     # This procedure is the core of the completion engine: it
 245     # generates a list of completion matches for the given string.
 246     # It must return a list made up of two intergers 'start' and 'end'
 247     # followed by 3-uplets { word append display } where 'word' is a
 248     # possible match, 'append' a string to append if the match is unique
 249     # and 'display' a string to append if there are several matches.
 250     # 'start' and 'end' are the indexes of the replacement text.
 251     proc matches { string } {
 252         variable completionPatterns
 253
 254         # the matching rule (empty if none applies)
 255         set rule ""
 256
 257         # just one weird case which is best worked around like this
 258         if {[string index $string end] == ":" &&
 259             [string index $string end-1] != ":"} {
 260             append string ":"
 261         }
 262
 263         # break the string up into its constituent elements
 264         set parse [el::parse $string]
 265         set end [lindex $parse 2]
 266         set items [lindex $parse 3]
 267         set nitems [llength $items]
 268
 269         # get the last item: this is the one we want to complete on
 270         set last [lindex $items end]
 271         if { $nitems == 0 || $end != [lindex $last 3] } {
 272             # add an empty token if we are at the beginning of a new word
 273             set last [list simple-word "" [expr $end+1] [expr $end+1] \
 274                           [list [list text "" \
 275                                      [expr $end+1] [expr $end+1] {} ]]]
 276             lappend items $last
 277             incr nitems
 278         }
 279
 280         # get the namespace hierarchy
 281         set new [namespace qualifiers "[lindex $last 1]"]
 282         if { $new == "" } { set new "::" }
 283         while { $new != "" } {
 284             set current $new
 285             set new ""
 286             foreach name $current { catch {
 287                 eval lappend new [namespace children $name]
 288             }}
 289             eval lappend namespaces $new
 290         }
 291
 292         # compute the kind of completion wanted, based on last item
 293         set lasttokens [lindex $last 4]
 294         set lasttoken [lindex $lasttokens end]
 295         set lasttokendescr [lindex [lindex $lasttoken 4] end]
 296
 297         if { [lindex $lasttoken 0] == "variable" &&
 298              [lindex $lasttokendescr 3] == [lindex $lasttoken 3]} {
 299             # special case of an incomplete variable name (we known it is
 300             # incomplete thanks to the length test above): just complete
 301             # on variables that match
 302             set vardescr [lindex $lasttoken 4]
 303             if { [llength $vardescr] == 2 &&
 304                  [lindex [lindex $vardescr 0] 0] == "text" &&
 305                  [lindex [lindex $vardescr 1] 0] == "text" } {
 306                 # array name
 307                 set start [lindex [lindex $vardescr 1] 2]
 308                 set end  [lindex [lindex $vardescr 1] 3]
 309                 set name1 [lindex [lindex $vardescr 0] 1]
 310                 set name2 [lindex [lindex $vardescr 1] 1]
 311
 312                 set completeon "array"
 313
 314             } else {
 315                 # scalar variable (or weird variable name)
 316                 set start [lindex [lindex $vardescr 0] 2]
 317                 foreach component $vardescr {
 318                     append name1 [lindex $component 1]
 319                 }
 320                 set end [lindex $component 3]
 321
 322                 set completeon "variable namespace"
 323             }
 324
 325         } elseif {[lindex $lasttoken 0] == "text" &&
 326             [lindex $lasttoken 1] == "$"} {
 327             # special case of an empty $ sign: complete on variables and
 328             # namespaces
 329             set start [expr [lindex $lasttoken 2]+1]
 330             set end $start
 331
 332             set name1 ""
 333             set completeon "variable namespace"
 334
 335         } else {
 336             # other cases: get the first item
 337             set first [lindex $items 0]
 338             set word [lindex $first 1]
 339
 340             # and the last word to complete: if it's a single token, and
 341             # it begins with some quoting stuff (either \{ or \"), just
 342             # strip the quoting char, unless the closing quote is also
 343             # present (yeah... that's tricky)
 344             if { [lindex $last 0] == "simple-word" } {
 345                 set text [lindex [lindex $last 4] 0]
 346                 if { [lindex $last 3] == [lindex $text 3] } {
 347                     set last $text
 348                 }
 349             }
 350             set start [lindex $last 2]
 351             set end [lindex $last 3]
 352             set name1 [lindex $last 1]
 353
 354             # find the first completion rule that match
 355             set rule ""
 356             foreach test $completionPatterns {
 357                 if {[regexp [lindex $test 0] $word]} {
 358                     set rule $test
 359                     break
 360                 }
 361             }
 362
 363             # if we've got one rule: see which of its subset applies
 364             if { $rule != "" } {
 365                 set rule [lreplace $rule 0 0]
 366                 set subset ""
 367                 foreach subitem $rule {
 368                     switch -regexp -- [lindex $subitem 0] {
 369                         "C" {
 370                             # current word (append)
 371                             set pattern [lindex $subitem 1]
 372                             if {[regexp -indices -all -- \
 373                                      $pattern $name1 pos]} {
 374                                 set name1 [string replace \
 375                                                $name1 0 [lindex $pos 1]]
 376                                 incr start [expr 1+[lindex $pos 1]]
 377                                 set subset $subitem
 378                                 break
 379                             }
 380                         }
 381
 382                         "c" {
 383                             # current word (replace)
 384                             set pattern [lindex $subitem 1]
 385                             if { [regexp -- $pattern $name1] } {
 386                                 set subset $subitem
 387                                 break
 388                             }
 389                         }
 390
 391                         "n|N" {
 392                             # next word
 393                             if { [lindex $subitem 0] == "n" } {
 394                                 set count 1
 395                             } else {
 396                                 set count 2
 397                             }
 398                             if { $nitems>$count } {
 399                                 set word [lindex [lindex $items end-$count] 1]
 400                                 set pattern [lindex $subitem 1]
 401                                 if { [regexp -- $pattern $word] } {
 402                                     set subset $subitem
 403                                     break
 404                                 }
 405                             }
 406                         }
 407
 408                         "p" {
 409                             # positional parameter
 410                             if { [regexp -- \
 411                                       [lindex $subitem 1] \
 412                                       [expr $nitems-1] match]} {
 413                                 if {"$match" == "[expr $nitems-1]"} {
 414                                     set subset $subitem
 415                                     break
 416                                 }
 417                             }
 418                         }
 419                     }
 420                 }
 421
 422                 if { $subset != "" } {
 423                     # determine action for this subset
 424                     set action [lindex $subset 2]
 425                     switch -glob -- $action {
 426                         "A" { lappend completeon arrayname namespace }
 427                         "v" { lappend completeon variable namespace }
 428                         "n" { lappend completeon namespace }
 429                         "N" { lappend completeon variable command namespace }
 430                         "d" { lappend completeon directory }
 431                         "f" { lappend completeon file }
 432                         "F" { lappend completeon file directory }
 433                         "c" { lappend completeon command namespace }
 434                         "C" { lappend completeon command shell namespace }
 435                         "p" { lappend completeon proc }
 436                         "k" { lappend completeon package }
 437                         "i" { lappend completeon slave }
 438
 439                         {\[*\]} {
 440                             lappend completeon "dictionary"
 441                             set dictionary [string range $action 1 end-1]
 442                             if {[catch {
 443                                 set dictionary [uplevel \#0 $dictionary]
 444                             }]} {
 445                                 error "bad completion rule \"$subset\"."
 446                             }
 447                         }
 448
 449                         default {
 450                             lappend completeon "dictionary"
 451                             set dictionary $action
 452                         }
 453                     }
 454                 } else {
 455                     set rule ""
 456                 }
 457             }
 458
 459             if { $rule == "" } {
 460                 # no matching rule
 461                 # complete on commands for first item and variables
 462                 # for others
 463                 if { $nitems == 1 } {
 464                     set completeon "command namespace"
 465                 } else {
 466                     set completeon "variable namespace"
 467                 }
 468             }
 469         }
 470
 471         # perform actual matching
 472         set matches ""
 473
 474         # array element
 475         if { [lsearch $completeon "array"] >= 0 } {
 476             if { $name1 == "" } {
 477                 error "empty array name"
 478             }
 479
 480             if { ![uplevel \#0 array exists [list [list $name1]]] } {
 481                 error "no such array: $name1"
 482             }
 483
 484             set list [uplevel \#0 array names [list [list $name1]]]
 485             foreach match $list {
 486                 if {[string match ${name2}* $match]} {
 487                     lappend matches "$match {) } {}"
 488                 }
 489             }
 490         }
 491
 492         # array name
 493         if { [lsearch $completeon "arrayname"] >= 0 } {
 494             set list [uplevel \#0 info vars [list [list ${name1}*]]]
 495             if { [llength $list] == 0 } {
 496                 # dig into children namespaces
 497                 foreach namespace $namespaces {
 498                     eval lappend list \
 499                         [uplevel \#0 info vars \
 500                              [list [list ${namespace}::${name1}*]]]
 501                 }
 502             }
 503             foreach match $list {
 504                 if { [uplevel \#0 array exists [list [list $match]]] } {
 505                     lappend matches "$match { } ()"
 506                 }
 507             }
 508         }
 509
 510         # variable
 511         if { [lsearch $completeon "variable"] >= 0 } {
 512             set list [uplevel \#0 info vars [list [list ${name1}*]]]
 513             if { [llength $list] == 0 } {
 514                 # dig into children namespaces
 515                 foreach namespace $namespaces {
 516                     eval lappend list \
 517                         [uplevel \#0 info vars \
 518                              [list [list ${namespace}::${name1}*]]]
 519                 }
 520             }
 521             foreach match $list {
 522                 if { [uplevel \#0 array exists [list [list $match]]] } {
 523                     lappend matches "$match ( ()"
 524                 } else {
 525                     lappend matches "$match { } {}"
 526                 }
 527             }
 528         }
 529
 530         # commands and procedures
 531         foreach corp { command proc } {
 532             if { [lsearch $completeon $corp] >= 0 } {
 533                 set list [uplevel \#0 info $corp [list [list ${name1}*]]]
 534                 if { [llength $list] == 0 } {
 535                     # dig into children namespaces
 536                     foreach namespace $namespaces {
 537                         eval lappend list \
 538                             [uplevel \#0 info $corp \
 539                                  [list [list ${namespace}::${name1}*]]]
 540                     }
 541                 }
 542                 foreach match $list {
 543                     lappend matches "$match { } {}"
 544                 }
 545             }
 546         }
 547
 548         # namespaces
 549         if { [lsearch $completeon "namespace"] >= 0 } {
 550             foreach namespace $namespaces {
 551                 if {[string match ${name1}* ${namespace}]} {
 552                     lappend matches "${namespace}:: {} {}"
 553                 } elseif {[string match ::${name1}* ${namespace}]} {
 554                     lappend matches \
 555                         "[string range ${namespace} 2 end]:: {} {}"
 556                 }
 557             }
 558         }
 559
 560         # interpreters
 561         if { [lsearch $completeon "slave"] >= 0 } {
 562             lappend completeon "dictionary"
 563             set new [interp slaves]
 564             eval lappend dictionary $new
 565             while { $new != "" } {
 566                 set current $new
 567                 set new ""
 568                 foreach name $current { catch {
 569                     foreach slave [interp slaves $name] {
 570                         lappend new "{$name $slave}"
 571                     }
 572                 }}
 573                 eval lappend dictionary $new
 574             }
 575         }
 576
 577         # packages
 578         if { [lsearch $completeon "package"] >= 0 } {
 579             lappend completeon "dictionary"
 580             eval lappend dictionary [package names]
 581         }
 582
 583         # dictionary (a given list of words)
 584         if { [lsearch $completeon "dictionary"] >= 0 } {
 585             foreach word $dictionary {
 586                 if {[string match ${name1}* $word]} {
 587                     lappend matches [list $word { } {}]
 588                 }
 589             }
 590         }
 591
 592         # if we did not match anything at this point, force file and
 593         # directory or shell commands search, if they're not already
 594         # present and if not in a rule
 595         if { $rule == "" && [llength $matches] == 0 } {
 596             if { [lsearch $completeon "file"] < 0 &&
 597                  [lsearch $completeon "directory"] < 0 &&
 598                  [lsearch $completeon "shell"] < 0 } {
 599                 if { $nitems == 1 } {
 600                     lappend completeon shell directory
 601                 } else {
 602                     lappend completeon file directory
 603                 }
 604             }
 605         }
 606
 607         # files
 608         if { [lsearch $completeon "file"] >= 0 } {
 609             foreach file [glob -type "f" -nocomplain -- ${name1}*] {
 610                 lappend matches "$file { } {}"
 611             }
 612             foreach file [glob -type "b c" -nocomplain -- ${name1}*] {
 613                 lappend matches "$file { } {%}"
 614             }
 615             foreach file [glob -type "l" -nocomplain -- ${name1}*] {
 616                 if { ![file isdirectory $file] } {
 617                     lappend matches "$file { } {@}"
 618                 }
 619             }
 620         }
 621
 622         # directories
 623         if { [lsearch $completeon "directory"] >= 0 } {
 624             foreach file [glob -type "d" -nocomplain -- ${name1}*] {
 625                 lappend matches "$file {/} {/}"
 626             }
 627             foreach file [glob -type "l" -nocomplain -- ${name1}*] {
 628                 if { [file isdirectory $file] } {
 629                     lappend matches "$file {/} {/@}"
 630                 }
 631             }
 632         }
 633
 634         # shell commands
 635         if { [lsearch $completeon "shell"] >= 0 } {
 636             global env
 637
 638             set findmatch {
 639                 set list [glob -type "f l" -nocomplain -- $path]
 640                 foreach file $list {
 641                     if { ! [file isdirectory $file] &&
 642                          [file readable $file] &&
 643                          [file executable $file]} {
 644                         # must remove path
 645                         set pos [string last $name1 $file]
 646                         if { $pos >= 0 } {
 647                             lappend matches \
 648                                 "[string range $file $pos end] { } {*}"
 649                         }
 650                     }
 651                 }
 652             }
 653
 654             if { [llength [file split ${name1}*]] == 1 } {
 655                 foreach path [split $env(PATH) :] {
 656                     set path [file join $path ${name1}*]
 657                     eval $findmatch
 658                 }
 659             } else {
 660                 set path ${name1}*
 661                 eval $findmatch
 662             }
 663         }
 664
 665         # last thing: if the incomplete word has a namespace or directory
 666         # pattern which is present in all the matches, it is not
 667         # necessary to replace it (completion will just append characters
 668         # and not change the beginning of the word). This is at least the
 669         # way tcsh works.
 670
 671         foreach pattern { :: / } {
 672             set slash [string last $pattern $name1]
 673             if { $slash >= 0 } {
 674                 # look if it is present everywhere
 675                 set ok 1
 676                 incr slash [string length $pattern]
 677                 foreach match $matches {
 678                     set string [lindex $match 0]
 679                     if { ! [string equal -length $slash $name1 $match]} {
 680                         set ok 0
 681                         break
 682                     }
 683                 }
 684                 if { $ok } {
 685                     # ok so replace
 686                     set tmpmatches ""
 687                     foreach match $matches {
 688                         set string [lindex $match 0]
 689                         set match [lreplace $match 0 0 \
 690                                        [string range $string $slash end]]
 691                         lappend tmpmatches $match
 692                     }
 693                     set matches $tmpmatches
 694                     incr start $slash
 695                 }
 696             }
 697         }
 698
 699         # sort the stuff and go home
 700         set matches [lsort -unique $matches]
 701         return "$start $end $matches"
 702     }
 703 }
 704
 705 package provide el::complete 1.0