aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlexander Shpilkin <ashpilkin@gmail.com>2012-09-17 15:52:47 +0400
committerSteve Bennett <steveb@workware.net.au>2012-09-20 08:47:26 +1000
commit7bf43eb589f738b7bdb3b4837bc0dde304046a2d (patch)
treeb412fd58f67f0fa8473b447698c670e14d629b4f
parent33e51c4b9ef4de3398a57da99eb6f5fbcd1d85e4 (diff)
downloadjimtcl-7bf43eb589f738b7bdb3b4837bc0dde304046a2d.zip
jimtcl-7bf43eb589f738b7bdb3b4837bc0dde304046a2d.tar.gz
jimtcl-7bf43eb589f738b7bdb3b4837bc0dde304046a2d.tar.bz2
Add support for glob -directory
Implement support for the -directory option to the [glob] command. The -tails option is accepted for Tcl compatibility, but ignored; the command always behaves as if -tails were given.
-rw-r--r--glob.tcl230
-rw-r--r--jim-file.c4
-rw-r--r--jim_tcl.txt7
3 files changed, 146 insertions, 95 deletions
diff --git a/glob.tcl b/glob.tcl
index 4bfb4f9..5e6abb5 100644
--- a/glob.tcl
+++ b/glob.tcl
@@ -1,127 +1,171 @@
-# Implements a Tcl-compatible glob command based on readdir
+# Implements a mostly Tcl-compatible glob command based on readdir
#
# (c) 2008 Steve Bennett <steveb@workware.net.au>
+# (c) 2012 Alexander Shpilkin <ashpilkin@gmail.com>
#
# See LICENCE in this directory for licensing.
package require readdir
-# 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} {
-
- # 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 {}
-
- # readdir doesn't return . or .., so simulate it here
- if {$pattern in {. ..}} {
- return $pattern
+# Return a list of all entries in $dir that match the pattern.
+proc glob.globdir {dir pattern} {
+ set result {}
+ set files [readdir $dir]
+ lappend files . ..
+
+ foreach name $files {
+ if {[string match $pattern $name]} {
+ # Starting dots match only explicitly
+ if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} {
+ continue
+ }
+ lappend result $name
}
+ }
- # 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 [file join $dir $pattern]]} {
- set files [list $pattern]
- } else {
- set files ""
- }
+ return $result
+}
- 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 "."} {
- continue
+# Return the list of patterns resulting from expanding any braced
+# alternatives inside the given pattern, prepending the unprocessed
+# part of the pattern. Does _not_ handle escaped braces or commas.
+proc glob.explode {pattern} {
+ set oldexp {}
+ set newexp {""}
+
+ while 1 {
+ set oldexp $newexp
+ set newexp {}
+ set ob [string first \{ $pattern]
+ set cb [string first \} $pattern]
+
+ if {$ob < $cb && $ob != -1} {
+ set mid [string range $pattern 0 $ob-1]
+ set subexp [lassign [glob.explode [string range $pattern $ob+1 end]] pattern]
+ if {$pattern eq ""} {
+ error "unmatched open brace in glob pattern"
+ }
+ set pattern [string range $pattern 1 end]
+
+ foreach subs $subexp {
+ foreach sub [split $subs ,] {
+ foreach old $oldexp {
+ lappend newexp $old$mid$sub
+ }
}
- lappend result $name
}
+ } elseif {$cb != -1} {
+ set suf [string range $pattern 0 $cb-1]
+ set rest [string range $pattern $cb end]
+ break
+ } else {
+ set suf $pattern
+ set rest ""
+ break
}
+ }
+
+ foreach old $oldexp {
+ lappend newexp $old$suf
+ }
+ linsert $newexp 0 $rest
+}
- return $result
+# Core glob implementation. Returns a list of files/directories inside
+# base matching pattern, in {realname name} pairs.
+proc glob.glob {base pattern} {
+ set dir [file dirname $pattern]
+ if {$pattern eq $dir || $pattern eq ""} {
+ return [list [file join $base $dir] $pattern]
+ } elseif {$pattern eq [file tail $pattern]} {
+ set dir ""
}
- # 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 [list $pattern]
+ # Recursively expand the parent directory
+ set dirlist [glob.glob $base $dir]
+ set pattern [file tail $pattern]
+
+ # Collect the files/directories
+ set result {}
+ foreach {realdir dir} $dirlist {
+ if {![file isdir $realdir]} {
+ continue
}
- if {[set nb [string first "\}" $pattern $fb]] < 0} {
- return [list $pattern]
+ if {[string index $dir end] ne "/" && $dir ne ""} {
+ append dir /
}
- 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]
-
- lmap part [split $braced ,] {
- set pat $before$part$after
+ foreach name [glob.globdir $realdir $pattern] {
+ lappend result [file join $realdir $name] $dir$name
}
}
+ 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]
- }
+# Implements the Tcl glob command
+#
+# Usage: glob ?-nocomplain? ?-directory dir? ?--? 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} {
+ set nocomplain 0
+ set base ""
- # 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 {
- set sep /
- }
- foreach pat [glob.expandbraces $pattern] {
- foreach name [glob.readdir_pattern $dir $pat] {
- lappend result $globdir$sep$name
+ while {[llength $args] > 0} {
+ switch -glob -- [set switch [lindex $args 0]] {
+ -directory {
+ if {[llength $args] < 2} {
+ return -code error "missing argument to \"$switch\""
}
+ set base [lindex $args 1]
+ set args [lrange $args 1 end]
+ }
+ -nocomplain {
+ set nocomplain 1
+ }
+ -tails {
+ # Ignored for Tcl compatibility
}
- }
- return $result
- }
-
- # Start of main glob
- set nocomplain 0
- if {[lindex $args 0] eq "-nocomplain"} {
- set nocomplain 1
+ -* {
+ return -code error "bad option \"$switch\": must be -directory, -nocomplain, -tails, or --"
+ }
+ -- -
+ * {
+ break
+ }
+ }
set args [lrange $args 1 end]
}
+ if {[llength $args] < 1} {
+ return -code error "wrong # args: should be \"glob ?options? pattern ?pattern ...?\""
+ }
set result {}
foreach pattern $args {
- lappend result {*}[glob.glob $pattern]
- }
+ set pattern [string map {
+ \\\\ \x01 \\\{ \x02 \\\} \x03 \\, \x04
+ } $pattern]
+ set patexps [lassign [glob.explode $pattern] rest]
+ if {$rest ne ""} {
+ return -code error "unmatched close brace in glob pattern"
+ }
+ foreach patexp $patexps {
+ set patexp [string map {
+ \x01 \\\\ \x02 \{ \x03 \} \x04 ,
+ } $patexp]
+ foreach {realname name} [glob.glob $base $patexp] {
+ lappend result $name
+ }
+ }
+ }
- if {$nocomplain == 0 && [llength $result] == 0} {
+ if {!$nocomplain && [llength $result] == 0} {
return -code error "no files matched glob patterns"
}
diff --git a/jim-file.c b/jim-file.c
index 8214437..6b834a2 100644
--- a/jim-file.c
+++ b/jim-file.c
@@ -199,7 +199,9 @@ static int file_cmd_dirname(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
const char *path = Jim_String(argv[0]);
const char *p = strrchr(path, '/');
- if (!p) {
+ if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') {
+ Jim_SetResultString(interp, "..", -1);
+ } else if (!p) {
Jim_SetResultString(interp, ".", -1);
}
else if (p == path) {
diff --git a/jim_tcl.txt b/jim_tcl.txt
index b461759..16d7891 100644
--- a/jim_tcl.txt
+++ b/jim_tcl.txt
@@ -2515,7 +2515,7 @@ for reading.
glob
~~~~
-+*glob* ?*-nocomplain*? 'pattern ?pattern \...?'+
++*glob* ?*-nocomplain*? ?*-directory* 'dir'? ?*--*? 'pattern ?pattern \...?'+
This command performs filename globbing, using csh rules. The returned
value from `glob` is the list of expanded filenames.
@@ -2525,6 +2525,11 @@ list may be returned; otherwise an error is returned if the expanded
list is empty. The +-nocomplain+ argument must be provided
exactly: an abbreviation will not be accepted.
+If +-directory+ is given, the +'dir'+ is understood to contain a
+directory name to search in. This allows globbing inside directories
+whose names may contain glob-sensitive characters. The returned names
+are specified relative to this directory.
+
global
~~~~~~