Tweaks to build

the zvfs.c file as a separate tool.

doc/tclsh.1

@@ -143,6 +143,15 @@ incomplete commands.
 .SH "STANDARD CHANNELS"
 .PP
 See \fBTcl_StandardChannels\fR for more explanations.
+.SH ZIPVFS
+.PP
+When a zipfile is concatenated to the end of a \fBtclsh\fR, on
+startup the contents of the zip archive will be mounted as the
+virtual file system /zvfs. If a top level directory tcl8.6 is
+present in the zip archive, it will become the directory loaded
+as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
+in the top level directory of the zip archive, it will be sourced
+instead of the shell's normal command line handing.
 .SH "SEE ALSO"
 auto_path(n), encoding(n), env(n), fconfigure(n)
 .SH KEYWORDS

doc/zvfs.n

@@ -0,0 +1,114 @@
+'\"
+'\" Copyright (c) 2014 Sean Woods
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH zvfs n 0.1 Zvfs "Zvfs Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+zvfs \- Mount and work with ZIP files within Tcl
+.SH SYNOPSIS
+.nf
+\fBpackage require zvfs \fR?\fB0.1\fR?
+.sp
+\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR?
+\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR?
+\fB::zvfs::dump\fR \fIzipfile\fR
+\fB::zvfs::exists\fR \fIfilename\fR
+\fB::zvfs::info\fR \fIfile\fR
+\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR?
+\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR?
+\fB::zvfs::start\fR \fIzipfile\fR
+\fB::zvfs::unmount \fIarchive\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBzvfs\fR package provides tcl with the ability to manipulate
+the contents of a zip file archive as a virtual file system.
+.TP
+\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR?
+.
+The \fB::zvfs::mount\fR procedure mounts a zipfile as a VFS.
+After this command
+executes, files contained in the ZIP archive, \fIarchive\fR, will appear to Tcl to be
+regular files at the mount point.
+.RS
+.PP
+With no \fImountpoint\fR, returns the mount point for \fIarchive\fR. With no \fIarchive\fR,
+return all archive/mount pairs. If \fImountpoint\fR is specified as an empty
+string, mount on file path.
+.RE
+.TP
+\fB::zvfs::unmount \fIarchive\fR
+.
+Unmounts a previously mounted zip, \fIarchive\fR.
+.TP
+\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR?
+.
+This command reads \fIsource\fR files and appends them (using the name
+\fIdestination\fR) to the zip archive named \fIarchive\fR. A new zip archive is created
+if it does not already exist. If \fIarchive\fR refers to a file which exists but
+is not a zip archive, then this command turns \fIarchive\fR into a zip archive by
+appending the necessary records and the table of contents. Treat all files
+as binary.
+.RS
+.PP
+Note: No duplicate checking is done, so multiple occurances of the same file is
+allowed.
+.RE
+.TP
+\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR?
+.
+This command is similar to \fBzvfs::append\fR in that it adds files to the zip archive
+named \fIarchive\fR, however file names are relative the current directory.  In
+addition, \fBfconfigure\fR is used to apply option pairs to set upon opening of
+each file.  Otherwise, default translation is allowed for those file
+extensions listed in the \fB::zvfs::auto_ext\fR variable.  Binary translation will be
+used for unknown extensions.
+.RS
+.PP
+NOTE: Use 
+.QW "\fB\-fconfigure {}\fR"
+to use auto translation for all.
+.RE
+.TP
+\fB::zvfs::exists\fR \fIfilename\fR
+.
+Return TRUE if the given filename exists in the mounted ZVFS and FALSE if it does
+not.
+.TP
+\fB::zvfs::info\fR \fIfile\fR
+.
+Return information about the given file in the mounted ZVFS.  The information
+consists of (1) the name of the ZIP archive that contains the file, (2) the
+size of the file after decompressions, (3) the compressed size of the file,
+and (4) the offset of the compressed data in the archive.
+.RS
+.PP
+Note: querying the mount point gives the start of zip data offset in (4),
+which can be used to truncate the zip info off an executable.
+.RE
+.TP
+\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR?
+.
+Return a list of all files in the mounted ZVFS.  The order of the names in the list
+is arbitrary.
+.TP
+\fB::zvfs::dump\fR \fIzipfile\fR
+.
+Describe the contents of a zip.
+.TP
+\fB::zvfs::start\fR \fIzipfile\fR
+.
+This command strips returns the offset of zip data.
+.SH "SEE ALSO"
+tclsh(1), file(n), zlib(n)
+.SH "KEYWORDS"
+compress, filesystem, zip
+'\" Local Variables:
+'\" mode: nroff
+'\" End:

generic/tclBootVfs.h

@@ -0,0 +1,24 @@
+#include <tcl.h>
+#include "tclInt.h"
+#include "tclFileSystem.h"
+
+#ifndef MODULE_SCOPE
+#   define MODULE_SCOPE extern
+#endif
+
+#define TCLVFSBOOT_INIT     "main.tcl"
+#define TCLVFSBOOT_MOUNT    "/zvfs"
+
+/* Make sure the stubbed variants of those are never used. */
+#undef Tcl_ObjSetVar2
+#undef Tcl_NewStringObj
+#undef Tk_Init
+#undef Tk_MainEx
+#undef Tk_SafeInit
+
+MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *);
+MODULE_SCOPE int Zvfs_Init(Tcl_Interp *);
+MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *);
+MODULE_SCOPE int Tclkit_Packages_Init(Tcl_Interp *);
+
+

generic/tclZipTools.c

@@ -0,0 +1,996 @@
+/*
+** Copyright (c) 2000 D. Richard Hipp
+** Copyright (c) 2007 PDQ Interfaces Inc.
+** Copyright (c) 2014 Sean Woods
+**
+** This file is now released under the BSD style license
+** outlined in the included file license.terms.
+**
+*************************************************************************
+**
+** Utilities to Create, Modify and Introspect Zip files
+** Originally distributed as part of ZipVfs.c, split into
+** Their own file for clarity.
+**
+** This version has been modified to run under Tcl 8.6
+**
+*/
+#include "tcl.h"
+#include <ctype.h>
+#include <zlib.h>
+#include <errno.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <time.h>
+
+/*
+** Size of the decompression input buffer
+*/
+#define COMPR_BUF_SIZE   8192
+static int maptolower=0;
+static int openarch=0;  /* Set to 1 when opening archive. */
+
+/*
+** All static variables are collected into a structure named "local".
+** That way, it is clear in the code when we are using a static
+** variable because its name begins with "local.".
+*/
+static struct {
+  Tcl_HashTable fileHash;     /* One entry for each file in the ZVFS.  The
+                              ** The key is the virtual filename.  The data
+                              ** an an instance of the ZvfsFile structure. */
+  Tcl_HashTable archiveHash;  /* One entry for each archive.  Key is the name. 
+                              ** data is the ZvfsArchive structure */
+  int isInit;                 /* True after initialization */
+} local;
+
+/*
+** Each ZIP archive file that is mounted is recorded as an instance
+** of this structure
+*/
+typedef struct ZvfsArchive {
+  char *zName;              /* Name of the archive */
+  char *zMountPoint;        /* Where this archive is mounted */
+  struct ZvfsFile *pFiles;  /* List of files in that archive */
+} ZvfsArchive;
+
+/*
+** Particulars about each virtual file are recorded in an instance
+** of the following structure.
+*/
+typedef struct ZvfsFile {
+  char *zName;              /* The full pathname of the virtual file */
+  ZvfsArchive *pArchive;    /* The ZIP archive holding this file data */
+  int iOffset;              /* Offset into the ZIP archive of the data */
+  int nByte;                /* Uncompressed size of the virtual file */
+  int nByteCompr;           /* Compressed size of the virtual file */
+  time_t timestamp;            /* Modification time */
+  int isdir;		    /* Set to 2 if directory, or 1 if mount */
+  int depth; 		    /* Number of slashes in path. */
+  int permissions;          /* File permissions. */
+  struct ZvfsFile *pNext;      /* Next file in the same archive */
+  struct ZvfsFile *pNextName;  /* A doubly-linked list of files with the same */
+  struct ZvfsFile *pPrevName;  /*  name.  Only the first is in local.fileHash */
+} ZvfsFile;
+
+/*
+** Information about each file within a ZIP archive is stored in
+** an instance of the following structure.  A list of these structures
+** forms a table of contents for the archive.
+*/
+typedef struct ZFile ZFile;
+struct ZFile {
+  char *zName;         /* Name of the file */
+  int isSpecial;       /* Not really a file in the ZIP archive */
+  int dosTime;         /* Modification time (DOS format) */
+  int dosDate;         /* Modification date (DOS format) */
+  int iOffset;         /* Offset into the ZIP archive of the data */
+  int nByte;           /* Uncompressed size of the virtual file */
+  int nByteCompr;      /* Compressed size of the virtual file */
+  int nExtra;          /* Extra space in the TOC header */
+  int iCRC;            /* Cyclic Redundancy Check of the data */
+  int permissions;     /* File permissions. */
+  int flags;		    /* Deletion = bit 0. */
+  ZFile *pNext;        /* Next file in the same archive */
+};
+
+/*
+** Macros to read 16-bit and 32-bit big-endian integers into the
+** native format of this local processor.  B is an array of
+** characters and the integer begins at the N-th character of
+** the array.
+*/
+#define INT16(B, N) (B[N] + (B[N+1]<<8))
+#define INT32(B, N) (INT16(B,N) + (B[N+2]<<16) + (B[N+3]<<24))
+
+static int ZvfsAppendObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv);
+static int ZvfsAddObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv);
+static int ZvfsDumpObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv);
+static int ZvfsStartObjCmd( void *NotUsed, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv);
+
+/*
+** Write a 16- or 32-bit integer as little-endian into the given buffer.
+*/
+static void put16(char *z, int v){
+  z[0] = v & 0xff;
+  z[1] = (v>>8) & 0xff;
+}
+static void put32(char *z, int v){
+  z[0] = v & 0xff;
+  z[1] = (v>>8) & 0xff;
+  z[2] = (v>>16) & 0xff;
+  z[3] = (v>>24) & 0xff;
+}
+
+/*
+** Make a new ZFile structure with space to hold a name of the number of
+** characters given.  Return a pointer to the new structure.
+*/
+static ZFile *newZFile(int nName, ZFile **ppList){
+  ZFile *pNew;
+
+  pNew = (ZFile*)Tcl_Alloc( sizeof(*pNew) + nName + 1 );
+  memset(pNew, 0, sizeof(*pNew));
+  pNew->zName = (char*)&pNew[1];
+  pNew->pNext = *ppList;
+  *ppList = pNew;
+  return pNew;
+}
+
+/*
+** Delete an entire list of ZFile structures
+*/
+static void deleteZFileList(ZFile *pList){
+  ZFile *pNext;
+  while( pList ){
+    pNext = pList->pNext;
+    Tcl_Free((char*)pList);
+    pList = pNext;
+  }
+}
+
+/* Convert DOS time to unix time. */
+static void UnixTimeDate(struct tm *tm, int *dosDate, int *dosTime){
+  *dosDate = ((((tm->tm_year-80)<<9)&0xfe00) | (((tm->tm_mon+1)<<5)&0x1e0) | (tm->tm_mday&0x1f));
+  *dosTime = (((tm->tm_hour<<11)&0xf800) | ((tm->tm_min<<5)&0x7e0) | (tm->tm_sec&0x1f));
+}
+
+/* Convert DOS time to unix time. */
+static time_t DosTimeDate(int dosDate, int dosTime){
+  time_t now;
+  struct tm *tm;
+  now=time(NULL);
+  tm = localtime(&now);
+  tm->tm_year=(((dosDate&0xfe00)>>9) + 80);
+  tm->tm_mon=((dosDate&0x1e0)>>5);
+  tm->tm_mday=(dosDate & 0x1f);
+  tm->tm_hour=(dosTime&0xf800)>>11;
+  tm->tm_min=(dosTime&0x7e0)>>5;
+  tm->tm_sec=(dosTime&0x1f);
+  return mktime(tm);
+}
+
+/*
+** Translate a DOS time and date stamp into a human-readable string.
+*/
+static void translateDosTimeDate(char *zStr, int dosDate, int dosTime){
+  static char *zMonth[] = { "nil",
+    "Jan", "Feb", "Mar", "Apr", "May", "Jun",
+    "Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
+  };
+ 
+  sprintf(zStr, "%02d-%s-%d %02d:%02d:%02d", 
+    dosDate & 0x1f,
+    zMonth[ ((dosDate&0x1e0)>>5) ],
+    ((dosDate&0xfe00)>>9) + 1980,
+    (dosTime&0xf800)>>11,
+    (dosTime&0x7e)>>5,
+    dosTime&0x1f
+  );
+}
+
+/* Return count of char ch in str */
+static int strchrcnt(char *str, char ch) {
+  int cnt=0;
+  char *cp=str;
+  while ((cp=strchr(cp,ch))) { cp++; cnt++; }
+  return cnt;
+}
+
+
+int ZvfsReadTOCStart(
+  Tcl_Interp *interp,    /* Leave error messages in this interpreter */
+  Tcl_Channel chan,
+  ZFile **pList,
+  int *iStart
+) {
+  char *zArchiveName = 0;    /* A copy of zArchive */
+  int nFile;                 /* Number of files in the archive */
+  int iPos;                  /* Current position in the archive file */
+  ZvfsArchive *pArchive;     /* The ZIP archive being mounted */
+  Tcl_HashEntry *pEntry;     /* Hash table entry */
+  int isNew;                 /* Flag to tell use when a hash entry is new */
+  unsigned char zBuf[100];   /* Space into which to read from the ZIP archive */
+  Tcl_HashSearch zSearch;   /* Search all mount points */
+  ZFile *p;
+  int zipStart;
+
+  if (!chan) {
+    return TCL_ERROR;
+  }
+  if (Tcl_SetChannelOption(interp, chan, "-translation", "binary") != TCL_OK){
+    return TCL_ERROR;
+  }
+  if (Tcl_SetChannelOption(interp, chan, "-encoding", "binary") != TCL_OK) {
+    return TCL_ERROR;
+  }
+
+  /* Read the "End Of Central Directory" record from the end of the
+  ** ZIP archive.
+  */
+  iPos = Tcl_Seek(chan, -22, SEEK_END);
+  Tcl_Read(chan, zBuf, 22);
+  if (memcmp(zBuf, "\120\113\05\06", 4)) {
+    /* Tcl_AppendResult(interp, "not a ZIP archive", NULL); */
+    return TCL_BREAK;
+  }
+
+  /* Compute the starting location of the directory for the ZIP archive
+  ** in iPos then seek to that location.
+  */
+  zipStart = iPos;
+  nFile = INT16(zBuf,8);
+  iPos -= INT32(zBuf,12);
+  Tcl_Seek(chan, iPos, SEEK_SET);
+
+  while(1) {
+    int lenName;            /* Length of the next filename */
+    int lenExtra;           /* Length of "extra" data for next file */
+    int iData;              /* Offset to start of file data */
+    int dosTime;
+    int dosDate;
+    int isdir;
+    ZvfsFile *pZvfs;        /* A new virtual file */
+    char *zFullPath;        /* Full pathname of the virtual file */
+    char zName[1024];       /* Space to hold the filename */
+
+    if (nFile-- <= 0 ){
+	break;
+    }
+    /* Read the next directory entry.  Extract the size of the filename,
+    ** the size of the "extra" information, and the offset into the archive
+    ** file of the file data.
+    */
+    Tcl_Read(chan, zBuf, 46);
+    if (memcmp(zBuf, "\120\113\01\02", 4)) {
+      Tcl_AppendResult(interp, "ill-formed central directory entry", NULL);
+      return TCL_ERROR;
+    }
+    lenName = INT16(zBuf,28);
+    lenExtra = INT16(zBuf,30) + INT16(zBuf,32);
+    iData = INT32(zBuf,42);
+    if (iData<zipStart) {
+        zipStart = iData;
+    }
+
+    p = newZFile(lenName, pList);
+    if (!p) break;
+
+    Tcl_Read(chan, p->zName, lenName);
+    p->zName[lenName] = 0;
+    if (lenName>0 && p->zName[lenName-1] == '/') {
+	p->isSpecial = 1;
+    }
+    p->dosDate = INT16(zBuf, 14);
+    p->dosTime = INT16(zBuf, 12);
+    p->nByteCompr = INT32(zBuf, 20);
+    p->nByte = INT32(zBuf, 24);
+    p->nExtra = INT32(zBuf, 28);
+    p->iCRC = INT32(zBuf, 32);
+
+    if (nFile < 0)
+	break;
+
+    /* Skip over the extra information so that the next read will be from
+    ** the beginning of the next directory entry.
+    */
+    Tcl_Seek(chan, lenExtra, SEEK_CUR);
+  }
+  *iStart = zipStart;
+  return TCL_OK;
+}
+
+/************************************************************************/
+/************************************************************************/
+/************************************************************************/
+
+/*
+** Implement the zvfs::dump command
+**
+**    zvfs::dump  ARCHIVE
+**
+** Each entry in the list returned is of the following form:
+**
+**   {FILENAME  DATE-TIME  SPECIAL-FLAG  OFFSET  SIZE  COMPRESSED-SIZE}
+**
+*/
+static int ZvfsDumpObjCmd(
+  void *NotUsed,             /* Client data for this command */
+  Tcl_Interp *interp,        /* The interpreter used to report errors */
+  int objc,                  /* Number of arguments */
+  Tcl_Obj *const* objv       /* Values of all arguments */
+){
+  char *zFilename;
+  Tcl_Channel chan;
+  ZFile *pList;
+  int rc,zipstart;
+  Tcl_Obj *pResult;
+
+  if( objc!=2 ){
+    Tcl_WrongNumArgs(interp, 1, objv, "FILENAME");
+    return TCL_ERROR;
+  }
+  zFilename = Tcl_GetString(objv[1]);
+  chan = Tcl_OpenFileChannel(interp, zFilename, "r", 0);
+  if( chan==0 ) return TCL_ERROR;
+  rc = ZvfsReadTOCStart(interp, chan, &pList,&zipstart);
+  if( rc==TCL_ERROR ){
+    deleteZFileList(pList);
+    return rc;
+  }
+  Tcl_Close(interp, chan);
+  pResult = Tcl_GetObjResult(interp);
+  while( pList ){
+    Tcl_Obj *pEntry = Tcl_NewObj();
+    ZFile *pNext;
+    char zDateTime[100];
+    Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewStringObj(pList->zName,-1));
+    translateDosTimeDate(zDateTime, pList->dosDate, pList->dosTime);
+    Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewStringObj(zDateTime, -1));
+    Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->isSpecial));
+    Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->iOffset));
+    Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByte));
+    Tcl_ListObjAppendElement(interp, pEntry, Tcl_NewIntObj(pList->nByteCompr));
+    Tcl_ListObjAppendElement(interp, pResult, pEntry);
+    pNext = pList->pNext;
+    Tcl_Free((char*)pList);
+    pList = pList->pNext;
+  }
+  return TCL_OK;
+}
+
+/*
+** Write a file record into a ZIP archive at the current position of
+** the write cursor for channel "chan".  Add a ZFile record for the file
+** to *ppList.  If an error occurs, leave an error message on interp
+** and return TCL_ERROR.  Otherwise return TCL_OK.
+*/
+static int writeFile(
+  Tcl_Interp *interp,     /* Leave an error message here */
+  Tcl_Channel out,        /* Write the file here */
+  Tcl_Channel in,         /* Read data from this file */
+  char *zSrc,             /* Name the new ZIP file entry this */
+  char *zDest,            /* Name the new ZIP file entry this */
+  ZFile **ppList          /* Put a ZFile struct for the new file here */
+){
+  z_stream stream;
+  ZFile *p;
+  int iEndOfData;
+  int nameLen;
+  int skip;
+  int toOut;
+  char zHdr[30];
+  char zInBuf[100000];
+  char zOutBuf[100000];
+  struct tm *tm;
+  time_t now;
+  struct stat stat;
+
+  /* Create a new ZFile structure for this file.
+   * TODO: fill in date/time etc.
+  */
+  nameLen = strlen(zDest);
+  p = newZFile(nameLen, ppList);
+  strcpy(p->zName, zDest);
+  p->isSpecial = 0;
+  Tcl_Stat(zSrc, &stat);
+  now=stat.st_mtime;
+  tm = localtime(&now);
+  UnixTimeDate(tm, &p->dosDate, &p->dosTime);
+  p->iOffset = Tcl_Tell(out);
+  p->nByte = 0;
+  p->nByteCompr = 0;
+  p->nExtra = 0;
+  p->iCRC = 0;
+  p->permissions = stat.st_mode;
+
+  /* Fill in as much of the header as we know.
+  */
+  put32(&zHdr[0], 0x04034b50);
+  put16(&zHdr[4], 0x0014);
+  put16(&zHdr[6], 0);
+  put16(&zHdr[8], 8);
+  put16(&zHdr[10], p->dosTime);
+  put16(&zHdr[12], p->dosDate);
+  put16(&zHdr[26], nameLen);
+  put16(&zHdr[28], 0);
+
+  /* Write the header and filename.
+  */
+  Tcl_Write(out, zHdr, 30);
+  Tcl_Write(out, zDest, nameLen);
+
+  /* The first two bytes that come out of the deflate compressor are
+  ** some kind of header that ZIP does not use.  So skip the first two
+  ** output bytes.
+  */
+  skip = 2;
+
+  /* Write the compressed file.  Compute the CRC as we progress.
+  */
+  stream.zalloc = (alloc_func)0;
+  stream.zfree = (free_func)0;
+  stream.opaque = 0;
+  stream.avail_in = 0;
+  stream.next_in = zInBuf;
+  stream.avail_out = sizeof(zOutBuf);
+  stream.next_out = zOutBuf;
+#if 1
+  deflateInit(&stream, 9);
+#else
+  {
+    int i, err, WSIZE = 0x8000, windowBits, level=6;
+    for (i = ((unsigned)WSIZE), windowBits = 0; i != 1; i >>= 1, ++windowBits);
+    err = deflateInit2(&stream, level, Z_DEFLATED, -windowBits, 8, 0);
+
+  }
+#endif
+  p->iCRC = crc32(0, 0, 0);
+  while( !Tcl_Eof(in) ){
+    if( stream.avail_in==0 ){
+      int amt = Tcl_Read(in, zInBuf, sizeof(zInBuf));
+      if( amt<=0 ) break;
+      p->iCRC = crc32(p->iCRC, zInBuf, amt);
+      stream.avail_in = amt;
+      stream.next_in = zInBuf;
+    }
+    deflate(&stream, 0);
+    toOut = sizeof(zOutBuf) - stream.avail_out;
+    if( toOut>skip ){
+      Tcl_Write(out, &zOutBuf[skip], toOut - skip);
+      skip = 0;
+    }else{
+      skip -= toOut;
+    }
+    stream.avail_out = sizeof(zOutBuf);
+    stream.next_out = zOutBuf;
+  }
+  do{
+    stream.avail_out = sizeof(zOutBuf);
+    stream.next_out = zOutBuf;
+    deflate(&stream, Z_FINISH);
+    toOut = sizeof(zOutBuf) - stream.avail_out;
+    if( toOut>skip ){
+      Tcl_Write(out, &zOutBuf[skip], toOut - skip);
+      skip = 0;
+    }else{
+      skip -= toOut;
+    }
+  }while( stream.avail_out==0 );
+  p->nByte = stream.total_in;
+  p->nByteCompr = stream.total_out - 2;
+  deflateEnd(&stream);
+  Tcl_Flush(out);
+
+  /* Remember were we are in the file.  Then go back and write the
+  ** header, now that we know the compressed file size.
+  */
+  iEndOfData = Tcl_Tell(out);
+  Tcl_Seek(out, p->iOffset, SEEK_SET);
+  put32(&zHdr[14], p->iCRC);
+  put32(&zHdr[18], p->nByteCompr);
+  put32(&zHdr[22], p->nByte);
+  Tcl_Write(out, zHdr, 30);
+  Tcl_Seek(out, iEndOfData, SEEK_SET);
+
+  /* Close the input file.
+  */
+  Tcl_Close(interp, in);
+
+  /* Finished!
+  */
+  return TCL_OK;
+}
+
+/*
+** The arguments are two lists of ZFile structures sorted by iOffset.
+** Either or both list may be empty.  This routine merges the two
+** lists together into a single sorted list and returns a pointer
+** to the head of the unified list.
+**
+** This is part of the merge-sort algorithm.
+*/
+static ZFile *mergeZFiles(ZFile *pLeft, ZFile *pRight){
+  ZFile fakeHead;
+  ZFile *pTail;
+
+  pTail = &fakeHead;
+  while( pLeft && pRight ){
+    ZFile *p;
+    if( pLeft->iOffset <= pRight->iOffset ){
+      p = pLeft;
+      pLeft = p->pNext;
+    }else{
+      p = pRight;
+      pRight = p->pNext;
+    }
+    pTail->pNext = p;
+    pTail = p;
+  }
+  if( pLeft ){
+    pTail->pNext = pLeft;
+  }else if( pRight ){
+    pTail->pNext = pRight;
+  }else{
+    pTail->pNext = 0;
+  }
+  return fakeHead.pNext;
+}
+
+/*
+** Sort a ZFile list so in accending order by iOffset.
+*/
+static ZFile *sortZFiles(ZFile *pList){
+# define NBIN 30
+  int i;
+  ZFile *p;
+  ZFile *aBin[NBIN+1];
+
+  for(i=0; i<=NBIN; i++) aBin[i] = 0;
+  while( pList ){
+    p = pList;
+    pList = p->pNext;
+    p->pNext = 0;
+    for(i=0; i<NBIN && aBin[i]; i++){
+      p = mergeZFiles(aBin[i],p);
+      aBin[i] = 0;
+    }
+    aBin[i] = aBin[i] ? mergeZFiles(aBin[i], p) : p;
+  }
+  p = 0;
+  for(i=0; i<=NBIN; i++){
+    if( aBin[i]==0 ) continue;
+    p = mergeZFiles(p, aBin[i]);
+  }
+  return p;
+}
+
+/*
+** Write a ZIP archive table of contents to the given
+** channel.
+*/
+static void writeTOC(Tcl_Channel chan, ZFile *pList){
+  int iTocStart, iTocEnd;
+  int nEntry = 0;
+  int i;
+  char zBuf[100];
+
+  iTocStart = Tcl_Tell(chan);
+  for(; pList; pList=pList->pNext){
+    if( pList->isSpecial ) continue;
+    put32(&zBuf[0], 0x02014b50);
+    put16(&zBuf[4], 0x0317);
+    put16(&zBuf[6], 0x0014);
+    put16(&zBuf[8], 0);
+    put16(&zBuf[10], pList->nByte>pList->nByteCompr ? 0x0008 : 0x0000);
+    put16(&zBuf[12], pList->dosTime);
+    put16(&zBuf[14], pList->dosDate);
+    put32(&zBuf[16], pList->iCRC);
+    put32(&zBuf[20], pList->nByteCompr);
+    put32(&zBuf[24], pList->nByte);
+    put16(&zBuf[28], strlen(pList->zName));
+    put16(&zBuf[30], 0);
+    put16(&zBuf[32], pList->nExtra);
+    put16(&zBuf[34], 1);
+    put16(&zBuf[36], 0);
+    put32(&zBuf[38], pList->permissions<<16);
+    put32(&zBuf[42], pList->iOffset);
+    Tcl_Write(chan, zBuf, 46);
+    Tcl_Write(chan, pList->zName, strlen(pList->zName));
+    for(i=pList->nExtra; i>0; i-=40){
+      int toWrite = i<40 ? i : 40;
+      Tcl_Write(chan,"                                             ",toWrite);
+    }
+    nEntry++;
+  }
+  iTocEnd = Tcl_Tell(chan);
+  put32(&zBuf[0], 0x06054b50);
+  put16(&zBuf[4], 0);
+  put16(&zBuf[6], 0);
+  put16(&zBuf[8], nEntry);
+  put16(&zBuf[10], nEntry);
+  put32(&zBuf[12], iTocEnd - iTocStart);
+  put32(&zBuf[16], iTocStart);
+  put16(&zBuf[20], 0);
+  Tcl_Write(chan, zBuf, 22);
+  Tcl_Flush(chan);
+}
+
+
+/*
+** Implementation of the zvfs::append command.
+**
+**    zvfs::append ARCHIVE (SOURCE DESTINATION)*
+**
+** This command reads SOURCE files and appends them (using the name
+** DESTINATION) to the zip archive named ARCHIVE.  A new zip archive
+** is created if it does not already exist.  If ARCHIVE refers to a
+** file which exists but is not a zip archive, then this command
+** turns ARCHIVE into a zip archive by appending the necessary
+** records and the table of contents.  Treat all files as binary.
+**
+** Note: No dup checking is done, so multiple occurances of the
+** same file is allowed.
+*/
+static int ZvfsAppendObjCmd(
+  void *NotUsed,             /* Client data for this command */
+  Tcl_Interp *interp,        /* The interpreter used to report errors */
+  int objc,                  /* Number of arguments */
+  Tcl_Obj *const* objv       /* Values of all arguments */
+){
+  char *zArchive;
+  Tcl_Channel chan;
+  ZFile *pList = NULL, *pToc;
+  int rc = TCL_OK, i,zipstart;
+
+  /* Open the archive and read the table of contents
+  */
+  if( objc<2 || (objc&1)!=0 ){
+    Tcl_WrongNumArgs(interp, 1, objv, "ARCHIVE (SRC DEST)+");
+    return TCL_ERROR;
+  }
+
+  zArchive = Tcl_GetString(objv[1]);
+  chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644);
+  if( chan==0 ) {
+    chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644);
+  }
+  if( chan==0 ) return TCL_ERROR;
+  if(  Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+	  || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+    ){
+      /* this should never happen */
+      Tcl_Close(0, chan);
+      return TCL_ERROR;
+  }
+
+  if (Tcl_Seek(chan, 0, SEEK_END) == 0) {
+      /* Null file is ok, we're creating new one. */
+  } else {
+    Tcl_Seek(chan, 0, SEEK_SET);
+    rc = ZvfsReadTOCStart(interp, chan, &pList,&zipstart);
+    if( rc==TCL_ERROR ){
+      deleteZFileList(pList);
+      Tcl_Close(interp, chan);
+      return rc;
+    } else rc=TCL_OK;
+  }
+
+  /* Move the file pointer to the start of
+  ** the table of contents.
+  */
+  for(pToc=pList; pToc; pToc=pToc->pNext){
+    if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) break;
+  }
+  if( pToc ){
+    Tcl_Seek(chan, pToc->iOffset, SEEK_SET);
+  }else{
+    Tcl_Seek(chan, 0, SEEK_END);
+  }
+
+  /* Add new files to the end of the archive.
+  */
+  for(i=2; rc==TCL_OK && i<objc; i+=2){
+    char *zSrc = Tcl_GetString(objv[i]);
+    char *zDest = Tcl_GetString(objv[i+1]);
+    Tcl_Channel in;
+    /* Open the file that is to be added to the ZIP archive
+     */
+    in = Tcl_OpenFileChannel(interp, zSrc, "r", 0);
+    if( in==0 ){
+      break;
+    }
+    if(  Tcl_SetChannelOption(interp, in, "-translation", "binary")
+	  || Tcl_SetChannelOption(interp, in, "-encoding", "binary")
+      ){
+        /* this should never happen */
+        Tcl_Close(0, in);
+	rc = TCL_ERROR;
+        break;
+    }
+
+    rc = writeFile(interp, chan, in, zSrc, zDest, &pList);
+  }
+
+  /* Write the table of contents at the end of the archive.
+  */
+  if (rc == TCL_OK) {
+    pList = sortZFiles(pList);
+    writeTOC(chan, pList);
+  }
+
+  /* Close the channel and exit */
+  deleteZFileList(pList);
+  Tcl_Close(interp, chan);
+  return rc;
+}
+
+static CONST char *
+GetExtension( CONST char *name)
+{
+    CONST char *p, *lastSep;
+#ifdef __WIN32__
+    lastSep = NULL;
+    for (p = name; *p != '\0'; p++) {
+	if (strchr("/\\:", *p) != NULL) {
+	    lastSep = p;
+	}
+    }
+#else
+    lastSep = strrchr(name, '/');
+#endif
+    p = strrchr(name, '.');
+    if ((p != NULL) && (lastSep != NULL) && (lastSep > p)) {
+	p = NULL;
+    }
+    return p;
+}
+
+/*
+** Implementation of the zvfs::add command.
+**
+**    zvfs::add ?-fconfigure optpairs? ARCHIVE FILE1 FILE2 ... 
+**
+** This command is similar to append in that it adds files to the zip
+** archive named ARCHIVE, however file names are relative the current directory.
+** In addition, fconfigure is used to apply  option pairs to set upon opening
+** of each file.  Otherwise, default translation is allowed
+** for those file extensions listed in the ::zvfs::auto_ext var.
+** Binary translation will be used for unknown extensions.
+**
+** NOTE Use '-fconfigure {}' to use auto translation for all.
+*/
+static int ZvfsAddObjCmd(
+  void *NotUsed,             /* Client data for this command */
+  Tcl_Interp *interp,        /* The interpreter used to report errors */
+  int objc,                  /* Number of arguments */
+  Tcl_Obj *CONST* objv       /* Values of all arguments */
+){
+  char *zArchive;
+  Tcl_Channel chan;
+  ZFile *pList = NULL, *pToc;
+  int rc = TCL_OK, i, j, oLen;
+  char *zOpts = NULL;
+  Tcl_Obj *confOpts = NULL;
+  int tobjc;
+  Tcl_Obj **tobjv;
+  Tcl_Obj *varObj = NULL;
+  int zipstart;
+  
+  /* Open the archive and read the table of contents
+  */
+  if (objc>3) {
+      zOpts =  Tcl_GetStringFromObj(objv[1], &oLen);
+      if (!strncmp("-fconfigure", zOpts, oLen)) {
+	  confOpts = objv[2];
+          if (TCL_OK != Tcl_ListObjGetElements(interp, confOpts, &tobjc, &tobjv) || (tobjc%2)) {
+	    return TCL_ERROR;
+	  }
+	  objc -= 2;
+	  objv += 2;
+      }
+  }
+  if( objc==2) {
+      return TCL_OK;
+  }
+
+  if( objc<3) {
+    Tcl_WrongNumArgs(interp, 1, objv, "?-fconfigure OPTPAIRS? ARCHIVE FILE1 FILE2 ..");
+    return TCL_ERROR;
+  }
+  zArchive = Tcl_GetString(objv[1]);
+  chan = Tcl_OpenFileChannel(interp, zArchive, "r+", 0644);
+  if( chan==0 ) {
+    chan = Tcl_OpenFileChannel(interp, zArchive, "w+", 0644);
+  }
+  if( chan==0 ) return TCL_ERROR;
+  if(  Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+	  || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+    ){
+      /* this should never happen */
+      Tcl_Close(0, chan);
+      return TCL_ERROR;
+  }
+
+  if (Tcl_Seek(chan, 0, SEEK_END) == 0) {
+      /* Null file is ok, we're creating new one. */
+  } else {
+    Tcl_Seek(chan, 0, SEEK_SET);
+    rc = ZvfsReadTOCStart(interp, chan, &pList,&zipstart);
+    if( rc==TCL_ERROR ){
+      deleteZFileList(pList);
+      Tcl_Close(interp, chan);
+      return rc;
+    } else rc=TCL_OK;
+  }
+
+  /* Move the file pointer to the start of
+  ** the table of contents.
+  */
+  for(pToc=pList; pToc; pToc=pToc->pNext){
+    if( pToc->isSpecial && strcmp(pToc->zName,"*TOC*")==0 ) break;
+  }
+  if( pToc ){
+    Tcl_Seek(chan, pToc->iOffset, SEEK_SET);
+  }else{
+    Tcl_Seek(chan, 0, SEEK_END);
+  }
+
+  /* Add new files to the end of the archive.
+  */
+  for(i=2; rc==TCL_OK && i<objc; i++){
+    char *zSrc = Tcl_GetString(objv[i]);
+    Tcl_Channel in;
+    /* Open the file that is to be added to the ZIP archive
+     */
+    in = Tcl_OpenFileChannel(interp, zSrc, "r", 0);
+    if( in==0 ){
+      break;
+    }
+    if (confOpts == NULL) {
+	CONST char *ext = GetExtension(zSrc);
+	if (ext != NULL) {
+	    /* Use auto translation for known text files. */
+	    if (varObj == NULL) {
+	        varObj=Tcl_GetVar2Ex(interp, "::zvfs::auto_ext", NULL, TCL_GLOBAL_ONLY);
+	    }
+	    if (varObj && TCL_OK != Tcl_ListObjGetElements(interp, varObj, &tobjc, &tobjv)) {
+		for (j=0; j<tobjc; j++) {
+		    if (!strcmp(ext, Tcl_GetString(tobjv[j]))) {
+		       break;
+		    }	       
+		}
+		if (j>=tobjc) {
+		       ext = NULL;
+		}
+
+	    }
+	}
+	if (ext == NULL) {
+	   if (( Tcl_SetChannelOption(interp, in, "-translation", "binary")
+		|| Tcl_SetChannelOption(interp, in, "-encoding", "binary"))
+	  ) {
+	    /* this should never happen */
+	    Tcl_Close(0, in);
+	    rc = TCL_ERROR;
+	    break;
+	  }
+	}
+    } else {
+	for (j=0; j<tobjc; j+=2) {
+	  if (Tcl_SetChannelOption(interp, in, Tcl_GetString(tobjv[j]), Tcl_GetString(tobjv[j+1]))) {
+	    Tcl_Close(0, in);
+	    rc = TCL_ERROR;
+	    break;
+	  }
+	}
+
+    }
+    if (rc == TCL_OK)
+	rc = writeFile(interp, chan, in, zSrc, zSrc, &pList);
+  }
+
+  /* Write the table of contents at the end of the archive.
+  */
+  if (rc == TCL_OK) {
+      pList = sortZFiles(pList);
+      writeTOC(chan, pList);
+  }
+
+  /* Close the channel and exit */
+  deleteZFileList(pList);
+  Tcl_Close(interp, chan);
+  return rc;
+}
+
+/*
+** Implementation of the zvfs::start command.
+**
+**    zvfs::start ARCHIVE
+**
+** This command strips returns the offset of zip data.
+**
+*/
+static int ZvfsStartObjCmd(
+void *NotUsed,             /* Client data for this command */
+Tcl_Interp *interp,        /* The interpreter used to report errors */
+int objc,                  /* Number of arguments */
+Tcl_Obj *CONST* objv       /* Values of all arguments */
+) {
+    char *zArchive;
+    Tcl_Channel chan;
+    ZFile *pList = NULL, *pToc;
+    int rc = TCL_OK, i, j, oLen;
+    char *zOpts = NULL;
+    Tcl_Obj *confOpts = NULL;
+    int tobjc;
+    Tcl_Obj **tobjv;
+    Tcl_Obj *varObj = NULL;
+    int zipStart;
+
+    /* Open the archive and read the table of contents
+    */
+    if( objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "ARCHIVE");
+        return TCL_ERROR;
+    }
+    zArchive = Tcl_GetString(objv[1]);
+    chan = Tcl_OpenFileChannel(interp, zArchive, "r", 0644);
+    if( chan==0 ) return TCL_ERROR;
+    if(  Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+    || Tcl_SetChannelOption(interp, chan, "-encoding", "binary")
+    ){
+        /* this should never happen */
+        Tcl_Close(0, chan);
+        return TCL_ERROR;
+    }
+
+    if (Tcl_Seek(chan, 0, SEEK_END) == 0) {
+        Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+        return TCL_OK;
+    } else {
+        Tcl_Seek(chan, 0, SEEK_SET);
+        rc = ZvfsReadTOCStart(interp, chan, &pList, &zipStart);
+        if( rc!=TCL_OK ){
+            deleteZFileList(pList);
+            Tcl_Close(interp, chan);
+            Tcl_AppendResult(interp, "not an archive", 0);
+            return TCL_ERROR;
+        }
+    }
+
+    /* Close the channel and exit */
+    deleteZFileList(pList);
+    Tcl_Close(interp, chan);
+    Tcl_SetObjResult(interp, Tcl_NewIntObj(zipStart));
+    return TCL_OK;
+}
+
+
+int ZvfsTools_Init(Tcl_Interp *interp){
+#ifdef USE_TCL_STUBS
+  if( Tcl_InitStubs(interp,"8.0",0)==0 ){
+    return TCL_ERROR;
+  }
+#endif
+  Tcl_CreateObjCommand(interp, "::zvfs::addlist", ZvfsAppendObjCmd, 0, 0);
+  Tcl_CreateObjCommand(interp, "::zvfs::add", ZvfsAddObjCmd, 0, 0);
+  Tcl_CreateObjCommand(interp, "::zvfs::dump", ZvfsDumpObjCmd, 0, 0);
+  Tcl_CreateObjCommand(interp, "::zvfs::start", ZvfsStartObjCmd, 0, 0);
+  Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY);
+  Tcl_PkgProvide(interp, "zvfsctools", "1.0"); 
+  return TCL_OK;
+}
+
+int ZvfsTools_SafeInit(Tcl_Interp *interp){
+#ifdef USE_TCL_STUBS
+  if( Tcl_InitStubs(interp,"8.0",0)==0 ){
+    return TCL_ERROR;
+  }
+#endif
+  Tcl_SetVar(interp, "::zvfs::auto_ext", ".tcl .tk .itcl .htcl .txt .c .h .tht", TCL_GLOBAL_ONLY);
+  Tcl_CreateObjCommand(interp, "::zvfs::dump", ZvfsDumpObjCmd, 0, 0);
+  Tcl_PkgProvide(interp, "zvfsctools", "1.0");
+
+  return TCL_OK;
+}

generic/tclZipVfsBoot.c

@@ -0,0 +1,86 @@
+#include <tcl.h>
+#include "tclInt.h"
+#include "tclFileSystem.h"
+
+int Zvfs_Common_Init(Tcl_Interp *);
+int Zvfs_Mount(Tcl_Interp *,CONST char *,CONST char *);
+
+
+/*
+** Boot a shell, mount the executable's VFS, detect main.tcl
+*/
+int Tcl_Zvfs_Boot(const char *archive,const char *vfsmountpoint,const char *initscript) {
+  Zvfs_Common_Init(NULL);
+  if(!vfsmountpoint) {
+    vfsmountpoint="/zvfs";
+  }
+  if(!initscript) {
+    initscript="main.tcl";
+  }
+  /* We have to initialize the virtual filesystem before calling
+  ** Tcl_Init().  Otherwise, Tcl_Init() will not be able to find
+  ** its startup script files.
+  */
+  if(!Zvfs_Mount(NULL, archive, vfsmountpoint)) {
+      Tcl_DString filepath;
+      Tcl_DString preinit;
+
+      Tcl_Obj *vfsinitscript;
+      Tcl_Obj *vfstcllib;
+      Tcl_Obj *vfstklib;
+      Tcl_Obj *vfspreinit;
+      Tcl_DStringInit(&filepath);
+      Tcl_DStringInit(&preinit);
+          
+      Tcl_DStringInit(&filepath);
+      Tcl_DStringAppend(&filepath,vfsmountpoint,-1);
+      Tcl_DStringAppend(&filepath,"/",-1);
+      Tcl_DStringAppend(&filepath,initscript,-1);
+      vfsinitscript=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1);
+      Tcl_DStringFree(&filepath);
+      
+      Tcl_DStringInit(&filepath);
+      Tcl_DStringAppend(&filepath,vfsmountpoint,-1);
+      Tcl_DStringAppend(&filepath,"/boot/tcl",-1);
+      vfstcllib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1);
+      Tcl_DStringFree(&filepath);
+
+      Tcl_DStringInit(&filepath);
+      Tcl_DStringAppend(&filepath,vfsmountpoint,-1);
+      Tcl_DStringAppend(&filepath,"/boot/tk",-1);
+      vfstklib=Tcl_NewStringObj(Tcl_DStringValue(&filepath),-1);
+      Tcl_DStringFree(&filepath);
+
+      Tcl_IncrRefCount(vfsinitscript);
+      Tcl_IncrRefCount(vfstcllib);
+      Tcl_IncrRefCount(vfstklib);
+
+      if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
+	/* Startup script should be set before calling Tcl_AppInit */
+        Tcl_SetStartupScript(vfsinitscript,NULL);
+      }
+      /* Record the mountpoint for scripts to refer back to */
+      Tcl_DStringAppend(&preinit,"\nset ::tcl_boot_vfs ",-1);
+      Tcl_DStringAppendElement(&preinit,vfsmountpoint);
+      Tcl_DStringAppend(&preinit,"\nset ::SRCDIR ",-1);
+      Tcl_DStringAppendElement(&preinit,vfsmountpoint);
+      
+      if(Tcl_FSAccess(vfstcllib,F_OK)==0) {
+        Tcl_DStringAppend(&preinit,"\nset tcl_library ",-1);
+        Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstcllib));
+      }
+      if(Tcl_FSAccess(vfstklib,F_OK)==0) {
+        Tcl_DStringAppend(&preinit,"\nset tk_library ",-1);
+        Tcl_DStringAppendElement(&preinit,Tcl_GetString(vfstklib));
+      }
+      vfspreinit=Tcl_NewStringObj(Tcl_DStringValue(&preinit),-1);
+      /* NOTE: We never decr this refcount, lest the contents of the script be deallocated */
+      Tcl_IncrRefCount(vfspreinit);
+      TclSetPreInitScript(Tcl_GetString(vfspreinit));
+
+      Tcl_DecrRefCount(vfsinitscript);
+      Tcl_DecrRefCount(vfstcllib);
+      Tcl_DecrRefCount(vfstklib);
+  }
+  return TCL_OK;
+}

library/zvfstools/pkgIndex.tcl

@@ -0,0 +1 @@
+package ifneeded zvfstools 0.1 [list source [file join $dir zvfstools.tcl]]

library/zvfstools/zvfstools.tcl

@@ -0,0 +1,205 @@
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Copyright (c) 2008-2009 ActiveState Software Inc.
+##                         Andreas Kupries
+## Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+## Copyright (C) 2014 Sean Woods <yoda@etoyoc.com>
+##
+## BSD License
+##
+# Package providing commands for:
+# * the generation of a zip archive,
+# * building a zip archive from a file system
+# * building a file system from a zip archive
+
+package require Tcl 8.6
+# Cop
+#
+#        Create ZIP archives in Tcl.
+#
+# Create a zipkit using mkzip filename.zkit -zipkit -directory xyz.vfs
+# or a zipfile using mkzip filename.zip -directory dirname -exclude "*~"
+#
+
+namespace eval ::zvfs {}
+
+proc ::zvfs::setbinary chan {
+  fconfigure $chan \
+      -encoding    binary \
+      -translation binary \
+      -eofchar     {}
+
+}
+
+# zip::timet_to_dos
+#
+#        Convert a unix timestamp into a DOS timestamp for ZIP times.
+#
+#   DOS timestamps are 32 bits split into bit regions as follows:
+#                  24                16                 8                 0
+#   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
+#   |Y|Y|Y|Y|Y|Y|Y|m| |m|m|m|d|d|d|d|d| |h|h|h|h|h|m|m|m| |m|m|m|s|s|s|s|s|
+#   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
+#
+proc ::zvfs::timet_to_dos {time_t} {
+    set s [clock format $time_t -format {%Y %m %e %k %M %S}]
+    scan $s {%d %d %d %d %d %d} year month day hour min sec
+    expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) 
+          | ($hour << 11) | ($min << 5) | ($sec >> 1)}
+}
+
+# zip::pop --
+#
+#        Pop an element from a list
+#
+proc ::zvfs::pop {varname {nth 0}} {
+    upvar $varname args
+    set r [lindex $args $nth]
+    set args [lreplace $args $nth $nth]
+    return $r
+}
+
+# zip::walk --
+#
+#        Walk a directory tree rooted at 'path'. The excludes list can be
+#        a set of glob expressions to match against files and to avoid.
+#        The match arg is internal.
+#        eg: walk library {CVS/* *~ .#*} to exclude CVS and emacs cruft.
+#
+proc ::zvfs::walk {base {excludes ""} {match *} {path {}}} {
+    set result {}
+    set imatch [file join $path $match]
+    set files [glob -nocomplain -tails -types f -directory $base $imatch]
+    foreach file $files {
+        set excluded 0
+        foreach glob $excludes {
+            if {[string match $glob $file]} {
+                set excluded 1
+                break
+            }
+        }
+        if {!$excluded} {lappend result $file}
+    }
+    foreach dir [glob -nocomplain -tails -types d -directory $base $imatch] {
+        lappend result $dir
+        set subdir [walk $base $excludes $match $dir]
+        if {[llength $subdir]>0} {
+            set result [concat $result [list $dir] $subdir]
+        }
+    }
+    return $result
+}
+
+# zvfs::mkzip --
+#
+#        Create a zip archive in 'filename'. If a file already exists it will be
+#        overwritten by a new file. If '-directory' is used, the new zip archive
+#        will be rooted in the provided directory.
+#        -runtime can be used to specify a prefix file. For instance, 
+#        zip myzip -runtime unzipsfx.exe -directory subdir
+#        will create a self-extracting zip archive from the subdir/ folder.
+#        The -comment parameter specifies an optional comment for the archive.
+#
+#        eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
+# 
+proc ::zvfs::mkzip {filename args} {
+  array set opts {
+      -zipkit 0 -runtime "" -comment "" -directory ""
+      -exclude {CVS/* */CVS/* *~ ".#*" "*/.#*"}
+  }
+  
+  while {[string match -* [set option [lindex $args 0]]]} {
+      switch -exact -- $option {
+          -zipkit  { set opts(-zipkit) 1 }
+          -comment { set opts(-comment) [encoding convertto utf-8 [pop args 1]] }
+          -runtime { set opts(-runtime) [pop args 1] }
+          -directory {set opts(-directory) [file normalize [pop args 1]] }
+          -exclude {set opts(-exclude) [pop args 1] }
+          -- { pop args ; break }
+          default {
+              break
+          }
+      }
+      pop args
+  }
+
+  set zf [::open $filename wb]
+  setbinary $zf
+  if {$opts(-runtime) ne ""} {
+      set rt [::open $opts(-runtime) rb]
+      setbinary $rt
+      fcopy $rt $zf
+      close $rt
+  } elseif {$opts(-zipkit)} {
+      set zkd {#!/usr/bin/env tclsh
+# This is a zip-based Tcl Module
+if {![package vsatisfies [package provide zvfs] 1.0]} {
+  package require vfs::zip
+  vfs::zip::Mount [info script] [info script]
+} else {
+  zvfs::mount [info script] [info script]
+}
+# Load any CLIP file present
+if {[file exists [file join [info script] pkgIndex.tcl]] } {
+  set dir [info script]
+  source [file join [info script] pkgIndex.tcl]
+}
+# Run any main.tcl present
+if {[file exists [file join [info script] main.tcl]] } {
+  source [file join [info script] main.tcl]
+}
+      }
+      ::append zkd \x1A
+      puts -nonewline $zf $zkd
+  }
+  close $zf
+
+  set count 0
+  set cd ""
+
+  if {$opts(-directory) ne ""} {
+    set paths [walk $opts(-directory) $opts(-exclude)]
+    set zippathlist {}
+    foreach path $paths {
+      if {[file isdirectory [file join $opts(-directory) $path]]} continue
+      lappend zippathlist [file join $opts(-directory) $path] $path
+    }
+    ::zvfs::addlist $filename {*}$zippathlist
+  } else {
+    ::zvfs::add $filename {*}[glob -nocomplain {*}$args]
+  }
+}
+
+###
+# Decode routines
+###
+proc ::zvfs::copy_file {zipbase destbase file} {
+    set l [string length $zipbase]
+    set relname [string trimleft [string range $file $l end] /]
+    if {[file isdirectory $file]} {
+      foreach sfile [glob -nocomplain $file/*] { 
+         file mkdir [file join $destbase $relname]
+         copy_file $zipbase $destbase $sfile
+      }
+      return
+    }
+    file copy -force $file [file join $destbase $relname]
+}
+
+# ### ### ### ######### ######### #########
+## Convenience command, decode and copy to dir
+## This routine relies on zvfs::mount, so we only load
+## it when the zvfs package is present
+##
+proc ::zvfs::unzip {in out} {
+    package require zvfs 1.0
+    set root /ziptmp#[incr ::zvfs::count]
+    zvfs::mount $in $root
+    set out [file normalize $out]
+    foreach file [glob $root/*] {
+      copy_file $root $out $file
+    }
+    zvfs::unmount $in
+    return
+}
+package provide zvfstools 0.1

tools/mkVfs.tcl

@@ -0,0 +1,99 @@
+proc cat fname {
+    set fname [open $fname r]
+    set data [read $fname]
+    close $fname
+    return $data
+}
+
+proc pkgIndexDir {root fout d1} {
+
+    puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \
+	      [file tail $d1]]
+    set idx [string length $root]
+    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+	set f [file join $d1 $ftail]
+	if {[file isdirectory $f] && [string compare CVS $ftail]} {
+	    pkgIndexDir $root $fout $f
+	} elseif {[file tail $f] eq "pkgIndex.tcl"} {
+	    puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]"
+	    puts $fout [cat $f]
+	}
+    }
+}
+
+###
+# Script to build the VFS file system
+###
+proc copyDir {d1 d2} {
+
+    puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
+	      [file tail $d2]]
+
+    file delete -force -- $d2
+    file mkdir $d2
+
+    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+	set f [file join $d1 $ftail]
+	if {[file isdirectory $f] && [string compare CVS $ftail]} {
+	    copyDir $f [file join $d2 $ftail]
+	} elseif {[file isfile $f]} {
+	    file copy -force $f [file join $d2 $ftail]
+	    if {$::tcl_platform(platform) eq {unix}} {
+		file attributes [file join $d2 $ftail] -permissions 0644
+	    } else {
+		file attributes [file join $d2 $ftail] -readonly 1
+	    }
+	}
+    }
+
+    if {$::tcl_platform(platform) eq {unix}} {
+	file attributes $d2 -permissions 0755
+    } else {
+	file attributes $d2 -readonly 1
+    }
+}
+
+if {[llength $argv] < 3} {
+    puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"
+    exit 1
+}
+set TCL_SCRIPT_DIR [lindex $argv 0]
+set TCLSRC_ROOT    [lindex $argv 1]
+set PLATFORM       [lindex $argv 2]
+set TKDLL          [lindex $argv 3]
+set TKVER          [lindex $argv 4]
+
+puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM"
+copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR}
+
+if {$PLATFORM == "windows"} {
+    set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
+    puts "DDE DLL $ddedll"
+    if {$ddedll != {}} {
+	file copy $ddedll ${TCL_SCRIPT_DIR}/dde
+    }
+    set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
+    puts "REG DLL $ddedll"
+    if {$regdll != {}} {
+	file copy $regdll ${TCL_SCRIPT_DIR}/reg
+    }
+} else {
+    # Remove the dde and reg package paths
+    file delete -force ${TCL_SCRIPT_DIR}/dde
+    file delete -force ${TCL_SCRIPT_DIR}/reg
+}
+
+# For the following packages, cat their pkgIndex files to tclIndex
+file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0
+set fout [open ${TCL_SCRIPT_DIR}/tclIndex a]
+puts $fout {#
+# MANIFEST OF INCLUDED PACKAGES
+#
+set VFSROOT $dir
+}
+if {$TKDLL ne {} && [file exists $TKDLL]} {
+  file copy $TKDLL ${TCL_SCRIPT_DIR}
+  puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"]
+}
+pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR}
+close $fout

tools/mkzip.tcl

@@ -0,0 +1,5 @@
+###
+# Wrapper to allow access to Tcl's zvfs::mkzip command from Makefiles
+###
+source [file join [file dirname [file normalize [info script]]] .. library zvfstools zvfstools.tcl]
+zvfs::mkzip {*}$argv

unix/Makefile.in

@@ -109,6 +109,7 @@ CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@
 LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
 LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
 LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@
+SHARED_BUILD		= @TCL_SHARED_BUILD@
 
 # To disable ANSI-C procedure prototypes reverse the comment characters on the
 # following lines:
@@ -167,6 +168,8 @@ INSTALL_DATA_DIR	= ${INSTALL} -d -m 755
 # Do not use SHELL_ENV for NATIVE_TCLSH unless it is the tclsh being built.
 EXE_SUFFIX		= @EXEEXT@
 TCL_EXE			= tclsh${EXE_SUFFIX}
+BASEKIT_EXE		= basekit${EXE_SUFFIX}
+
 TCLTEST_EXE		= tcltest${EXE_SUFFIX}
 NATIVE_TCLSH		= @TCLSH_PROG@
 
@@ -282,7 +285,7 @@ LIBS		= @TCL_LIBS@
 DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
 ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
 
-TCLSH_OBJS = tclAppInit.o
+TCLSH_OBJS = tclAppInit.o tclZipVfs.o tclZipVfsBoot.o tclZipTools.o
 
 TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
 	tclThreadTest.o tclUnixTest.o
@@ -614,7 +617,7 @@ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
 
 all: binaries libraries doc packages
 
-binaries: ${LIB_FILE} ${TCL_EXE}
+binaries: ${LIB_FILE} ${TCL_EXE} ${BASEKIT_EXE}
 
 libraries:
 
@@ -632,7 +635,7 @@ ${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
 	fi
 	rm -f $@
 	@MAKE_STUB_LIB@
-
+	
 # Make target which outputs the list of the .o contained in the Tcl lib useful
 # to build a single big shared library containing Tcl and other extensions.
 # Used for the Tcl Plugin.  -- dl
@@ -647,18 +650,41 @@ ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE}
 	${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \
 		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
 		${CC_SEARCH_FLAGS} -o ${TCL_EXE}
-
+	
 # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above
 ${NATIVE_TCLSH}:
 
+# Rather than force an install, pack the files we need into a
+# file system under our control
+basekit.vfs:
+	@echo "Building VFS File system in basekit.vfs"
+	@$(TCL_EXE) "$(TOP_DIR)/tools/mkVfs.tcl" \
+	    "$(UNIX_DIR)/basekit.vfs/boot/tcl" "$(TOP_DIR)"  unix
+
+# Builds an executable directly from the Tcl sources
+${BASEKIT_EXE}: ${TCLSH_OBJS} ${OBJS} ${ZLIB_OBJS} ${TCL_EXE} basekit.vfs
+
+	${CC} ${CFLAGS} ${LDFLAGS} \
+		${TCLSH_OBJS} ${OBJS} ${ZLIB_OBJS} \
+		${LIBS} @EXTRA_TCLSH_LIBS@ \
+		${CC_SEARCH_FLAGS} -o ${BASEKIT_EXE}_bare
+	@echo zipping... $(TCL_EXE)
+	./$(TCL_EXE) ../tools/mkzip.tcl ${BASEKIT_EXE} \
+		-runtime ${BASEKIT_EXE}_bare \
+		-directory basekit.vfs
+	chmod a+x ${BASEKIT_EXE}	
+
+
 Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
 	$(SHELL) config.status
 #tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
 #	$(SHELL) config.status
 
 clean: clean-packages
+	rm -rf basekit.vfs null.zip
 	rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
-		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@
+		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \
+		${BASEKIT_EXE} basekit*
 	cd dltest ; $(MAKE) clean
 
 distclean: distclean-packages clean
@@ -802,6 +828,9 @@ install-binaries: binaries
 	@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
 	@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
 	@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
+	@echo "Installing ${BASEKIT_EXE} as $(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}"
+	@$(INSTALL_PROGRAM) ${BASEKIT_EXE} "$(BIN_INSTALL_DIR)/${BASEKIT_EXE}$(VERSION)${EXE_SUFFIX}"
+
 	@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
 	@$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
 	@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
@@ -861,6 +890,10 @@ install-libraries: libraries
 	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
 	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;
 
+
+	@echo "Installing package zvfstools 0.1 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/zvfstools/zvfstools.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/zvfstools-0.1.tm;
+
 	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
 	@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
 		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
@@ -1024,7 +1057,11 @@ xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
 	@if test -f tclAppInit.sav ; then \
 	    mv tclAppInit.sav tclAppInit.o; \
 	fi;
-
+	
+tclZipShInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
+	$(CC) -c $(APP_CC_SWITCHES) \
+		-DTCL_ZIPVFS $(UNIX_DIR)/tclAppInit.c -o tclZipShInit.o
+	
 # Object files used on all Unix systems:
 
 REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
@@ -1323,6 +1360,15 @@ tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
 tclVar.o: $(GENERIC_DIR)/tclVar.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c
 
+tclZipVfs.o:  $(GENERIC_DIR)/tclZipVfs.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclZipVfs.c
+
+tclZipVfsBoot.o:  $(GENERIC_DIR)/tclZipVfsBoot.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclZipVfsBoot.c
+
+tclZipTools.o:  $(GENERIC_DIR)/tclZipTools.c
+	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZipTools.c
+
 tclZlib.o: $(GENERIC_DIR)/tclZlib.c
 	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c
 

unix/tclAppInit.c

@@ -40,6 +40,11 @@ extern Tcl_PackageInitProc Tclxttest_Init;
 #endif
 MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
 MODULE_SCOPE int main(int, char **);
+MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *);
+MODULE_SCOPE int Zvfs_Init(Tcl_Interp *);
+MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *);
+MODULE_SCOPE int ZvfsTools_Init(Tcl_Interp *);
+MODULE_SCOPE int ZvfsTools_SafeInit(Tcl_Interp *);
 
 /*
  * The following #if block allows you to change how Tcl finds the startup
@@ -80,7 +85,11 @@ main(
 #ifdef TCL_LOCAL_MAIN_HOOK
     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
 #endif
-
+    #define TCLKIT_INIT     "main.tcl"
+    #define TCLKIT_VFSMOUNT "/zvfs"
+    Tcl_FindExecutable(argv[0]);
+    CONST char *cp=Tcl_GetNameOfExecutable();
+    Tcl_Zvfs_Boot(cp,TCLKIT_VFSMOUNT,TCLKIT_INIT);
     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
     return 0;			/* Needed only to prevent compiler warning. */
 }
@@ -111,7 +120,15 @@ Tcl_AppInit(
     if ((Tcl_Init)(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }
-
+    /* Load the ZipVfs package */
+    Tcl_StaticPackage(interp, "zvfs", Zvfs_Init, Zvfs_SafeInit);
+    if(Zvfs_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage(interp, "zvfsctools", ZvfsTools_Init, ZvfsTools_SafeInit);
+    if(ZvfsTools_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
 #ifdef TCL_XT_TEST
     if (Tclxttest_Init(interp) == TCL_ERROR) {
 	return TCL_ERROR;

unix/tclKitInit.c

@@ -0,0 +1,86 @@
+/*
+** This file implements the main routine for a standalone Tcl/Tk shell.
+*/
+#include <tcl.h>
+#include "tclInt.h"
+#define TCLKIT_INIT     "main.tcl"
+#define TCLKIT_VFSMOUNT "/zvfs"
+
+#define TCL_LOCAL_APPINIT Tclkit_AppInit
+MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
+MODULE_SCOPE int main(int, char **);
+
+/*
+** This routine runs first.  
+*/
+int main(int argc, char **argv){
+  Tcl_FindExecutable(argv[0]);
+  Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL);
+  Tcl_Main(argc,argv,&Tclkit_AppInit);
+  return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tclkit_AppInit --
+ *
+ *	This procedure performs application-specific initialization. Most
+ *	applications, especially those that incorporate additional packages,
+ *	will have their own version of this procedure.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code, and leaves an error message in
+ *	the interp's result if an error occurs.
+ *
+ * Side effects:
+ *	Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tclkit_AppInit(
+    Tcl_Interp *interp)		/* Interpreter for application. */
+{
+    Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT);
+
+    if ((Tcl_Init)(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Call the init procedures for included packages. Each call should look
+     * like this:
+     *
+     * if (Mod_Init(interp) == TCL_ERROR) {
+     *     return TCL_ERROR;
+     * }
+     *
+     * where "Mod" is the name of the module. (Dynamically-loadable packages
+     * should have the same entry-point name.)
+     */
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if they
+     * weren't already created by the init procedures called above.
+     */
+
+    /*
+     * Specify a user-specific startup file to invoke if the application is
+     * run interactively. Typically the startup file is "~/.apprc" where "app"
+     * is the name of the application. If this line is deleted then no
+     * user-specific startup file will be run under any conditions.
+     */
+
+#ifdef DJGPP
+    (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+	    Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY);
+#else
+    (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+	    Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY);
+#endif
+
+    return TCL_OK;
+}

win/Makefile.in

@@ -103,6 +103,10 @@ COMPAT_DIR		= $(TOP_DIR)/compat
 PKGS_DIR		= $(TOP_DIR)/pkgs
 ZLIB_DIR		= $(COMPAT_DIR)/zlib
 
+VFS_SCRIPT_INSTALL_DIR  = $(WIN_DIR)/tclvfs.zip/tcl$(VERSION)
+VFS_PKG_INSTALL_DIR  = $(WIN_DIR)/tclvfs.zip/lib
+
+
 # Converts a POSIX path to a Windows native path.
 CYGPATH			= @CYGPATH@
 
@@ -145,6 +149,7 @@ SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
 STATIC_LIBRARIES	= $(TCL_LIB_FILE)
 
 TCLSH			= tclsh$(VER)${EXESUFFIX}
+TCLZSH			= tclzsh$(VER)${EXESUFFIX}
 CAT32			= cat32$(EXEEXT)
 MAN2TCL			= man2tcl$(EXEEXT)
 
@@ -296,7 +301,7 @@ GENERIC_OBJS = \
 	tclUtil.$(OBJEXT) \
 	tclVar.$(OBJEXT) \
 	tclZlib.$(OBJEXT)
-
+	
 TOMMATH_OBJS = \
 	bncore.${OBJEXT} \
 	bn_reverse.${OBJEXT} \
@@ -406,6 +411,8 @@ ZLIB_OBJS = \
 
 TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} @ZLIB_OBJS@
 
+TCLZSH_OBJS = tclZipShInit.$(OBJEXT) tclZipVfs.$(OBJEXT) tclZipVfsBoot.$(OBJEXT)
+
 TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]
 
 all: binaries libraries doc packages
@@ -423,6 +430,42 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
         tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
 	@VC_MANIFEST_EMBED_EXE@
 
+tclzsh: $(TCLZSH)
+
+null.zip:
+	touch .empty
+	zip -q null.zip .empty
+	
+# Rather than force an install, pack the files we need into a
+# file system under our control
+tclzsh.vfs: $(TCLSH) $(DDE_DLL_FILE) $(REG_DLL_FILE)
+	@echo "Building VFS File system in tclzsh.vfs"
+	@$(TCL_EXE) "$(ROOT_DIR)/tools/mkVfs.tcl" \
+	    "$(WIN_DIR)/tclzsh.vfs/boot/tcl" "$(ROOT_DIR)"  windows
+
+tclzsh_bare: $(TCLZSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) 
+	$(CC) $(CFLAGS) $(TCLZSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
+        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+	@VC_MANIFEST_EMBED_EXE@
+
+$(TCLZSH): tclzsh_bare tclzsh.vfs
+	./${TCLZSH_BASE}_bare ../tools/mkzip.tcl ${TCLZSH_EXE} \
+		-runtime ${TCLZSH_BASE}_bare \
+		-directory tclzsh.vfs
+	chmod a+x ${TCLZSH_EXE}
+
+# Builds an executable directly from the Tcl sources
+tclzsh-direct:  $(TCLZSH_OBJS) ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES) null.zip tclzsh.vfs
+	rm *.$(OBJEXT)
+	$(CC) $(CFLAGS) -DSTATIC_BUILD -UUSE_STUBS $(TCLZSH_OBJS) \
+	${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS} ${ZLIB_OBJS} \
+	$(LIBS) \
+        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+	@VC_MANIFEST_EMBED_EXE@
+	rm *.$(OBJEXT)
+	cat null.zip >> $(TCLZSH)
+	cd tclzsh.vfs ; zip -rAq $(WIN_DIR)/$(TCLZSH) .
+
 cat32.$(OBJEXT): cat.c
 	$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
 
@@ -486,6 +529,9 @@ testMain.${OBJEXT}: tclAppInit.c
 tclMain2.${OBJEXT}: tclMain.c
 	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
 
+tclZipShInit.${OBJEXT}: tclAppInit.c
+	$(CC) -c $(CC_SWITCHES) -DTCL_ZIPVFS @DEPARG@ $(CC_OBJNAME)
+
 # TIP #59, embedding of configuration information into the binary library.
 #
 # Part of Tcl's configuration information are the paths where it was installed
@@ -570,7 +616,7 @@ install-binaries: binaries
 		else true; \
 		fi; \
 	    done;
-	@for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH); \
+	@for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TCLSH) $(TCLZSH); \
 	    do \
 	    if [ -f $$i ]; then \
 		echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
@@ -735,8 +781,9 @@ cleanhelp:
 
 clean: cleanhelp clean-packages
 	$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
-	$(RM) $(TCLSH) $(CAT32)
-	$(RM) *.pch *.ilk *.pdb
+	$(RM) $(TCLSH) $(CAT32) $(TCLZSH) null.zip
+	$(RM) *.pch *.ilk *.pdb tclzsh*
+	$(RMDIR) tclzsh.vfs
 
 distclean: distclean-packages clean
 	$(RM) Makefile config.status config.cache config.log tclConfig.sh \
@@ -868,6 +915,8 @@ html-tk: $(TCLSH)
 .PHONY: install-doc install-private-headers test test-tcl runtest shell
 .PHONY: gdb depend cleanhelp clean distclean packages install-packages
 .PHONY: test-packages clean-packages distclean-packages genstubs html
-.PHONY: html-tcl html-tk
+.PHONY: html-tcl html-tk tclzsh
+.PHONY: tclzsh-direct tclzsh-dynamic tclzsh-kitlib
+
 
 # DO NOT DELETE THIS LINE -- make depend depends on it.

win/makefile.bc

@@ -159,6 +159,7 @@ TCLPLUGINDLLNAME	= $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
 TCLPLUGINDLL	= $(OUTDIR)\$(TCLPLUGINDLLNAME)
 TCLSH		= $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
 TCLSHP		= $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
+TCLKIT		= $(OUTDIR)\$(NAMEPREFIX)kit$(VERSION)$(DBGX).exe
 TCLREGDLLNAME	= $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
 TCLREGDLL	= $(OUTDIR)\$(TCLREGDLLNAME)
 TCLDDEDLLNAME	= $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
@@ -177,6 +178,10 @@ INCLUDE_INSTALL_DIR	= $(INSTALLDIR)\include
 TCLSHOBJS	= \
 	$(TMPDIR)\tclAppInit.obj
 
+TCLKITOBJS	= \
+	$(TMP_DIR)\tclZipVfs.obj \
+	$(TMPDIR)\tclKitInit.obj
+
 TCLTESTOBJS	= \
 	$(TMPDIR)\tclTest.obj \
 	$(TMPDIR)\tclTestObj.obj \
@@ -392,6 +397,11 @@ $(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
 		$(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
 !
 
+$(TCLKIT): $(TCLKITOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
+	$(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
+		$(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
+!
+
 $(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
 	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
 		$(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
@@ -512,6 +522,10 @@ $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
 $(TMPDIR)\tclAppInit.obj : $(WINDIR)\tclAppInit.c
 	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?
 
+$(TMPDIR)\tclKitInit.obj : $(WINDIR)\tclAppInit.c
+	$(cc32) $(TCL_CFLAGS) -DDTCL_ZIPVFS -o$(TMPDIR)\$@ $?
+
+
 # The following objects should be built using the stub interfaces
 
 # tclWinReg: Produces errors in ANSI mode

win/makefile.vc

@@ -209,6 +209,9 @@ TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)
 TCLSHNAME	= $(PROJECT)sh$(VERSION)$(SUFX).exe
 TCLSH		= $(OUT_DIR)\$(TCLSHNAME)
 
+TCLKITNAME	= $(PROJECT)kit$(VERSION)$(SUFX).exe
+TCLKIT		= $(OUT_DIR)\$(TCLSHNAME)
+
 TCLREGLIBNAME	= $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
 TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)
 
@@ -244,6 +247,18 @@ TCLSHOBJS = \
 !endif
 	$(TMP_DIR)\tclsh.res
 
+TCLKITOBJS = \
+	$(TMP_DIR)\tclKitInit.obj \
+	$(TMP_DIR)\tclZipVfs.obj \
+!if !$(STATIC_BUILD)
+!if $(TCL_USE_STATIC_PACKAGES)
+	$(TMP_DIR)\tclWinReg.obj \
+	$(TMP_DIR)\tclWinDde.obj \
+!endif
+!endif
+	$(TMP_DIR)\tclsh.res
+
+
 TCLTESTOBJS = \
 	$(TMP_DIR)\tclTest.obj \
 	$(TMP_DIR)\tclTestObj.obj \
@@ -932,6 +947,9 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
 $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
 	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
 
+$(TMP_DIR)\tclZipVfs.obj: $(GENERICDIR)\tclZipVfs.c
+	$(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
+
 $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
 	$(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
 
@@ -954,6 +972,12 @@ $(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
 	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
 	    -Fo$@ $?
 
+$(TMP_DIR)\tclKitInit.obj: $(WINDIR)\tclAppInit.c
+	$(cc32) $(TCL_CFLAGS) \
+	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
+	    -DTCL_ZIPVFS \
+	    -Fo$@ $?
+
 ### The following objects should be built using the stub interfaces
 ### *ALL* extensions need to built with -DTCL_THREADS=1
 

win/tclAppInit.c

@@ -27,6 +27,12 @@ extern Tcl_PackageInitProc Tcltest_Init;
 extern Tcl_PackageInitProc Tcltest_SafeInit;
 #endif /* TCL_TEST */
 
+#ifdef TCL_ZIPVFS
+  MODULE_SCOPE int Tcl_Zvfs_Boot(const char *,const char *,const char *);
+  MODULE_SCOPE int Zvfs_Init(Tcl_Interp *);
+  MODULE_SCOPE int Zvfs_SafeInit(Tcl_Interp *);
+#endif /* TCL_ZIPVFS */
+
 #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
 extern Tcl_PackageInitProc Registry_Init;
 extern Tcl_PackageInitProc Dde_Init;
@@ -123,7 +129,13 @@ _tmain(
 #ifdef TCL_LOCAL_MAIN_HOOK
     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
 #endif
-
+#ifdef TCL_ZIPVFS
+    #define TCLKIT_INIT     "main.tcl"
+    #define TCLKIT_VFSMOUNT "/zvfs"
+    Tcl_FindExecutable(argv[0]);
+    CONST char *cp=Tcl_GetNameOfExecutable();
+    Tcl_Zvfs_Boot(cp,TCLKIT_VFSMOUNT,TCLKIT_INIT);
+#endif
     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
     return 0;			/* Needed only to prevent compiler warning. */
 }
@@ -154,7 +166,13 @@ Tcl_AppInit(
     if ((Tcl_Init)(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }
-
+#ifdef TCL_ZIPVFS
+    /* Load the ZipVfs package */
+    Tcl_StaticPackage(interp, "zvfs", Zvfs_Init, Zvfs_SafeInit);
+    if(Zvfs_Init(interp) == TCL_ERROR) {
+      return TCL_ERROR;
+    }
+#endif
 #if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
     if (Registry_Init(interp) == TCL_ERROR) {
 	return TCL_ERROR;

win/tclKitInit.c

@@ -0,0 +1,325 @@
+/*
+ * tclAppInit.c --
+ *
+ *	Provides a default version of the main program and TclKit_AppInit
+ *	procedure for tclsh and other Tcl-based applications (without Tk).
+ *	Note that this program must be built in Win32 console mode to work
+ *	properly.
+ *
+ * Copyright (c) 1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 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.
+ */
+
+#include "tclWinInt.h"
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+#include <locale.h>
+#include <stdlib.h>
+#include <tchar.h>
+
+extern Tcl_PackageInitProc Registry_Init;
+extern Tcl_PackageInitProc Dde_Init;
+extern Tcl_PackageInitProc Dde_SafeInit;
+
+#ifdef TCL_BROKEN_MAINARGS
+int _CRT_glob = 0;
+static void setargv(int *argcPtr, TCHAR ***argvPtr);
+#endif /* TCL_BROKEN_MAINARGS */
+
+/*
+ * The following #if block allows you to change the AppInit function by using
+ * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
+ * #if checks for that #define and uses TclKit_AppInit if it does not exist.
+ */
+#define TCLKIT_INIT     "main.tcl"
+#define TCLKIT_VFSMOUNT "/zvfs"
+#ifndef TCL_LOCAL_APPINIT
+#define TCL_LOCAL_APPINIT TclKit_AppInit
+#endif
+#ifndef MODULE_SCOPE
+#   define MODULE_SCOPE extern
+#endif
+MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
+
+/*
+ * The following #if block allows you to change how Tcl finds the startup
+ * script, prime the library or encoding paths, fiddle with the argv, etc.,
+ * without needing to rewrite Tcl_Main()
+ */
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ *	This is the main program for the application.
+ *
+ * Results:
+ *	None: Tcl_Main never returns here, so this procedure never returns
+ *	either.
+ *
+ * Side effects:
+ *	Just about anything, since from here we call arbitrary Tcl code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TCL_BROKEN_MAINARGS
+int
+main(
+    int argc,			/* Number of command-line arguments. */
+    char *dummy[])		/* Not used. */
+{
+    TCHAR **argv;
+#else
+int
+_tmain(
+    int argc,			/* Number of command-line arguments. */
+    TCHAR *argv[])		/* Values of command-line arguments. */
+{
+#endif
+    TCHAR *p;
+
+    /*
+     * Set up the default locale to be standard "C" locale so parsing is
+     * performed correctly.
+     */
+
+    setlocale(LC_ALL, "C");
+
+#ifdef TCL_BROKEN_MAINARGS
+    /*
+     * Get our args from the c-runtime. Ignore command line.
+     */
+
+    setargv(&argc, &argv);
+#endif
+
+    /*
+     * Forward slashes substituted for backslashes.
+     */
+
+    for (p = argv[0]; *p != '\0'; p++) {
+	if (*p == '\\') {
+	    *p = '/';
+	}
+    }
+
+#ifdef TCL_LOCAL_MAIN_HOOK
+    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#endif
+    /* This voodoo ensures that Tcl_Main does not eat the first argument */
+    Tcl_FindExecutable(argv[0]);
+    Tcl_SetStartupScript(Tcl_NewStringObj("noop",-1),NULL);
+    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
+    return 0;			/* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclKit_AppInit --
+ *
+ *	This procedure performs application-specific initialization. Most
+ *	applications, especially those that incorporate additional packages,
+ *	will have their own version of this procedure.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code, and leaves an error message in
+ *	the interp's result if an error occurs.
+ *
+ * Side effects:
+ *	Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclKit_AppInit(
+    Tcl_Interp *interp)		/* Interpreter for application. */
+{
+    Tcl_Zvfs_Boot(interp,TCLKIT_VFSMOUNT,TCLKIT_INIT);
+    if ((Tcl_Init)(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+//    if (Registry_Init(interp) == TCL_ERROR) {
+//	return TCL_ERROR;
+//    }
+//    Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
+//
+//    if (Dde_Init(interp) == TCL_ERROR) {
+//	return TCL_ERROR;
+//    }
+//    Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
+
+    /*
+     * Call the init procedures for included packages. Each call should look
+     * like this:
+     *
+     * if (Mod_Init(interp) == TCL_ERROR) {
+     *     return TCL_ERROR;
+     * }
+     *
+     * where "Mod" is the name of the module. (Dynamically-loadable packages
+     * should have the same entry-point name.)
+     */
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if they
+     * weren't already created by the init procedures called above.
+     */
+
+    /*
+     * Specify a user-specific startup file to invoke if the application is
+     * run interactively. Typically the startup file is "~/.apprc" where "app"
+     * is the name of the application. If this line is deleted then no
+     * user-specific startup file will be run under any conditions.
+     */
+
+    (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
+	    Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * setargv --
+ *
+ *	Parse the Windows command line string into argc/argv. Done here
+ *	because we don't trust the builtin argument parser in crt0. Windows
+ *	applications are responsible for breaking their command line into
+ *	arguments.
+ *
+ *	2N backslashes + quote -> N backslashes + begin quoted string
+ *	2N + 1 backslashes + quote -> literal
+ *	N backslashes + non-quote -> literal
+ *	quote + quote in a quoted string -> single quote
+ *	quote + quote not in quoted string -> empty string
+ *	quote -> begin quoted string
+ *
+ * Results:
+ *	Fills argcPtr with the number of arguments and argvPtr with the array
+ *	of arguments.
+ *
+ * Side effects:
+ *	Memory allocated.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+#ifdef TCL_BROKEN_MAINARGS
+static void
+setargv(
+    int *argcPtr,		/* Filled with number of argument strings. */
+    TCHAR ***argvPtr)		/* Filled with argument strings (malloc'd). */
+{
+    TCHAR *cmdLine, *p, *arg, *argSpace;
+    TCHAR **argv;
+    int argc, size, inquote, copy, slashes;
+
+    cmdLine = GetCommandLine();
+
+    /*
+     * Precompute an overly pessimistic guess at the number of arguments in
+     * the command line by counting non-space spans.
+     */
+
+    size = 2;
+    for (p = cmdLine; *p != '\0'; p++) {
+	if ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
+	    size++;
+	    while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
+		p++;
+	    }
+	    if (*p == '\0') {
+		break;
+	    }
+	}
+    }
+
+    /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
+    #undef Tcl_Alloc
+    #undef Tcl_DbCkalloc
+
+    argSpace = ckalloc(size * sizeof(char *)
+	    + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
+    argv = (TCHAR **) argSpace;
+    argSpace += size * (sizeof(char *)/sizeof(TCHAR));
+    size--;
+
+    p = cmdLine;
+    for (argc = 0; argc < size; argc++) {
+	argv[argc] = arg = argSpace;
+	while ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
+	    p++;
+	}
+	if (*p == '\0') {
+	    break;
+	}
+
+	inquote = 0;
+	slashes = 0;
+	while (1) {
+	    copy = 1;
+	    while (*p == '\\') {
+		slashes++;
+		p++;
+	    }
+	    if (*p == '"') {
+		if ((slashes & 1) == 0) {
+		    copy = 0;
+		    if ((inquote) && (p[1] == '"')) {
+			p++;
+			copy = 1;
+		    } else {
+			inquote = !inquote;
+		    }
+		}
+		slashes >>= 1;
+	    }
+
+	    while (slashes) {
+		*arg = '\\';
+		arg++;
+		slashes--;
+	    }
+
+	    if ((*p == '\0') || (!inquote &&
+		    ((*p == ' ') || (*p == '\t')))) {	/* INTL: ISO space. */
+		break;
+	    }
+	    if (copy != 0) {
+		*arg = *p;
+		arg++;
+	    }
+	    p++;
+	}
+	*arg = '\0';
+	argSpace = arg + 1;
+    }
+    argv[argc] = NULL;
+
+    *argcPtr = argc;
+    *argvPtr = argv;
+}
+#endif /* TCL_BROKEN_MAINARGS */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */

win/tclkit.exe.manifest.in

@@ -0,0 +1,51 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"
+	xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
+    <assemblyIdentity
+	    version="@TCL_WIN_VERSION@"
+	    processorArchitecture="@MACHINE@"
+	    name="Tcl.tclsh"
+	    type="win32"
+	/>
+    <description>Tcl self-contained executable (tclkit)</description>
+    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
+	<security>
+	    <requestedPrivileges>
+		<requestedExecutionLevel
+			level="asInvoker"
+			uiAccess="false"
+		    />
+	    </requestedPrivileges>
+	</security>
+    </trustInfo>
+    <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
+	<application>
+	    <!-- Windows 8.1 -->
+	    <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
+	    <!-- Windows 8 -->
+	    <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
+	    <!-- Windows 7 -->
+	    <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
+	    <!-- Windows Vista -->
+	    <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
+	</application>
+    </compatibility>
+    <asmv3:application>
+	<asmv3:windowsSettings
+		xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
+	    <dpiAware>true</dpiAware>
+	</asmv3:windowsSettings>
+    </asmv3:application>
+    <dependency>
+	<dependentAssembly>
+	    <assemblyIdentity
+		    type="win32"
+		    name="Microsoft.Windows.Common-Controls"
+		    version="6.0.0.0"
+		    processorArchitecture="@MACHINE@"
+		    publicKeyToken="6595b64144ccf1df"
+		    language="*"
+		/>
+	</dependentAssembly>
+    </dependency>
+</assembly>

win/tclkit.rc

@@ -0,0 +1,82 @@
+//
+// Version Resource Script
+//
+
+#include <winver.h>
+#include <tcl.h>
+
+//
+// build-up the name suffix that defines the type of build this is.
+//
+#if TCL_THREADS
+#define SUFFIX_THREADS	    "t"
+#else
+#define SUFFIX_THREADS	    ""
+#endif
+
+#if STATIC_BUILD
+#define SUFFIX_STATIC	    "s"
+#else
+#define SUFFIX_STATIC	    ""
+#endif
+
+#if DEBUG && !UNCHECKED
+#define SUFFIX_DEBUG	    "g"
+#else
+#define SUFFIX_DEBUG	    ""
+#endif
+
+#define SUFFIX		    SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG
+
+
+LANGUAGE 0x9, 0x1	/* LANG_ENGLISH, SUBLANG_DEFAULT */
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ FILEFLAGSMASK 	0x3fL
+#ifdef DEBUG
+ FILEFLAGS 	VS_FF_DEBUG
+#else
+ FILEFLAGS 	0x0L
+#endif
+ FILEOS 	VOS__WINDOWS32
+ FILETYPE 	VFT_APP
+ FILESUBTYPE 	0x0L
+BEGIN
+    BLOCK "StringFileInfo"
+    BEGIN
+        BLOCK "040904b0"
+        BEGIN
+            VALUE "FileDescription", "Tclkit Application\0"
+            VALUE "OriginalFilename", "tclkit" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0"
+            VALUE "CompanyName", "ActiveState Corporation\0"
+            VALUE "FileVersion", TCL_PATCH_LEVEL
+            VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0"
+            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
+            VALUE "ProductVersion", TCL_PATCH_LEVEL
+        END
+    END
+    BLOCK "VarFileInfo"
+    BEGIN
+        VALUE "Translation", 0x409, 1200
+    END
+END
+
+//
+// Icon
+//
+
+tclsh                      ICON    DISCARDABLE     "tclsh.ico"
+
+//
+// This is needed for Windows 8.1 onwards.
+//
+
+#ifndef RT_MANIFEST
+#define RT_MANIFEST     24
+#endif
+#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID
+#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
+#endif
+CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclkit.exe.manifest"