diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-01-24 12:44:43 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:44 +1000 |
commit | a230afdc68bcad14a9dfd0f9c8c6955980669cd6 (patch) | |
tree | 7f0824345c96818381a7e8c4f919d1aadce44322 /glob.tcl | |
parent | 9652302fec62f76bf894c6b9eb849bda6994c293 (diff) | |
download | jimtcl-a230afdc68bcad14a9dfd0f9c8c6955980669cd6.zip jimtcl-a230afdc68bcad14a9dfd0f9c8c6955980669cd6.tar.gz jimtcl-a230afdc68bcad14a9dfd0f9c8c6955980669cd6.tar.bz2 |
Many improvements, bug fixes
*: Allow math functions to be enabled via configure
*: Allow support for references to be removed
*: Documentation updates
*: Jim_ListLength() now returns the result directly
*: Optimise list -> dict conversion
*: Consistent capitalisation of some structures, functions
*: Add support for abbreviations to Jim_GetEnum()
*: The commands to 'info' may be abbreviated
*: Use abbreviation support in parsing options to 'subst'
*: Use Jim_GetEnum() to parse return code names
*: Optimise 'array get', 'array set' if no conversion needed
*: Import Tcl string.test
*: string compare now returns -1,0,1 like Tcl
*: Fix 'string last' with index=0
*: Add support for 'string reverse'
*: Add -nocase option to 'string equal'
*: Fix infinite loop in 'string repeat str -1'
*: Support braced patterns in glob
*: glob should not return dot files unless the pattern starts with .
*: Simplify glob.tcl by using some new features
*: When creating C extensions from Tcl, preserve newlines and invoke
with Jim_Eval_Named() to produce more meaningful error messages.
*: Also remove all comments, not just those starting in the first column
*: Add support for 'n+n' and 'n-n' in string/list indexes (Tcl 8.5)
*: Add a level to the stack trace for 'return -code error'
*: 'return -code' should also affect the return from 'source' (see Tcl docs)
*: Fix lsort -command
*: Some systems don't have INFINITY
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] } } |