# If set to "auto" it will be maintained in a file called .version
# in the source directory and the revision will be incremented
# each time a "makearch" is done.
#
# If @@SVNLCR@@ is used anywhere in this version number, it will be
# replaced with the highest last-changed-rev from the output of
#   svn info -R    (or 0)
VERS="0.2.4.@@SVNLCR@@"

# Space sperated list of documents, if they exist, they will be
# prefixed with the contents of the DOC_HDR file and substitution
# will occur:
#     @@UTIL@@ becomes the utility name ${UTIL}
#     @@VERS@@ becomes the utility version
#     @@DATE@@ becomes the current date

# If set to "auto" it will be maintained in a file called .version
# in the source directory and the revision will be incremented
# each time a "makearch" is done.
#
# If @@SVNLCR@@ is used anywhere in this version number, it will be
# replaced with the highest last-changed-rev from the output of
#   svn info -R    (or 0)
VERS="0.3.0.@@SVNLCR@@"

# Space sperated list of documents, if they exist, they will be
# prefixed with the contents of the DOC_HDR file and substitution
# will occur:
#     @@UTIL@@ becomes the utility name ${UTIL}
#     @@VERS@@ becomes the utility version
#     @@DATE@@ becomes the current date

	cd "${KITSHROOTDIR}" || exit 1

	autoconf; autoheader
	rm -rf autom4te.cache
	rm -f *~

	./configure || exit 1
	make mk4tcl.tcl.h


	make distclean
) || exit 1

find . -name '.*.sw?' -type f | xargs rm -f

	cd "${KITSHROOTDIR}" || exit 1

	autoconf; autoheader
	rm -rf autom4te.cache
	rm -f *~

	./configure || exit 1
	make boot.tcl.h
	make zipvfs.tcl.h

	make distclean
) || exit 1

find . -name '.*.sw?' -type f | xargs rm -f

kit.res.o: kit.rc kit.ico
	$(RC) -o kit.res.o $(CPPFLAGS) kit.rc

kit: $(OBJS) $(ARCHS)
	$(CC) $(CPPFLAGS) $(CFLAGS) -o kit $(OBJS) $(ARCHS) $(LDFLAGS) $(LIBS)

mk4tcl.tcl.h: mk4tcl.tcl
	./stringify.tcl mk4tcl.tcl > mk4tcl.tcl.h




clean:
	rm -f kit $(OBJS)

distclean: clean
	rm -f config.h Makefile config.log config.status
	rm -rf autom4te.cache

mrproper: distclean
	rm -f configure config.h mk4tcl.tcl.h

.PHONY: all clean distclean

kit.res.o: kit.rc kit.ico
	$(RC) -o kit.res.o $(CPPFLAGS) kit.rc

kit: $(OBJS) $(ARCHS)
	$(CC) $(CPPFLAGS) $(CFLAGS) -o kit $(OBJS) $(ARCHS) $(LDFLAGS) $(LIBS)

boot.tcl.h: boot.tcl
	./stringify.tcl boot.tcl > boot.tcl.h

zipvfs.tcl.h: zipvfs.tcl
	./stringify.tcl zipvfs.tcl > zipvfs.tcl.h

clean:
	rm -f kit $(OBJS)

distclean: clean
	rm -f config.h Makefile config.log config.status
	rm -rf autom4te.cache

mrproper: distclean
	rm -f configure config.h boot.tcl.h zipvfs.tcl.h

.PHONY: all clean distclean

proc tclInit {} {
  rename tclInit {}

  global auto_path tcl_library tcl_libPath
  global tcl_version tcl_rcFileName
  
  set noe [info nameofexecutable]

  # Resolve symlinks
  set noe [file dirname [file normalize [file join $noe __dummy__]]]

  set tcl_library [file join $noe lib tcl$tcl_version]
  set tcl_libPath [list $tcl_library [file join $noe lib]]

  # get rid of a build residue
  unset -nocomplain ::tclDefaultLibrary

  # the following code only gets executed once on startup
  if {[info exists tcl_rcFileName]} {



    load {} vfs

    # lookup and emulate "source" of lib/vfs/{vfs*.tcl,mk4vfs.tcl}
    # must use raw MetaKit calls because VFS is not yet in place
    set d [${::tclkitMkNamespace}::select exe.dirs parent 0 name lib]
    set d [${::tclkitMkNamespace}::select exe.dirs parent $d name vfs]
    
    foreach x {vfsUtils vfslib mk4vfs} {
      set n [${::tclkitMkNamespace}::select exe.dirs!$d.files name $x.tcl]
      set s [${::tclkitMkNamespace}::get exe.dirs!$d.files!$n contents]
      catch {set s [zlib decompress $s]}
      uplevel #0 $s
    }

    # use on-the-fly decompression, if mk4vfs understands that
    switch -- $::tclkitMkNamespace {
        "mk" {
            set mk4vfs::zstreamed 1
            set vfsimpl "mk4"
        }

        "readkit" {
            set mkcl_vfs::zstreamed 1

            set vfsimpl "mkcl"



        }



    }




























    # mount the executable, i.e. make all runtime files available
    vfs::filesystem mount $noe [list ::vfs::${vfsimpl}::handler exe]

    # alter path to find encodings
    if {[info tclversion] eq "8.4"} {
      load {} pwb
      librarypath [info library]
    } else {
      encoding dirs [list [file join [info library] encoding]] ;# TIP 258
    }

    # fix system encoding, if it wasn't properly set up (200207.004 bug)
    if {[encoding system] eq "identity"} {
      switch $::tcl_platform(platform) {
        windows		{ encoding system cp1252 }
        macintosh	{ encoding system macRoman }
        default		{ encoding system iso8859-1 }
      }
    }

    # now remount the executable with the correct encoding
    #vfs::filesystem unmount $noe
    vfs::filesystem unmount [lindex [::vfs::filesystem info] 0]

    set noe [info nameofexecutable]

  	# Resolve symlinks
  	set noe [file dirname [file normalize [file join $noe __dummy__]]]

    set tcl_library [file join $noe lib tcl$tcl_version]
    set tcl_libPath [list $tcl_library [file join $noe lib]]

    vfs::filesystem mount $noe [list ::vfs::${vfsimpl}::handler exe]
  }
  
  # load config settings file if present
  namespace eval ::vfs { variable tclkit_version 1 }
  catch { uplevel #0 [list source [file join $noe config.tcl]] }

  uplevel #0 [list source [file join $tcl_library init.tcl]]
  
# reset auto_path, so that init.tcl's search outside of tclkit is cancelled
  set auto_path $tcl_libPath







  unset ::tclkitMkNamespace

}

proc tclInit {} {
	rename tclInit {}

	global auto_path tcl_library tcl_libPath
	global tcl_version tcl_rcFileName
  
	set noe [info nameofexecutable]

	# Resolve symlinks
	set noe [file dirname [file normalize [file join $noe __dummy__]]]

	set tcl_library [file join $noe lib tcl$tcl_version]
	set tcl_libPath [list $tcl_library [file join $noe lib]]

	# get rid of a build residue
	unset -nocomplain ::tclDefaultLibrary

	# the following code only gets executed once on startup
	if {[info exists tcl_rcFileName]} {
		# lookup and emulate "source" of lib/vfs/{vfs*.tcl,mk4vfs.tcl}
		switch -- $::tclKitStorage {
			"mk4" {
				load {} vfs


				# must use raw MetaKit calls because VFS is not yet in place
				set d [mk::select exe.dirs parent 0 name lib]
				set d [mk::select exe.dirs parent $d name vfs]
    
				foreach x {vfsUtils vfslib mk4vfs} {
					set n [mk::select exe.dirs!$d.files name $x.tcl]
					set s [mk::get exe.dirs!$d.files!$n contents]
					catch {set s [zlib decompress $s]}
					uplevel #0 $s
				}

				# use on-the-fly decompression, if mk4vfs understands that


				set mk4vfs::zstreamed 1


				# Set VFS handler name
				set vfsHandler [list ::vfs::mk4::handler exe]

			}
			"zip" {
				set prefix "lib/vfs"
				foreach file [list vfsUtils vfslib] {
					set fullfile "${prefix}/${file}.tcl"

					::zip::stat $::tclKitStorage_fd $fullfile finfo
					seek $::tclKitStorage_fd $finfo(ino)
					zip::Data $::tclKitStorage_fd sb s

					switch -- $file {
						"vfsUtils" {
							# Preserve our working "::vfs::zip" implementation
							# so we can replace it after the stub is replaced
							# from vfsUtils
							# The correct implementation will be provided by vfslib, 
							# but only if we can read it
							rename ::vfs::zip ::vfs::zip_impl
						}
					}

					uplevel #0 $s

					switch -- $file {
						"vfsUtils" {
							# Restore preserved "::vfs:zip" implementation
							rename ::vfs::zip {}
							rename ::vfs::zip_impl ::vfs::zip
						}
					}
				}

				seek $::tclKitStorage_fd 0
				set vfsHandler [list ::vfs::zip::handler $::tclKitStorage_fd]
				unset ::tclKitStorage_fd
			}
		}

		# mount the executable, i.e. make all runtime files available
		vfs::filesystem mount $noe $vfsHandler

		# alter path to find encodings
		if {[info tclversion] eq "8.4"} {
			load {} pwb
			librarypath [info library]
		} else {
			encoding dirs [list [file join [info library] encoding]] ;# TIP 258
		}

		# fix system encoding, if it wasn't properly set up (200207.004 bug)
		if {[encoding system] eq "identity"} {
			switch $::tcl_platform(platform) {
				windows		{ encoding system cp1252 }
				macintosh	{ encoding system macRoman }
			        default		{ encoding system iso8859-1 }
			}
		}

		# now remount the executable with the correct encoding

		vfs::filesystem unmount [lindex [::vfs::filesystem info] 0]

		set noe [info nameofexecutable]

		# Resolve symlinks
		set noe [file dirname [file normalize [file join $noe __dummy__]]]

		set tcl_library [file join $noe lib tcl$tcl_version]
		set tcl_libPath [list $tcl_library [file join $noe lib]]

		vfs::filesystem mount $noe $vfsHandler
	}
  
	# load config settings file if present
	namespace eval ::vfs { variable tclkit_version 1 }
	catch { uplevel #0 [list source [file join $noe config.tcl]] }

	uplevel #0 [list source [file join $tcl_library init.tcl]]
  
	# reset auto_path, so that init.tcl's search outside of tclkit is cancelled
	set auto_path $tcl_libPath

	# This loads everything needed for "clock scan" to work
	# "clock scan" is used within "vfs::zip", which may be
	# loaded before this is run causing the root VFS to break
	catch { clock scan }

	# Cleanup
	unset ::tclKitStorage
	unset -nocomplain ::tclKitStorage_fd
}

#! /usr/bin/env tclsh


set opt_compression 1
if {[llength $argv] < 2} {
	puts stderr "Usage: installvfs.tcl <kitfile> <vfsdir> \[<enable_compression>\]"

	exit 1
}

set kitfile [lindex $argv 0]
set vfsdir [lindex $argv 1]
if {[lindex $argv 2] != ""} {
	set opt_compression [lindex $argv 2]
}

if {[catch {
	package require vfs::mk4
}]} {
	catch {
		load "" vfs
		load "" Mk4tcl


		source [file join $vfsdir lib/vfs/vfsUtils.tcl]
		source [file join $vfsdir lib/vfs/vfslib.tcl]
		source [file join $vfsdir lib/vfs/mk4vfs.tcl]
	}
}
set mk4vfs::compress $opt_compression

proc copy_file {srcfile destfile} {
	switch -glob -- $srcfile {
		"*.tcl" - "*.txt" {
			set ifd [open $srcfile r]
			set ofd [open $destfile w]

			set ret [fcopy $ifd $ofd]
................................................................................
			copy_file $file $destfile
		} err]} {
			puts stderr "Failed to copy: $file: $err"
		}
	}
}




















set handle [vfs::mk4::Mount $kitfile /kit -nocommit]

recursive_copy $vfsdir /kit

vfs::unmount /kit

#! /usr/bin/env tclsh

# Parse arguments
set opt_compression 1
if {[llength $argv] < 2} {
	puts stderr "Usage: installvfs.tcl <kitfile> <vfsdir> \[<enable_compression>\]"

	exit 1
}

set kitfile [lindex $argv 0]
set vfsdir [lindex $argv 1]
if {[lindex $argv 2] != ""} {
	set opt_compression [lindex $argv 2]
}

# Determine what storage mechanism is being used
## This logic must be duplicated from "kitInit.c"
set fd [open Makefile r]
set data [read $fd]
close $fd


if {[string match "*KIT_INCLUDES_MK4TCL*" $data]} {
	set tclKitStorage mk4
} else {
	set tclKitStorage zip
}

# Define procedures

proc copy_file {srcfile destfile} {
	switch -glob -- $srcfile {
		"*.tcl" - "*.txt" {
			set ifd [open $srcfile r]
			set ofd [open $destfile w]

			set ret [fcopy $ifd $ofd]
................................................................................
			copy_file $file $destfile
		} err]} {
			puts stderr "Failed to copy: $file: $err"
		}
	}
}

# Update the kit, based on what kind of kit this is
switch -- $tclKitStorage {
	"mk4" {
		if {[catch {
			# Try as if a pre-existing Tclkit, or a tclsh
			package require vfs::mk4
		}]} {
			# Try as if uninitialized Tclkit
			catch {
				load "" vfs
				load "" Mk4tcl

				source [file join $vfsdir lib/vfs/vfsUtils.tcl]
				source [file join $vfsdir lib/vfs/vfslib.tcl]
				source [file join $vfsdir lib/vfs/mk4vfs.tcl]
			}
		}
		set mk4vfs::compress $opt_compression

		set handle [vfs::mk4::Mount $kitfile /kit -nocommit]

		recursive_copy $vfsdir /kit

		vfs::unmount /kit
	}
	"zip" {
		set kitfd [open $kitfile a+]
		fconfigure $kitfd -translation binary

		cd $vfsdir
		set zipfd [open "|zip -r - [glob *] 2> /dev/null"]
		fconfigure $zipfd -translation binary

		fcopy $zipfd $kitfd

		close $kitfd
		if {[catch {
			close $zipfd
		} err]} {
			puts stderr "Error while updating executable: $err"

			exit 1
		}
	}
}

 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id$
 */

#ifdef KIT_INCLUDES_TK
#include <tk.h>
#else
#include <tcl.h>
#endif

#ifdef _WIN32
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#endif

#ifndef MB_TASKMODAL
#define MB_TASKMODAL 0
#endif

#include "tclInt.h"

#ifdef KIT_INCLUDES_ITCL
Tcl_AppInitProc	Itcl_Init;
#endif
#ifdef KIT_INCLUDES_MK4TCL
................................................................................
#ifdef TCL_THREADS
Tcl_AppInitProc	Thread_Init;
#endif
#ifdef _WIN32
Tcl_AppInitProc	Dde_Init, Registry_Init;
#endif













char *tclExecutableName;

    /*
     *  Attempt to load a "boot.tcl" entry from the embedded MetaKit file.
     *  If there isn't one, try to open a regular "setup.tcl" file instead.
     *  If that fails, this code will throw an error, using a message box.
     */

................................................................................
static char *preInitCmd = 
#ifdef _WIN32_WCE
/* silly hack to get wince port to launch, some sort of std{in,out,err} problem */
"open /kitout.txt a; open /kitout.txt a; open /kitout.txt a\n"
/* this too seems to be needed on wince - it appears to be related to the above */
"catch {rename source ::tcl::source}\n"
"proc source file {\n"
    "set old [info script]\n"
    "info script $file\n"
    "set fid [open $file]\n"
    "set data [read $fid]\n"
    "close $fid\n"
    "set code [catch {uplevel 1 $data} res]\n"
    "info script $old\n"
    "if {$code == 2} { set code 0 }\n"
    "return -code $code $res\n"
"}\n"
#endif
"proc tclKitInit {} {\n"
    "rename tclKitInit {}\n"
#ifdef KIT_INCLUDES_MK4TCL

    "catch { load {} Mk4tcl }\n"
    "set ::tclkitMkNamespace \"mk\"\n"
#else
#include "mk4tcl.tcl.h"
    "set ::tclkitMkNamespace \"readkit\"\n"
#endif
    "${::tclkitMkNamespace}::file open exe [info nameofexecutable] -readonly\n"
    "set n [${::tclkitMkNamespace}::select exe.dirs!0.files name boot.tcl]\n"
    "if {$n != \"\"} {\n"
        "set s [${::tclkitMkNamespace}::get exe.dirs!0.files!$n contents]\n"
	"if {![string length $s]} { error \"empty boot.tcl\" }\n"
        "catch {load {} zlib}\n"
        "if {[${::tclkitMkNamespace}::get exe.dirs!0.files!$n size] != [string length $s]} {\n"
	    "set s [zlib decompress $s]\n"
	"}\n"




    "} else {\n"








        "set f [open setup.tcl]\n"
        "set s [read $f]\n"
        "close $f\n"
    "}\n"
    "uplevel #0 $s\n"
#ifdef _WIN32
    "catch {load {} dde}\n"
    "catch {load {} registry}\n"
#endif

"}\n"
"tclKitInit"
;

static const char initScript[] =
"if {[file isfile [file join [info nameofexe] main.tcl]]} {\n"
    "if {[info commands console] != {}} { console hide }\n"
    "set tcl_interactive 0\n"
    "incr argc\n"
    "set argv [linsert $argv 0 $argv0]\n"
    "set argv0 [file join [info nameofexe] main.tcl]\n"
"} else continue\n"
;

/* SetExecName --

   Hack to get around Tcl bug 1224888.
*/

void SetExecName(Tcl_Interp *interp) {
    if (tclExecutableName == NULL) {
	int len = 0;
	Tcl_Obj *execNameObj;
	Tcl_Obj *lobjv[1];

	lobjv[0] = Tcl_GetVar2Ex(interp, "argv0", NULL, TCL_GLOBAL_ONLY);
	execNameObj = Tcl_FSJoinToPath(Tcl_FSGetCwd(interp), 1, lobjv);

	tclExecutableName = strdup(Tcl_GetStringFromObj(execNameObj, &len));
    }
}

int 
TclKit_AppInit(Tcl_Interp *interp)
{
#ifdef KIT_INCLUDES_ITCL
    Tcl_StaticPackage(0, "Itcl", Itcl_Init, NULL);
#endif 
#ifdef KIT_INCLUDES_MK4TCL
    Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
#endif
#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
    Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL);
#endif 
    Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
    Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
    Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
#ifdef TCL_THREADS
    Tcl_StaticPackage(0, "Thread", Thread_Init, NULL);
#endif
#ifdef _WIN32
    Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
    Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
#endif
#ifdef KIT_INCLUDES_TK
    Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
#endif

    /* the tcl_rcFileName variable only exists in the initial interpreter */
#ifdef _WIN32
    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
#else
    Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
#endif

    /* Hack to get around Tcl bug 1224888.  This must be run here and
     * in LibraryPathObjCmd because this information is needed both
     * before and after that command is run. */
    SetExecName(interp);

    TclSetPreInitScript(preInitCmd);
    if (Tcl_Init(interp) == TCL_ERROR)
        goto error;


#ifdef KIT_INCLUDES_TK
#ifdef _WIN32
    if (Tk_Init(interp) == TCL_ERROR)
        goto error;

    if (Tk_CreateConsoleWindow(interp) == TCL_ERROR)
        goto error;

#endif
#endif

      /* messy because TclSetStartupScriptPath is called slightly too late */
    if (Tcl_Eval(interp, initScript) == TCL_OK) {
        Tcl_Obj* path;
#ifdef HAVE_TCLSETSTARTUPSCRIPTPATH
        path = TclGetStartupScriptPath();
	TclSetStartupScriptPath(Tcl_GetObjResult(interp));
#else
#  ifdef HAVE_TCL_SETSTARTUPSCRIPT
        path = Tcl_GetStartupScript(NULL);
	Tcl_SetStartupScript(Tcl_GetObjResult(interp), NULL);
#  endif
#endif
	if (path == NULL)
	  Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]");
    }


    Tcl_SetVar(interp, "errorInfo", "", TCL_GLOBAL_ONLY);
    Tcl_ResetResult(interp);

    return TCL_OK;

error:
#ifdef KIT_INCLUDES_TK
#ifdef _WIN32
    MessageBeep(MB_ICONEXCLAMATION);
#ifndef _WIN32_WCE
    MessageBox(NULL, Tcl_GetStringResult(interp), "Error in TclKit",
        MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);

    ExitProcess(1);
#endif

    /* we won't reach this, but we need the return */
#endif
#endif


    return TCL_ERROR;
}

 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id$
 */

#ifdef KIT_INCLUDES_TK
#  include <tk.h>
#else
#  include <tcl.h>
#endif /* KIT_INCLUDES_TK */

#ifdef _WIN32
#  define WIN32_LEAN_AND_MEAN
#  include <windows.h>
#  undef WIN32_LEAN_AND_MEAN
#endif /* _WIN32 */

#ifndef MB_TASKMODAL
#  define MB_TASKMODAL 0
#endif /* MB_TASKMODAL */

#include "tclInt.h"

#ifdef KIT_INCLUDES_ITCL
Tcl_AppInitProc	Itcl_Init;
#endif
#ifdef KIT_INCLUDES_MK4TCL
................................................................................
#ifdef TCL_THREADS
Tcl_AppInitProc	Thread_Init;
#endif
#ifdef _WIN32
Tcl_AppInitProc	Dde_Init, Registry_Init;
#endif

/* Determine which type of storage to use -- MK4 or ZIP */
#if defined(KIT_STORAGE_MK4) && defined(KIT_STORAGE_ZIP)
#  undef KIT_STORAGE_ZIP
#endif
#if !defined(KIT_STORAGE_MK4) && !defined(KIT_STORAGE_ZIP)
#  ifdef KIT_INCLUDES_MK4TCL
#    define KIT_STORAGE_MK4 1
#  else
#    define KIT_STORAGE_ZIP 1
#  endif
#endif

static char *tclExecutableName;

    /*
     *  Attempt to load a "boot.tcl" entry from the embedded MetaKit file.
     *  If there isn't one, try to open a regular "setup.tcl" file instead.
     *  If that fails, this code will throw an error, using a message box.
     */

................................................................................
static char *preInitCmd = 
#ifdef _WIN32_WCE
/* silly hack to get wince port to launch, some sort of std{in,out,err} problem */
"open /kitout.txt a; open /kitout.txt a; open /kitout.txt a\n"
/* this too seems to be needed on wince - it appears to be related to the above */
"catch {rename source ::tcl::source}\n"
"proc source file {\n"
	"set old [info script]\n"
	"info script $file\n"
	"set fid [open $file]\n"
	"set data [read $fid]\n"
	"close $fid\n"
	"set code [catch {uplevel 1 $data} res]\n"
	"info script $old\n"
	"if {$code == 2} { set code 0 }\n"
	"return -code $code $res\n"
"}\n"
#endif /* _WIN32_WCE */
"proc tclKitInit {} {\n"
	"rename tclKitInit {}\n"
#ifdef KIT_STORAGE_MK4
	"set ::tclKitStorage \"mk4\"\n"
	"catch { load {} Mk4tcl }\n"





	"mk::file open exe [info nameofexecutable] -readonly\n"
	"set n [mk::select exe.dirs!0.files name boot.tcl]\n"
	"if {$n != \"\"} {\n"
		"set s [mk::get exe.dirs!0.files!$n contents]\n"
		"if {![string length $s]} { error \"empty boot.tcl\" }\n"
		"catch {load {} zlib}\n"
		"if {[mk::get exe.dirs!0.files!$n size] != [string length $s]} {\n"
			"set s [zlib decompress $s]\n"
		"}\n"
	"}\n"
#endif /* KIT_STORAGE_MK4 */
#ifdef KIT_STORAGE_ZIP
	"set ::tclKitStorage \"zip\"\n"
	"catch { load {} vfs }\n"
#  include "zipvfs.tcl.h"
	"set ::tclKitStorage_fd [zip::open [info nameofexecutable]]\n"
	"if {![catch { ::zip::stat $::tclKitStorage_fd boot.tcl sb }]} {\n"
		"seek $::tclKitStorage_fd $sb(ino)\n"
		"zip::Data $::tclKitStorage_fd sb s\n"
	"}\n"
#endif /* KIT_STORAGE_ZIP */
	"if {![info exists s]} {\n"
		"set f [open setup.tcl]\n"
		"set s [read $f]\n"
		"close $f\n"
	"}\n"
	"uplevel #0 $s\n"
#ifdef _WIN32
	"catch {load {} dde}\n"
	"catch {load {} registry}\n"
#endif /* _WIN32 */
	"return 0\n"
"}\n"
"tclKitInit";


static const char initScript[] =
"if {[file isfile [file join [info nameofexe] main.tcl]]} {\n"
	"if {[info commands console] != {}} { console hide }\n"
	"set tcl_interactive 0\n"
	"incr argc\n"
	"set argv [linsert $argv 0 $argv0]\n"
	"set argv0 [file join [info nameofexe] main.tcl]\n"
"} else continue\n";


/* SetExecName --

   Hack to get around Tcl bug 1224888.
*/

void SetExecName(Tcl_Interp *interp) {
	if (tclExecutableName == NULL) {
		int len = 0;
		Tcl_Obj *execNameObj;
		Tcl_Obj *lobjv[1];

		lobjv[0] = Tcl_GetVar2Ex(interp, "argv0", NULL, TCL_GLOBAL_ONLY);
		execNameObj = Tcl_FSJoinToPath(Tcl_FSGetCwd(interp), 1, lobjv);

		tclExecutableName = strdup(Tcl_GetStringFromObj(execNameObj, &len));
	}
}


int TclKit_AppInit(Tcl_Interp *interp) {

#ifdef KIT_INCLUDES_ITCL
	Tcl_StaticPackage(0, "Itcl", Itcl_Init, NULL);
#endif 
#ifdef KIT_INCLUDES_MK4TCL
	Tcl_StaticPackage(0, "Mk4tcl", Mk4tcl_Init, NULL);
#endif
#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
	Tcl_StaticPackage(0, "pwb", Pwb_Init, NULL);
#endif 
	Tcl_StaticPackage(0, "rechan", Rechan_Init, NULL);
	Tcl_StaticPackage(0, "vfs", Vfs_Init, NULL);
	Tcl_StaticPackage(0, "zlib", Zlib_Init, NULL);
#ifdef TCL_THREADS
	Tcl_StaticPackage(0, "Thread", Thread_Init, NULL);
#endif
#ifdef _WIN32
	Tcl_StaticPackage(0, "dde", Dde_Init, NULL);
	Tcl_StaticPackage(0, "registry", Registry_Init, NULL);
#endif
#ifdef KIT_INCLUDES_TK
	Tcl_StaticPackage(0, "Tk", Tk_Init, Tk_SafeInit);
#endif

	/* the tcl_rcFileName variable only exists in the initial interpreter */
#ifdef _WIN32
	Tcl_SetVar(interp, "tcl_rcFileName", "~/tclkitrc.tcl", TCL_GLOBAL_ONLY);
#else
	Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclkitrc", TCL_GLOBAL_ONLY);
#endif

	/* Hack to get around Tcl bug 1224888.  This must be run here and
	 * in LibraryPathObjCmd because this information is needed both
	 * before and after that command is run. */
	SetExecName(interp);

	TclSetPreInitScript(preInitCmd);
	if (Tcl_Init(interp) == TCL_ERROR) {
		goto error;
	}

#ifdef KIT_INCLUDES_TK
#  ifdef _WIN32
	if (Tk_Init(interp) == TCL_ERROR) {
		goto error;
	}
	if (Tk_CreateConsoleWindow(interp) == TCL_ERROR) {
		goto error;
	}
#  endif /* _WIN32 */
#endif /* KIT_INCLUDES_TK */

	/* messy because TclSetStartupScriptPath is called slightly too late */
	if (Tcl_Eval(interp, initScript) == TCL_OK) {
		Tcl_Obj* path;
#ifdef HAVE_TCLSETSTARTUPSCRIPTPATH
		path = TclGetStartupScriptPath();
		TclSetStartupScriptPath(Tcl_GetObjResult(interp));

#elif defined(HAVE_TCL_SETSTARTUPSCRIPT)
		path = Tcl_GetStartupScript(NULL);
		Tcl_SetStartupScript(Tcl_GetObjResult(interp), NULL);

#endif
		if (path == NULL) {
			Tcl_Eval(interp, "incr argc -1; set argv [lrange $argv 1 end]");
		}
	}

	Tcl_SetVar(interp, "errorInfo", "", TCL_GLOBAL_ONLY);
	Tcl_ResetResult(interp);

	return TCL_OK;

error:
#ifdef KIT_INCLUDES_TK
#  ifdef _WIN32
	MessageBeep(MB_ICONEXCLAMATION);
#    ifndef _WIN32_WCE
	MessageBox(NULL, Tcl_GetStringResult(interp), "Error in TclKit",
	           MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);

	ExitProcess(1);

#    endif /* !_WIN32_WCE */
    /* we won't reach this, but we need the return */
#  endif /* _WIN32 */

#endif /* KIT_INCLUDES_TK */

	return TCL_ERROR;
}

#! /usr/bin/env tclsh

namespace eval ::mk {}
namespace eval ::mk::file {}
namespace eval ::mk::view {}
namespace eval ::mk::cursor {}
namespace eval ::mk::row {}
namespace eval ::mk::private {}

proc ::mk::file {cmd args} {
	set args [lindex $args 0 ::mk::file::${cmd}]

	return [eval $args]
}

proc ::mk::file::open {args} {
	if {[llength $args] == 0} {
		# Return open tags

		set retval [list]
		foreach tag [array names ::mk::private::tags] {
			unset -nocomplain taginfo
			array set taginfo $::mk::private::tags($tag)

			lappend retval $tag $taginfo(file)
		}

		return 
	}

	set tag [lindex $args 0]
	if {[info exists ::mk::private::tags($tag)]} {
		return -code error "tag is already open"
	}

	set taginfo(writable) 1
	set taginfo(commit_on_close) 1
	set taginfo(commit_on_set) 0
	set taginfo(extend) 0
	set taginfo(shared) 0

	if {[llength $args] == 1} {
		# Use in-memory file

		set taginfo(file) ""
		set taginfo(fd) ""
	} else {
		set filename [lindex $args 1]

		foreach opt [lrange $args 2 end] {
			switch -- $opt {
				"-readonly" {
					set taginfo(writable) 0
				}
				"-nocommit" {
					set taginfo(commit_on_close) 0
				}
				"-extend" {
					set taginfo(extend) 1
				}
				"-shared" {
					set taginfo(shared) 1
				}
			}
		}

		if {$taginfo(writable)} {
			set fd [open $filename a+]
			seek $fd 0 start
		} else {
			set fd [open $filename r]
		}

		set taginfo(file) $filename
		set taginfo(fd) $fd
	}

	set ::mk::private::changes($tag) [list]
	set ::mk::private::tags($tag) [array get taginfo]
}

proc ::mk::file::close {tag} {
	if {![info exists ::mk::private::tags($tag)]} {
		return -code error "no storage with this name"
	}

	array set taginfo $::mk::private::tags($tag)

	if {$taginfo(commit_on_close) && $taginfo(writable) && $taginfo(fd) != ""} {
		mk::file commit $tag -full
	}

	if {$taginfo(fd) != ""} {
		close $taginfo(fd)
	}

	unset ::mk::private::changes($tag)
	unset ::mk::private::tags($tag)
}

proc ::mk::file::views {{tag ""}} {
	return -code error "Not Implemented"
}

proc ::mk::file::commit {tag {fullOpt ""}} {
	if {![info exists ::mk::private::tags($tag)]} {
		return -code error "no storage with this name"
	}

	array set taginfo $::mk::private::tags($tag)

	if {$fullOpt == "-full"} {
		# Flush asides
		# XXX: TODO
	}

	if {$taginfo(fd) == ""} {
		# We can't commit if we weren't asked to write to stable
		# storage
		return
	}

	# XXX: TODO
	return -code error "Not Implemented"
}

proc ::mk::file::rollback {tag {fullOpt ""}} {
	if {![info exists ::mk::private::tags($tag)]} {
		return -code error "no storage with this name"
	}

	if {$fullOpt == "-full"} {
		# Clear asides ...
		# XXX: TODO
	}

	set ::mk::private::changes($tag) ""
}

proc ::mk::file::load {{tag ""} {channel ""}} {
	return -code error "Not Implemented"
}

proc ::mk::file::save {{tag ""} {channel ""}} {
	return -code error "Not Implemented"
}

proc ::mk::file::aside {{tag1 ""} {tag2 ""}} {
	return -code error "Not Implemented"
}

proc ::mk::file::autocommit {tag} {
	if {![info exists ::mk::private::tags($tag)]} {
		return -code error "no storage with this name"
	}

	array set taginfo $::mk::private::tags($tag)

	set taginfo(commit_on_close) 1

	set ::mk::private::tags($tag) [array get taginfo]
}

proc ::mk::view {cmd args} {
	return -code error "Not Implemented"
}

proc ::mk::cursor {cmd args} {
	return -code error "Not Implemented"
}

proc ::mk::row {cmd args} {
	return -code error "Not Implemented"
}

proc ::mk::get {args} {
	return -code error "Not Implemented"
}

proc ::mk::set {args} {
	return -code error "Not Implemented"
}

proc ::mk::loop {args} {
	return -code error "Not Implemented"
}

proc ::mk::select {args} {
	return -code error "Not Implemented"
}

proc ::mk::channel {args} {
	return -code error "Not Implemented"
}

package provide Mk4tcl 2.4.9.6

#! /usr/bin/env tclsh
# ReadKit, a viewer/extractor/converter for starkits which does not
# require TclKit or MetaKit.  This file was generated by "rkgen.tcl".
#
# June 2002, Jean-Claude Wippler <jcw@equi4.com>

# this is needed so often that I just drop copies of it all over the place
if {![info exists auto_index(lassign)] && [info commands lassign] == ""} {
  proc lassign {l args} {
    foreach v $l a $args { uplevel 1 [list set $a $v] }
  }
}

catch {
	load {} zlib
}
catch {
	package require zlib
}

if {[info comm mmap] == ""} {
    # mmap and mvec primitives in pure Tcl (a C version is present in critlib)

    namespace export mmap mvec

    namespace eval v {
	array set mmap_data {}
	array set mvec_shifts {
    - -1    0 -1
    1  0    2  1    4  2    8   3
    16 4   16r 4
    32 5   32r 5   32f 5   32fr 5
    64 6   64r 6   64f 6   64fr 6 }
    }

    proc mmap {fd args} {
	upvar #0 v::mmap_data($fd) data
	# special case if fd is the name of a variable (qualified or global)
	if {[uplevel #0 [list info exists $fd]]} {
	    upvar #0 $fd var
	    set data $var
	}
	# cache a full copy of the file to simulate memory mapping
	if {![info exists data]} {
	    set pos [tell $fd]
	    seek $fd 0 end
	    set end [tell $fd]
	    seek $fd 0
	    set trans [fconfigure $fd -translation]
	    fconfigure $fd -translation binary
	    set data [read $fd $end]
	    fconfigure $fd -translation $trans
	    seek $fd $pos
	}
	set total [string length $data]
	if {[llength $args] == 0} {
	    return $total
	}
	foreach {off len} $args break
	if {$len < 0} {
	    set len $total
	}
	if {$len < 0 || $len > $total - $off} {
	    set len [expr {$total - $off}]
	}
	binary scan $data @${off}a$len s
	return $s
    }

    proc mvec {v args} {
	foreach {mode data off len} $v break
	if {[info exists v::mvec_shifts($mode)]} {
	    # use _mvec_get to access elements
	    set shift $v::mvec_shifts($mode)
	    if {[llength $v] < 4} {
		set len $off
	    }
	    set get [list _mvec_get $shift $v *]
	} else {
	    # virtual mode, set to evaluate script
	    set shift ""
	    set len [lindex $v end]
	    set get $v
	}
	# try to derive vector length from data length if not specified
	if {$len == "" || $len < 0} {
	    set len 0
	    if {$shift >= 0} {
		if {[llength $v] < 4} {
		    set n [string length $data]
		} else {
		    set n [mmap $data]
		}
		set len [expr {($n << 3) >> $shift}]
	    }
	}
	set nargs [llength $args]
	# with just a varname as arg, return info about this vector
	if {$nargs == 0} {
	    if {$shift == ""} {
		return [list $len {} $v]
	    }
	    return [list $len $mode $shift]
	}
	foreach {pos count pred cond} $args break
	# with an index as second arg, do a single access and return element
	if {$nargs == 1} {
	    return [uplevel 1 [lreplace $get end end $pos]]
	}
	if {$count < 0} {
	    set count $len
	}
	if {$count > $len - $pos && $shift != -1} {
	    set count [expr {$len - $pos}]
	}
	if {$nargs == 4} {
	    upvar $pred x
	}
	set r {}
	incr count $pos
	# loop through specified range to build result vector
	# with four args, used that as predicate function to filter
	# with five args, use fourth as loop var and apply fifth as condition
	for {set x $pos} {$x < $count} {incr x} {
	    set y [uplevel 1 [lreplace $get end end $x]]
	    switch $nargs {
		3 {
			if {![uplevel 1 [list $pred $v $x $y]]} continue
		    }
		4 {
			if {![uplevel 1 [list expr $cond]]} continue
		    }
	    }
	    lappend r $y
	}
	return $r
    }

    proc _mvec_get {shift desc index} {
	foreach {mode data off len} $desc break
	switch -- $mode {
	    - {
		    return $index
		}
	    0 {
		    return $data
		}
	}
	if {[llength $desc] < 4} {
	    set off [expr {($index << $shift) >> 3}]
	} else {
	    # don't load more than 8 bytes from the proper offset
	    incr off [expr {($index << $shift) >> 3}]
	    set data [mmap $data $off 8]
	    set off 0
	}
	switch -- $mode {
	    1 {
		    binary scan $data @${off}c value
		    return [expr {($value>>($index&7)) &1}]
		}
	    2 {
		    binary scan $data @${off}c value
		    return [expr {($value>>(($index&3) <<1)) &3}]
		}
	    4 {
		    binary scan $data @${off}c value
		    return [expr {($value>>(($index&1) <<2)) &15}]
		}
	    8 {
		    set w 1
		    set f c
		}
	    16 {
		    set w 2
		    set f s
		}
	    16r {
		    set w 2
		    set f S
		}
	    32 {
		    set w 4
		    set f i
		}
	    32r {
		    set w 4
		    set f I
		}
	    32fr -
	    32f {
		    set w 4
		    set f f
		}
	    64 -
	    64r {
		    set w 8
		    set f i2
		}
	    64fr -
	    64f {
		    set w 8
		    set f d
		}
	}

	binary scan $data @$off$f value
	return $value
    }

    # vim: ft=tcl

}

if {[info comm dbopen] == ""} {
    # Decoder for MetaKit datafiles in Tcl

    # requires mmap/mvec primitives:
    #source [file join [info dirname [info script]] mvprim.tcl]

    namespace export dbopen dbclose dbtree access vnames vlen

    namespace eval v {
	variable widths {
    {8 16  1 32  2  4}
    {4  8  1 16  2  0}
    {2  4  8  1  0 16}
    {2  4  0  8  1  0}
    {1  2  4  0  8  0}
    {1  2  4  0  0  8}
    {1  2  0  4  0  0} }
    }

    proc fetch {file} {
	if {$file == ""} {
	    error "temp storages not supported"
	}
	set v::data [open $file]
	set v::seqn 0
    }

    proc byte_seg {off len} {
	incr off $v::zero
	return [mmap $v::data $off $len]
    }

    proc int_seg {off cnt} {
	set vec [list 32r [byte_seg $off [expr {4*$cnt}]]]
	return [mvec $vec 0 $cnt]
    }

    proc get_s {len} {
	set s [byte_seg $v::curr $len]
	incr v::curr $len
	return $s
    }

    proc get_v {} {
	set v 0
	while 1 {
	    set char [mvec $v::byte $v::curr]
	    incr v::curr
	    set v [expr {$v*128+($char&0xff)}]
	    if {$char < 0} {
		return [incr v -128]
	    }
	}
    }

    proc get_p {rows vs vo} {
	upvar $vs size $vo off
	set off 0
	if {$rows == 0} {
	    set size 0
	} else {
	    set size [get_v]
	    if {$size > 0} {
		set off [get_v]
	    }
	}
    }

    proc header {{end ""}} {
	set v::zero 0
	if {$end == ""} {
	    set end [mmap $v::data]
	}
	set v::byte [list 8 $v::data $v::zero $end]
	lassign [int_seg [expr {$end-16}] 4] t1 t2 t3 t4
	set v::zero [expr {$end-$t2-16}]
	incr end -$v::zero
	set v::byte [list 8 $v::data $v::zero $end]
	lassign [int_seg 0 2] h1 h2
	lassign [int_seg [expr {$h2-8}] 2] e1 e2
	set v::info(mkend) $h2
	set v::info(mktoc) $e2
	set v::info(mklen) [expr {$e1 & 0xffffff}]
	set v::curr $e2
    }

    proc layout {fmt} {
	regsub -all { } $fmt "" fmt
	regsub -all {(\w+)\[} $fmt "{\\1 {" fmt
	regsub -all {\]} $fmt "}}" fmt
	regsub -all {,} $fmt " " fmt
	return $fmt
    }

    proc descparse {desc} {
	set names {}
	set types {}
	foreach x $desc {
	    if {[llength $x] == 1} {
		lassign [split $x :] name type
		if {$type == ""} {
		    set type S
		}
	    } else {
		lassign $x name type
	    }
	    lappend names $name
	    lappend types $type
	}
	return [list $names $types]
    }

    proc numvec {rows type} {
	get_p $rows size off
	if {$size == 0} {
	    return {0 0}
	}
	set w [expr {int(($size<<3) /$rows)}]
	if {$rows <= 7 && 0 < $size && $size <= 6} {
	    set w [lindex [lindex $v::widths [expr {$rows-1}]] [expr {$size-1}]]
	}
	if {$w == 0} {
	    error "numvec?"
	}
	switch $type\
	      F {
		    set w 32f
		}\
	      D {
		    set w 64f
		}
	incr off $v::zero
	return [list $w $v::data $off $rows]
    }

    proc lazy_str {self rows type pos sizes msize moff index} {
	set soff {}
	for {set i 0} {$i < $rows} {incr i} {
	    set n [mvec $sizes $i]
	    lappend soff $pos
	    incr pos $n
	}
	if {$msize > 0} {
	    set slen [mvec $sizes 0 $rows]
	    set v::curr $moff
	    set limit [expr {$moff+$msize}]
	    for {set row 0} {$v::curr < $limit} {incr row} {
		incr row [get_v]
		get_p 1 ms mo
		set soff [lreplace $soff $row $row $mo]
		set slen [lreplace $slen $row $row $ms]
	    }
	    set sizes [list lindex $slen $rows]
	}
	if {$type == "S"} {
	    set adj -1
	} else {
	    set adj 0
	}
	set v::node($self) [list get_str $soff $sizes $adj $rows]
	return [mvec $v::node($self) $index]
    }

    proc get_str {soff sizes adj index} {
	set n [mvec $sizes $index]
	return [byte_seg [lindex $soff $index] [incr n $adj]]
    }

    proc lazy_sub {self desc size off rows index} {
	set v::curr $off
	lassign [descparse $desc] names types
	set subs {}
	for {set i 0} {$i < $rows} {incr i} {
	    if {[get_v] != 0} {
		error "lazy_sub?"
	    }
	    lappend subs [prepare $types]
	}
	set v::node($self) [list get_sub $names $subs $rows]
	return [mvec $v::node($self) $index]
    }

#proc backtrace {{level_adj 0}} {
#                        set ret [list]          
#
#                        set level [expr 0 - $level_adj]
#                        for {set i [expr [info level] - $level_adj]} {$i > 1} {incr i -1} {
#                                incr level -1
#                                set ret [linsert $ret 0 [lindex [info level $level] 0]]
#                        }
#                        set ret [linsert $ret 0 GLOBAL]
#        
#                        return $ret
#}

    proc get_sub {names subs index} {
#puts stderr "DEBUG: get_sub: [list $names $subs $index]"
#puts "backtrace: [backtrace]"
	lassign [lindex $subs $index] rows handlers
	return [list get_view $names $rows $handlers $rows]
    }

    proc prepare {types} {
	set r [get_v]
	set handlers {}
	foreach x $types {
	    set n [incr v::seqn]
	    lappend handlers $n
	    switch $x {
		I -
		L -
		F -
		D {
			set v::node($n) [numvec $r $x]
		    }
		B -
		S {
			get_p $r size off
			set sizes {0 0}
			if {$size > 0} {
			    set sizes [numvec $r I]
			}
			get_p $r msize moff
			set v::node($n) [list lazy_str $n $r $x $off $sizes\
			  $msize $moff $r]
		    }
		default {
			get_p $r size off
			set v::node($n) [list lazy_sub $n $x $size $off $r $r]
		    }
	    }
	}
	return [list $r $handlers]
    }

    proc get_view {names rows handlers index} {
	return [list get_prop $names $rows $handlers $index [llength $names]]
    }

    proc get_prop {names rows handlers index ident} {
	set col [lsearch -exact $names $ident]
	if {$col < 0} {
	    error "unknown property: $ident"
	}
	set h [lindex $handlers $col]
	set ret [mvec $v::node($h) $index]

	return $ret
    }

    proc dbopen {db file} {
	# open datafile, stores datafile descriptors and starts building tree
	if {$db == ""} {
	    set r {}
	    foreach {k v} [array get v::dbs] {
		lappend r $k [lindex $v 0]
	    }
	    return $r
	}
	fetch $file
	header
	if {[get_v] != 0} {
	    error "dbopen?"
	}
	set desc [layout [get_s [get_v]]]
	lassign [descparse $desc] names types
	set root [get_sub $names [list [prepare $types]] 0]
	set v::dbs($db) [list $file $v::data $desc [mvec $root 0]]
	return $db
    }

    proc dbclose {db} {
	# close datafile, get rid of stored info
	unset v::dbs($db)
	set v::data "" ;# it may be big 
    }

    proc dbtree {db} {
	# datafile selection, first step in access navigation loop
	return [lindex $v::dbs($db) 3]
    }

    proc access {spec} {
	# this is the main access navigation loop
	set s [split $spec ".!"]
	set x [list dbtree [array size v::dbs]]
	foreach y $s {
	    set x [mvec $x $y]
	}
	return $x
    }

    proc vnames {view} {
	# return a list of property names
	if {[lindex $view 0] != "get_view"} {
	    error "vnames?"
	}
	return [lindex $view 1]
    }

    proc vlen {view} {
	# return the number of rows in this view
	if {[lindex $view 0] != "get_view"} {
	    error "vlen?"
	}
	return [lindex $view 2]
    }

    # vim: ft=tcl

}

if {[info comm mk_file] == ""} {
    # Compatibility layer for MetaKit

    # requires dbopen/dbclose/dbtree/access/vnames/vlen/mvec primitives
    #source [file join [info dirname [info script]] decode.tcl]

    namespace export mk_*

    proc mk_file {cmd args} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::file $cmd $args"
	lassign $args db file
	switch $cmd {
	    open {
		    return [dbopen $db $file]
		}
	    close {
		    dbclose $db
		}
	    views {
		    return [vnames [dbtree $db]]
		}
	    commit {

		}
	    default {
		    error "mk_file $cmd?"
		}
	}
    }

    proc mk_view {cmd path args} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::view $cmd $path $args"
	lassign $args a1
	switch $cmd {
	    info {
		    return [vnames [access $path]]
		}
	    layout {
		    set layout "NOTYET"
		    if {[llength $args] > 0 && $layout != $a1} {
			#error "view restructuring not supported"
		    }
		    return $layout
		}
	    size {
		    set len [vlen [access $path]]
		    if {[llength $args] > 0 && $len != $a1} {
			error "view resizing not supported"
		    }
		    return [vlen [access $path]]
		}
	    default {
		    error "mk_view $cmd?"
		}
	}
    }

    proc mk_cursor {cmd cursor args} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::cursor $cmd $cursor $args"
	upvar $cursor v
	switch $cmd {
	    create {
		    NOTYET
		}
	    incr {
		    NOTYET
		}
	    pos -
	    position {
		    if {$args != ""} {
			regsub {!-?\d+$} $v {} v
			append v !$args
			return $args
		    }
		    if {![regexp {\d+$} $v n]} {
			set n -1
		    }
		    return $n
		}
	    default {
		    error "mk_cursor $cmd?"
		}
	}
    }

    proc mk_get {path args} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::get $path $args"
	set rowref [access $path]
	set sized 0
	if {[lindex $args 0] == "-size"} {
	    set sized 1
	    set args [lrange $args 1 end]
	}
	set ids 0
	if {[llength $args] == 0} {
	    set args [vnames $rowref]
	    set ids 1
	}
	set r {}
	foreach x $args {
	    if {$ids} {
		lappend r $x
	    }
	    set v [mvec $rowref $x]
if {[string range $v 0 8] == "get_view "} {
# XXX: ?!?!?: TODO: FIX
set v 1
}
	    if {$sized} {
		lappend r [string length $v]
	    } else {
		lappend r $v
	    }
	}
	if {[llength $args] == 1} {
	    set r [lindex $r 0]
	}

	return $r
    }

    proc mk_loop {cursor path args} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::loop $cursor $path ..."
	upvar $cursor v
	if {[llength $args] == 0} {
	    set args [list $path]
	    set path $v
	    regsub {!-?\d+$} $path {} path
	}
	lassign $args a1 a2 a3 a4
	set rowref [access $path]
	set first 0
	set limit [vlen $rowref]
	set step 1
	switch [llength $args] {
	    1 {
		    set body $a1
		}
	    2 {
		    set first $a1
		    set body $a2
		}
	    3 {
		    set first $a1
		    set limit $a2
		    set body $a3
		}
	    4 {
		    set first $a1
		    set limit $a2
		    set step $a3
		    set body $a4
		}
	    default {
		    error "mk_loop arg count?"
		}
	}
	set code 0
	for {set i $first} {$i < $limit} {incr i $step} {
	    set v $path!$i
	    set code [catch [list uplevel 1 $body] err]
	    switch $code {
		1 -
		2 {
			return -code $code $err
		    }
		3 {
			break
		    }
	    }
	}
    }

    proc mk_select {path args} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::select $path $args"
	# only handle the simplest case: exact matches
	if {[lindex $args 0] == "-count"} {
		set maxitems [lindex $args 1]
		set args [lrange $args 2 end]
	}

	set currmatchmode "caseinsensitive"

	set keys {}
	set value {}
	set matchmodes {}
	for {set idx 0} {$idx < [llength $args]} {incr idx 2} {
		switch -glob -- [lindex $args $idx] {
			"-glob" {
				set currmatchmode "glob"
				incr idx -1
				continue
			}
			"-*" {
				error "Unhandled option: [lindex $args $idx]"
			}
		}

		set k [lindex $args $idx]
		set v [lindex $args [expr {$idx+1}]]

		lappend keys $k
		lappend values $v
		lappend matchmodes $currmatchmode
	}
	set r {}
	mk_loop c $path {
		set x [eval mk_get $c $keys]
		set matchCnt 0
		for {set idx 0} {$idx < [llength $x]} {incr idx} {
			set val [lindex $values $idx]
			set chkval [lindex $x $idx]
			set matchmode [lindex $matchmodes $idx]

			switch -- $matchmode {
				"caseinsensitive" {
					if {$val == $chkval} {
						incr matchCnt
					}
				}
				"glob" {
					if {[string match $val $chkval]} {
						incr matchCnt
					}
				}
			}

		}
		if {$matchCnt == [llength $keys]} {
			lappend r [mk_cursor position c]
		}
	}

	if {[info exists maxitems]} {
		set r [lrange $r 0 [expr $maxitems - 1]]
	}

	return $r
    }

    proc mk__rechan {path prop cmd chan args} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::_rechan $path $prop $cmd $chan $args"

        set key [list $path $prop]
        if {![info exists ::mk__cache($key)]} {
          set ::mk__cache($key) [readkit::get $path $prop]
        }
        if {![info exists ::mk__offset($key)]} {
          set ::mk__offset($key) 0
        }
        set data $::mk__cache($key)
        set offset $::mk__offset($key)

        switch -- $cmd {
            "read" {
                set count [lindex $args 0]
                set retval [string range $data $offset [expr {$offset + $count - 1}]]

                set readbytes [string length $retval]

                incr offset $readbytes
            }
            "close" {
                unset -nocomplain ::mk__cache($key)
                unset -nocomplain ::mk__offset($key)
                return
            }
            default {
#puts stderr "${indent}DEBUG: readkit::_rechan: Called for cmd $cmd"
                return -code error "Not implemented: cmd = $cmd"
            }
        }

        set ::mk__offset($key) $offset

	return $retval
    }

    proc mk_channel {path prop {mode "r"}} {
#set indent [string repeat "    " [info level]]
#puts stderr "${indent}DEBUG: readkit::channel $path $prop $mode"
	set fd [rechan [list mk__rechan $path $prop] 2]

	return $fd
    }
    # vim: ft=tcl

}

# set up the MetaKit compatibility definitions
foreach x {file view cursor get loop select channel} {
    interp alias {} ::readkit::$x {} ::mk_$x
}



# mk4vfs.tcl -- Mk4tcl Virtual File System driver
# Copyright (C) 1997-2003 Sensus Consulting Ltd. All Rights Reserved.
# Matt Newman <matt@sensus.org> and Jean-Claude Wippler <jcw@equi4.com>
#
# $Id: mk4vfs.tcl,v 1.41 2008/04/15 21:11:53 andreas_kupries Exp $
#
# 05apr02 jcw	1.3	fixed append mode & close,
#			privatized memchan_handler
#			added zip, crc back in
# 28apr02 jcw	1.4	reorged memchan and pkg dependencies
# 22jun02 jcw	1.5	fixed recursive dir deletion
# 16oct02 jcw	1.6	fixed periodic commit once a change is made
# 20jan03 jcw	1.7	streamed zlib decompress mode, reduces memory usage
# 01feb03 jcw	1.8	fix mounting a symlink, cleanup mount/unmount procs
# 04feb03 jcw	1.8	whoops, restored vfs::mkcl::Unmount logic
# 17mar03 jcw	1.9	start with mode translucent or readwrite
# 18oct05 jcw	1.10	add fallback to MK Compatible Lite driver (vfs::mkcl)

# Removed provision of the backward compatible name. Moved to separate
# file/package.
catch {
	load {} vfs
}
package require vfs

# things that can no longer really be left out (but this is the wrong spot!)
# be as non-invasive as possible, using these definitions as last resort

namespace eval vfs::mkcl {
    proc Mount {mkfile local args} {
	if {$mkfile != ""} {
	  # dereference a symlink, otherwise mounting on it fails (why?)
	  catch {
	    set mkfile [file join [file dirname $mkfile] \
	    			  [file readlink $mkfile]]
	  }
	  set mkfile [file normalize $mkfile]
	}
	set db [eval [list ::mkcl_vfs::_mount $mkfile] $args]
	::vfs::filesystem mount $local [list ::vfs::mkcl::handler $db]
	::vfs::RegisterMount $local [list ::vfs::mkcl::Unmount $db]
	return $db
    }

    proc Unmount {db local} {
	vfs::filesystem unmount $local
	::mkcl_vfs::_umount $db
    }

    proc attributes {db} { return [list "state" "commit"] }
    
    # Can use this to control commit/nocommit or whatever.
    # I'm not sure yet of what functionality jcw needs.
    proc commit {db args} {
	switch -- [llength $args] {
	    0 {
		if {$::mkcl_vfs::v::mode($db) == "readonly"} {
		    return 0
		} else {
		    # To Do: read the commit state
		    return 1
		}
	    }
	    1 {
		set val [lindex $args 0]
		if {$val != 0 && $val != 1} {
		    return -code error \
		      "invalid commit value $val, must be 0,1"
		}
		# To Do: set the commit state.
	    }
	    default {
		return -code error "Wrong num args"
	    }
	}
    }
    
    proc state {db args} {
	switch -- [llength $args] {
	    0 {
		return $::mkcl_vfs::v::mode($db)
	    }
	    1 {
		set val [lindex $args 0]
		if {[lsearch -exact [::vfs::states] $val] == -1} {
		    return -code error \
		      "invalid state $val, must be one of: [vfs::states]"
		}
		set ::mkcl_vfs::v::mode($db) $val
		::mkcl_vfs::setupCommits $db
	    }
	    default {
		return -code error "Wrong num args"
	    }
	}
    }
    
    proc handler {db cmd root relative actualpath args} {
	#puts stderr "handler: $db - $cmd - $root - $relative - $actualpath - $args"
	if {$cmd == "matchindirectory"} {
	    eval [list $cmd $db $relative $actualpath] $args
	} elseif {$cmd == "fileattributes"} {
	    eval [list $cmd $db $root $relative] $args
	} else {
	    eval [list $cmd $db $relative] $args
	}
    }

    proc utime {db path actime modtime} {
	::mkcl_vfs::stat $db $path sb
	
	if { $sb(type) == "file" } {
	    readkit::set $sb(ino) date $modtime
	}
    }

    proc matchindirectory {db path actualpath pattern type} {
	set newres [list]
	if {![string length $pattern]} {
	    # check single file
	    if {[catch {access $db $path 0}]} {
		return {}
	    }
	    set res [list $actualpath]
	    set actualpath ""
	} else {
	    set res [::mkcl_vfs::getdir $db $path $pattern]
	}
	foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
	    lappend newres [file join $actualpath $p]
	}
	return $newres
    }

    proc stat {db name} {
	::mkcl_vfs::stat $db $name sb

	set sb(ino) 0
	array get sb
    }

    proc access {db name mode} {
	if {$mode & 2} {
	    if {$::mkcl_vfs::v::mode($db) == "readonly"} {
		vfs::filesystem posixerror $::vfs::posix(EROFS)
	    }
	}
	# We can probably do this more efficiently, can't we?
	::mkcl_vfs::stat $db $name sb
    }

    proc open {db file 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 -glob -- $mode {
	    {}  -
	    r {
		::mkcl_vfs::stat $db $file sb

		if { $sb(csize) != $sb(size) } {
		    if {$::mkcl_vfs::zstreamed} {
		      set fd [readkit::channel $sb(ino) contents r]
		      fconfigure $fd -translation binary
		      set fd [vfs::zstream decompress $fd $sb(csize) $sb(size)]
		    } else {
		      set fd [vfs::memchan]
		      fconfigure $fd -translation binary
		      set s [readkit::get $sb(ino) contents]
		      puts -nonewline $fd [vfs::zip -mode decompress $s]

		      fconfigure $fd -translation auto
		      seek $fd 0
		    }
		} elseif { $::mkcl_vfs::direct } {
		    set fd [vfs::memchan]
		    fconfigure $fd -translation binary
		    puts -nonewline $fd [readkit::get $sb(ino) contents]

		    fconfigure $fd -translation auto
		    seek $fd 0
		} else {
		    set fd [readkit::channel $sb(ino) contents r]
		}
		return [list $fd]
	    }
	    a {
		if {$::mkcl_vfs::v::mode($db) == "readonly"} {
		    vfs::filesystem posixerror $::vfs::posix(EROFS)
		}
		if { [catch {::mkcl_vfs::stat $db $file sb }] } {
		    # Create file
		    ::mkcl_vfs::stat $db [file dirname $file] sb
		    set tail [file tail $file]
		    set fview $sb(ino).files
		    if {[info exists mkcl_vfs::v::fcache($fview)]} {
			lappend mkcl_vfs::v::fcache($fview) $tail
		    }
		    set now [clock seconds]
		    set sb(ino) [readkit::row append $fview \
			    name $tail size 0 date $now ]

		    if { [string match *z* $mode] || $mkcl_vfs::compress } {
			set sb(csize) -1  ;# HACK - force compression
		    } else {
			set sb(csize) 0
		    }
		}

		set fd [vfs::memchan]
		fconfigure $fd -translation binary
		set s [readkit::get $sb(ino) contents]

		if { $sb(csize) != $sb(size) && $sb(csize) > 0 } {
		    append mode z
		    puts -nonewline $fd [vfs::zip -mode decompress $s]
		} else {
		    if { $mkcl_vfs::compress } { append mode z }
		    puts -nonewline $fd $s
		    #set fd [readkit::channel $sb(ino) contents a]
		}
		fconfigure $fd -translation auto
		seek $fd 0 end
		return [list $fd [list mkcl_vfs::do_close $db $fd $mode $sb(ino)]]
	    }
	    w*  {
		if {$::mkcl_vfs::v::mode($db) == "readonly"} {
		    vfs::filesystem posixerror $::vfs::posix(EROFS)
		}
		if { [catch {::mkcl_vfs::stat $db $file sb }] } {
		    # Create file
		    ::mkcl_vfs::stat $db [file dirname $file] sb
		    set tail [file tail $file]
		    set fview $sb(ino).files
		    if {[info exists mkcl_vfs::v::fcache($fview)]} {
			lappend mkcl_vfs::v::fcache($fview) $tail
		    }
		    set now [clock seconds]
		    set sb(ino) [readkit::row append $fview \
			    name $tail size 0 date $now ]
		}

		if { [string match *z* $mode] || $mkcl_vfs::compress } {
		    append mode z
		    set fd [vfs::memchan]
		} else {
		    set fd [readkit::channel $sb(ino) contents w]
		}
		return [list $fd [list mkcl_vfs::do_close $db $fd $mode $sb(ino)]]
	    }
	    default   {
		error "illegal access mode \"$mode\""
	    }
	}
    }

    proc createdirectory {db name} {
	mkcl_vfs::mkdir $db $name
    }

    proc removedirectory {db name recursive} {
	mkcl_vfs::delete $db $name $recursive
    }

    proc deletefile {db name} {
	mkcl_vfs::delete $db $name
    }

    proc fileattributes {db root relative args} {
	switch -- [llength $args] {
	    0 {
		# list strings
		return [::vfs::listAttributes]
	    }
	    1 {
		# get value
		set index [lindex $args 0]
		return [::vfs::attributesGet $root $relative $index]

	    }
	    2 {
		# set value
		if {$::mkcl_vfs::v::mode($db) == "readonly"} {
		    vfs::filesystem posixerror $::vfs::posix(EROFS)
		}
		set index [lindex $args 0]
		set val [lindex $args 1]
		return [::vfs::attributesSet $root $relative $index $val]
	    }
	}
    }
}

namespace eval mkcl_vfs {
    variable compress 1     ;# HACK - needs to be part of "Super-Block"
    variable flush    5000  ;# Auto-Commit frequency
    variable direct   0	    ;# read through a memchan, or from Mk4tcl if zero
    variable zstreamed 1    ;# decompress on the fly (needs zlib 1.1)

    namespace eval v {
	variable seq      0
	variable mode	    ;# array key is db, value is mode 
	             	     # (readwrite/translucent/readonly)
	variable timer	    ;# array key is db, set to afterid, periodicCommit

	array set cache {}
	array set fcache {}

	array set mode {exe translucent}
    }

    proc init {db} {
	readkit::view layout $db.dirs \
		{name:S parent:I {files {name:S size:I date:I contents:M}}}

	if { [readkit::view size $db.dirs] == 0 } {
	    readkit::row append $db.dirs name <root> parent -1
	}
    }

    proc _mount {{file ""} args} {
	set db mk4vfs[incr v::seq]

	if {$file == ""} {
	    readkit::file open $db
	    init $db
	    set v::mode($db) "translucent"
	} else {
	    eval [list readkit::file open $db $file] $args
	    
	    init $db
	    
	    set mode 0
	    foreach arg $args {
		switch -- $arg {
		    -readonly   { set mode 1 }
		    -nocommit   { set mode 2 }
		}
	    }
	    if {$mode == 0} {
		periodicCommit $db
	    }
	    set v::mode($db) [lindex {translucent readwrite readwrite} $mode]
	}
	return $db
    }

    proc periodicCommit {db} {
	variable flush
	set v::timer($db) [after $flush [list ::mkcl_vfs::periodicCommit $db]]
	readkit::file commit $db
	return ;# 2005-01-20 avoid returning a value
    }

    proc _umount {db args} {
	catch {after cancel $v::timer($db)}
	array unset v::mode $db
	array unset v::timer $db
	array unset v::cache $db,*
	array unset v::fcache $db.*
	readkit::file close $db
    }

    proc stat {db path {arr ""}} {
	set sp [::file split $path]
	set tail [lindex $sp end]

	set parent 0
	set view $db.dirs
	set type directory

	foreach ele [lrange $sp 0 end-1] {
	    if {[info exists v::cache($db,$parent,$ele)]} {
		set parent $v::cache($db,$parent,$ele)
	    } else {
		set row [readkit::select $view -count 1 parent $parent name $ele]
		if { $row == "" } {
		    vfs::filesystem posixerror $::vfs::posix(ENOENT)
		}
		set v::cache($db,$parent,$ele) $row
		set parent $row
	    }
	}
	
	# Now check if final comp is a directory or a file
	# CACHING is required - it can deliver a x15 speed-up!
	
	if { [string equal $tail "."] || [string equal $tail ":"] \
	  || [string equal $tail ""] } {
	    set row $parent

	} elseif { [info exists v::cache($db,$parent,$tail)] } {
	    set row $v::cache($db,$parent,$tail)
	} else {
	    # File?
	    set fview $view!$parent.files
	    # create a name cache of files in this directory
	    if {![info exists v::fcache($fview)]} {
		# cache only a limited number of directories
		if {[array size v::fcache] >= 10} {
		    array unset v::fcache *
		}
		set v::fcache($fview) {}
		readkit::loop c $fview {
		    lappend v::fcache($fview) [readkit::get $c name]
		}
	    }
	    set row [lsearch -exact $v::fcache($fview) $tail]
	    #set row [readkit::select $fview -count 1 name $tail]
	    #if {$row == ""} { set row -1 }
	    if { $row != -1 } {
		set type file
		set view $view!$parent.files
	    } else {
		# Directory?
		set row [readkit::select $view -count 1 parent $parent name $tail]
		if { $row != "" } {
		    set v::cache($db,$parent,$tail) $row
		} else { 
		    vfs::filesystem posixerror $::vfs::posix(ENOENT)
		}
	    }
	}
 
        if {![string length $arr]} {
            # The caller doesn't need more detailed information.
            return 1
        }
 
	set cur $view!$row

	upvar 1 $arr sb

	set sb(type)    $type
	set sb(view)    $view
	set sb(ino)     $cur

	if { [string equal $type "directory"] } {
	    set sb(atime) 0
	    set sb(ctime) 0
	    set sb(gid)   0
	    set sb(mode)  0777
	    set sb(mtime) 0
	    set sb(nlink) [expr { [readkit::get $cur files] + 1 }]
	    set sb(size)  0
	    set sb(csize) 0
	    set sb(uid)   0
	} else {
	    set mtime   [readkit::get $cur date]
	    set sb(atime) $mtime
	    set sb(ctime) $mtime
	    set sb(gid)   0
	    set sb(mode)  0777
	    set sb(mtime) $mtime
	    set sb(nlink) 1
	    set sb(size)  [readkit::get $cur size]
	    set sb(csize) [readkit::get $cur -size contents]
	    set sb(uid)   0
	}
    }

    proc do_close {db fd mode cur} {
	if {![regexp {[aw]} $mode]} {
	    error "mkcl_vfs::do_close called with bad mode: $mode"
	}

	readkit::set $cur size -1 date [clock seconds]
	flush $fd
	if { [string match *z* $mode] } {
	    fconfigure $fd -translation binary
	    seek $fd 0
	    set data [read $fd]
	    set cdata [vfs::zip -mode compress $data]
	    set len [string length $data]
	    set clen [string length $cdata]
	    if { $clen < $len } {
		readkit::set $cur size $len contents $cdata
	    } else {
		readkit::set $cur size $len contents $data
	    }
	} else {
	    readkit::set $cur size [readkit::get $cur -size contents]
	}
	# 16oct02 new logic to start a periodic commit timer if not yet running
	setupCommits $db
	return ""
    }

    proc setupCommits {db} {
	if {$v::mode($db) eq "readwrite" && ![info exists v::timer($db)]} {
	    periodicCommit $db
	    readkit::file autocommit $db
	}
    }

    proc mkdir {db path} {
	if {$v::mode($db) == "readonly"} {
	    vfs::filesystem posixerror $::vfs::posix(EROFS)
	}
	set sp [::file split $path]
	set parent 0
	set view $db.dirs

	set npath {}
	# This actually does more work than is needed. Tcl's
	# vfs only requires us to create the last piece, and
	# Tcl already knows it is not a file.
	foreach ele $sp {
	    set npath [file join $npath $ele]

	    if {![catch {stat $db $npath sb}] } {
		if { $sb(type) != "directory" } {
		    vfs::filesystem posixerror $::vfs::posix(EROFS)
		}
		set parent [readkit::cursor position sb(ino)]
		continue
	    }
	    #set parent [readkit::cursor position sb(ino)]
	    set cur [readkit::row append $view name $ele parent $parent]
	    set parent [readkit::cursor position cur]
	}
	setupCommits $db
	return ""
    }

    proc getdir {db path {pat *}} {
	if {[catch { stat $db $path sb }] || $sb(type) != "directory" } {
	    return
	}

	# Match directories
	set parent [readkit::cursor position sb(ino)] 
	foreach row [readkit::select $sb(view) parent $parent -glob name $pat] {
	    set hits([readkit::get $sb(view)!$row name]) 1
	}
	# Match files
	set view $sb(view)!$parent.files
	foreach row [readkit::select $view -glob name $pat] {
	    set hits([readkit::get $view!$row name]) 1
	}
	return [lsort [array names hits]]
    }

    proc mtime {db path time} {
	if {$v::mode($db) == "readonly"} {
	    vfs::filesystem posixerror $::vfs::posix(EROFS)
	}
	stat $db $path sb
	if { $sb(type) == "file" } {
	    readkit::set $sb(ino) date $time
	}
	return $time
    }

    proc delete {db path {recursive 0}} {
	#puts stderr "mk4delete db $db path $path recursive $recursive"
	if {$v::mode($db) == "readonly"} {
	    vfs::filesystem posixerror $::vfs::posix(EROFS)
	}
	stat $db $path sb
	if {$sb(type) == "file" } {
	    readkit::row delete $sb(ino)
	    if {[regexp {(.*)!(\d+)} $sb(ino) - v r] \
		    && [info exists v::fcache($v)]} {
		set v::fcache($v) [lreplace $v::fcache($v) $r $r]
	    }
	} else {
	    # just mark dirs as deleted
	    set contents [getdir $db $path *]
	    if {$recursive} {
		# We have to delete these manually, else
		# they (or their cache) may conflict with
		# something later
		foreach f $contents {
		    delete $db [file join $path $f] $recursive
		}
	    } else {
		if {[llength $contents]} {
		    vfs::filesystem posixerror $::vfs::posix(ENOTEMPTY)
		}
	    }
	    array unset v::cache \
		    "$db,[readkit::get $sb(ino) parent],[file tail $path]"
	    
	    # flag with -99, because parent -1 is not reserved for the root dir
	    # deleted entries never get re-used, should be cleaned up one day
	    readkit::set $sb(ino) parent -99 name ""
	    # get rid of file entries to release the space in the datafile
	    readkit::view size $sb(ino).files 0
	}
	setupCommits $db
	return ""
    }
}

package provide readkit 0.8
package provide vfs::mkcl 2.4.0.1

# Removed provision of the backward compatible name. Moved to separate
# file/package.
package provide vfs::zip 1.0.1

package require vfs

# 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.

................................................................................
	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]

    # time = fedcba9876543210
    #        HHHHHmmmmmmSSSSS (sec/2 actually)

    # data = fedcba9876543210
................................................................................
    set hour [expr { ($time >> 11) & 0x1F }]

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

    # Fix up bad date/time data, no need to fail
    while {$sec  > 59} {incr sec  -60}
    while {$min  > 59} {incr sec  -60}
    while {$hour > 23} {incr hour -24}
    if {$mday < 1}  {incr mday}

    if {$mon  < 1}  {incr mon}
    while {$mon > 12} {incr hour -12}

    while {[catch {


	set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
		    $year $mon $mday $hour $min $sec]
	set res [clock scan $dt -gmt 1]
    }]} {
	# Only mday can be wrong, at end of month
	incr mday -1
    }

    return $res
}


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

................................................................................

    # 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} {
................................................................................
	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)]]
................................................................................
proc zip::_close {fd} {
    variable $fd
    variable $fd.toc
    unset $fd
    unset $fd.toc
    ::close $fd
}

# Removed provision of the backward compatible name. Moved to separate
# file/package.


package require vfs

# 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.

................................................................................
	128	{normal}
    }

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

proc zip::DosTime {date time} {
    # The pre-VFS environment will not have access to "clock", so don't even
    # bother
    return 0

    set time [u_short $time]
    set date [u_short $date]

    # time = fedcba9876543210
    #        HHHHHmmmmmmSSSSS (sec/2 actually)

    # data = fedcba9876543210
................................................................................
    set hour [expr { ($time >> 11) & 0x1F }]

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

    # Fix up bad date/time data, no need to fail
    if {$sec  > 59} {set sec  59}
    if {$min  > 59} {set sec  59}
    if {$hour > 23} {set hour 23}
    if {$mday < 1}  {set mday 1}
    if {$mday > 35} {set mday 35}
    if {$mon  < 1}  {set mon  1}
    if {$mon > 12}  {set mon  12}


    set res 0
    while {$mday > 1 && [catch {
	set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
		    $year $mon $mday $hour $min $sec]
	set res [clock scan $dt -gmt 1]
    }]} {
	# Only mday can be wrong, at end of month
	incr mday -1
    }

    return $res
}


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

................................................................................

    # 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 #0 zip::$fd cb
    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)

    set sb(ino) [expr {$cb(base) + $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} {
................................................................................
	upvar #0 zip::$fd cb
	upvar #0 zip::$fd.toc toc

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

	seek $fd [expr {$cb(base) + $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)]]
................................................................................
proc zip::_close {fd} {
    variable $fd
    variable $fd.toc
    unset $fd
    unset $fd.toc
    ::close $fd
}

# use zlib to define zip and crc if available
if {[llength [info command vfs::zip]] == 0 && [llength [info command zlib]] || ![catch {load "" zlib}]} {
	proc vfs::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] eq "-nowrap 1"} {
			if {$mode eq "compress"} {
				set mode deflate
			} else {
				set mode inflate
			}
		}

		return [zlib $mode [lindex $args end]]
	}
}

Binary files tclvfs-20080503.orig//library/.zipvfs.tcl.swp and tclvfs-20080503-1rsk//library/.zipvfs.tcl.swp differ
diff -uNr tclvfs-20080503.orig//library/zipvfs.tcl tclvfs-20080503-1rsk//library/zipvfs.tcl
--- tclvfs-20080503.orig//library/zipvfs.tcl	2008-04-15 16:11:53.000000000 -0500
+++ tclvfs-20080503-1rsk//library/zipvfs.tcl	2010-09-10 06:48:25.026165002 -0500
@@ -255,21 +255,21 @@
     set year [expr { (($date >> 9) & 0xFF) + 1980 }]
 
     # Fix up bad date/time data, no need to fail
-    while {$sec  > 59} {incr sec  -60}
-    while {$min  > 59} {incr sec  -60}
-    while {$hour > 23} {incr hour -24}
-    if {$mday < 1}  {incr mday}
-    if {$mon  < 1}  {incr mon}
-    while {$mon > 12} {incr hour -12}
+    if {$sec  > 59} {set sec  59}
+    if {$min  > 59} {set sec  59}
+    if {$hour > 23} {set hour 23}
+    if {$mday < 1}  {set mday 1}
+    if {$mday > 31} {set mday 31}
+    if {$mon  < 1}  {set mon  1}
+    if {$mon > 12}  {set mon  12}
 
-    while {[catch {
+    set res 0
+    catch {
 	set dt [format {%4.4d-%2.2d-%2.2d %2.2d:%2.2d:%2.2d} \
 		    $year $mon $mday $hour $min $sec]
 	set res [clock scan $dt -gmt 1]
-    }]} {
-	# Only mday can be wrong, at end of month
-	incr mday -1
     }
+
     return $res
 }
 
@@ -400,6 +400,7 @@
 }
 
 proc zip::TOC {fd arr} {
+    upvar #0 zip::$fd cb
     upvar 1 $arr sb
 
     set buf [read $fd 46]
@@ -410,6 +411,8 @@
       flen elen clen sb(disk) sb(attr) \
       sb(atx) sb(ino)
 
+    set sb(ino) [expr {$cb(base) + $sb(ino)}]
+
     if { ![string equal "PK\01\02" $hdr] } {
 	binary scan $hdr H* x
 	error "bad central header: $x"
@@ -442,7 +445,7 @@
 	
 	zip::EndOfArchive $fd cb
 
-	seek $fd $cb(coff) start
+	seek $fd [expr {$cb(base) + $cb(coff)}] start
 
 	set toc(_) 0; unset toc(_); #MakeArray