From: Pat Thoyts Date: Sun, 11 Jul 2010 11:02:01 +0000 (+0100) Subject: Roll back tclvfs to a valid version. X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=973dc82d4ee903db90b339e05648c59dc4711769;p=kitgen Roll back tclvfs to a valid version. Signed-off-by: Pat Thoyts --- diff --git a/8.x/tclvfs/ChangeLog b/8.x/tclvfs/ChangeLog index b261d85..7192e3e 100644 --- a/8.x/tclvfs/ChangeLog +++ b/8.x/tclvfs/ChangeLog @@ -1,34 +1,3 @@ -2010-05-16 Steve Huntley - - * library/vfslib.tcl: Changed memchan condition from Tcl version 8.6 or - greater to presence of chan command (since chan now in later 8.5 builds) - -2010-02-01 Steve Huntley - - * Makefile.in (PKG_TCL_SOURCES): Added 'template/tclIndex' to the list - of installed files. Required for vfs's based on template vfs to load. - -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. - -2009-10-15 Steve Huntley - - vfs::template package update ver. 1.5.3: - - * templatevfs.tcl: Incorporated AK's fix below. - * collatevfs.tcl: ensured binary file contents got written - correctly, and ensured that not only file contents but - also file attributes were updated to all write targets. - 2009-07-06 Andreas Kupries * library/template/templatevfs.tcl (memchan): Fix result for diff --git a/8.x/tclvfs/Makefile.in b/8.x/tclvfs/Makefile.in index 680c404..712a720 100644 --- a/8.x/tclvfs/Makefile.in +++ b/8.x/tclvfs/Makefile.in @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: Makefile.in,v 1.31 2010/02/01 07:32:58 blacksqr Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.30 2009/02/06 19:13:27 andreas_kupries Exp $ #======================================================================== # Edit the following few lines when writing a new extension @@ -49,7 +49,7 @@ PKG_TCL_SOURCES = @PKG_TCL_SOURCES@ \ template/fishvfs.tcl template/globfind.tcl \ template/quotavfs.tcl template/tdelta.tcl \ template/templatevfs.tcl template/versionvfs.tcl \ - template/chrootvfs.tcl template/tclIndex vfs.tcl + template/chrootvfs.tcl vfs.tcl #======================================================================== diff --git a/8.x/tclvfs/library/template/collatevfs.tcl b/8.x/tclvfs/library/template/collatevfs.tcl index 770f11e..45616bb 100644 --- a/8.x/tclvfs/library/template/collatevfs.tcl +++ b/8.x/tclvfs/library/template/collatevfs.tcl @@ -5,7 +5,7 @@ collatevfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5.3 +Version 1.5 A collate/broadcast/collect/catchup virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -78,6 +78,7 @@ mount -read C:/install/package/images FTP:/pub/releases/package/images -collect } package require vfs::template 1.5 +package provide vfs::template::collate 1.5.2 namespace eval ::vfs::template::collate { @@ -92,10 +93,7 @@ foreach templateProc [namespace eval ::vfs::template {info procs}] { proc close_ {channel} { upvar root root relative relative foreach file [lrange [WriteFile $root $relative close] 1 end] { - if ![WriteTest $file] {continue} - file mkdir [file dirname $file] set f [open $file w] - fconfigure $f -translation binary seek $channel 0 fcopy $channel $f close $f @@ -104,18 +102,17 @@ proc close_ {channel} { } proc file_atime {file time} { upvar root root relative relative - foreach file [WriteFile $root $relative open] { - file atime $file $time - } + set file [AcquireFile $root $relative] + file atime $file $time } proc file_mtime {file time} { upvar root root relative relative - foreach file [WriteFile $root $relative open] { - file mtime $file $time - } + set file [AcquireFile $root $relative] + file mtime $file $time } proc file_attributes {file {attribute {}} args} { upvar root root relative relative + set file [AcquireFile $root $relative] if {($relative == {}) && ([string map {-read 1 -write 1 -collect 1 -catchup 1} $attribute] == 1)} { set attribute [string range $attribute 1 end] if {$args == {}} {eval return \$::vfs::template::collate::${attribute}(\$root)} @@ -123,13 +120,6 @@ proc file_attributes {file {attribute {}} args} { set ::vfs::template::collate::catchup [file isdirectory [lindex $::vfs::template::collate::catchupstore 0]] return } - if {$args != {}} { - foreach file [WriteFile $root $relative open] { - file attributes $file $attribute $args - } - return - } - set file [AcquireFile $root $relative] set returnValue [eval file attributes \$file $attribute $args] if {($relative == {}) && ($attribute == {})} {set returnValue [concat $returnValue [list -read $::vfs::template::collate::read($root) -write $::vfs::template::collate::write($root) -collect $::vfs::template::collate::collect($root) -catchup $::vfs::template::collate::catchupstore($root)]]} return $returnValue @@ -363,9 +353,5 @@ proc WriteFile {root relative action} { return $returnValue } -proc WriteTest {args} { - return 1 -} - } # end namespace ::vfs::template::collate diff --git a/8.x/tclvfs/library/template/tclIndex b/8.x/tclvfs/library/template/tclIndex index 6cda2aa..443c5c7 100644 --- a/8.x/tclvfs/library/template/tclIndex +++ b/8.x/tclvfs/library/template/tclIndex @@ -6,7 +6,7 @@ # element name is the name of a command and the value is # a script that loads the command. -set auto_index(::vfs::template::mount) [list package require vfs::template 1.5.3] +set auto_index(::vfs::template::mount) [list package require vfs::template 1.5.2] set auto_index(::vfs::template::collate::mount) [list source [file join $dir collatevfs.tcl]] set auto_index(::vfs::template::quota::mount) [list source [file join $dir quotavfs.tcl]] set auto_index(::vfs::template::version::mount) [list source [file join $dir versionvfs.tcl]] diff --git a/8.x/tclvfs/library/template/templatevfs.tcl b/8.x/tclvfs/library/template/templatevfs.tcl index f7c48c3..ccd04c5 100644 --- a/8.x/tclvfs/library/template/templatevfs.tcl +++ b/8.x/tclvfs/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.4 +Version 1.5.3 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.4 +package provide vfs::template 1.5.3 namespace eval ::vfs::template { @@ -185,13 +185,7 @@ proc mount {args} { set [namespace current]::cache($to) $cache # register location with Tclvfs package: - 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\] + eval ::vfs::filesystem mount $volume \$to \[list [namespace current]::handler \$path\] ::vfs::RegisterMount $to [list [namespace current]::unmount] # ensure close callback background error appears at script execution level: @@ -205,9 +199,7 @@ proc mount {args} { # undo Tclvfs API hooks: proc unmount {to} { - if {[lsearch [::vfs::filesystem info] $to] < 0} { - set to [::file normalize $to] - } + set to [::file normalize $to] set path [lindex [::vfs::filesystem info $to] end] # call custom unmount procedure: @@ -558,7 +550,7 @@ proc memchan {args} { set chan [uplevel 1 ::memchan $args] return $chan } else { - return [eval [linsert $args 0 ::vfs::memchan]] + return [eval [linsert $args 0 ::vfs::memchan]] } } @@ -570,12 +562,12 @@ proc memchan {args} { catch {rename ::exit ::vfs::template::exit} -proc ::exit {args} { +proc ::exit {} { foreach vfs [::vfs::filesystem info] { - if [catch {$::vfs::_unmountCmd([file normalize $vfs]) $vfs} result] { + if [catch {$::vfs::_unmountCmd($vfs) $vfs} result] { puts "$vfs: $result" } } - ::vfs::template::exit [lindex $args 0] + ::vfs::template::exit } diff --git a/8.x/tclvfs/library/vfslib.tcl b/8.x/tclvfs/library/vfslib.tcl index c03d05c..d44a8c9 100644 --- a/8.x/tclvfs/library/vfslib.tcl +++ b/8.x/tclvfs/library/vfslib.tcl @@ -32,7 +32,7 @@ if {[llength [info command zlib]] || ![catch {load "" zlib}]} { # Use 8.6 reflected channels or the rechan package in earlier versions to # provide a memory channel implementation. # -if {[info command ::chan] ne {}} { +if {[package vsatisfies [package provide Tcl] 8.6]} { # As the core zlib channel stacking make non-seekable channels we cannot # implement vfs::zstream and this feature is disabled in tclkit boot.tcl diff --git a/8.x/tclvfs/pkgIndex.tcl.in b/8.x/tclvfs/pkgIndex.tcl.in index 0554ac6..1128445 100644 --- a/8.x/tclvfs/pkgIndex.tcl.in +++ b/8.x/tclvfs/pkgIndex.tcl.in @@ -32,10 +32,19 @@ package ifneeded vfs::tk 0.5 [list source [file join $dir tkvfs.tcl]] # # Virtual filesystems based on the template vfs: # -if {[lsearch -exact $::auto_path [file join $dir template]] == -1} { - lappend ::auto_path [file join $dir template] -} -package ifneeded vfs::template 1.5.4 \ +package ifneeded vfs::template::chroot 1.5.2 \ + [list source [file join $dir template chrootvfs.tcl]] +package ifneeded vfs::template::collate 1.5.2 \ + [list source [file join $dir template collatevfs.tcl]] +package ifneeded vfs::template::version 1.5.2 \ + [list source [file join $dir template versionvfs.tcl]] +package ifneeded vfs::template::version::delta 1.5.2 \ + [list source [file join $dir template deltavfs.tcl]] +package ifneeded vfs::template::fish 1.5.2 \ + [list source [file join $dir template fishvfs.tcl]] +package ifneeded vfs::template::quota 1.5.2 \ + [list source [file join $dir template quotavfs.tcl]] +package ifneeded vfs::template 1.5.3 \ [list source [file join $dir template templatevfs.tcl]] # # Helpers