From: Steve Huntley Date: Tue, 4 Mar 2008 21:38:05 +0000 (+0000) Subject: 2008-03-04 Steve Huntley X-Git-Tag: vfs-1-4~28 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=2cd4a36712ba7e549dab03df590a5d8feb861f47;p=tclvfs 2008-03-04 Steve Huntley vfs::template package update ver. 1.5.2: * templatevfs.tcl, deltavfs.tcl, versionvfs.tcl, quotavfs.tcl, fishvfs.tcl: added workaround to memchan bug that shows up when tclkit used. * pkgIndex.tcl, tclIndex: moved auto_index edits from former to latter to conform to Tcl package management standard practice. --- diff --git a/ChangeLog b/ChangeLog index ee6424b..a386be6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2008-03-04 Steve Huntley + + vfs::template package update ver. 1.5.2: + + * templatevfs.tcl, deltavfs.tcl, versionvfs.tcl, quotavfs.tcl, fishvfs.tcl: + added workaround to memchan bug that shows up when tclkit used. + * pkgIndex.tcl, tclIndex: moved auto_index edits from former to latter + to conform to Tcl package management standard practice. + 2008-02-26 Steve Huntley vfs::template package update ver. 1.5.1: diff --git a/library/template/deltavfs.tcl b/library/template/deltavfs.tcl index 499fcd0..8d26ec0 100644 --- a/library/template/deltavfs.tcl +++ b/library/template/deltavfs.tcl @@ -5,7 +5,7 @@ deltavfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5.1 +Version 1.5.2 A delta virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -136,7 +136,7 @@ proc open_ {file mode} { if ![file exists $fileName] {set newFile 1} set fileName $file set channelID [Reconstitute $fileName] - if [string equal $channelID {}] {set channelID [open $fileName $mode] ; close $channelID ; set channelID [::vfs::memchan]} + if [string equal $channelID {}] {set channelID [open $fileName $mode] ; close $channelID ; set channelID [memchan]} if $newFile {catch {file attributes $fileName -permissions $permissions}} return $channelID } @@ -267,7 +267,7 @@ proc Reconstitute {fileName} { fconfigure $f -translation binary set copyInstructions [read $f] close $f - set fileToConstruct [::vfs::memchan] + set fileToConstruct [memchan] tpatch $targetFile $copyInstructions $fileToConstruct catch {close $targetFile} set targetFile $fileToConstruct diff --git a/library/template/fishvfs.tcl b/library/template/fishvfs.tcl index 64d2a4e..3ea8d27 100644 --- a/library/template/fishvfs.tcl +++ b/library/template/fishvfs.tcl @@ -13,7 +13,7 @@ fishvfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license - Version 1.5 + Version 1.5.2 Usage: mount ?-volume? \ ?-cache ? \ # cache retention seconds @@ -331,7 +331,7 @@ proc open_ {file mode} { set command "ls -l '$file' | ( read a b c d x e\; echo \$x )" if {([catch {set fileSize [Transport $root $command]}]) && ($mode == "r")} {error "couldn't open \"$file\": no such file or directory" "no such file or directory" {POSIX ENOENT {no such file or directory}}} - set channelID [::vfs::memchan] + set channelID [memchan] # file must exist after open procedure, ensure it: set command "touch -a '$file'" diff --git a/library/template/pkgIndex.tcl b/library/template/pkgIndex.tcl index 4a44cf7..fed201e 100644 --- a/library/template/pkgIndex.tcl +++ b/library/template/pkgIndex.tcl @@ -8,16 +8,9 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -package ifneeded vfs::template 1.5.1 [list source [file join $dir templatevfs.tcl]] +if {[lsearch -exact $::auto_path $dir] == -1} { + lappend ::auto_path $dir +} -set ::auto_index(::vfs::template::mount) [list package require vfs::template 1.5.1] -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]] -set ::auto_index(::vfs::template::version::delta::mount) [list source [file join $dir deltavfs.tcl]] -set ::auto_index(::vfs::template::chroot::mount) [list source [file join $dir chrootvfs.tcl]] -set ::auto_index(::vfs::template::fish::mount) [list source [file join $dir fishvfs.tcl]] - -package ifneeded fileutil::globfind 1.5 [list source [file join $dir globfind.tcl]] -package ifneeded trsync 1.0 [list source [file join $dir tdelta.tcl]] +package ifneeded vfs::template 1.5.2 [list source [file join $dir templatevfs.tcl]] diff --git a/library/template/quotavfs.tcl b/library/template/quotavfs.tcl index e258b90..5ef9c99 100644 --- a/library/template/quotavfs.tcl +++ b/library/template/quotavfs.tcl @@ -5,7 +5,7 @@ quotavfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5.1 +Version 1.5.2 A quota-enforcing virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -202,7 +202,7 @@ if $newFile { set ::vfs::template::quota::quota($root) [array get quotaArray] # Use memchan to store edits so edit can be rejected if it violates size quotas: - set memchannel [vfs::memchan] + set memchannel [memchan] fconfigure $channel -translation binary fconfigure $memchannel -translation binary seek $channel 0 diff --git a/library/template/tclIndex b/library/template/tclIndex new file mode 100644 index 0000000..443c5c7 --- /dev/null +++ b/library/template/tclIndex @@ -0,0 +1,15 @@ +# Tcl autoload index file, version 2.0 +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# 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.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]] +set auto_index(::vfs::template::version::delta::mount) [list source [file join $dir deltavfs.tcl]] +set auto_index(::vfs::template::chroot::mount) [list source [file join $dir chrootvfs.tcl]] +set auto_index(::vfs::template::fish::mount) [list source [file join $dir fishvfs.tcl]] diff --git a/library/template/templatevfs.tcl b/library/template/templatevfs.tcl index 386df88..8c99227 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.1 +Version 1.5.2 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.1 +package provide vfs::template 1.5.2 namespace eval ::vfs::template { @@ -543,6 +543,17 @@ proc tk_chooseDirectory {args} { eval [eval list ::tk::dialog::file::chooseDir:: $args] } +# workaround for bug in tclkit: +proc memchan {args} { + if {$::tcl_platform(platform) == "windows"} { + package require Memchan + set chan [uplevel 1 ::memchan $args] + return $chan + } else { + return ::vfs::memchan $args + } +} + } # end namespace eval ::vfs::template diff --git a/library/template/versionvfs.tcl b/library/template/versionvfs.tcl index aff036c..7add562 100644 --- a/library/template/versionvfs.tcl +++ b/library/template/versionvfs.tcl @@ -5,7 +5,7 @@ versionvfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5.1 +Version 1.5.2 A versioning virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -298,7 +298,7 @@ proc open_ {file mode} { if {$fileName == [file join $path $relative]} { set fileName [VFileNameEncode [file join $path $relative]]\;[VCreateTag $root] close [open $fileName $mode] - set channelID [vfs::memchan] + set channelID [memchan] set ::vfs::template::version::filestats($channelID) "filename [list $fileName] hash [list $hash]" return $channelID } @@ -309,7 +309,7 @@ proc open_ {file mode} { fconfigure $f -translation binary set hash [Hash $f] close $f - set filed [vfs::memchan] + set filed [memchan] if {[string index $mode 0] == "a"} { set f [open $fileName r] fconfigure $f -translation binary