From: Vince Darley <vincentdarley@sourceforge.net>
Date: Wed, 8 Aug 2001 17:05:06 +0000 (+0000)
Subject: Fix to directory globs
X-Git-Tag: vfs-1-2~140
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=62e637f9e17a7cafd24c75f619806b338a6c3625;p=tclvfs

Fix to directory globs
---

diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index c581891..d5c24f1 100644
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -91,7 +91,7 @@ proc ::vfs::auto {filename args} {
 # we match properly when given 'directory'
 # specifications, since this is used for
 # recursive globbing by Tcl.
-proc vfs::matchCorrectTypes {types filelist} {
+proc vfs::matchCorrectTypes {types filelist {inDir ""}} {
     if {$types != 0} {
 	# Which types to return.  We must do special
 	# handling of directories and files.
@@ -104,16 +104,33 @@ proc vfs::matchCorrectTypes {types filelist} {
 	    return [list]
 	}
 	set newres [list]
-	if {$file} {
-	    foreach r $filelist {
-		if {[::file isfile $r]} {
-		    lappend newres $r
+	if {[string length $inDir]} {
+	    if {$file} {
+		foreach r $filelist {
+		    if {[::file isfile [file join $inDir $r]]} {
+			lappend newres $r
+		    }
+		}
+	    } else {
+		foreach r $filelist {
+		    #puts [file join $inDir $r]
+		    if {[::file isdirectory [file join $inDir $r]]} {
+			lappend newres $r
+		    }
 		}
 	    }
 	} else {
-	    foreach r $filelist {
-		if {[::file isdirectory $r]} {
-		    lappend newres $r
+	    if {$file} {
+		foreach r $filelist {
+		    if {[::file isfile $r]} {
+			lappend newres $r
+		    }
+		}
+	    } else {
+		foreach r $filelist {
+		    if {[::file isdirectory $r]} {
+			lappend newres $r
+		    }
 		}
 	    }
 	}
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 4a2602c..3d40da5 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -32,8 +32,9 @@ proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
 proc vfs::zip::matchindirectory {zipfd path actualpath pattern type} {
     puts stderr [list matchindirectory $path $actualpath $pattern $type]
     set res [::zip::getdir $zipfd $path $pattern]
+    #puts stderr "got $res"
     set newres [list]
-    foreach p [::vfs::matchCorrectTypes $type $res] {
+    foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
 	lappend newres "$actualpath$p"
     }
     #puts "got $newres"