diff options
author | Steve Bennett <steveb@workware.net.au> | 2011-07-07 16:10:52 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2011-07-07 21:16:31 +1000 |
commit | 71d6afa67a8e8931723b3688c2b892cecfb1ed31 (patch) | |
tree | 02c1f0543ed13083f49c52b39a5b51b001d39f9b | |
parent | 981a0d901de47d09993233f28b71cf9ff1d1e5e1 (diff) | |
download | jimtcl-71d6afa67a8e8931723b3688c2b892cecfb1ed31.zip jimtcl-71d6afa67a8e8931723b3688c2b892cecfb1ed31.tar.gz jimtcl-71d6afa67a8e8931723b3688c2b892cecfb1ed31.tar.bz2 |
Simplify glob and make it work with mingw
Support absolute paths which don't necessarily
begin with /
Signed-off-by: Steve Bennett <steveb@workware.net.au>
-rw-r--r-- | glob.tcl | 107 |
1 files changed, 55 insertions, 52 deletions
@@ -30,8 +30,17 @@ proc glob {args} { return $pattern } - # Use -nocomplain here to return nothing if $dir is not a directory - foreach name [readdir -nocomplain $dir] { + # If the pattern isn't actually a pattern... + if {[string match {*[*?]*} $pattern]} { + # Use -nocomplain here to return nothing if $dir is not a directory + set files [readdir -nocomplain $dir] + } elseif {[file isdir $dir] && [file exists $dir/$pattern]} { + set files [list $pattern] + } else { + set files "" + } + + foreach name $files { if {[string match $pattern $name]} { # Only include entries starting with . if the pattern starts with . if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} { @@ -44,56 +53,56 @@ proc glob {args} { return $result } - # glob entries in directory $dir and pattern $rem - # - local proc glob.do {dir rem} { - # Take one level from rem - # Avoid regexp here - set i [string first / $rem] - if {$i < 0} { - set pattern $rem - set rempattern "" - } else { - set pattern [string range $rem 0 $i-1] - set rempattern [string range $rem $i+1 end] + # If the pattern contains a braced expression, return a list of + # patterns with the braces expanded. {c,b}* => c* b* + # Otherwise just return the pattern + # Note: Only supports one braced expression. i.e. not {a,b}*{c,d}* + proc glob.expandbraces {pattern} { + # Avoid regexp for dependency reasons. + # XXX: Doesn't handle backslashed braces + if {[set fb [string first "\{" $pattern]] < 0} { + return $pattern } - - # Determine the appropriate separator and globbing dir - set sep / - set globdir $dir - if {[string match "*/" $dir]} { - set sep "" - } elseif {$dir eq ""} { - set globdir . - set sep "" + if {[set nb [string first "\}" $pattern $fb]] < 0} { + return $pattern } + set before [string range $pattern 0 $fb-1] + set braced [string range $pattern $fb+1 $nb-1] + set after [string range $pattern $nb+1 end] - set result {} + lmap part [split $braced ,] { + set pat $before$part$after + } + } - # If the pattern contains a braced expression, recursively call glob.do - # to expand the alternations. Avoid regexp for dependency reasons. - # XXX: Doesn't handle backslashed braces - if {[set fb [string first "\{" $pattern]] >= 0} { - if {[set nb [string first "\}" $pattern $fb]] >= 0} { - set before [string range $pattern 0 $fb-1] - set braced [string range $pattern $fb+1 $nb-1] - set after [string range $pattern $nb+1 end] - - foreach part [split $braced ,] { - lappend result {*}[glob.do $dir $before$part$after] - } - return $result - } + # Core glob implementation. Returns a list of files/directories matching the pattern + proc glob.glob {pattern} { + set dir [file dirname $pattern] + if {$dir eq $pattern} { + # At the top level + return [list $dir] } - # Use readdir and select all files which match the pattern - foreach f [glob.readdir_pattern $globdir $pattern] { - if {$rempattern eq ""} { - # This is a terminal entry, so add it - lappend result $dir$sep$f + # Recursively expand the parent directory + set dirlist [glob.glob $dir] + set pattern [file tail $pattern] + + # Now collect the fiels/directories + set result {} + foreach dir $dirlist { + set globdir $dir + if {[string match "*/" $dir]} { + set sep "" + } elseif {$dir eq "."} { + set globdir "" + set sep "" } else { - # Expany any entries at this level and add them - lappend result {*}[glob.do $dir$sep$f $rempattern] + set sep / + } + foreach pat [glob.expandbraces $pattern] { + foreach name [glob.readdir_pattern $dir $pat] { + lappend result $globdir$sep$name + } } } return $result @@ -109,13 +118,7 @@ proc glob {args} { set result {} foreach pattern $args { - if {$pattern eq "/"} { - lappend result / - } elseif {[string match "/*" $pattern]} { - lappend result {*}[glob.do / [string range $pattern 1 end]] - } else { - lappend result {*}[glob.do "" $pattern] - } + lappend result {*}[glob.glob $pattern] } if {$nocomplain == 0 && [llength $result] == 0} { |