TclVFS

2010-01-30  Steve Huntley  <[email protected]>

	* 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  <[email protected]>

	* tclIndex: Corrected version number.
	* pkgIndex.tcl.in: Edited to replace function of deleted 
	pkgIndex.tcl in template subdir.

2009-10-15  Steve Huntley  <[email protected]>

	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.

#/usr/bin/env tclsh

if 0 {
########################

templatevfs.tcl --

Written by Stephen Huntley ([email protected])
License: Tcl license
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
vfs, requiring no knowledge of the Tclvfs API. 

In addition, several behind-the-scenes functions are provided to make new vfs's more stable and
scalable, including file information caching and management of close callback errors. 

package require vfs 1.0

# force sourcing of vfsUtils.tcl: 
set vfs::posix(load) x
vfs::posixError load
unset vfs::posix(load)

package provide vfs::template 1.5.4

namespace eval ::vfs::template {

if 0 {
########################

In order to create a new virtual filesystem:

	if {[lsearch [::vfs::filesystem info] $to] != -1} {::vfs::filesystem unmount $to}
	array unset ::vfs::_unmountCmd $to

# set file info cache dwell time value:
	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\]
	::vfs::RegisterMount $to [list [namespace current]::unmount]

# ensure close callback background error appears at script execution level:
	trace remove execution ::close leave ::vfs::template::CloseTrace
	trace remove execution ::file leave ::vfs::template::FileTrace
	trace add execution ::close leave vfs::template::CloseTrace
	trace add execution ::file leave vfs::template::FileTrace

	return $to
}

# undo Tclvfs API hooks:
proc unmount {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:
	set ::vfs::template::vfs_retrieve 1
	UnmountProcedure $path $to
	unset -nocomplain ::vfs::template::vfs_retrieve

# end namespace eval ::vfs::template

# overload exit command so that all vfs's are explicitly 
# unmounted before program termination:
 
catch {rename ::exit ::vfs::template::exit}

proc ::exit {args} {
	foreach vfs [::vfs::filesystem info] {
		if [catch {$::vfs::_unmountCmd([file normalize $vfs]) $vfs} result] {
			puts "$vfs: $result"
		}		
	}
	::vfs::template::exit [lindex $args 0]
}

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 \
    [list source [file join $dir template templatevfs.tcl]]
#
# Helpers
#
package ifneeded fileutil::globfind 1.5 \
    [list source [file join $dir template globfind.tcl]]
package ifneeded trsync 1.0 [list source [file join $dir template tdelta.tcl]]