glob: bug fixes and Tcl compatibility

Fix the case where the pattern/filename contains a space
Respect the —tails option, but generate an error if -types is given.
Change the error message on no match to be Tcl-compatible

Signed-off-by: Steve Bennett <steveb@workware.net.au>

1 files changed, 20 insertions, 12 deletions

diff --git a/glob.tcl b/glob.tcl
index ea27fde..be341f4 100644
--- a/glob.tcl
+++ b/glob.tcl
@@ -11,7 +11,7 @@ package require readdir
 proc glob.globdir {dir pattern} {
 	if {[file exists $dir/$pattern]} {
 		# Simple case
-		return $pattern
+		return [list $pattern]
 	}
 
 	set result {}
@@ -35,6 +35,7 @@ proc glob.globdir {dir pattern} {
 # alternatives inside the given pattern, prepending the unprocessed
 # part of the pattern. Does _not_ handle escaped braces or commas.
 proc glob.explode {pattern} {
+	set orig $pattern
 	set oldexp {}
 	set newexp {""}
 
@@ -73,7 +74,7 @@ proc glob.explode {pattern} {
 	foreach old $oldexp {
 		lappend newexp $old$suf
 	}
-	linsert $newexp 0 $rest
+	list $rest {*}$newexp
 }
 
 # Core glob implementation. Returns a list of files/directories inside
@@ -120,6 +121,8 @@ proc glob.glob {base pattern} {
 proc glob {args} {
 	set nocomplain 0
 	set base ""
+	set tails 0
+	set complain ""
 
 	set n 0
 	foreach arg $args {
@@ -137,17 +140,16 @@ proc glob {args} {
 			-n* {
 				set nocomplain 1
 			}
-			-t* {
-				# Ignored for Tcl compatibility
-			}
-
-			-* {
-				return -code error "bad option \"$switch\": must be -directory, -nocomplain, -tails, or --"
+			-ta* {
+				set tails 1
 			}
 			-- {
 				incr n
 				break
 			}
+			-* {
+				return -code error "bad option \"$arg\": must be -directory, -nocomplain, -tails, or --"
+			}
 			*  {
 				break
 			}
@@ -165,10 +167,10 @@ proc glob {args} {
 
 	set result {}
 	foreach pattern $args {
-		set pattern [string map {
+		set escpattern [string map {
 			\\\\ \x01 \\\{ \x02 \\\} \x03 \\, \x04
 		} $pattern]
-		set patexps [lassign [glob.explode $pattern] rest]
+		set patexps [lassign [glob.explode $escpattern] rest]
 		if {$rest ne ""} {
 			return -code error "unmatched close brace in glob pattern"
 		}
@@ -177,13 +179,19 @@ proc glob {args} {
 				\x01 \\\\ \x02 \{ \x03 \} \x04 ,
 			} $patexp]
 			foreach {realname name} [glob.glob $base $patexp] {
-				lappend result $name
+				incr n
+				if {$tails} {
+					lappend result $name
+				} else {
+					lappend result [file join $base $name]
+				}
 			}
 		}
 	}
 
 	if {!$nocomplain && [llength $result] == 0} {
-		return -code error "no files matched glob patterns"
+		set s $(([llength $args] > 1) ? "s" : "")
+		return -code error "no files matched glob pattern$s \"[join $args]\""
 	}
 
 	return $result