From 92bdc8c7f3a2d975a11608b78363469f57f8eb42 Mon Sep 17 00:00:00 2001 From: Vince Darley Date: Wed, 20 Feb 2002 16:06:53 +0000 Subject: [PATCH] for latest cvs head --- ChangeLog | 17 ++++++++++++----- library/httpvfs.tcl | 10 ++++++++++ library/tclprocvfs.tcl | 14 ++++++++++++-- library/vfsUrl.tcl | 4 ++++ library/zipvfs.tcl | 8 +++++++- 5 files changed, 45 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 61b8181..5a1c2f8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2002-02-19 Vince Darley + * library/*.tcl: updated the vfs implementations to deal + with the 2002-02-01 change below. More work needed. + +2002-02-17 Vince Darley + * generic/vfs.c: updated for TIP#72 application to cvs head. + The 'file stat' implementation now deals with files of size + greater than a 32 bit representation. This requires the + very latest cvs head of Tcl 8.4a4, and is not compatible + with previous releases (but that is fine, since we're still + tracking alpha releases anyway). + 2002-02-01 Vince Darley * generic/vfs.c: allow 'pattern' to be NULL in calls to Tcl_FSMatchInDirectory in preparation for fix of Tcl bug @@ -51,11 +63,6 @@ * examples/simpleExamples.tcl: a demo * doc/vfslib.n: some documentation on the 'library' code. -2002-02-17 Vince Darley - * generic/vfs.c: updated for TIP#72 application to cvs head. - The 'file stat' implementation now deals with files of size - greater than a 32 bit representation. - 2001-10-29 Vince Darley * win/makefile.vc: installation is better. * library/vfsUrl.tcl: improved urltype mounting. The following diff --git a/library/httpvfs.tcl b/library/httpvfs.tcl index de2afbc..dae654a 100644 --- a/library/httpvfs.tcl +++ b/library/httpvfs.tcl @@ -125,6 +125,16 @@ proc vfs::http::matchindirectory {dirurl path actualpath pattern type} { ::vfs::log "matchindirectory $path $pattern $type" set res [list] + if {[string length $pattern]} { + # need to match all files in a given remote http site. + + } else { + # single file + if {![catch {access $dirurl $path}]} { + lappend res $path + } + } + return $res } diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl index 84677b6..43f69b0 100644 --- a/library/tclprocvfs.tcl +++ b/library/tclprocvfs.tcl @@ -114,12 +114,22 @@ proc vfs::ns::matchindirectory {ns path actualpath pattern type} { if {[::vfs::matchDirectories $type]} { # add matching directories to $res - eval lappend res [namespace children ::${ns}::${path} $pattern] + if {[string length $pattern]} { + eval lappend res [namespace children ::${ns}::${path} $pattern] + } else { + if {[namespace exists ::${ns}::${path}]} { + eval lappend res ::${ns}::${path} + } + } } if {[::vfs::matchFiles $type]} { # add matching files to $res - eval lappend res [info procs ::${ns}::${path}::$pattern] + if {[string length $pattern]} { + eval lappend res [info procs ::${ns}::${path}::$pattern] + } else { + eval lappend res [info procs ::${ns}] + } } set realres [list] foreach r $res { diff --git a/library/vfsUrl.tcl b/library/vfsUrl.tcl index b5a6517..68f9c33 100644 --- a/library/vfsUrl.tcl +++ b/library/vfsUrl.tcl @@ -97,6 +97,10 @@ proc vfs::urltype::matchindirectory {type root path actualpath pattern types} { if {![vfs::matchDirectories $types]} { return [list] } + if {![string length $pattern]} { + return foo + } + set res [list] set len [string length $root] diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl index 121301f..98d0689 100644 --- a/library/zipvfs.tcl +++ b/library/zipvfs.tcl @@ -43,6 +43,9 @@ proc vfs::zip::handler {zipfd cmd root relative actualpath args} { proc vfs::zip::matchindirectory {zipfd path actualpath pattern type} { #::vfs::log [list matchindirectory $path $actualpath $pattern $type] + + # This call to zip::getdir handles empty patterns properly as asking + # for the existence of a single file $path only set res [::zip::getdir $zipfd $path $pattern] #::vfs::log "got $res" set newres [list] @@ -436,6 +439,7 @@ proc zip::stat {fd path arr} { return "" } +# Treats empty pattern as asking for a particular file only proc zip::getdir {fd path {pat *}} { # ::vfs::log [list getdir $fd $path $pat] upvar #0 zip::$fd.toc toc @@ -444,7 +448,9 @@ proc zip::getdir {fd path {pat *}} { set path $pat } else { set path [string tolower $path] - append path /$pat + if {$pat != ""} { + append path /$pat + } } set depth [llength [file split $path]] -- 2.23.0