diff options
Diffstat (limited to 'glob.tcl')
| -rw-r--r-- | glob.tcl | 78 |
1 files changed, 35 insertions, 43 deletions
@@ -2,37 +2,9 @@ # # Implements a Tcl-compatible glob command based on readdir # -# The FreeBSD license -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions -# are met: -# -# 1. Redistributions of source code must retain the above copyright -# notice, this list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above -# copyright notice, this list of conditions and the following -# disclaimer in the documentation and/or other materials -# provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY -# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, -# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE -# JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, -# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, -# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -# -# The views and conclusions contained in the software and documentation -# are those of the authors and should not be interpreted as representing -# official policies, either expressed or implied, of the Jim Tcl Project. - -package provide glob +# This file is licenced under the FreeBSD license +# See LICENCE in this directory for full details. + # If $dir is a directory, return a list of all entries # it contains which match $pattern @@ -41,12 +13,17 @@ proc _glob_readdir_pattern {dir pattern} { set result {} # readdir doesn't return . or .., so simulate it here - if {$pattern eq "." || $pattern eq ".."} { + if {$pattern in {. ..}} { return $pattern } + # Use -nocomplain here to return nothing if $dir is not a directory foreach name [readdir -nocomplain $dir] { 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 "."} { + continue + } lappend result $name } } @@ -64,11 +41,8 @@ proc _glob_do {dir rem} { set pattern $rem set rempattern "" } else { - set j $i - incr j - incr i -1 - set pattern [string range $rem 0 $i] - set rempattern [string range $rem $j end] + set pattern [string range $rem 0 $i-1] + set rempattern [string range $rem $i+1 end] } # Determine the appropriate separator and globbing dir @@ -83,6 +57,22 @@ proc _glob_do {dir rem} { set result {} + # 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 + } + } + # Use readdir and select all files which match the pattern foreach f [_glob_readdir_pattern $globdir $pattern] { if {$rempattern eq ""} { @@ -90,7 +80,7 @@ proc _glob_do {dir rem} { lappend result $dir$sep$f } else { # Expany any entries at this level and add them - lappend result {expand}[_glob_do $dir$sep$f $rempattern] + lappend result {*}[_glob_do $dir$sep$f $rempattern] } } return $result @@ -100,11 +90,13 @@ proc _glob_do {dir rem} { # # Usage: glob ?-nocomplain? pattern ... # -# Patterns use string match pattern matching for each -# directory level. +# Patterns use 'string match' (glob) pattern matching for each +# directory level, plus support for braced alternations. # -# e.g. glob te[a-e]*/*.tcl +# e.g. glob "te[a-e]*/*.{c,tcl}" # +# Note: files starting with . will only be returned if matching component +# of the pattern starts with . proc glob {args} { set nocomplain 0 @@ -118,9 +110,9 @@ proc glob {args} { if {$pattern eq "/"} { lappend result / } elseif {[string match "/*" $pattern]} { - lappend result {expand}[_glob_do / [string range $pattern 1 end]] + lappend result {*}[_glob_do / [string range $pattern 1 end]] } else { - lappend result {expand}[_glob_do "" $pattern] + lappend result {*}[_glob_do "" $pattern] } } |