glob forwards compatibility

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