Tcl 8.3 introduces some new options to glob which generally make scripts more robust and cross-platform. For example, they help to avoid incorrect usage like:
glob $dir/* glob [file join $dir *]
which both fail if $dir contains glob sensitive characters. The new syntax would be:
glob -dir $dir *
which besides fixing the above problem has the added benefit of working on old MacOS, since '/' is not assumed to be the directory separator.
If you want to write code using the new glob flags/options, such as glob -dir $dir -type d *, obviously your new code will no longer work with older versions of Tcl (e.g. 8.0-8.2). If you would like a compatibility layer which can be loaded into Tcl 8.0-8.2 (probably even older versions of Tcl too), overriding the old glob to emulate the new one in Tcl 8.3, here it is:
New: this now adds support for '-tails' which was introduced in Tcl 8.4a3.
# Tcl 8.3 or newer have a more complex glob already.
if {[info tclversion] < 8.3} {
# we've copied this here from stringsLists.tcl to avoid some
# bad auto-loading problems if there are early startup errors.
;proc getOpts {{take_value ""} {set "set"}} {
upvar args a
upvar opts o
while {[string match \-* [set arg [lindex $a 0]]]} {
set a [lreplace $a 0 0]
if {$arg == "--"} {
return
} else {
if {[set idx [lsearch -regexp $take_value \
"^-?[string range $arg 1 end]( .*)?$"]] == -1} {
set o($arg) 1
} else {
if {[llength [set the_arg \
[lindex $take_value $idx]]] == 1} {
$set o($arg) [lindex $a 0]
set a [lreplace $a 0 0]
} else {
set numargs [expr {[lindex $the_arg 1] -1}]
$set o($arg) [lrange $a 0 $numargs]
set a [lreplace $a 0 $numargs]
}
}
}
}
}
rename glob __glob
;proc glob {args} {
getOpts {-t -types -type -dir -directory -path}
# place platform specific file separator in variable 'separator's
regexp {Z(.)Z} [file join Z Z] "" separator
if {[info exists opts(-join)]} {
unset opts(-join)
set args [list [eval file join $args]]
}
set add ""
foreach t {t type} {
if {[info exists opts(-$t)]} {
eval lappend opts(-types) $opts(-$t)
unset opts(-$t)
}
}
if {[info exists opts(-directory)]} {
set opts(-dir) $opts(-directory)
unset opts(-directory)
}
if {[info exists opts(-types)]} {
if {[set item [lsearch -exact $opts(-types) "d"]] != -1} {
set opts(-types) [lreplace $opts(-types) $item $item]
set add $separator
set isdirectory 1
}
}
if {[set nocomplain [info exists opts(-nocomplain)]]} {
unset opts(-nocomplain)
}
if {[info exists opts(-path)]} {
if {[info exists opts(-dir)]} {
error {"-directory" cannot be used with "-path"}
}
regsub -all {[][*?\{\}\\]} $opts(-path) {\\&} prefix
unset opts(-path)
} elseif {[info exists opts(-dir)]} {
regsub -all {[][*?\{\}\\]} $opts(-dir) {\\&} prefix
append prefix ${separator}
unset opts(-dir)
} else {
set prefix ""
}
if {[info exists opts(-tails)]} {
set tails [file dirname "${prefix}xx"]
unset opts(-tails)
if {![string length $prefix]} {
error {"-tails" must be used with either "-directory" or "-path"}
}
}
set res {}
foreach arg $args {
eval lappend res [__glob -nocomplain -- \
"${prefix}${arg}${add}"]
}
if {[info exists opts(-types)]} {
# we ignore arguments to -types which haven't yet been
# handled, since they are assumed to be platform
# specific
unset opts(-types)
}
if {[set llen [llength [array names opts]]]} {
set ok "-nocomplain, -join, -dir <dir>,\
-path <path>, -types <list of types>"
if {$llen > 1} {
error "bad switches \"[array names opts]\":\
must be $ok or --"
} else {
error "bad switch \"[array names opts]\":\
must be $ok or --"
}
} elseif {[llength $res]} {
if {[info exists isdirectory]} {
foreach r $res {
lappend newres [string trimright $r $separator]
}
set res $newres
}
if {[info exists tails]} {
set res [list]
set len [expr {[string length $tails]}]
foreach r $newres {
lappend res [string range $r $len end]
}
}
return $res
} elseif {$nocomplain} {
return ""
} else {
switch -- [llength $args] {
0 {
error "wrong # args: should be \"glob ?switches?\
name ?name ...?\""
}
1 {
error "no files matched glob pattern \"$args\""
}
default {
error "no files matched glob patterns \"$args\""
}
}
}
}
} else {
# Version 8.3.x have all the glob flags apart from -tails which
# should be introduced in 8.4a3. Therefore we overload glob
# here for 8.3.x-8.4a2 specifically to support -tails (which is
# quite easy).
if {([info tclversion] < 8.4) || [regexp {8\.4a[12]} [info patchlevel]]} {
# Need to add '-tails' to glob
rename glob __glob
;proc glob {args} {
set i 0
while {1} {
set str [lindex $args $i]
if {[string index $str 0] != "-"} {
break
}
switch -glob -- $str {
"--" { break }
"-n*" - "-j*" {
}
"-ty*" {
incr i
}
"-d*" {
incr i
set dir [lindex $args $i]
}
"-p*" {
incr i
set dir [file dirname [lindex $args $i]]
}
"-ta*" {
set tails $i
}
"-t" {
error {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
}
}
incr i
}
if {[info exists tails]} {
if {![info exists dir]} {
error {"-tails" must be used with either "-directory" or "-path"}
}
set args [lreplace $args $tails $tails]
set res [uplevel 1 [list __glob] $args]
set realres {}
set len [expr {1+ [string length $dir]}]
foreach r $res {
lappend realres [string range $r $len end]
}
return $realres
} else {
uplevel 1 [list __glob] $args
}
}
}
}I'm confused. Can you show some old code that breaks?
By the way, I assume you meant to say "if you want your OLD glob code to work ..."
Vince: hopefully the clarification above solves your confusion. The Tcl 8.3 changes to glob are 100% backwards compatible. The goal of this page is to provide forwards compatibility for people who write 'modern' code but still want those stuck at Tcl 8.0-8.2 to be able to use it. It handles most common uses of Tcl 8.3's glob.
This approach deserves its own page IMO: Forward compatibility --jcw