# this fake module serves purposes to bootstrap Tcl/Tk compiled into
# Perl as extension with all Tcl/Tk scripts (including pure-Tcl widgets)
# being inside ZIP file;
# a mission of this file is to keep 6 Tcl scripts to facilitate bootstraping.

$::tcl_library = __FILE__;
$::tcl_library =~ s/Tclaux\.pm$//;
$::tcl_library1 = $::tcl_library;
$::tcl_library = "$::tcl_library/tcl8.4";

$Tcl::tcl_init0 = sub {
  my $interp = shift;
  $interp->Eval($Tcl::init_scripts{'tcl8.4/init.tcl'});
  $interp->Eval("proc tclInit {} {}"); # so this will avoid extra searching of init.tcl
};
$Tcl::tcl_init = sub {
  my $interp = shift;

  $interp->Eval($Tcl::init_scripts{'tcl8.4/package.tcl'});
  $interp->Eval($Tcl::init_scripts{'tcl8.4/auto.tcl'});

  my $t5=Win32::GetTickCount;
  $interp->Vfs_Init;
  $interp->Eval($Tcl::init_scripts{'vfs1.3/vfslib.tcl'});
  $interp->Eval($Tcl::init_scripts{'vfs1.3/vfsUtils.tcl'});
  $interp->Eval($Tcl::init_scripts{'vfs1.3/zipvfs.tcl'});

  $interp->Trf_Init;
  $interp->Memchan_Init;
  #print STDERR $::tcl_library,'--',map{"{$_}"}$interp->Eval('info procs'),"\n";
  my $t4=Win32::GetTickCount;
  $interp->invoke("vfs::zip::Mount", "$::tcl_library1/tclscripts.zip.pm", "$::tcl_library1");
  
  $int = $interp;
  my $t3=Win32::GetTickCount;
  $interp->Tk_Init;
  my $t2=Win32::GetTickCount;
  print STDERR "*".($t2-$t0),"(","tk=",($t2-$t3),":mount=",($t3-$t4),":vfs=",($t4-$t5),"z)\n";
};

# Perl hash array to hold bootstrap Tcl scripts (init/tcl etc)
%Tcl::init_scripts = (
  'tcl8.4/init.tcl' , <<'EOSEOS',
# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# RCS: @(#) $Id: init.tcl,v 1.55.2.6 2005/07/22 21:59:40 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

if {[info commands package] == ""} {
    error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 8.4

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.
# tclInitScript.h searches around for the directory containing this
# init.tcl and defines tcl_library to that location before sourcing it.
#
# The parent directory of tcl_library. Adding the parent
# means that packages in peer directories will be found automatically.
#
# Also add the directory ../lib relative to the directory where the
# executable is located.  This is meant to find binary packages for the
# same architecture as the current executable.
#
# tcl_pkgPath, which is set by the platform-specific initialization routines
#	On UNIX it is compiled in
#       On Windows, it is not used
#	On Macintosh it is "Tool Command Language" in the Extensions folder

if {![info exists auto_path]} {
    if {[info exists env(TCLLIBPATH)]} {
	set auto_path $env(TCLLIBPATH)
    } else {
	set auto_path ""
    }
}
namespace eval tcl {
    variable Dir
    if {[info library] ne ""} {
	foreach Dir [list [info library] [file dirname [info library]]] {
	    if {[lsearch -exact $::auto_path $Dir] < 0} {
		lappend ::auto_path $Dir
	    }
	}
    }
    set Dir [file join [file dirname [file dirname \
	    [info nameofexecutable]]] lib]
    if {[lsearch -exact $::auto_path $Dir] < 0} {
	lappend ::auto_path $Dir
    }
    if {[info exists ::tcl_pkgPath]} {
	foreach Dir $::tcl_pkgPath {
	    if {[lsearch -exact $::auto_path $Dir] < 0} {
		lappend ::auto_path $Dir
	    }
	}
    }
}
  
# Windows specific end of initialization

if {(![interp issafe]) && $tcl_platform(platform) eq "windows"} {
    namespace eval tcl {
	proc EnvTraceProc {lo n1 n2 op} {
	    set x $::env($n2)
	    set ::env($lo) $x
	    set ::env([string toupper $lo]) $x
	}
	proc InitWinEnv {} {
	    global env tcl_platform
	    foreach p [array names env] {
		set u [string toupper $p]
		if {$u ne $p} {
		    switch -- $u {
			COMSPEC -
			PATH {
			    if {![info exists env($u)]} {
				set env($u) $env($p)
			    }
			    trace add variable env($p) write \
				    [namespace code [list EnvTraceProc $p]]
			    trace add variable env($u) write \
				    [namespace code [list EnvTraceProc $p]]
			}
		    }
		}
	    }
	    if {![info exists env(COMSPEC)]} {
		if {$tcl_platform(os) eq "Windows NT"} {
		    set env(COMSPEC) cmd.exe
		} else {
		    set env(COMSPEC) command.com
		}
	    }
	}
	InitWinEnv
    }
}

# Setup the unknown package handler

package unknown tclPkgUnknown

if {![interp issafe]} {
    # setup platform specific unknown package handlers
    if {$::tcl_platform(platform) eq "unix"
	    && $::tcl_platform(os) eq "Darwin"} {
	package unknown [list tcl::MacOSXPkgUnknown [package unknown]]
    }
    if {$::tcl_platform(platform) eq "macintosh"} {
	package unknown [list tcl::MacPkgUnknown [package unknown]]
    }
}

# Conditionalize for presence of exec.

if {[namespace which -command exec] eq ""} {

    # Some machines, such as the Macintosh, do not have exec. Also, on all
    # platforms, safe interpreters do not have exec.

    set auto_noexec 1
}
set errorCode ""
set errorInfo ""

# Define a log command (which can be overwitten to log errors
# differently, specially when stderr is not available)

if {[namespace which -command tclLog] eq ""} {
    proc tclLog {string} {
	catch {puts stderr $string}
    }
}

# unknown --
# This procedure is called when a Tcl command is invoked that doesn't
# exist in the interpreter.  It takes the following steps to make the
# command available:
#
#	1. See if the command has the form "namespace inscope ns cmd" and
#	   if so, concatenate its arguments onto the end and evaluate it.
#	2. See if the autoload facility can locate the command in a
#	   Tcl script file.  If so, load it and execute it.
#	3. If the command was invoked interactively at top-level:
#	    (a) see if the command exists as an executable UNIX program.
#		If so, "exec" the command.
#	    (b) see if the command requests csh-like history substitution
#		in one of the common forms !!, !<number>, or ^old^new.  If
#		so, emulate csh's history substitution.
#	    (c) see if the command is a unique abbreviation for another
#		command.  If so, invoke the command.
#
# Arguments:
# args -	A list whose elements are the words of the original
#		command, including the command name.

proc unknown args {
    global auto_noexec auto_noload env unknown_pending tcl_interactive
    global errorCode errorInfo

    # If the command word has the form "namespace inscope ns cmd"
    # then concatenate its arguments onto the end and evaluate it.

    set cmd [lindex $args 0]
    if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
        set arglist [lrange $args 1 end]
	set ret [catch {uplevel 1 ::$cmd $arglist} result]
        if {$ret == 0} {
            return $result
        } else {
	    return -code $ret -errorcode $errorCode $result
        }
    }

    # Save the values of errorCode and errorInfo variables, since they
    # may get modified if caught errors occur below.  The variables will
    # be restored just before re-executing the missing command.

    # Safety check in case something unsets the variables 
    # ::errorInfo or ::errorCode.  [Bug 1063707]
    if {![info exists errorCode]} {
	set errorCode ""
    }
    if {![info exists errorInfo]} {
	set errorInfo ""
    }
    set savedErrorCode $errorCode
    set savedErrorInfo $errorInfo
    set name $cmd
    if {![info exists auto_noload]} {
	#
	# Make sure we're not trying to load the same proc twice.
	#
	if {[info exists unknown_pending($name)]} {
	    return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
	}
	set unknown_pending($name) pending;
	set ret [catch {auto_load $name [uplevel 1 {::namespace current}]} msg]
	unset unknown_pending($name);
	if {$ret != 0} {
	    append errorInfo "\n    (autoloading \"$name\")"
	    return -code $ret -errorcode $errorCode -errorinfo $errorInfo $msg
	}
	if {![array size unknown_pending]} {
	    unset unknown_pending
	}
	if {$msg} {
	    set errorCode $savedErrorCode
	    set errorInfo $savedErrorInfo
	    set code [catch {uplevel 1 $args} msg]
	    if {$code ==  1} {
		#
		# Compute stack trace contribution from the [uplevel].
		# Note the dependence on how Tcl_AddErrorInfo, etc. 
		# construct the stack trace.
		#
		set cinfo $args
		set ellipsis ""
		while {[string bytelength $cinfo] > 150} {
		    set cinfo [string range $cinfo 0 end-1]
		    set ellipsis "..."
		}
		append cinfo $ellipsis "\"\n    (\"uplevel\" body line 1)"
		append cinfo "\n    invoked from within"
		append cinfo "\n\"uplevel 1 \$args\""
		#
		# Try each possible form of the stack trace
		# and trim the extra contribution from the matching case
		#
		set expect "$msg\n    while executing\n\"$cinfo"
		if {$errorInfo eq $expect} {
		    #
		    # The stack has only the eval from the expanded command
		    # Do not generate any stack trace here.
		    #
		    return -code error -errorcode $errorCode $msg
		}
		#
		# Stack trace is nested, trim off just the contribution
		# from the extra "eval" of $args due to the "catch" above.
		#
		set expect "\n    invoked from within\n\"$cinfo"
		set exlen [string length $expect]
		set eilen [string length $errorInfo]
		set i [expr {$eilen - $exlen - 1}]
		set einfo [string range $errorInfo 0 $i]
		#
		# For now verify that $errorInfo consists of what we are about
		# to return plus what we expected to trim off.
		#
		if {$errorInfo ne "$einfo$expect"} {
		    error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
			[list CORE UNKNOWN BADTRACE $expect $errorInfo]
		}
		return -code error -errorcode $errorCode \
			-errorinfo $einfo $msg
	    } else {
		return -code $code $msg
	    }
	}
    }

    if {([info level] == 1) && [info script] eq "" \
	    && [info exists tcl_interactive] && $tcl_interactive} {
	if {![info exists auto_noexec]} {
	    set new [auto_execok $name]
	    if {$new ne ""} {
		set errorCode $savedErrorCode
		set errorInfo $savedErrorInfo
		set redir ""
		if {[namespace which -command console] eq ""} {
		    set redir ">&@stdout <@stdin"
		}
		return [uplevel 1 exec $redir $new [lrange $args 1 end]]
	    }
	}
	set errorCode $savedErrorCode
	set errorInfo $savedErrorInfo
	if {$name eq "!!"} {
	    set newcmd [history event]
	} elseif {[regexp {^!(.+)$} $name -> event]} {
	    set newcmd [history event $event]
	} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} {
	    set newcmd [history event -1]
	    catch {regsub -all -- $old $newcmd $new newcmd}
	}
	if {[info exists newcmd]} {
	    tclLog $newcmd
	    history change $newcmd 0
	    return [uplevel 1 $newcmd]
	}

	set ret [catch {set candidates [info commands $name*]} msg]
	if {$name eq "::"} {
	    set name ""
	}
	if {$ret != 0} {
	    return -code $ret -errorcode $errorCode \
		"error in unknown while checking if \"$name\" is\
		a unique command abbreviation:\n$msg"
	}
	# Handle empty $name separately due to strangeness in [string first]
	if {$name eq ""} {
	    if {[llength $candidates] != 1} {
		return -code error "empty command name \"\""
	    }
	    return [uplevel 1 [lreplace $args 0 0 [lindex $candidates 0]]]
	}
	# Filter out bogus matches when $name contained
	# a glob-special char [Bug 946952]
	set cmds [list]
	foreach x $candidates {
	    if {[string first $name $x] == 0} {
		lappend cmds $x
	    }
	}
	if {[llength $cmds] == 1} {
	    return [uplevel 1 [lreplace $args 0 0 [lindex $cmds 0]]]
	}
	if {[llength $cmds]} {
	    return -code error "ambiguous command name \"$name\": [lsort $cmds]"
	}
    }
    return -code error "invalid command name \"$name\""
}

# auto_load --
# Checks a collection of library directories to see if a procedure
# is defined in one of them.  If so, it sources the appropriate
# library file to create the procedure.  Returns 1 if it successfully
# loaded the procedure, 0 otherwise.
#
# Arguments: 
# cmd -			Name of the command to find and load.
# namespace (optional)  The namespace where the command is being used - must be
#                       a canonical namespace as returned [namespace current]
#                       for instance. If not given, namespace current is used.

proc auto_load {cmd {namespace {}}} {
    global auto_index auto_oldpath auto_path

    if {$namespace eq ""} {
	set namespace [uplevel 1 [list ::namespace current]]
    }
    set nameList [auto_qualify $cmd $namespace]
    # workaround non canonical auto_index entries that might be around
    # from older auto_mkindex versions
    lappend nameList $cmd
    foreach name $nameList {
	if {[info exists auto_index($name)]} {
	    namespace eval :: $auto_index($name)
	    # There's a couple of ways to look for a command of a given
	    # name.  One is to use
	    #    info commands $name
	    # Unfortunately, if the name has glob-magic chars in it like *
	    # or [], it may not match.  For our purposes here, a better
	    # route is to use 
	    #    namespace which -command $name
	    if {[namespace which -command $name] ne ""} {
		return 1
	    }
	}
    }
    if {![info exists auto_path]} {
	return 0
    }

    if {![auto_load_index]} {
	return 0
    }
    foreach name $nameList {
	if {[info exists auto_index($name)]} {
	    namespace eval :: $auto_index($name)
	    if {[namespace which -command $name] ne ""} {
		return 1
	    }
	}
    }
    return 0
}

# auto_load_index --
# Loads the contents of tclIndex files on the auto_path directory
# list.  This is usually invoked within auto_load to load the index
# of available commands.  Returns 1 if the index is loaded, and 0 if
# the index is already loaded and up to date.
#
# Arguments: 
# None.

proc auto_load_index {} {
    global auto_index auto_oldpath auto_path errorInfo errorCode

    if {[info exists auto_oldpath] && $auto_oldpath eq $auto_path} {
	return 0
    }
    set auto_oldpath $auto_path

    # Check if we are a safe interpreter. In that case, we support only
    # newer format tclIndex files.

    set issafe [interp issafe]
    for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
	set dir [lindex $auto_path $i]
	set f ""
	if {$issafe} {
	    catch {source [file join $dir tclIndex]}
	} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
	    continue
	} else {
	    set error [catch {
		set id [gets $f]
		if {$id eq "# Tcl autoload index file, version 2.0"} {
		    eval [read $f]
		} elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} {
		    while {[gets $f line] >= 0} {
			if {[string index $line 0] eq "#" 
				|| ([llength $line] != 2)} {
			    continue
			}
			set name [lindex $line 0]
			set auto_index($name) \
				"source [file join $dir [lindex $line 1]]"
		    }
		} else {
		    error "[file join $dir tclIndex] isn't a proper Tcl index file"
		}
	    } msg]
	    if {$f ne ""} {
		close $f
	    }
	    if {$error} {
		error $msg $errorInfo $errorCode
	    }
	}
    }
    return 1
}

# auto_qualify --
#
# Compute a fully qualified names list for use in the auto_index array.
# For historical reasons, commands in the global namespace do not have leading
# :: in the index key. The list has two elements when the command name is
# relative (no leading ::) and the namespace is not the global one. Otherwise
# only one name is returned (and searched in the auto_index).
#
# Arguments -
# cmd		The command name. Can be any name accepted for command
#               invocations (Like "foo::::bar").
# namespace	The namespace where the command is being used - must be
#               a canonical namespace as returned by [namespace current]
#               for instance.

proc auto_qualify {cmd namespace} {

    # count separators and clean them up
    # (making sure that foo:::::bar will be treated as foo::bar)
    set n [regsub -all {::+} $cmd :: cmd]

    # Ignore namespace if the name starts with ::
    # Handle special case of only leading ::

    # Before each return case we give an example of which category it is
    # with the following form :
    # ( inputCmd, inputNameSpace) -> output

    if {[string match ::* $cmd]} {
	if {$n > 1} {
	    # ( ::foo::bar , * ) -> ::foo::bar
	    return [list $cmd]
	} else {
	    # ( ::global , * ) -> global
	    return [list [string range $cmd 2 end]]
	}
    }
    
    # Potentially returning 2 elements to try  :
    # (if the current namespace is not the global one)

    if {$n == 0} {
	if {$namespace eq "::"} {
	    # ( nocolons , :: ) -> nocolons
	    return [list $cmd]
	} else {
	    # ( nocolons , ::sub ) -> ::sub::nocolons nocolons
	    return [list ${namespace}::$cmd $cmd]
	}
    } elseif {$namespace eq "::"} {
	#  ( foo::bar , :: ) -> ::foo::bar
	return [list ::$cmd]
    } else {
	# ( foo::bar , ::sub ) -> ::sub::foo::bar ::foo::bar
	return [list ${namespace}::$cmd ::$cmd]
    }
}

# auto_import --
#
# Invoked during "namespace import" to make see if the imported commands
# reside in an autoloaded library.  If so, the commands are loaded so
# that they will be available for the import links.  If not, then this
# procedure does nothing.
#
# Arguments -
# pattern	The pattern of commands being imported (like "foo::*")
#               a canonical namespace as returned by [namespace current]

proc auto_import {pattern} {
    global auto_index

    # If no namespace is specified, this will be an error case

    if {![string match *::* $pattern]} {
	return
    }

    set ns [uplevel 1 [list ::namespace current]]
    set patternList [auto_qualify $pattern $ns]

    auto_load_index

    foreach pattern $patternList {
        foreach name [array names auto_index $pattern] {
            if {([namespace which -command $name] eq "")
		    && ([namespace qualifiers $pattern] eq [namespace qualifiers $name])} {
                namespace eval :: $auto_index($name)
            }
        }
    }
}

# auto_execok --
#
# Returns string that indicates name of program to execute if 
# name corresponds to a shell builtin or an executable in the
# Windows search path, or "" otherwise.  Builds an associative 
# array auto_execs that caches information about previous checks, 
# for speed.
#
# Arguments: 
# name -			Name of a command.

if {$tcl_platform(platform) eq "windows"} {
# Windows version.
#
# Note that info executable doesn't work under Windows, so we have to
# look for files with .exe, .com, or .bat extensions.  Also, the path
# may be in the Path or PATH environment variables, and path
# components are separated with semicolons, not colons as under Unix.
#
proc auto_execok name {
    global auto_execs env tcl_platform

    if {[info exists auto_execs($name)]} {
	return $auto_execs($name)
    }
    set auto_execs($name) ""

    set shellBuiltins [list cls copy date del erase dir echo mkdir \
	    md rename ren rmdir rd time type ver vol]
    if {$tcl_platform(os) eq "Windows NT"} {
	# NT includes the 'start' built-in
	lappend shellBuiltins "start"
    }
    if {[info exists env(PATHEXT)]} {
	# Add an initial ; to have the {} extension check first.
	set execExtensions [split ";$env(PATHEXT)" ";"]
    } else {
	set execExtensions [list {} .com .exe .bat]
    }

    if {[lsearch -exact $shellBuiltins $name] != -1} {
	# When this is command.com for some reason on Win2K, Tcl won't
	# exec it unless the case is right, which this corrects.  COMSPEC
	# may not point to a real file, so do the check.
	set cmd $env(COMSPEC)
	if {[file exists $cmd]} {
	    set cmd [file attributes $cmd -shortname]
	}
	return [set auto_execs($name) [list $cmd /c $name]]
    }

    if {[llength [file split $name]] != 1} {
	foreach ext $execExtensions {
	    set file ${name}${ext}
	    if {[file exists $file] && ![file isdirectory $file]} {
		return [set auto_execs($name) [list $file]]
	    }
	}
	return ""
    }

    set path "[file dirname [info nameof]];.;"
    if {[info exists env(WINDIR)]} {
	set windir $env(WINDIR) 
    }
    if {[info exists windir]} {
	if {$tcl_platform(os) eq "Windows NT"} {
	    append path "$windir/system32;"
	}
	append path "$windir/system;$windir;"
    }

    foreach var {PATH Path path} {
	if {[info exists env($var)]} {
	    append path ";$env($var)"
	}
    }

    foreach dir [split $path {;}] {
	# Skip already checked directories
	if {[info exists checked($dir)] || $dir eq {}} { continue }
	set checked($dir) {}
	foreach ext $execExtensions {
	    set file [file join $dir ${name}${ext}]
	    if {[file exists $file] && ![file isdirectory $file]} {
		return [set auto_execs($name) [list $file]]
	    }
	}
    }
    return ""
}

} else {
# Unix version.
#
proc auto_execok name {
    global auto_execs env

    if {[info exists auto_execs($name)]} {
	return $auto_execs($name)
    }
    set auto_execs($name) ""
    if {[llength [file split $name]] != 1} {
	if {[file executable $name] && ![file isdirectory $name]} {
	    set auto_execs($name) [list $name]
	}
	return $auto_execs($name)
    }
    foreach dir [split $env(PATH) :] {
	if {$dir eq ""} {
	    set dir .
	}
	set file [file join $dir $name]
	if {[file executable $file] && ![file isdirectory $file]} {
	    set auto_execs($name) [list $file]
	    return $auto_execs($name)
	}
    }
    return ""
}

}

# ::tcl::CopyDirectory --
#
# This procedure is called by Tcl's core when attempts to call the
# filesystem's copydirectory function fail.  The semantics of the call
# are that 'dest' does not yet exist, i.e. dest should become the exact
# image of src.  If dest does exist, we throw an error.  
# 
# Note that making changes to this procedure can change the results
# of running Tcl's tests.
#
# Arguments: 
# action -              "renaming" or "copying" 
# src -			source directory
# dest -		destination directory
proc tcl::CopyDirectory {action src dest} {
    set nsrc [file normalize $src]
    set ndest [file normalize $dest]
    if {$action eq "renaming"} {
	# Can't rename volumes.  We could give a more precise
	# error message here, but that would break the test suite.
	if {[lsearch -exact [file volumes] $nsrc] != -1} {
	    return -code error "error $action \"$src\" to\
	      \"$dest\": trying to rename a volume or move a directory\
	      into itself"
	}
    }
    if {[file exists $dest]} {
	if {$nsrc eq $ndest} {
	    return -code error "error $action \"$src\" to\
	      \"$dest\": trying to rename a volume or move a directory\
	      into itself"
	}
	if {$action eq "copying"} {
	    return -code error "error $action \"$src\" to\
	      \"$dest\": file already exists"
	} else {
	    # Depending on the platform, and on the current
	    # working directory, the directories '.', '..'
	    # can be returned in various combinations.  Anyway,
	    # if any other file is returned, we must signal an error.
	    set existing [glob -nocomplain -directory $dest * .*]
	    eval [linsert \
		    [glob -nocomplain -directory $dest -type hidden * .*] 0 \
		    lappend existing]
	    foreach s $existing {
		if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
		    return -code error "error $action \"$src\" to\
		      \"$dest\": file already exists"
		}
	    }
	}
    } else {
	if {[string first $nsrc $ndest] != -1} {
	    set srclen [expr {[llength [file split $nsrc]] -1}]
	    set ndest [lindex [file split $ndest] $srclen]
	    if {$ndest eq [file tail $nsrc]} {
		return -code error "error $action \"$src\" to\
		  \"$dest\": trying to rename a volume or move a directory\
		  into itself"
	    }
	}
	file mkdir $dest
    }
    # Have to be careful to capture both visible and hidden files.
    # We will also be more generous to the file system and not
    # assume the hidden and non-hidden lists are non-overlapping.
    # 
    # On Unix 'hidden' files begin with '.'.  On other platforms
    # or filesystems hidden files may have other interpretations.
    set filelist [concat [glob -nocomplain -directory $src *] \
      [glob -nocomplain -directory $src -types hidden *]]
    
    foreach s [lsort -unique $filelist] {
	if {([file tail $s] ne ".") && ([file tail $s] ne "..")} {
	    file copy $s [file join $dest [file tail $s]]
	}
    }
    return
}

EOSEOS
  'tcl8.4/package.tcl' , <<'EOSEOS',
# package.tcl --
#
# utility procs formerly in init.tcl which can be loaded on demand
# for package management.
#
# RCS: @(#) $Id: package.tcl,v 1.23.2.3 2005/07/22 21:59:41 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# Create the package namespace
namespace eval ::pkg {
}

# pkg_compareExtension --
#
#  Used internally by pkg_mkIndex to compare the extension of a file to
#  a given extension. On Windows, it uses a case-insensitive comparison
#  because the file system can be file insensitive.
#
# Arguments:
#  fileName	name of a file whose extension is compared
#  ext		(optional) The extension to compare against; you must
#		provide the starting dot.
#		Defaults to [info sharedlibextension]
#
# Results:
#  Returns 1 if the extension matches, 0 otherwise

proc pkg_compareExtension { fileName {ext {}} } {
    global tcl_platform
    if {$ext eq ""} {set ext [info sharedlibextension]}
    if {$tcl_platform(platform) eq "windows"} {
        return [string equal -nocase [file extension $fileName] $ext]
    } else {
        # Some unices add trailing numbers after the .so, so
        # we could have something like '.so.1.2'.
        set root $fileName
        while {1} {
            set currExt [file extension $root]
            if {$currExt eq $ext} {
                return 1
            } 

	    # The current extension does not match; if it is not a numeric
	    # value, quit, as we are only looking to ignore version number
	    # extensions.  Otherwise we might return 1 in this case:
	    #		pkg_compareExtension foo.so.bar .so
	    # which should not match.

	    if { ![string is integer -strict [string range $currExt 1 end]] } {
		return 0
	    }
            set root [file rootname $root]
	}
    }
}

# pkg_mkIndex --
# This procedure creates a package index in a given directory.  The
# package index consists of a "pkgIndex.tcl" file whose contents are
# a Tcl script that sets up package information with "package require"
# commands.  The commands describe all of the packages defined by the
# files given as arguments.
#
# Arguments:
# -direct		(optional) If this flag is present, the generated
#			code in pkgMkIndex.tcl will cause the package to be
#			loaded when "package require" is executed, rather
#			than lazily when the first reference to an exported
#			procedure in the package is made.
# -verbose		(optional) Verbose output; the name of each file that
#			was successfully rocessed is printed out. Additionally,
#			if processing of a file failed a message is printed.
# -load pat		(optional) Preload any packages whose names match
#			the pattern.  Used to handle DLLs that depend on
#			other packages during their Init procedure.
# dir -			Name of the directory in which to create the index.
# args -		Any number of additional arguments, each giving
#			a glob pattern that matches the names of one or
#			more shared libraries or Tcl script files in
#			dir.

proc pkg_mkIndex {args} {
    global errorCode errorInfo
    set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"};

    set argCount [llength $args]
    if {$argCount < 1} {
	return -code error "wrong # args: should be\n$usage"
    }

    set more ""
    set direct 1
    set doVerbose 0
    set loadPat ""
    for {set idx 0} {$idx < $argCount} {incr idx} {
	set flag [lindex $args $idx]
	switch -glob -- $flag {
	    -- {
		# done with the flags
		incr idx
		break
	    }
	    -verbose {
		set doVerbose 1
	    }
	    -lazy {
		set direct 0
		append more " -lazy"
	    }
	    -direct {
		append more " -direct"
	    }
	    -load {
		incr idx
		set loadPat [lindex $args $idx]
		append more " -load $loadPat"
	    }
	    -* {
		return -code error "unknown flag $flag: should be\n$usage"
	    }
	    default {
		# done with the flags
		break
	    }
	}
    }

    set dir [lindex $args $idx]
    set patternList [lrange $args [expr {$idx + 1}] end]
    if {[llength $patternList] == 0} {
	set patternList [list "*.tcl" "*[info sharedlibextension]"]
    }

    set oldDir [pwd]
    cd $dir

    if {[catch {eval [linsert $patternList 0 glob --]} fileList]} {
	global errorCode errorInfo
	cd $oldDir
	return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
    }
    foreach file $fileList {
	# For each file, figure out what commands and packages it provides.
	# To do this, create a child interpreter, load the file into the
	# interpreter, and get a list of the new commands and packages
	# that are defined.

	if {$file eq "pkgIndex.tcl"} {
	    continue
	}

	# Changed back to the original directory before initializing the
	# slave in case TCL_LIBRARY is a relative path (e.g. in the test
	# suite). 

	cd $oldDir
	set c [interp create]

	# Load into the child any packages currently loaded in the parent
	# interpreter that match the -load pattern.

	if {$loadPat ne ""} {
	    if {$doVerbose} {
		tclLog "currently loaded packages: '[info loaded]'"
		tclLog "trying to load all packages matching $loadPat"
	    }
	    if {![llength [info loaded]]} {
		tclLog "warning: no packages are currently loaded, nothing"
		tclLog "can possibly match '$loadPat'"
	    }
	}
	foreach pkg [info loaded] {
	    if {! [string match -nocase $loadPat [lindex $pkg 1]]} {
		continue
	    }
	    if {$doVerbose} {
		tclLog "package [lindex $pkg 1] matches '$loadPat'"
	    }
	    if {[catch {
		load [lindex $pkg 0] [lindex $pkg 1] $c
	    } err]} {
		if {$doVerbose} {
		    tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
		}
	    } elseif {$doVerbose} {
		tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
	    }
	    if {[lindex $pkg 1] eq "Tk"} {
		# Withdraw . if Tk was loaded, to avoid showing a window.
		$c eval [list wm withdraw .]
	    }
	}
	cd $dir

	$c eval {
	    # Stub out the package command so packages can
	    # require other packages.

	    rename package __package_orig
	    proc package {what args} {
		switch -- $what {
		    require { return ; # ignore transitive requires }
		    default { uplevel 1 [linsert $args 0 __package_orig $what] }
		}
	    }
	    proc tclPkgUnknown args {}
	    package unknown tclPkgUnknown

	    # Stub out the unknown command so package can call
	    # into each other during their initialilzation.

	    proc unknown {args} {}

	    # Stub out the auto_import mechanism

	    proc auto_import {args} {}

	    # reserve the ::tcl namespace for support procs
	    # and temporary variables.  This might make it awkward
	    # to generate a pkgIndex.tcl file for the ::tcl namespace.

	    namespace eval ::tcl {
		variable file		;# Current file being processed
		variable direct		;# -direct flag value
		variable x		;# Loop variable
		variable debug		;# For debugging
		variable type		;# "load" or "source", for -direct
		variable namespaces	;# Existing namespaces (e.g., ::tcl)
		variable packages	;# Existing packages (e.g., Tcl)
		variable origCmds	;# Existing commands
		variable newCmds	;# Newly created commands
		variable newPkgs {}	;# Newly created packages
	    }
	}

	$c eval [list set ::tcl::file $file]
	$c eval [list set ::tcl::direct $direct]

	# Download needed procedures into the slave because we've
	# just deleted the unknown procedure.  This doesn't handle
	# procedures with default arguments.

	foreach p {pkg_compareExtension} {
	    $c eval [list proc $p [info args $p] [info body $p]]
	}

	if {[catch {
	    $c eval {
		set ::tcl::debug "loading or sourcing"

		# we need to track command defined by each package even in
		# the -direct case, because they are needed internally by
		# the "partial pkgIndex.tcl" step above.

		proc ::tcl::GetAllNamespaces {{root ::}} {
		    set list $root
		    foreach ns [namespace children $root] {
			eval [linsert [::tcl::GetAllNamespaces $ns] 0 \
				lappend list]
		    }
		    return $list
		}

		# init the list of existing namespaces, packages, commands

		foreach ::tcl::x [::tcl::GetAllNamespaces] {
		    set ::tcl::namespaces($::tcl::x) 1
		}
		foreach ::tcl::x [package names] {
		    if {[package provide $::tcl::x] ne ""} {
			set ::tcl::packages($::tcl::x) 1
		    }
		}
		set ::tcl::origCmds [info commands]

		# Try to load the file if it has the shared library
		# extension, otherwise source it.  It's important not to
		# try to load files that aren't shared libraries, because
		# on some systems (like SunOS) the loader will abort the
		# whole application when it gets an error.

		if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {
		    # The "file join ." command below is necessary.
		    # Without it, if the file name has no \'s and we're
		    # on UNIX, the load command will invoke the
		    # LD_LIBRARY_PATH search mechanism, which could cause
		    # the wrong file to be used.

		    set ::tcl::debug loading
		    load [file join . $::tcl::file]
		    set ::tcl::type load
		} else {
		    set ::tcl::debug sourcing
		    source $::tcl::file
		    set ::tcl::type source
		}

		# As a performance optimization, if we are creating 
		# direct load packages, don't bother figuring out the 
		# set of commands created by the new packages.  We 
		# only need that list for setting up the autoloading 
		# used in the non-direct case.
		if { !$::tcl::direct } {
		    # See what new namespaces appeared, and import commands
		    # from them.  Only exported commands go into the index.
		    
		    foreach ::tcl::x [::tcl::GetAllNamespaces] {
			if {! [info exists ::tcl::namespaces($::tcl::x)]} {
			    namespace import -force ${::tcl::x}::*
			}

			# Figure out what commands appeared
			
			foreach ::tcl::x [info commands] {
			    set ::tcl::newCmds($::tcl::x) 1
			}
			foreach ::tcl::x $::tcl::origCmds {
			    unset -nocomplain ::tcl::newCmds($::tcl::x)
			}
			foreach ::tcl::x [array names ::tcl::newCmds] {
			    # determine which namespace a command comes from
			    
			    set ::tcl::abs [namespace origin $::tcl::x]
			    
			    # special case so that global names have no leading
			    # ::, this is required by the unknown command
			    
			    set ::tcl::abs \
				    [lindex [auto_qualify $::tcl::abs ::] 0]
			    
			    if {$::tcl::x ne $::tcl::abs} {
				# Name changed during qualification
				
				set ::tcl::newCmds($::tcl::abs) 1
				unset ::tcl::newCmds($::tcl::x)
			    }
			}
		    }
		}

		# Look through the packages that appeared, and if there is
		# a version provided, then record it

		foreach ::tcl::x [package names] {
		    if {[package provide $::tcl::x] ne ""
			    && ![info exists ::tcl::packages($::tcl::x)]} {
			lappend ::tcl::newPkgs \
			    [list $::tcl::x [package provide $::tcl::x]]
		    }
		}
	    }
	} msg] == 1} {
	    set what [$c eval set ::tcl::debug]
	    if {$doVerbose} {
		tclLog "warning: error while $what $file: $msg"
	    }
	} else {
	    set what [$c eval set ::tcl::debug]
	    if {$doVerbose} {
		tclLog "successful $what of $file"
	    }
	    set type [$c eval set ::tcl::type]
	    set cmds [lsort [$c eval array names ::tcl::newCmds]]
	    set pkgs [$c eval set ::tcl::newPkgs]
	    if {$doVerbose} {
		if { !$direct } {
		    tclLog "commands provided were $cmds"
		}
		tclLog "packages provided were $pkgs"
	    }
	    if {[llength $pkgs] > 1} {
		tclLog "warning: \"$file\" provides more than one package ($pkgs)"
	    }
	    foreach pkg $pkgs {
		# cmds is empty/not used in the direct case
		lappend files($pkg) [list $file $type $cmds]
	    }

	    if {$doVerbose} {
		tclLog "processed $file"
	    }
	}
	interp delete $c
    }

    append index "# Tcl package index file, version 1.1\n"
    append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
    append index "# and sourced either when an application starts up or\n"
    append index "# by a \"package unknown\" script.  It invokes the\n"
    append index "# \"package ifneeded\" command to set up package-related\n"
    append index "# information so that packages will be loaded automatically\n"
    append index "# in response to \"package require\" commands.  When this\n"
    append index "# script is sourced, the variable \$dir must contain the\n"
    append index "# full path name of this file's directory.\n"

    foreach pkg [lsort [array names files]] {
	set cmd {}
	foreach {name version} $pkg {
	    break
	}
	lappend cmd ::pkg::create -name $name -version $version
	foreach spec $files($pkg) {
	    foreach {file type procs} $spec {
		if { $direct } {
		    set procs {}
		}
		lappend cmd "-$type" [list $file $procs]
	    }
	}
	append index "\n[eval $cmd]"
    }

    set f [open pkgIndex.tcl w]
    puts $f $index
    close $f
    cd $oldDir
}

# tclPkgSetup --
# This is a utility procedure use by pkgIndex.tcl files.  It is invoked
# as part of a "package ifneeded" script.  It calls "package provide"
# to indicate that a package is available, then sets entries in the
# auto_index array so that the package's files will be auto-loaded when
# the commands are used.
#
# Arguments:
# dir -			Directory containing all the files for this package.
# pkg -			Name of the package (no version number).
# version -		Version number for the package, such as 2.1.3.
# files -		List of files that constitute the package.  Each
#			element is a sub-list with three elements.  The first
#			is the name of a file relative to $dir, the second is
#			"load" or "source", indicating whether the file is a
#			loadable binary or a script to source, and the third
#			is a list of commands defined by this file.

proc tclPkgSetup {dir pkg version files} {
    global auto_index

    package provide $pkg $version
    foreach fileInfo $files {
	set f [lindex $fileInfo 0]
	set type [lindex $fileInfo 1]
	foreach cmd [lindex $fileInfo 2] {
	    if {$type eq "load"} {
		set auto_index($cmd) [list load [file join $dir $f] $pkg]
	    } else {
		set auto_index($cmd) [list source [file join $dir $f]]
	    } 
	}
    }
}

# tclPkgUnknown --
# This procedure provides the default for the "package unknown" function.
# It is invoked when a package that's needed can't be found.  It scans
# the auto_path directories and their immediate children looking for
# pkgIndex.tcl files and sources any such files that are found to setup
# the package database.  (On the Macintosh we also search for pkgIndex
# TEXT resources in all files.)  As it searches, it will recognize changes
# to the auto_path and scan any new directories.
#
# Arguments:
# name -		Name of desired package.  Not used.
# version -		Version of desired package.  Not used.
# exact -		Either "-exact" or omitted.  Not used.

proc tclPkgUnknown {name version {exact {}}} {
    global auto_path env

    if {![info exists auto_path]} {
	return
    }
    # Cache the auto_path, because it may change while we run through
    # the first set of pkgIndex.tcl files
    set old_path [set use_path $auto_path]
    while {[llength $use_path]} {
	set dir [lindex $use_path end]
	
	# Make sure we only scan each directory one time.
	if {[info exists tclSeenPath($dir)]} {
	    set use_path [lrange $use_path 0 end-1]
	    continue
	}
	set tclSeenPath($dir) 1

	# we can't use glob in safe interps, so enclose the following
	# in a catch statement, where we get the pkgIndex files out
	# of the subdirectories
	catch {
	    foreach file [glob -directory $dir -join -nocomplain \
		    * pkgIndex.tcl] {
		set dir [file dirname $file]
		if {![info exists procdDirs($dir)] && [file readable $file]} {
		    if {[catch {source $file} msg]} {
			tclLog "error reading package index file $file: $msg"
		    } else {
			set procdDirs($dir) 1
		    }
		}
	    }
	}
	set dir [lindex $use_path end]
	if {![info exists procdDirs($dir)]} {
	    set file [file join $dir pkgIndex.tcl]
	    # safe interps usually don't have "file readable", 
	    # nor stderr channel
	    if {([interp issafe] || [file readable $file])} {
		if {[catch {source $file} msg] && ![interp issafe]}  {
		    tclLog "error reading package index file $file: $msg"
		} else {
		    set procdDirs($dir) 1
		}
	    }
	}

	set use_path [lrange $use_path 0 end-1]

	# Check whether any of the index scripts we [source]d above
	# set a new value for $::auto_path.  If so, then find any
	# new directories on the $::auto_path, and lappend them to
	# the $use_path we are working from.  This gives index scripts
	# the (arguably unwise) power to expand the index script search
	# path while the search is in progress.
	set index 0
	if {[llength $old_path] == [llength $auto_path]} {
	    foreach dir $auto_path old $old_path {
		if {$dir ne $old} {
		    # This entry in $::auto_path has changed.
		    break
		}
		incr index
	    }
	}

	# $index now points to the first element of $auto_path that
	# has changed, or the beginning if $auto_path has changed length
	# Scan the new elements of $auto_path for directories to add to
	# $use_path.  Don't add directories we've already seen, or ones
	# already on the $use_path.
	foreach dir [lrange $auto_path $index end] {
	    if {![info exists tclSeenPath($dir)] 
		    && ([lsearch -exact $use_path $dir] == -1) } {
		lappend use_path $dir
	    }
	}
	set old_path $auto_path
    }
}

# tcl::MacOSXPkgUnknown --
# This procedure extends the "package unknown" function for MacOSX.
# It scans the Resources/Scripts directories of the immediate children
# of the auto_path directories for pkgIndex files.
# Only installed in interps that are not safe so we don't check
# for [interp issafe] as in tclPkgUnknown.
#
# Arguments:
# original -		original [package unknown] procedure
# name -		Name of desired package.  Not used.
# version -		Version of desired package.  Not used.
# exact -		Either "-exact" or omitted.  Not used.

proc tcl::MacOSXPkgUnknown {original name version {exact {}}} {

    #  First do the cross-platform default search
    uplevel 1 $original [list $name $version $exact]

    # Now do MacOSX specific searching
    global auto_path

    if {![info exists auto_path]} {
	return
    }
    # Cache the auto_path, because it may change while we run through
    # the first set of pkgIndex.tcl files
    set old_path [set use_path $auto_path]
    while {[llength $use_path]} {
	set dir [lindex $use_path end]
	# get the pkgIndex files out of the subdirectories
	foreach file [glob -directory $dir -join -nocomplain \
		* Resources Scripts pkgIndex.tcl] {
	    set dir [file dirname $file]
	    if {[file readable $file] && ![info exists procdDirs($dir)]} {
		if {[catch {source $file} msg]} {
		    tclLog "error reading package index file $file: $msg"
		} else {
		    set procdDirs($dir) 1
		}
	    }
	}
	set use_path [lrange $use_path 0 end-1]
	if {$old_path ne $auto_path} {
	    foreach dir $auto_path {
		lappend use_path $dir
	    }
	    set old_path $auto_path
	}
    }
}

# tcl::MacPkgUnknown --
# This procedure extends the "package unknown" function for Mac.
# It searches for pkgIndex TEXT resources in all files
# Only installed in interps that are not safe so we don't check
# for [interp issafe] as in tclPkgUnknown.
#
# Arguments:
# original -		original [package unknown] procedure
# name -		Name of desired package.  Not used.
# version -		Version of desired package.  Not used.
# exact -		Either "-exact" or omitted.  Not used.

proc tcl::MacPkgUnknown {original name version {exact {}}} {

    #  First do the cross-platform default search
    uplevel 1 $original [list $name $version $exact]

    # Now do Mac specific searching
    global auto_path

    if {![info exists auto_path]} {
	return
    }
    # Cache the auto_path, because it may change while we run through
    # the first set of pkgIndex.tcl files
    set old_path [set use_path $auto_path]
    while {[llength $use_path]} {
	# We look for pkgIndex TEXT resources in the resource fork of shared libraries
	set dir [lindex $use_path end]
	foreach x [concat [list $dir] [glob -directory $dir -nocomplain *] ] {
	    if {[file isdirectory $x] && ![info exists procdDirs($x)]} {
		set dir $x
		foreach x [glob -directory $dir -nocomplain *.shlb] {
		    if {[file isfile $x]} {
			set res [resource open $x]
			foreach y [resource list TEXT $res] {
			    if {$y eq "pkgIndex"} {source -rsrc pkgIndex}
			}
			catch {resource close $res}
		    }
		}
		set procdDirs($dir) 1
	    }
	}
	set use_path [lrange $use_path 0 end-1]
	if {$old_path ne $auto_path} {
	    foreach dir $auto_path {
		lappend use_path $dir
	    }
	    set old_path $auto_path
	}
    }
}

# ::pkg::create --
#
#	Given a package specification generate a "package ifneeded" statement
#	for the package, suitable for inclusion in a pkgIndex.tcl file.
#
# Arguments:
#	args		arguments used by the create function:
#			-name		packageName
#			-version	packageVersion
#			-load		{filename ?{procs}?}
#			...
#			-source		{filename ?{procs}?}
#			...
#
#			Any number of -load and -source parameters may be
#			specified, so long as there is at least one -load or
#			-source parameter.  If the procs component of a 
#			module specifier is left off, that module will be
#			set up for direct loading; otherwise, it will be
#			set up for lazy loading.  If both -source and -load
#			are specified, the -load'ed files will be loaded 
#			first, followed by the -source'd files.
#
# Results:
#	An appropriate "package ifneeded" statement for the package.

proc ::pkg::create {args} {
    append err(usage) "[lindex [info level 0] 0] "
    append err(usage) "-name packageName -version packageVersion"
    append err(usage) "?-load {filename ?{procs}?}? ... "
    append err(usage) "?-source {filename ?{procs}?}? ..."

    set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
    set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
    set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""
    set err(noLoadOrSource) "at least one of -load and -source must be given"

    # process arguments
    set len [llength $args]
    if { $len < 6 } {
	error $err(wrongNumArgs)
    }
    
    # Initialize parameters
    set opts(-name)		{}
    set opts(-version)		{}
    set opts(-source)		{}
    set opts(-load)		{}

    # process parameters
    for {set i 0} {$i < $len} {incr i} {
	set flag [lindex $args $i]
	incr i
	switch -glob -- $flag {
	    "-name"		-
	    "-version"		{
		if { $i >= $len } {
		    error [format $err(valueMissing) $flag]
		}
		set opts($flag) [lindex $args $i]
	    }
	    "-source"		-
	    "-load"		{
		if { $i >= $len } {
		    error [format $err(valueMissing) $flag]
		}
		lappend opts($flag) [lindex $args $i]
	    }
	    default {
		error [format $err(unknownOpt) [lindex $args $i]]
	    }
	}
    }

    # Validate the parameters
    if { [llength $opts(-name)] == 0 } {
	error [format $err(valueMissing) "-name"]
    }
    if { [llength $opts(-version)] == 0 } {
	error [format $err(valueMissing) "-version"]
    }
    
    if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {
	error $err(noLoadOrSource)
    }

    # OK, now everything is good.  Generate the package ifneeded statment.
    set cmdline "package ifneeded $opts(-name) $opts(-version) "
    
    set cmdList {}
    set lazyFileList {}

    # Handle -load and -source specs
    foreach key {load source} {
	foreach filespec $opts(-$key) {
	    foreach {filename proclist} {{} {}} {
		break
	    }
	    foreach {filename proclist} $filespec {
		break
	    }
	    
	    if { [llength $proclist] == 0 } {
		set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
		lappend cmdList $cmd
	    } else {
		lappend lazyFileList [list $filename $key $proclist]
	    }
	}
    }

    if { [llength $lazyFileList] > 0 } {
	lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
		$opts(-version) [list $lazyFileList]\]"
    }
    append cmdline [join $cmdList "\\n"]
    return $cmdline
}


EOSEOS
  'tcl8.4/auto.tcl' , <<'EOSEOS',
# auto.tcl --
#
# utility procs formerly in init.tcl dealing with auto execution
# of commands and can be auto loaded themselves.
#
# RCS: @(#) $Id: auto.tcl,v 1.12.2.10 2005/07/23 03:31:41 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# auto_reset --
#
# Destroy all cached information for auto-loading and auto-execution,
# so that the information gets recomputed the next time it's needed.
# Also delete any procedures that are listed in the auto-load index
# except those defined in this file.
#
# Arguments: 
# None.

proc auto_reset {} {
    global auto_execs auto_index auto_oldpath
    foreach p [info procs] {
	if {[info exists auto_index($p)] && ![string match auto_* $p]
		&& ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
			tcl_findLibrary pkg_compareExtension
			tclPkgUnknown tcl::MacOSXPkgUnknown
			tcl::MacPkgUnknown} $p] < 0)} {
	    rename $p {}
	}
    }
    unset -nocomplain auto_execs auto_index auto_oldpath
}

# tcl_findLibrary --
#
#	This is a utility for extensions that searches for a library directory
#	using a canonical searching algorithm. A side effect is to source
#	the initialization script and set a global library variable.
#
# Arguments:
# 	basename	Prefix of the directory name, (e.g., "tk")
#	version		Version number of the package, (e.g., "8.0")
#	patch		Patchlevel of the package, (e.g., "8.0.3")
#	initScript	Initialization script to source (e.g., tk.tcl)
#	enVarName	environment variable to honor (e.g., TK_LIBRARY)
#	varName		Global variable to set when done (e.g., tk_library)

proc tcl_findLibrary {basename version patch initScript enVarName varName} {
    upvar #0 $varName the_library
    global env errorInfo

    set dirs {}
    set errors {}

    # The C application may have hardwired a path, which we honor

    if {[info exists the_library] && $the_library ne ""} {
	lappend dirs $the_library
    } else {

	# Do the canonical search

	# 1. From an environment variable, if it exists.
	#    Placing this first gives the end-user ultimate control
	#    to work-around any bugs, or to customize.

        if {[info exists env($enVarName)]} {
            lappend dirs $env($enVarName)
        }

	# 2. In the package script directory registered within
	#    the configuration of the package itself.
	#
	# Only do this for Tcl 8.5+, when Tcl_RegsiterConfig() is available.
	#if {[catch {
	#    ::${basename}::pkgconfig get scriptdir,runtime
	#} value] == 0} {
	#    lappend dirs $value
	#}

	# 3. Relative to auto_path directories.  This checks relative to the
	# Tcl library as well as allowing loading of libraries added to the
	# auto_path that is not relative to the core library or binary paths.
	foreach d $::auto_path {
	    lappend dirs [file join $d $basename$version]
	    if {$::tcl_platform(platform) eq "unix"
		&& $::tcl_platform(os) eq "Darwin"} {
		# 4. On MacOSX, check the Resources/Scripts subdir too
		lappend dirs [file join $d $basename$version Resources Scripts]
	    }
	}

	# 3. Various locations relative to the executable
	# ../lib/foo1.0		(From bin directory in install hierarchy)
	# ../../lib/foo1.0	(From bin/arch directory in install hierarchy)
	# ../library		(From unix directory in build hierarchy)
        set parentDir [file dirname [file dirname [info nameofexecutable]]]
        set grandParentDir [file dirname $parentDir]
        lappend dirs [file join $parentDir lib $basename$version]
        lappend dirs [file join $grandParentDir lib $basename$version]
        lappend dirs [file join $parentDir library]

	# Remaining locations are out of date (when relevant, they ought
	# to be covered by the $::auto_path seach above).
	#
	# ../../library		(From unix/arch directory in build hierarchy)
	# ../../foo1.0.1/library
	#		(From unix directory in parallel build hierarchy)
	# ../../../foo1.0.1/library
	#		(From unix/arch directory in parallel build hierarchy)
	#
	# For the sake of extra compatibility safety, we keep adding these
	# paths during the 8.4.* release series.
	if {1} {
	    lappend dirs [file join $grandParentDir library]
	    lappend dirs [file join $grandParentDir $basename$patch library]
	    lappend dirs [file join [file dirname $grandParentDir] \
			      $basename$patch library]
	}
    }
    # uniquify $dirs in order
    array set seen {}
    foreach i $dirs {
	# For Tcl 8.4.9, we've disabled the use of [file normalize] here.
	# This means that two different path names that are the same path
	# in normalized form, will both remain on the search path.  There
	# should be no harm in that, just a bit more file system access
	# than is strictly necessary.
	#
	# [file normalize] has been disabled because of reports it has
	# caused difficulties with the freewrap utility.  To keep
	# compatibility with freewrap's needs, we'll keep this disabled
	# throughout the 8.4.x (x >= 9) releases.  See Bug 1072136.
	if {1 || [interp issafe]} {
	    set norm $i
	} else {
	    set norm [file normalize $i]
	}
	if {[info exists seen($norm)]} { continue }
	set seen($norm) ""
	lappend uniqdirs $i
    }
    set dirs $uniqdirs
    foreach i $dirs {
        set the_library $i
        set file [file join $i $initScript]

	# source everything when in a safe interpreter because
	# we have a source command, but no file exists command

        if {[interp issafe] || [file exists $file]} {
            if {![catch {uplevel #0 [list source $file]} msg]} {
                return
            } else {
                append errors "$file: $msg\n$errorInfo\n"
            }
        }
    }
    unset -nocomplain the_library
    set msg "Can't find a usable $initScript in the following directories: \n"
    append msg "    $dirs\n\n"
    append msg "$errors\n\n"
    append msg "This probably means that $basename wasn't installed properly.\n"
    error $msg
}


# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
# The following procedures are used to generate the tclIndex file
# from Tcl source files.  They use a special safe interpreter to
# parse Tcl source files, writing out index entries as "proc"
# commands are encountered.  This implementation won't work in a
# safe interpreter, since a safe interpreter can't create the
# special parser and mess with its commands.  

if {[interp issafe]} {
    return	;# Stop sourcing the file here
}

# auto_mkindex --
# Regenerate a tclIndex file from Tcl source files.  Takes as argument
# the name of the directory in which the tclIndex file is to be placed,
# followed by any number of glob patterns to use in that directory to
# locate all of the relevant files.
#
# Arguments: 
# dir -		Name of the directory in which to create an index.
# args -	Any number of additional arguments giving the
#		names of files within dir.  If no additional
#		are given auto_mkindex will look for *.tcl.

proc auto_mkindex {dir args} {
    global errorCode errorInfo

    if {[interp issafe]} {
        error "can't generate index within safe interpreter"
    }

    set oldDir [pwd]
    cd $dir
    set dir [pwd]

    append index "# Tcl autoload index file, version 2.0\n"
    append index "# This file is generated by the \"auto_mkindex\" command\n"
    append index "# and sourced to set up indexing information for one or\n"
    append index "# more commands.  Typically each line is a command that\n"
    append index "# sets an element in the auto_index array, where the\n"
    append index "# element name is the name of a command and the value is\n"
    append index "# a script that loads the command.\n\n"
    if {[llength $args] == 0} {
	set args *.tcl
    }

    auto_mkindex_parser::init
    foreach file [eval [linsert $args 0 glob --]] {
        if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
            append index $msg
        } else {
            set code $errorCode
            set info $errorInfo
            cd $oldDir
            error $msg $info $code
        }
    }
    auto_mkindex_parser::cleanup

    set fid [open "tclIndex" w]
    puts -nonewline $fid $index
    close $fid
    cd $oldDir
}

# Original version of auto_mkindex that just searches the source
# code for "proc" at the beginning of the line.

proc auto_mkindex_old {dir args} {
    global errorCode errorInfo
    set oldDir [pwd]
    cd $dir
    set dir [pwd]
    append index "# Tcl autoload index file, version 2.0\n"
    append index "# This file is generated by the \"auto_mkindex\" command\n"
    append index "# and sourced to set up indexing information for one or\n"
    append index "# more commands.  Typically each line is a command that\n"
    append index "# sets an element in the auto_index array, where the\n"
    append index "# element name is the name of a command and the value is\n"
    append index "# a script that loads the command.\n\n"
    if {[llength $args] == 0} {
	set args *.tcl
    }
    foreach file [eval [linsert $args 0 glob --]] {
	set f ""
	set error [catch {
	    set f [open $file]
	    while {[gets $f line] >= 0} {
		if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
		    set procName [lindex [auto_qualify $procName "::"] 0]
		    append index "set [list auto_index($procName)]"
		    append index " \[list source \[file join \$dir [list $file]\]\]\n"
		}
	    }
	    close $f
	} msg]
	if {$error} {
	    set code $errorCode
	    set info $errorInfo
	    catch {close $f}
	    cd $oldDir
	    error $msg $info $code
	}
    }
    set f ""
    set error [catch {
	set f [open tclIndex w]
	puts -nonewline $f $index
	close $f
	cd $oldDir
    } msg]
    if {$error} {
	set code $errorCode
	set info $errorInfo
	catch {close $f}
	cd $oldDir
	error $msg $info $code
    }
}

# Create a safe interpreter that can be used to parse Tcl source files
# generate a tclIndex file for autoloading.  This interp contains
# commands for things that need index entries.  Each time a command
# is executed, it writes an entry out to the index file.

namespace eval auto_mkindex_parser {
    variable parser ""          ;# parser used to build index
    variable index ""           ;# maintains index as it is built
    variable scriptFile ""      ;# name of file being processed
    variable contextStack ""    ;# stack of namespace scopes
    variable imports ""         ;# keeps track of all imported cmds
    variable initCommands ""    ;# list of commands that create aliases

    proc init {} {
	variable parser
	variable initCommands

	if {![interp issafe]} {
	    set parser [interp create -safe]
	    $parser hide info
	    $parser hide rename
	    $parser hide proc
	    $parser hide namespace
	    $parser hide eval
	    $parser hide puts
	    $parser invokehidden namespace delete ::
	    $parser invokehidden proc unknown {args} {}

	    # We'll need access to the "namespace" command within the
	    # interp.  Put it back, but move it out of the way.

	    $parser expose namespace
	    $parser invokehidden rename namespace _%@namespace
	    $parser expose eval
	    $parser invokehidden rename eval _%@eval

	    # Install all the registered psuedo-command implementations

	    foreach cmd $initCommands {
		eval $cmd
	    }
	}
    }
    proc cleanup {} {
	variable parser
	interp delete $parser
	unset parser
    }
}

# auto_mkindex_parser::mkindex --
#
# Used by the "auto_mkindex" command to create a "tclIndex" file for
# the given Tcl source file.  Executes the commands in the file, and
# handles things like the "proc" command by adding an entry for the
# index file.  Returns a string that represents the index file.
#
# Arguments: 
#	file	Name of Tcl source file to be indexed.

proc auto_mkindex_parser::mkindex {file} {
    variable parser
    variable index
    variable scriptFile
    variable contextStack
    variable imports

    set scriptFile $file

    set fid [open $file]
    set contents [read $fid]
    close $fid

    # There is one problem with sourcing files into the safe
    # interpreter:  references like "$x" will fail since code is not
    # really being executed and variables do not really exist.
    # To avoid this, we replace all $ with \0 (literally, the null char)
    # later, when getting proc names we will have to reverse this replacement,
    # in case there were any $ in the proc name.  This will cause a problem
    # if somebody actually tries to have a \0 in their proc name.  Too bad
    # for them.
    set contents [string map "$ \u0000" $contents]
    
    set index ""
    set contextStack ""
    set imports ""

    $parser eval $contents

    foreach name $imports {
        catch {$parser eval [list _%@namespace forget $name]}
    }
    return $index
}

# auto_mkindex_parser::hook command
#
# Registers a Tcl command to evaluate when initializing the
# slave interpreter used by the mkindex parser.
# The command is evaluated in the master interpreter, and can
# use the variable auto_mkindex_parser::parser to get to the slave

proc auto_mkindex_parser::hook {cmd} {
    variable initCommands

    lappend initCommands $cmd
}

# auto_mkindex_parser::slavehook command
#
# Registers a Tcl command to evaluate when initializing the
# slave interpreter used by the mkindex parser.
# The command is evaluated in the slave interpreter.

proc auto_mkindex_parser::slavehook {cmd} {
    variable initCommands

    # The $parser variable is defined to be the name of the
    # slave interpreter when this command is used later.

    lappend initCommands "\$parser eval [list $cmd]"
}

# auto_mkindex_parser::command --
#
# Registers a new command with the "auto_mkindex_parser" interpreter
# that parses Tcl files.  These commands are fake versions of things
# like the "proc" command.  When you execute them, they simply write
# out an entry to a "tclIndex" file for auto-loading.
#
# This procedure allows extensions to register their own commands
# with the auto_mkindex facility.  For example, a package like
# [incr Tcl] might register a "class" command so that class definitions
# could be added to a "tclIndex" file for auto-loading.
#
# Arguments:
#	name 	Name of command recognized in Tcl files.
#	arglist	Argument list for command.
#	body 	Implementation of command to handle indexing.

proc auto_mkindex_parser::command {name arglist body} {
    hook [list auto_mkindex_parser::commandInit $name $arglist $body]
}

# auto_mkindex_parser::commandInit --
#
# This does the actual work set up by auto_mkindex_parser::command
# This is called when the interpreter used by the parser is created.
#
# Arguments:
#	name 	Name of command recognized in Tcl files.
#	arglist	Argument list for command.
#	body 	Implementation of command to handle indexing.

proc auto_mkindex_parser::commandInit {name arglist body} {
    variable parser

    set ns [namespace qualifiers $name]
    set tail [namespace tail $name]
    if {$ns eq ""} {
        set fakeName [namespace current]::_%@fake_$tail
    } else {
        set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
    }
    proc $fakeName $arglist $body

    # YUK!  Tcl won't let us alias fully qualified command names,
    # so we can't handle names like "::itcl::class".  Instead,
    # we have to build procs with the fully qualified names, and
    # have the procs point to the aliases.

    if {[string match *::* $name]} {
        set exportCmd [list _%@namespace export [namespace tail $name]]
        $parser eval [list _%@namespace eval $ns $exportCmd]
 
	# The following proc definition does not work if you
	# want to tolerate space or something else diabolical
	# in the procedure name, (i.e., space in $alias)
	# The following does not work:
	#   "_%@eval {$alias} \$args"
	# because $alias gets concat'ed to $args.
	# The following does not work because $cmd is somehow undefined
	#   "set cmd {$alias} \; _%@eval {\$cmd} \$args"
	# A gold star to someone that can make test
	# autoMkindex-3.3 work properly

        set alias [namespace tail $fakeName]
        $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
        $parser alias $alias $fakeName
    } else {
        $parser alias $name $fakeName
    }
    return
}

# auto_mkindex_parser::fullname --
# Used by commands like "proc" within the auto_mkindex parser.
# Returns the qualified namespace name for the "name" argument.
# If the "name" does not start with "::", elements are added from
# the current namespace stack to produce a qualified name.  Then,
# the name is examined to see whether or not it should really be
# qualified.  If the name has more than the leading "::", it is
# returned as a fully qualified name.  Otherwise, it is returned
# as a simple name.  That way, the Tcl autoloader will recognize
# it properly.
#
# Arguments:
# name -		Name that is being added to index.

proc auto_mkindex_parser::fullname {name} {
    variable contextStack

    if {![string match ::* $name]} {
        foreach ns $contextStack {
            set name "${ns}::$name"
            if {[string match ::* $name]} {
                break
            }
        }
    }

    if {[namespace qualifiers $name] eq ""} {
        set name [namespace tail $name]
    } elseif {![string match ::* $name]} {
        set name "::$name"
    }
    
    # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse
    # that replacement.
    return [string map "\u0000 $" $name]
}

# Register all of the procedures for the auto_mkindex parser that
# will build the "tclIndex" file.

# AUTO MKINDEX:  proc name arglist body
# Adds an entry to the auto index list for the given procedure name.

auto_mkindex_parser::command proc {name args} {
    variable index
    variable scriptFile
    # Do some fancy reformatting on the "source" call to handle platform
    # differences with respect to pathnames.  Use format just so that the
    # command is a little easier to read (otherwise it'd be full of 
    # backslashed dollar signs, etc.
    append index [list set auto_index([fullname $name])] \
	    [format { [list source [file join $dir %s]]} \
	    [file split $scriptFile]] "\n"
}

# Conditionally add support for Tcl byte code files.  There are some
# tricky details here.  First, we need to get the tbcload library
# initialized in the current interpreter.  We cannot load tbcload into the
# slave until we have done so because it needs access to the tcl_patchLevel
# variable.  Second, because the package index file may defer loading the
# library until we invoke a command, we need to explicitly invoke auto_load
# to force it to be loaded.  This should be a noop if the package has
# already been loaded

auto_mkindex_parser::hook {
    if {![catch {package require tbcload}]} {
	if {[namespace which -command tbcload::bcproc] eq ""} {
	    auto_load tbcload::bcproc
	}
	load {} tbcload $auto_mkindex_parser::parser

	# AUTO MKINDEX:  tbcload::bcproc name arglist body
	# Adds an entry to the auto index list for the given pre-compiled
	# procedure name.  

	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
	    variable index
	    variable scriptFile
	    # Do some nice reformatting of the "source" call, to get around
	    # path differences on different platforms.  We use the format
	    # command just so that the code is a little easier to read.
	    append index [list set auto_index([fullname $name])] \
		    [format { [list source [file join $dir %s]]} \
		    [file split $scriptFile]] "\n"
	}
    }
}

# AUTO MKINDEX:  namespace eval name command ?arg arg...?
# Adds the namespace name onto the context stack and evaluates the
# associated body of commands.
#
# AUTO MKINDEX:  namespace import ?-force? pattern ?pattern...?
# Performs the "import" action in the parser interpreter.  This is
# important for any commands contained in a namespace that affect
# the index.  For example, a script may say "itcl::class ...",
# or it may import "itcl::*" and then say "class ...".  This
# procedure does the import operation, but keeps track of imported
# patterns so we can remove the imports later.

auto_mkindex_parser::command namespace {op args} {
    switch -- $op {
        eval {
            variable parser
            variable contextStack

            set name [lindex $args 0]
            set args [lrange $args 1 end]

            set contextStack [linsert $contextStack 0 $name]
	    $parser eval [list _%@namespace eval $name] $args
            set contextStack [lrange $contextStack 1 end]
        }
        import {
            variable parser
            variable imports
            foreach pattern $args {
                if {$pattern ne "-force"} {
                    lappend imports $pattern
                }
            }
            catch {$parser eval "_%@namespace import $args"}
        }
    }
}

return

EOSEOS
  'vfs1.3/vfslib.tcl' , <<'EOSEOS',
# Remnants of what used to be VFS init, this is TclKit-specific

package require Tcl 8.4; # vfs is all new for 8.4
package provide vfslib 1.3.1

namespace eval ::vfs {

    variable zseq 0	;# used to generate temp zstream cmd names

    # for backwards compatibility
    proc normalize {path} { ::file normalize $path }

    # use zlib to define zip and crc if available
    if {[info command zlib] != "" || ![catch {load "" zlib}]} {

	proc zip {flag value args} {
	    switch -glob -- "$flag $value" {
		{-mode d*} { set mode decompress }
		{-mode c*} { set mode compress }
		default { error "usage: zip -mode {compress|decompress} data" }
	    }
	    # kludge to allow "-nowrap 1" as second option, 5-9-2002
	    if {[llength $args] > 2 && [lrange $args 0 1] == "-nowrap 1"} {
		if {$mode == "compress"} {
		    set mode deflate
		} else {
		    set mode inflate
		}
	    }
	    return [zlib $mode [lindex $args end]]
	}

	proc crc {data} {
	    return [zlib crc32 $data]
	}
    }

    # use rechan to define memchan and zstream if available
    if {[info command rechan] != "" || ![catch {load "" rechan}]} {

	proc memchan_handler {cmd fd args} {
	    upvar ::vfs::_memchan_buf($fd) buf
	    upvar ::vfs::_memchan_pos($fd) pos
	    set arg1 [lindex $args 0]

	    switch -- $cmd {
		seek {
		    switch [lindex $args 1] {
			1 - current { incr arg1 $pos }
			2 - end { incr arg1 [string length $buf]}
		    }
		    return [set pos $arg1]
		}
		read {
		    set r [string range $buf $pos [expr { $pos + $arg1 - 1 }]]
		    incr pos [string length $r]
		    return $r
		}
		write {
		    set n [string length $arg1]
		    if { $pos >= [string length $buf] } {
			append buf $arg1
		    } else { # the following doesn't work yet :(
			set last [expr { $pos + $n - 1 }]
			set buf [string replace $buf $pos $last $arg1]
			error "vfs memchan: sorry no inline write yet"
		    }
		    incr pos $n
		    return $n
		}
		close {
		    unset buf pos
		}
		default { error "bad cmd in memchan_handler: $cmd" }
	    }
	}
	
	proc memchan {} {
	    set fd [rechan ::vfs::memchan_handler 6]
	    set ::vfs::_memchan_buf($fd) ""
	    set ::vfs::_memchan_pos($fd) 0
	    return $fd
	}

	proc zstream_handler {zcmd ifd clen ilen imode cmd fd {a1 ""} {a2 ""}} {
	    #puts stderr "z $zcmd $ifd $ilen $cmd $fd $a1 $a2"
	    upvar ::vfs::_zstream_pos($fd) pos

	    switch -- $cmd {
		seek {
		    switch $a2 {
			1 - current { incr a1 $pos }
			2 - end { incr a1 $ilen }
		    }
		    # to seek back, rewind, i.e. start from scratch
		    if {$a1 < $pos} {
		      rename $zcmd ""
		      zlib $imode $zcmd
		      seek $ifd 0
		      set pos 0
		    }
		    # consume data while not yet at seek position
		    while {$pos < $a1} {
		      set n [expr {$a1 - $pos}]
		      if {$n > 4096} { set n 4096 }
		      # 2003-02-09: read did not work (?), spell it out instead
		      #read $fd $n
		      zstream_handler $zcmd $ifd $clen $ilen $imode read $fd $n
		    }
		    return $pos
		}
		read {
		    set r ""
		    set n $a1
		    #puts stderr " want $n z $zcmd pos $pos ilen $ilen"
		    if {$n + $pos > $ilen} { set n [expr {$ilen - $pos}] }
		    while {$n > 0} {
		      if {[$zcmd fill] == 0} {
		        set c [expr {$clen - [tell $ifd]}]
			if {$c > 4096} { set c 4096 }
			set data [read $ifd $c]
			#puts "filled $c [string length $data]"
			$zcmd fill $data
		      }
		      set data [$zcmd drain $n]
		      #puts stderr " read [string length $data]"
		      if {$data eq ""} break
		      append r $data
		      incr pos [string length $data]
		      incr n -[string length $data]
		    }
		    return $r
		}
		close {
		    rename $zcmd ""
		    close $ifd
		    unset pos
		}
		default { error "bad cmd in zstream_handler: $cmd" }
	    }
	}

	proc zstream {mode ifd clen ilen} {
	    set cname _zstream_[incr ::vfs::zseq]
	    zlib s$mode $cname
	    set cmd [list ::vfs::zstream_handler $cname $ifd $clen $ilen s$mode]
	    set fd [rechan $cmd 2]
	    set ::vfs::_zstream_pos($fd) 0
	    return $fd
	}
    }
}

EOSEOS
  'vfs1.3/vfsUtils.tcl' , <<'EOSEOS',
# vfsUtils.tcl --
#
# $Id: vfsUtils.tcl,v 1.27 2004/07/04 23:42:04 andreas_kupries Exp $

package require Tcl 8.4
package require vfs

namespace eval ::vfs {
    variable debug 0
    if {[info exists ::env(VFS_DEBUG)]} {
	set debug $::env(VFS_DEBUG)
    }
}

# This can be overridden to use a different memchan implementation
proc ::vfs::memchan {args} {
    ::package require Memchan
    uplevel 1 [list ::memchan] $args
}

# This can be overridden to use a different crc implementation
proc ::vfs::crc {args} {
    ::package require Trf
    uplevel 1 [linsert [linsert $args end-1 "--"] 0 ::crc]
}

# This can be overridden to use a different zip implementation
proc ::vfs::zip {args} {
    ::package require Trf
    uplevel 1 [linsert [linsert $args end-1 "--"] 0 ::zip]
}

proc ::vfs::autoMountExtension {ext cmd {pkg ""}} {
    variable extMounts
    set extMounts($ext) [list $cmd $pkg]
}

proc ::vfs::autoMountUrl {type cmd {pkg ""}} {
    variable urlMounts
    set urlMounts($type) [list $cmd $pkg]
}

proc ::vfs::log {msg {lvl 0}} {
    if {$lvl < ${::vfs::debug}} {
	#tclLog "vfs($lvl): $msg"
	puts stderr $msg
    }
}

proc ::vfs::RegisterMount {mountpoint unmountcmd} {
    variable _unmountCmd
    set _unmountCmd([file normalize $mountpoint]) $unmountcmd
}

proc ::vfs::unmount {mountpoint} {
    variable _unmountCmd
    set norm [file normalize $mountpoint]
    uplevel \#0 $_unmountCmd($norm) [list $norm]
    unset _unmountCmd($norm)
}

proc vfs::states {} {
    return [list "readwrite" "translucent" "readonly"]
}

# vfs::attributes mountpoint ?-opt val? ?...-opt val?
proc ::vfs::attributes {mountpoint args} {
    set handler [::vfs::filesystem info $mountpoint]
    
    set res {}
    
    if {[regsub -- "::handler" $handler ::attributes cmd]} {
	set attrs [eval $cmd]
    } else {
	return -code error "No known attributes"
    }

    if {![llength $args]} {
	foreach attr $attrs {
	    regsub -- "::handler" $handler ::$attr cmd
	    if {[catch $cmd val]} {
		return -code error "error reading filesystem attribute\
		  \"$attr\": $val"
	    } else {
		lappend res -$attr $val
	    }
	}
	return $res
    }
    
    while {[llength $args] > 1} {
	set attr [string range [lindex $args 0] 1 end]
	set val [lindex $args 1]
	set args [lrange $args 2 end]
	regsub -- "::handler" $handler ::$attr cmd
	if {[catch {eval $cmd [list $val]} err]} {
	    return -code error "error setting filesystem attribute\
	      \"$attr\": $err"
	} else {
	    set res $val
	}
    }
    if {[llength $args]} {
	set attr [string range [lindex $args 0] 1 end]
	regsub -- "::handler" $handler ::$attr cmd
	if {[catch $cmd val]} {
	    return -code error "error reading filesystem attribute\
	      \"$attr\": $val"
	} else {
	    set res $val
	}
    }
    return $res
}

proc vfs::attributeCantConfigure {attr val largs} {
    switch -- [llength $largs] {
	0 {
	    return $val
	}
	1 {
	    return -code error "Can't set $attr"
	}
	default {
	    return -code error "Wrong num args"
	}
    }
}

::vfs::autoMountExtension "" ::vfs::mk4::Mount vfs::mk4
::vfs::autoMountExtension .bin ::vfs::mk4::Mount vfs::mk4
::vfs::autoMountExtension .kit ::vfs::mk4::Mount vfs::mk4
::vfs::autoMountExtension .tar ::vfs::tar::Mount vfs::tar
::vfs::autoMountExtension .zip ::vfs::zip::Mount vfs::zip
::vfs::autoMountUrl ftp ::vfs::ftp::Mount vfs::ftp
::vfs::autoMountUrl file ::vfs::fileUrlMount vfs
::vfs::autoMountUrl tclns ::vfs::tclprocMount vfs::ns

proc ::vfs::haveMount {url} {
    variable mounted
    info exists mounted($url)
}

proc ::vfs::urlMount {url args} {
    ::vfs::log "$url $args"
    variable urlMounts
    if {[regexp {^([a-zA-Z]+)://(.*)} $url "" urltype rest]} {
	if {[info exists urlMounts($urltype)]} {
	    #::vfs::log "automounting $path"
	    foreach {cmd pkg} $urlMounts($urltype) {}
	    if {[string length $pkg]} {
		package require $pkg
	    }
	    eval $cmd [list $url] $args
	    variable mounted
	    set mounted($url) 1
	    return
	}
	return -code error "Unknown url type '$urltype'"
    }
    return -code error "Couldn't parse url $url"
}

proc ::vfs::fileUrlMount {url args} {
    # Strip off the leading 'file://'
    set file [string range $url 7 end]
    eval [list ::vfs::auto $file] $args
}

proc ::vfs::tclprocMount {url args} {
    # Strip off the leading 'tclns://'
    set ns [string range $url 8 end]
    eval [list ::vfs::tclproc::Mount $ns] $args
}

proc ::vfs::auto {filename args} {
    variable extMounts
    
    set np {}
    set split [::file split $filename]
    
    foreach ele $split {
	lappend np $ele
	set path [::file normalize [eval [list ::file join] $np]]
	if {[::file isdirectory $path]} {
	    # already mounted
	    continue
	} elseif {[::file isfile $path]} {
	    set ext [string tolower [::file extension $ele]]
	    if {[::info exists extMounts($ext)]} {
		#::vfs::log "automounting $path"
		foreach {cmd pkg} $extMounts($ext) {}
		if {[string length $pkg]} {
		    package require $pkg
		}
		eval $cmd [list $path $path] $args
	    } else {
		continue
	    }
	} else {
	    # It doesn't exist, so just return
	    # return -code error "$path doesn't exist"
	    return
	}
    }
}

# Helper procedure for vfs matchindirectory
# implementations.  It is very important that
# we match properly when given 'directory'
# specifications, since this is used for
# recursive globbing by Tcl.
proc vfs::matchCorrectTypes {types filelist {inDir ""}} {
    if {$types != 0} {
	# Which types to return.  We must do special
	# handling of directories and files.
	set file [matchFiles $types]
	set dir [matchDirectories $types]
	if {$file && $dir} {
	    return $filelist
	}
	if {$file == 0 && $dir == 0} {
	    return [list]
	}
	set newres [list]
	set subcmd [expr {$file ? "isfile" : "isdirectory"}]
	if {[string length $inDir]} {
	    foreach r $filelist {
		if {[::file $subcmd [file join $inDir $r]]} {
		    lappend newres $r
		}
	    }
	} else {
	    foreach r $filelist {
		if {[::file $subcmd $r]} {
		    lappend newres $r
		}
	    }
	}
	set filelist $newres
    }
    return $filelist
}

# Convert integer mode to a somewhat preferable string.
proc vfs::accessMode {mode} {
    lindex [list F X W XW R RX RW] $mode
}

proc vfs::matchDirectories {types} {
    return [expr {$types == 0 ? 1 : $types & (1<<2)}]
}

proc vfs::matchFiles {types} {
    return [expr {$types == 0 ? 1 : $types & (1<<4)}]
}

proc vfs::modeToString {mode} {
    # Turn a POSIX open 'mode' set of flags into a more readable
    # string 'r', 'w', 'w+', 'a', etc.
    set res ""
    if {$mode & 1} {
	append res "r"
    } elseif {$mode & 2} {
	if {$mode & 16} {
	    append res "w"
	} else {
	    append res "a"
	}
    }
    if {$mode & 4} {
	append res "+"
    }
    set res
}

# These lists are used to convert attribute indices into the string equivalent.
# They are copied from Tcl's C sources.  There is no need for them to be
# the same as in the native filesystem; we can use completely different
# attribute sets.  However some items, like '-longname' it is probably
# best to implement.
set vfs::attributes(windows) [list -archive -hidden -longname -readonly -shortname -system -vfs]
set vfs::attributes(macintosh) [list -creator -hidden -readonly -type -vfs]
set vfs::attributes(unix) [list -group -owner -permissions -vfs]

proc vfs::listAttributes {} {
    variable attributes
    global tcl_platform
    set attributes($tcl_platform(platform))
}

proc vfs::indexToAttribute {idx} {
    return [lindex [listAttributes] $idx]
}

proc vfs::attributesGet {root stem index} {
    # Return standard Tcl result, or error.
    set attribute [indexToAttribute $index]
    switch -- $attribute {
	"-longname" {
	    # We always use the normalized form!
	    return [file join $root $stem]
	}
	"-shortname" {
	    set rootdir [file attributes [file dirname $root] -shortname]
	    return [file join $rootdir [file tail $root] $stem]
	}
	"-archive" {
	    return 0
	}
	"-hidden" {
	    return 0
	}
	"-readonly" {
	    return 0
	}
	"-system" {
	    return 0
	}
	"-vfs" {
	    return 1
	}
	"-owner" {
	    return
	}
	"-group" {
	    return
	}
    }
}

proc vfs::attributesSet {root stem index val} {
    # Return standard Tcl result, or error.
    set attribute [indexToAttribute $index]
    #::vfs::log "$attribute"
    switch -- $attribute {
	"-owner"   -
	"-group"   -
	"-archive" -
	"-hidden"  -
	"-permissions" {
	    return
	}
	"-longname" {
	    return -code error "no such luck"
	}
	"-vfs" {
	    return -code error "read-only"
	}
    }
}

proc vfs::posixError {name} {
    variable posix
    return $posix($name)
}

set vfs::posix(EPERM)		1	;# Operation not permitted
set vfs::posix(ENOENT)		2	;# No such file or directory
set vfs::posix(ESRCH)		3	;# No such process
set vfs::posix(EINTR)		4	;# Interrupted system call
set vfs::posix(EIO)		5	;# Input/output error
set vfs::posix(ENXIO)		6	;# Device not configured
set vfs::posix(E2BIG)		7	;# Argument list too long
set vfs::posix(ENOEXEC)		8	;# Exec format error
set vfs::posix(EBADF)		9	;# Bad file descriptor
set vfs::posix(ECHILD)		10	;# No child processes
set vfs::posix(EDEADLK)		11	;# Resource deadlock avoided
					;# 11 was EAGAIN
set vfs::posix(ENOMEM)		12	;# Cannot allocate memory
set vfs::posix(EACCES)		13	;# Permission denied
set vfs::posix(EFAULT)		14	;# Bad address
set vfs::posix(ENOTBLK)		15	;# Block device required
set vfs::posix(EBUSY)		16	;# Device busy
set vfs::posix(EEXIST)		17	;# File exists
set vfs::posix(EXDEV)		18	;# Cross-device link
set vfs::posix(ENODEV)		19	;# Operation not supported by device
set vfs::posix(ENOTDIR)		20	;# Not a directory
set vfs::posix(EISDIR)		21	;# Is a directory
set vfs::posix(EINVAL)		22	;# Invalid argument
set vfs::posix(ENFILE)		23	;# Too many open files in system
set vfs::posix(EMFILE)		24	;# Too many open files
set vfs::posix(ENOTTY)		25	;# Inappropriate ioctl for device
set vfs::posix(ETXTBSY)		26	;# Text file busy
set vfs::posix(EFBIG)		27	;# File too large
set vfs::posix(ENOSPC)		28	;# No space left on device
set vfs::posix(ESPIPE)		29	;# Illegal seek
set vfs::posix(EROFS)		30	;# Read-only file system
set vfs::posix(EMLINK)		31	;# Too many links
set vfs::posix(EPIPE)		32	;# Broken pipe
set vfs::posix(EDOM)		33	;# Numerical argument out of domain
set vfs::posix(ERANGE)		34	;# Result too large
set vfs::posix(EAGAIN)		35	;# Resource temporarily unavailable
set vfs::posix(EWOULDBLOCK)	35	;# Operation would block
set vfs::posix(EINPROGRESS)	36	;# Operation now in progress
set vfs::posix(EALREADY)	37	;# Operation already in progress
set vfs::posix(ENOTSOCK)	38	;# Socket operation on non-socket
set vfs::posix(EDESTADDRREQ)	39	;# Destination address required
set vfs::posix(EMSGSIZE)	40	;# Message too long
set vfs::posix(EPROTOTYPE)	41	;# Protocol wrong type for socket
set vfs::posix(ENOPROTOOPT)	42	;# Protocol not available
set vfs::posix(EPROTONOSUPPORT)	43	;# Protocol not supported
set vfs::posix(ESOCKTNOSUPPORT)	44	;# Socket type not supported
set vfs::posix(EOPNOTSUPP)	45	;# Operation not supported on socket
set vfs::posix(EPFNOSUPPORT)	46	;# Protocol family not supported
set vfs::posix(EAFNOSUPPORT)	47	;# Address family not supported by protocol family
set vfs::posix(EADDRINUSE)	48	;# Address already in use
set vfs::posix(EADDRNOTAVAIL)	49	;# Can't assign requested address
set vfs::posix(ENETDOWN)	50	;# Network is down
set vfs::posix(ENETUNREACH)	51	;# Network is unreachable
set vfs::posix(ENETRESET)	52	;# Network dropped connection on reset
set vfs::posix(ECONNABORTED)	53	;# Software caused connection abort
set vfs::posix(ECONNRESET)	54	;# Connection reset by peer
set vfs::posix(ENOBUFS)		55	;# No buffer space available
set vfs::posix(EISCONN)		56	;# Socket is already connected
set vfs::posix(ENOTCONN)	57	;# Socket is not connected
set vfs::posix(ESHUTDOWN)	58	;# Can't send after socket shutdown
set vfs::posix(ETOOMANYREFS)	59	;# Too many references: can't splice
set vfs::posix(ETIMEDOUT)	60	;# Connection timed out
set vfs::posix(ECONNREFUSED)	61	;# Connection refused
set vfs::posix(ELOOP)		62	;# Too many levels of symbolic links
set vfs::posix(ENAMETOOLONG)	63	;# File name too long
set vfs::posix(EHOSTDOWN)	64	;# Host is down
set vfs::posix(EHOSTUNREACH)	65	;# No route to host
set vfs::posix(ENOTEMPTY)	66	;# Directory not empty
set vfs::posix(EPROCLIM)	67	;# Too many processes
set vfs::posix(EUSERS)		68	;# Too many users
set vfs::posix(EDQUOT)		69	;# Disc quota exceeded
set vfs::posix(ESTALE)		70	;# Stale NFS file handle
set vfs::posix(EREMOTE)		71	;# Too many levels of remote in path
set vfs::posix(EBADRPC)		72	;# RPC struct is bad
set vfs::posix(ERPCMISMATCH)	73	;# RPC version wrong
set vfs::posix(EPROGUNAVAIL)	74	;# RPC prog. not avail
set vfs::posix(EPROGMISMATCH)	75	;# Program version wrong
set vfs::posix(EPROCUNAVAIL)	76	;# Bad procedure for program
set vfs::posix(ENOLCK)		77	;# No locks available
set vfs::posix(ENOSYS)		78	;# Function not implemented
set vfs::posix(EFTYPE)		79	;# Inappropriate file type or format

EOSEOS
  'vfs1.3/zipvfs.tcl' , <<'EOSEOS',

package provide vfs::zip 1.0

package require vfs
package provide zipvfs 1.0

# Using the vfs, memchan and Trf extensions, we ought to be able
# to write a Tcl-only zip virtual filesystem.  What we have below
# is basically that.

namespace eval vfs::zip {}

# Used to execute a zip archive.  This is rather like a jar file
# but simpler.  We simply mount it and then source a toplevel
# file called 'main.tcl'.
proc vfs::zip::Execute {zipfile} {
    Mount $zipfile $zipfile
    source [file join $zipfile main.tcl]
}

proc vfs::zip::Mount {zipfile local} {
    set fd [::zip::open [::file normalize $zipfile]]
    vfs::filesystem mount $local [list ::vfs::zip::handler $fd]
    # Register command to unmount
    vfs::RegisterMount $local [list ::vfs::zip::Unmount $fd]
    return $fd
}

proc vfs::zip::Unmount {fd local} {
    vfs::filesystem unmount $local
    ::zip::_close $fd
}

proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
    #::vfs::log [list $zipfd $cmd $root $relative $actualpath $args]
    if {$cmd == "matchindirectory"} {
	eval [list $cmd $zipfd $relative $actualpath] $args
    } else {
	eval [list $cmd $zipfd $relative] $args
    }
}

proc vfs::zip::attributes {zipfd} { return [list "state"] }
proc vfs::zip::state {zipfd args} {
    vfs::attributeCantConfigure "state" "readonly" $args
}

# If we implement the commands below, we will have a perfect
# virtual file system for zip files.

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"
    if {![string length $pattern]} {
	if {![::zip::exists $zipfd $path]} { return {} }
	set res [list $actualpath]
	set actualpath ""
    }

    set newres [list]
    foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
	lappend newres [file join $actualpath $p]
    }
    #::vfs::log "got $newres"
    return $newres
}

proc vfs::zip::stat {zipfd name} {
    #::vfs::log "stat $name"
    ::zip::stat $zipfd $name sb
    #::vfs::log [array get sb]
    array get sb
}

proc vfs::zip::access {zipfd name mode} {
    #::vfs::log "zip-access $name $mode"
    if {$mode & 2} {
	vfs::filesystem posixerror $::vfs::posix(EROFS)
    }
    # Readable, Exists and Executable are treated as 'exists'
    # Could we get more information from the archive?
    if {[::zip::exists $zipfd $name]} {
	return 1
    } else {
	error "No such file"
    }
    
}

proc vfs::zip::open {zipfd name mode permissions} {
    #::vfs::log "open $name $mode $permissions"
    # return a list of two elements:
    # 1. first element is the Tcl channel name which has been opened
    # 2. second element (optional) is a command to evaluate when
    #    the channel is closed.

    switch -- $mode {
	"" -
	"r" {
	    if {![::zip::exists $zipfd $name]} {
		vfs::filesystem posixerror $::vfs::posix(ENOENT)
	    }
	    
	    ::zip::stat $zipfd $name sb

	    set nfd [vfs::memchan]
	    fconfigure $nfd -translation binary

	    seek $zipfd $sb(ino) start
	    zip::Data $zipfd sb data

	    puts -nonewline $nfd $data

	    fconfigure $nfd -translation auto
	    seek $nfd 0
	    return [list $nfd]
	}
	default {
	    vfs::filesystem posixerror $::vfs::posix(EROFS)
	}
    }
}

proc vfs::zip::createdirectory {zipfd name} {
    #::vfs::log "createdirectory $name"
    vfs::filesystem posixerror $::vfs::posix(EROFS)
}

proc vfs::zip::removedirectory {zipfd name recursive} {
    #::vfs::log "removedirectory $name"
    vfs::filesystem posixerror $::vfs::posix(EROFS)
}

proc vfs::zip::deletefile {zipfd name} {
    #::vfs::log "deletefile $name"
    vfs::filesystem posixerror $::vfs::posix(EROFS)
}

proc vfs::zip::fileattributes {zipfd name args} {
    #::vfs::log "fileattributes $args"
    switch -- [llength $args] {
	0 {
	    # list strings
	    return [list]
	}
	1 {
	    # get value
	    set index [lindex $args 0]
	    return ""
	}
	2 {
	    # set value
	    set index [lindex $args 0]
	    set val [lindex $args 1]
	    vfs::filesystem posixerror $::vfs::posix(EROFS)
	}
    }
}

proc vfs::zip::utime {fd path actime mtime} {
    vfs::filesystem posixerror $::vfs::posix(EROFS)
}

# Below copied from TclKit distribution

#
# ZIP decoder:
#
# Format of zip file:
# [ Data ]* [ TOC ]* EndOfArchive
#
# Note: TOC is refered to in ZIP doc as "Central Archive"
#
# This means there are two ways of accessing:
#
# 1) from the begining as a stream - until the header
#	is not "PK\03\04" - ideal for unzipping.
#
# 2) for table of contents without reading entire
#	archive by first fetching EndOfArchive, then
#	just loading the TOC
#

namespace eval zip {
    array set methods {
	0	{stored - The file is stored (no compression)}
	1	{shrunk - The file is Shrunk}
	2	{reduce1 - The file is Reduced with compression factor 1}
	3	{reduce2 - The file is Reduced with compression factor 2}
	4	{reduce3 - The file is Reduced with compression factor 3}
	5	{reduce4 - The file is Reduced with compression factor 4}
	6	{implode - The file is Imploded}
	7	{reserved - Reserved for Tokenizing compression algorithm}
	8	{deflate - The file is Deflated}
	9	{reserved - Reserved for enhanced Deflating}
	10	{pkimplode - PKWARE Date Compression Library Imploding}
    }
    # Version types (high-order byte)
    array set systems {
	0	{dos}
	1	{amiga}
	2	{vms}
	3	{unix}
	4	{vm cms}
	5	{atari}
	6	{os/2}
	7	{macos}
	8	{z system 8}
	9	{cp/m}
	10	{tops20}
	11	{windows}
	12	{qdos}
	13	{riscos}
	14	{vfat}
	15	{mvs}
	16	{beos}
	17	{tandem}
	18	{theos}
    }
    # DOS File Attrs
    array set dosattrs {
	1	{readonly}
	2	{hidden}
	4	{system}
	8	{unknown8}
	16	{directory}
	32	{archive}
	64	{unknown64}
	128	{normal}
    }

    proc u_short {n}  { return [expr { ($n+0x10000)%0x10000 }] }
}

proc zip::DosTime {date time} {
    set time [u_short $time]
    set date [u_short $date]

    set sec [expr { ($time & 0x1F) * 2 }]
    set min [expr { ($time >> 5) & 0x3F }]
    set hour [expr { ($time >> 11) & 0x1F }]

    set mday [expr { $date & 0x1F }]
    set mon [expr { (($date >> 5) & 0xF) }]
    set year [expr { (($date >> 9) & 0xFF) + 1980 }]

    set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
	$year $mon $mday $hour $min $sec]
    return [clock scan $dt -gmt 1]
}


proc zip::Data {fd arr {varPtr ""} {verify 0}} {
    upvar 1 $arr sb

    if { $varPtr != "" } {
	upvar 1 $varPtr data
    }

    set buf [read $fd 30]
    set n [binary scan $buf A4sssssiiiss \
		hdr sb(ver) sb(flags) sb(method) \
		time date \
		sb(crc) sb(csize) sb(size) flen elen]

    if { ![string equal "PK\03\04" $hdr] } {
	binary scan $hdr H* x
	error "bad header: $x"
    }
    set sb(ver)		[u_short $sb(ver)]
    set sb(flags)	[u_short $sb(flags)]
    set sb(method)	[u_short $sb(method)]
    set sb(mtime)	[DosTime $date $time]

    set sb(name) [read $fd [u_short $flen]]
    set sb(extra) [read $fd [u_short $elen]]

    if { $varPtr == "" } {
	seek $fd $sb(csize) current
    } else {
	# Added by Chuck Ferril 10-26-03 to fix reading of OpenOffice
	#  .sxw files. Any files in the zip that had a method of 8
	#  (deflate) failed here because size and csize were zero.
	#  I'm not sure why the above computes the size and csize
	#  wrong, but stat appears works properly. I originally
	#  checked for csize of zero, but adding this change didn't
	#  appear to break the none deflated file access and seemed
	#  more natural.
 	zip::stat $fd $sb(name) sb

	set data [read $fd $sb(csize)]
    }

    if { $sb(flags) & 0x4 } {
	# Data Descriptor used
	set buf [read $fd 12]
	binary scan $buf iii sb(crc) sb(csize) sb(size)
    }


    if { $varPtr == "" } {
	return ""
    }

    if { $sb(method) != 0 } {
	if { [catch {
	    set data [vfs::zip -mode decompress -nowrap 1 $data]
	} err] } {
	    ::vfs::log "$sb(name): inflate error: $err"
	    binary scan $data H* x
	    ::vfs::log $x
	}
    }
    return
    if { $verify } {
	set ncrc [vfs::crc $data]
	if { $ncrc != $sb(crc) } {
	    tclLog [format {%s: crc mismatch: expected 0x%x, got 0x%x} \
		    $sb(name) $sb(crc) $ncrc]
	}
    }
}

proc zip::EndOfArchive {fd arr} {
    upvar 1 $arr cb

    # [SF Tclvfs Bug 1003574]. Do not seek over beginning of file.
    seek $fd 0 end
    set n [tell $fd]
    if {$n < 512} {set n -$n} else {set n -512}
    seek $fd $n end

    set hdr [read $fd 512]
    set pos [string first "PK\05\06" $hdr]
    if {$pos == -1} {
	error "no header found"
    }
    set hdr [string range $hdr [expr $pos + 4] [expr $pos + 21]]
    set pos [expr [tell $fd] + $pos - 512]

    binary scan $hdr ssssiis \
	cb(ndisk) cb(cdisk) \
	cb(nitems) cb(ntotal) \
	cb(csize) cb(coff) \
	cb(comment)

    set cb(ndisk)	[u_short $cb(ndisk)]
    set cb(nitems)	[u_short $cb(nitems)]
    set cb(ntotal)	[u_short $cb(ntotal)]
    set cb(comment)	[u_short $cb(comment)]

    # Compute base for situations where ZIP file
    # has been appended to another media (e.g. EXE)
    set cb(base)	[expr { $pos - $cb(csize) - $cb(coff) }]
}

proc zip::TOC {fd arr} {
    upvar 1 $arr sb

    set buf [read $fd 46]

    binary scan $buf A4ssssssiiisssssii hdr \
      sb(vem) sb(ver) sb(flags) sb(method) time date \
      sb(crc) sb(csize) sb(size) \
      flen elen clen sb(disk) sb(attr) \
      sb(atx) sb(ino)

    if { ![string equal "PK\01\02" $hdr] } {
	binary scan $hdr H* x
	error "bad central header: $x"
    }

    foreach v {vem ver flags method disk attr} {
	set cb($v) [u_short [set sb($v)]]
    }

    set sb(mtime) [DosTime $date $time]
    set sb(mode) [expr { ($sb(atx) >> 16) & 0xffff }]
    if { ( $sb(atx) & 0xff ) & 16 } {
	set sb(type) directory
    } else {
	set sb(type) file
    }
    set sb(name) [read $fd [u_short $flen]]
    set sb(extra) [read $fd [u_short $elen]]
    set sb(comment) [read $fd [u_short $clen]]
}

proc zip::open {path} {
    set fd [::open $path]
    
    if {[catch {
	upvar #0 zip::$fd cb
	upvar #0 zip::$fd.toc toc

	fconfigure $fd -translation binary ;#-buffering none
	
	zip::EndOfArchive $fd cb

	seek $fd $cb(coff) start

	set toc(_) 0; unset toc(_); #MakeArray
	
	for { set i 0 } { $i < $cb(nitems) } { incr i } {
	    zip::TOC $fd sb
	    
	    set sb(depth) [llength [file split $sb(name)]]
	    
	    set name [string tolower $sb(name)]
	    set toc($name) [array get sb]
	    FAKEDIR toc [file dirname $name]
	}
    } err]} {
	close $fd
	return -code error $err
    }

    return $fd
}

proc zip::FAKEDIR {arr path} {
    upvar 1 $arr toc

    if { $path == "."} { return }


    if { ![info exists toc($path)] } {
	# Implicit directory
	lappend toc($path) \
		name $path \
		type directory mtime 0 size 0 mode 0777 \
		ino -1 depth [llength [file split $path]]
    }
    FAKEDIR toc [file dirname $path]
}

proc zip::exists {fd path} {
    #::vfs::log "$fd $path"
    if {$path == ""} {
	return 1
    } else {
	upvar #0 zip::$fd.toc toc
	info exists toc([string tolower $path])
    }
}

proc zip::stat {fd path arr} {
    upvar #0 zip::$fd.toc toc
    upvar 1 $arr sb

    set name [string tolower $path]
    if { $name == "" || $name == "." } {
	array set sb {
	    type directory mtime 0 size 0 mode 0777 
	    ino -1 depth 0 name ""
	}
    } elseif {![info exists toc($name)] } {
	return -code error "could not read \"$path\": no such file or directory"
    } else {
	array set sb $toc($name)
    }
    set sb(dev) -1
    set sb(uid)	-1
    set sb(gid)	-1
    set sb(nlink) 1
    set sb(atime) $sb(mtime)
    set sb(ctime) $sb(mtime)
    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

    if { $path == "." || $path == "" } {
	set path [string tolower $pat]
    } else {
	set path [string tolower $path]
	if {$pat != ""} {
	    append path /[string tolower $pat]
	}
    }
    set depth [llength [file split $path]]

    #puts stderr "getdir $fd $path $depth $pat [array names toc $path]"
    if {$depth} {
	set ret {}
	foreach key [array names toc $path] {
	    if {[string index $key end] == "/"} {
		# Directories are listed twice: both with and without
		# the trailing '/', so we ignore the one with
		continue
	    }
	    array set sb $toc($key)

	    if { $sb(depth) == $depth } {
		if {[info exists toc(${key}/)]} {
		    array set sb $toc(${key}/)
		}
		lappend ret [file tail $sb(name)]
	    } else {
		#::vfs::log "$sb(depth) vs $depth for $sb(name)"
	    }
	    unset sb
	}
	return $ret
    } else {
	# just the 'root' of the zip archive.  This obviously exists and
	# is a directory.
	return [list {}]
    }
}

proc zip::_close {fd} {
    variable $fd
    variable $fd.toc
    unset $fd
    unset $fd.toc
    ::close $fd
}

EOSEOS
);
1;
