From 62e637f9e17a7cafd24c75f619806b338a6c3625 Mon Sep 17 00:00:00 2001 From: Vince Darley Date: Wed, 8 Aug 2001 17:05:06 +0000 Subject: [PATCH] Fix to directory globs --- library/vfsUtils.tcl | 33 +++++++++++++++++++++++++-------- library/zipvfs.tcl | 3 ++- 2 files changed, 27 insertions(+), 9 deletions(-) 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" -- 2.23.0