[AMG]: Here is a Tcl 8.5-compatible implementation of tcl::[prefix] that passes the 8.6.8 test suite. It uses [throw], so also use [forward-compatible try and throw] to make it actually work in 8.5. ====== proc tcl::prefix {subcommand args} { switch $subcommand { a - al - all { # Process arguments. if {[llength $args] != 2} { throw {TCL WRONGARGS} "wrong # args: should be\ \"tcl::prefix all table string\"" } lassign $args table string # Return list of all strings with the given prefix. lsearch -all -inline $table [regsub -all {[][?*\\]} $string {\\&}]* } l - lo - lon - long - longe - longes - longest { # Process arguments. if {[llength $args] != 2} { throw {TCL WRONGARGS} "wrong # args: should be\ \"tcl::prefix longest table string\"" } lassign $args table string # Search for the longest common prefix. foreach entry $table { if {[string equal -length [string length $string] $entry $string]} { if {![info exists common]} { set common $entry } else { for {set i 0} {$i < [string length $common] && $i < [string length $entry]} {incr i} { if {[string index $common $i] ne [string index $entry $i]} { break } } set common [string range $common 0 [expr {$i - 1}]] } } } # Return the longest common prefix, or empty string if no matches. if {[info exists common]} { return $common } } m - ma - mat - matc - match { # Process arguments. if {[llength $args] < 2} { throw {TCL WRONGARGS} "wrong # args: should be\ \"tcl::prefix match ?options? table string\"" } lassign [lrange $args end-1 end] table string set args [lrange $args 0 end-2] set message option while {[llength $args]} { set args [lassign $args arg] switch $arg { -ex - -exa - -exac - -exact { # -exact switch. set exact {} } -m - -me - -mes - -mess - -messa - -messag - -message { # -message switch. Next argument is the message string. if {![llength $args]} { throw {TCL OPERATION NOARG} "missing value for -message" } set args [lassign $args message] } -er - -err - -erro - -error { # -error switch. Next argument is the error options dict. if {![llength $args]} { throw {TCL OPERATION NOARG} "missing value for -error" } set args [lassign $args options] if {[llength $options] & 1} { throw {TCL VALUE DICTIONARY} "error options must have an\ even number of elements" } } -e { # Ambiguous switch. throw [list TCL LOOKUP INDEX option $arg] "ambiguous option\ \"$arg\": must be -error, -exact, or -message" } default { # Invalid switch. throw [list TCL LOOKUP INDEX option $arg] "bad option\ \"$arg\": must be -error, -exact, or -message" }} } # Always accept exact match, no questions asked, even if it happens to # also be the prefix for another string in the table. if {$string in $table} { return $string } # Attempt prefix matching unless -exact was used. Accept a prefix match # if unambiguous. if {![info exists exact]} { set matches [prefix all $table $string] if {[llength $matches] == 1} { return [lindex $matches 0] } } # Match failed. Assemble and return the error result. if {![info exists exact] && [llength $matches]} { set message "ambiguous $message \"$string\": " } else { set message "bad $message \"$string\": " } if {![llength $table]} { append message "no valid options" } else { if {[llength $table] > 1} { lset table end "or [lindex $table end]" } append message "must be [join $table\ {*}[if {[llength $table] > 2} {list ", "}]]" } if {![info exists options]} { set options [list -level 0 -code error\ -errorcode [list TCL LOOKUP INDEX $message $string]] } if {![dict size $options]} { set message {} } elseif {![dict exists $options -code]} { dict set options -code error } dict incr options -level return {*}$options $message } default { # Invalid subcommand. throw [list TCL LOOKUP SUBCOMMAND $arg] "unknown or ambiguous\ subcommand \"$arg\": must be all, longest, or match" }} } ====== <> Command