From: Steve Huntley Date: Sat, 30 Jan 2010 08:22:24 +0000 (+0000) Subject: 2010-01-30 Steve Huntley X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=126c7bebf3f9db3fc9cf5b4ce0b56d1f00ab8e9c;p=tclvfs 2010-01-30 Steve Huntley * templatevfs.tcl: workaround for bug in how virtual volumes are mounted. Version bumped to 1.5.4. See: http://sf.net/tracker/?func=detail&aid=2886914&group_id=10894&atid=110894 --- diff --git a/ChangeLog b/ChangeLog index 27b545e..bb793d8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,10 +1,16 @@ -2008-10-20 Steve Huntley +2010-01-30 Steve Huntley + + * templatevfs.tcl: workaround for bug in how virtual volumes + are mounted. Version bumped to 1.5.4. See: +http://sf.net/tracker/?func=detail&aid=2886914&group_id=10894&atid=110894 + +2009-10-20 Steve Huntley * tclIndex: Corrected version number. * pkgIndex.tcl.in: Edited to replace function of deleted pkgIndex.tcl in template subdir. -2008-10-15 Steve Huntley +2009-10-15 Steve Huntley vfs::template package update ver. 1.5.3: diff --git a/library/template/templatevfs.tcl b/library/template/templatevfs.tcl index d0aee64..f7c48c3 100644 --- a/library/template/templatevfs.tcl +++ b/library/template/templatevfs.tcl @@ -7,7 +7,7 @@ templatevfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5.3 +Version 1.5.4 The template virtual filesystem is designed as a prototype on which to build new virtual filesystems. Only a few simple, abstract procedures have to be overridden to produce a new @@ -54,7 +54,7 @@ set vfs::posix(load) x vfs::posixError load unset vfs::posix(load) -package provide vfs::template 1.5.3 +package provide vfs::template 1.5.4 namespace eval ::vfs::template { @@ -185,7 +185,13 @@ proc mount {args} { set [namespace current]::cache($to) $cache # register location with Tclvfs package: - eval ::vfs::filesystem mount $volume \$to \[list [namespace current]::handler \$path\] + set div {} + if {$volume ne {}} { + if {[string index $to end] ne "/"} { + set div / + } + } + eval ::vfs::filesystem mount $volume \$to$div \[list [namespace current]::handler \$path\] ::vfs::RegisterMount $to [list [namespace current]::unmount] # ensure close callback background error appears at script execution level: @@ -199,7 +205,9 @@ proc mount {args} { # undo Tclvfs API hooks: proc unmount {to} { - set to [::file normalize $to] + if {[lsearch [::vfs::filesystem info] $to] < 0} { + set to [::file normalize $to] + } set path [lindex [::vfs::filesystem info $to] end] # call custom unmount procedure: @@ -562,12 +570,12 @@ proc memchan {args} { catch {rename ::exit ::vfs::template::exit} -proc ::exit {} { +proc ::exit {args} { foreach vfs [::vfs::filesystem info] { - if [catch {$::vfs::_unmountCmd($vfs) $vfs} result] { + if [catch {$::vfs::_unmountCmd([file normalize $vfs]) $vfs} result] { puts "$vfs: $result" } } - ::vfs::template::exit + ::vfs::template::exit [lindex $args 0] } diff --git a/pkgIndex.tcl.in b/pkgIndex.tcl.in index 8c07661..0554ac6 100644 --- a/pkgIndex.tcl.in +++ b/pkgIndex.tcl.in @@ -35,7 +35,7 @@ package ifneeded vfs::tk 0.5 [list source [file join $dir tkvfs.tcl]] if {[lsearch -exact $::auto_path [file join $dir template]] == -1} { lappend ::auto_path [file join $dir template] } -package ifneeded vfs::template 1.5.3 \ +package ifneeded vfs::template 1.5.4 \ [list source [file join $dir template templatevfs.tcl]] # # Helpers