From b83beb2febcbe0abcf338e3f915b43889ce93eca Mon Sep 17 00:00:00 2001 From: Steve Bennett Date: Wed, 3 Mar 2010 16:00:33 +1000 Subject: Move some core procs into the (Tcl) stdlib extension Also implement 'local' to declare/delete local procs * Add tests/alias.test for testing alias, current, local * proc now returns the name of the proc created * Add helper 'function' to stdlib Reimplement glob and case to use local procs * This keeps these internal procs out of the global namespace Signed-off-by: Steve Bennett --- glob.tcl | 158 ++++++++++++++++++++++++++++++++------------------------------- 1 file changed, 80 insertions(+), 78 deletions(-) (limited to 'glob.tcl') diff --git a/glob.tcl b/glob.tcl index 8288bc1..dbad26e 100644 --- a/glob.tcl +++ b/glob.tcl @@ -6,98 +6,100 @@ # See LICENCE in this directory for full details. -# If $dir is a directory, return a list of all entries -# it contains which match $pattern +# Implements the Tcl glob command # -proc _glob_readdir_pattern {dir pattern} { - set result {} +# Usage: glob ?-nocomplain? pattern ... +# +# Patterns use 'string match' (glob) pattern matching for each +# directory level, plus support for braced alternations. +# +# 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} { - # readdir doesn't return . or .., so simulate it here - if {$pattern in {. ..}} { - return $pattern - } + # If $dir is a directory, return a list of all entries + # it contains which match $pattern + # + local proc glob.readdir_pattern {dir pattern} { + set result {} - # 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 + # readdir doesn't return . or .., so simulate it here + if {$pattern in {. ..}} { + return $pattern } - } - return $result -} + # 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 + } + } -# glob entries in directory $dir and pattern $rem -# -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] + return $result } - # 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 "" - } + # 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] + } - set result {} + # 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 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] + 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 } - return $result } - } - # 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 - } else { - # Expany any entries at this level and add them - lappend result {*}[_glob_do $dir$sep$f $rempattern] + # 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 + } else { + # Expany any entries at this level and add them + lappend result {*}[glob.do $dir$sep$f $rempattern] + } } + return $result } - return $result -} -# Implements the Tcl glob command -# -# Usage: glob ?-nocomplain? pattern ... -# -# Patterns use 'string match' (glob) pattern matching for each -# directory level, plus support for braced alternations. -# -# 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} { + # Start of main glob set nocomplain 0 if {[lindex $args 0] eq "-nocomplain"} { @@ -110,9 +112,9 @@ proc glob {args} { if {$pattern eq "/"} { lappend result / } elseif {[string match "/*" $pattern]} { - lappend result {*}[_glob_do / [string range $pattern 1 end]] + lappend result {*}[glob.do / [string range $pattern 1 end]] } else { - lappend result {*}[_glob_do "" $pattern] + lappend result {*}[glob.do "" $pattern] } } -- cgit v1.1