--- /dev/null
+TCL_CVS = :pserver:anonymous@tcl.cvs.sourceforge.net:/cvsroot/tcl
+TK_CVS = :pserver:anonymous@tktoolkit.cvs.sourceforge.net:/cvsroot/tktoolkit
+VFS_CVS = :pserver:anonymous@tclvfs.cvs.sourceforge.net:/cvsroot/tclvfs
+VLERQ_CVS = :pserver:anonymous@equi4.com:/home/cvs
+ZLIB_CVS = :pserver:anonymous@equi4.com:/home/cvs
+ZLIB_URL = http://www.zlib.net/zlib-1.2.3.tar.gz
+
+unspecified-target:
+
+8.4:
+ mkdir -p $@ && cd $@ && \
+ cvs -d $(TCL_CVS) co -r core-8-4-branch tcl && \
+ cvs -d $(TCL_CVS) co thread && \
+ cvs -d $(TK_CVS) co -r core-8-4-branch tk && \
+ cvs -d $(VFS_CVS) co tclvfs && \
+ cvs -d $(VLERQ_CVS) co -d vlerq vlerq/tcl && \
+ cvs -d $(ZLIB_CVS) co zlib
+ #sh config.sh 8.4/base-aqua sym univ aqua
+ #sh config.sh 8.4/base-x11 sym univ
+ sh config.sh 8.4/base-std sym
+
+8.5:
+ mkdir -p $@ && cd $@ && \
+ cvs -d $(TCL_CVS) co tcl && \
+ cvs -d $(TCL_CVS) co thread && \
+ cvs -d $(TK_CVS) co tk && \
+ cvs -d $(VFS_CVS) co tclvfs && \
+ cvs -d $(VLERQ_CVS) co -d vlerq vlerq/tcl && \
+ cvs -d $(ZLIB_CVS) co zlib
+ #sh config.sh 8.5/base-aqua sym univ aqua thread
+ #sh config.sh 8.5/base-x11 sym univ thread
+ sh config.sh 8.5/base-std sym thread
+
+cvs:
+ for i in 8*/*/CVS; do (cd `dirname $$i`; cvs up); done
+
+small: 8.4
+ sh config.sh 8.4/kit-small cli dyn
+ cd 8.4/kit-small && $(MAKE) && $(MAKE) clean
+
+large: 8.5
+ sh config.sh 8.5/kit-large aqua univ thread allenc allmsgs tzdata
+ cd 8.5/kit-large && $(MAKE) && $(MAKE) clean
+
+base tidy:
+ for i in 8*/base-*/Makefile; do (cd `dirname $$i`; $(MAKE) $@); done
+all clean distclean tclkit-cli tclkit-dyn tclkit-gui:
+ for i in 8*/kit-*/Makefile; do (cd `dirname $$i`; $(MAKE) $@); done
+
+# this is not for general use, due to the custom script and hard-wired paths
+docs:
+ markdown-tm 'Kitgen - Tclkit Lite executable builder' \
+ <README >~/Sites/www.equi4.com/kitgen.html
+ markdown-tm 'Swisskit - a big single-file Tcl/Tk for Mac OS X' \
+ <README.swisskit >~/Sites/www.equi4.com/swisskit.html
+
+.PHONY: all base tidy clean distclean cvs small large docs
--- /dev/null
+Kitgen
+======
+
+[Kitgen][1] consists of a makefile, scripts, and C source code to generate
+variations of [Tclkit Lite][2], a version of [Tclkit][3] based on [Vlerq][4].
+
+ [1]: http://www.equi4.com/kitgen.html
+ [2]: http://www.equi4.com/tclkitlite.html
+ [3]: http://www.equi4.com/tclkit.html
+ [4]: http://www.vlerq.org/
+
+Kitgen is pronounced "kit-chen", which also means "little kit" in German.
+
+
+News
+----
+
+ * 2007-01-11 : fixed a vfs thread issue in boot.tcl, by Jeff Hobbs
+ * 2006-12-20 : fixed typo, mention the FFF feedback forum below
+ * 2006-12-15 : added *BSD support (use gmake i.s.o. make)
+ * 2006-12-12 : doc tweaks, added "cvs" target, support vlerq safe interps
+ * 2006-12-06 : updated to vlerq 4.1 and vfs::m2m 1.8
+ * 2006-12-05 : added "base" & "tidy" targets for Tcl/Tk-only builds
+ * 2006-12-04 : added "gcov" and "gprof" options, keep symbols with "sym" opt
+ * 2006-12-01 : added "b64" option to enable 64-bit compiles
+ * 2006-11-21 : simpler makefile, tweaked to work with Mingw on Win32
+ * 2006-11-19 : first release, tested on Mac OS X and Linux x86 only so far
+
+
+Overview
+--------
+
+To build Tclkit Lite, you need to bring several pieces together:
+
+ * sources for Tcl and Tk
+ * sources for the Thread, TclVFS, and Vlerq extensions
+ * sources for Zlib
+ * the files in this Kitgen package
+
+There are several ways to go about this, depending on whether you want to use
+the latest sources in cvs, or tarfile releases, or your own custom versions.
+
+
+Quick start
+-----------
+
+These instructions are for a Unix-type system and do a build using CVS sources:
+
+ cvs -d :pserver:anonymous@equi4.com:/home/cvs co kitgen
+ cd kitgen
+ make small
+
+That's it. This produces two executables in `8.4/kit-small/`:
+
+ * `tclkit-cli` - a tclsh-like console app
+ * `tclkit-dyn` - wish-like, after a `package require Tk`
+
+Or, to build a threaded Tcl/Tk 8.5 build with all encodings and more included:
+
+ cvs -d :pserver:anonymous@equi4.com:/home/cvs co kitgen
+ cd kitgen
+ make large
+
+In this case a third executable is also produced:
+
+ * `tclkit-gui` - same as "tclkit-dyn", but with Tk linked-in statically
+
+On **Mac OS X**, "make large" builds a universal binary for PowerPC and Intel.
+
+On **Windows** you can use this approach if you download `msys_mingw 0.8` from
+<http://tcl.sourceforge.net/> (make sure you extract to a path without spaces).
+Then launch `msys.bat` to get a bash shell and proceed further as above.
+The binaries will end up as "tclkit-{cli,dyn,gui}.exe" in this case.
+
+You can use `make cvs` to update all cvs areas under `8.4/` and `8.5/`.
+
+
+Tcl/Tk builds
+-------------
+
+Kitgen can also be used to build Tcl/Tk binaries in various configurations.
+There is a make target called "base" which builds just `tclsh` and `wish` and
+installs them in the `build/{bin,include,lib}` directories. The Tcl/Tk headers
+are included so that these areas can be used as basis for building extensions.
+
+In the top-level makefile, `make base` rebuilds all areas matching `8.*/base-*`.
+This can be used to rebuild all build variants you have set up in one step,
+after a source change to Tcl and/or Tk.
+
+If you've set up the `8.4/` and `8.5/` directories as described above, then a
+`base-std` configuration will already have been set up, with symbols enabled.
+So after the quick-start, you can do the following to build 8.4 and 8.5 versions
+of `tclsh` and `wish` and clean up all intermediate files with one command:
+
+ make base tidy
+
+The `make tidy` command removes all intermediate build files, but is careful to
+keep the `8.*/base-*/build/{bin,include,lib}` directories.
+
+
+In detail
+---------
+
+The makefile in kitgen/ is only a convenience wrapper to make the above
+possible. The real work is carried out by two other scripts:
+
+ * `config.sh` is a script to set up specific build configurations
+ * `setupvfs.tcl` is the script used internally to construct the final app
+
+Kitgen is designed to proceed in several phases, so many variants can be built:
+
+ 1. place all necessary source code in directories named `8.4` or `8.5`
+ 2. configure one or more build directories using the config.sh script
+ 3. go to any of these build directories and type `make`
+ 4. remove intermediate build results with `make clean`
+ 5. copy and rename the final tclkit-* files to your ~/bin/ or some such
+ 6. remove the generated executables as well with `make distclean`
+ 7. forget about kitgen, until you need to update your builds
+
+Note: after updating any of the sources, you can do a `make all` in the kitgen/
+directory to rebuild all executables (assuming you did `make clean` before).
+
+
+Directory structure
+-------------------
+
+The key trick is to get the directory structure right so that `sh config.sh` and
+`make` will do the right thing. Both assume the following structure exists:
+
+ kitgen/
+ 8.4/
+ base-*/
+ kit-*/
+ tcl/
+ tclvfs/
+ thread/
+ tk/
+ vlerq/
+ zlib/
+ 8.5/
+ base-*/
+ kit-*/
+ tcl/
+ tclvfs/
+ thread/
+ tk/
+ vlerq/
+ zlib/
+ config.sh
+ files/
+ ...
+
+You do not have to have both 8.4/ and 8.5/, nor do you have to give them exactly
+these names, but they must start with "8". There can be multiple sets of code
+sources co-existing next to each other even, if needed. Symlinks should work.
+
+
+config.sh
+---------
+
+The config.sh script creates a Makefile with settings that specify exactly what
+type of executable(s) are to be generated. All these makefiles end up in sub-
+directories of 8.4/, 8.5/, or whatever other 8-prefixed name you work with.
+
+The `make small` example given in the quick start uses default settings:
+
+ sh config.sh 8.4/kit-small cli dyn
+
+The result is a makefile called "8.4/kit-small/Makefile". To build that setup,
+just do `cd 8.4/kit-small && make` . Since cli & dyn were specified, only those
+two executables will be built, but you can do an explicit `make tclkit-gui` .
+
+The `make large` example in the quick start uses these more elaborate settings:
+
+ sh config.sh 8.5/kit-large aqua univ thread allenc allmsgs tzdata
+
+Again, `cd 8.5/kit-large && make` is all it takes to build that configuation.
+
+The first argument of config.sh is the build name. It must be a two-part name,
+and the first part must be one of your existing "8*/" directory areas. The
+second part could be any name, but the suggested name is "kit-something".
+
+The remaining arguments of config.sh specify one or more build options:
+
+ * `allenc` - include all encodings, not just the usual set of 7
+ * `allmsgs` - include all localized message catalogs _(8.5 only)_
+ * `aqua` - build Tk for Aqua i.s.o. X11 _(Mac OS X only)_
+ * `b64` - generate 64-bit binaries
+ * `cli` - build the "tclkit-cli" command-line version
+ * `dyn` - build the "tclkit-dyn" version which loads Tk dynamically
+ * `gcov` - enable code coverage _(implies `sym`)_
+ * `gprof` - enable profiling _(implies `sym`)_
+ * `gui` - build the "tclkit-gui" version which has Tk linked-in statically
+ * `ppc` - build for PowerPC _(Mac OS X only)_
+ * `sym` - enable & keep debugger symbols in the executable
+ * `thread` - build with threading and include the Thread extension
+ * `tzdata` - include a huge set of timezone data files _(8.5 only)_
+ * `univ` - build for both PowerPC and Intel _(Mac OS X only)_
+ * `x86` - build for Intel _(Mac OS X only)_
+
+When not specified, the default is to build all `cli`, `dyn`, `gui` variants.
+
+
+Makefile
+--------
+
+All makefiles created by config.sh or manually need to reside in subdirectories
+of some 8*/ source directory. That location determines which source code will
+be used, since all builds are done relative to their parent dirs.
+
+To generate a Makefile with config and then do a build, proceed as follows:
+
+ sh config.sh 8.4/kit-mybuild <config options ...>
+ cd 8.4/kit-mybuild
+ make
+
+Often, that's all you'll need. However, to debug or tweak things, read on...
+
+The common parts of these makefiles is read in during use, through the
+
+ include ../../makefile.include
+
+line at the end of each makefile. It defines the following main targets:
+
+ * `all` - builds all targets given to config.sh (default is cli + dyn + gui)
+ * `tclkit-cli` - builds just that executable (same for -dyn and -gui)
+ * `clean` - removes all intermediate build results
+ * `distclean` - removes the tclkit-* executables as well
+
+Note that these same build targets also exist in the top-level makefile in
+kitgen/ - when used there, the corresponding target in *all* subdirectory
+makefiles will be invoked. To prevent a specific makefile from being run that
+way, give it some other name than "Makefile".
+
+The individual make's are configured mostly by setting make variables:
+
+ * `GUI_OPTS` - options needed to build with Tk
+ * `KIT_OPTS` - flags used by the setupvfs.tcl script
+ * `PLAT` - either "unix" or "win" to select the proper source directory
+ * `PRIV` - normally "install-private-headers", but omitted on Windows
+ * `TCL_OPTS` - flags for configuring the build of Tcl
+ * `TK_OPTS` - flags for configuring the build of Tk
+ * `TKDYN_OPTS` - flags for configuring the build of Tk as shared lib
+ * `THREADDYN_OPTS` - flags for configuring the build of Thread as shared lib
+ * `VFS_OPTS` - flags for configuring the build of the TclVFS extension
+ * `VLERQ_OPTS` - flags for configuring the build of the Vlerq extension
+
+Other variables such as CFLAGS and LDFLAGS also affect the build settings.
+
+Doing `make` will build the executables. This only does a full build when there
+are no build/* directories present. One way to force this is `make clean`
+which does a `rm -rf build` . Otherwise, for directories which already exist,
+the rebuild is skipped. To force a rebuild of only the vlerq extension, do:
+
+ rm -rf build/vlerq && make
+
+The sub-directories of build/ are the areas where each call to the respective
+"configure" script places its results. When debugging either a build or the
+extension itself, it may be more convenient to work in that specific subdir:
+
+ cd builds/vlerq && make
+
+After that, you can do `cd ../.. && make` to complete the tclkit builds.
+
+
+setupvfs.tcl
+------------
+
+This is an internal script used as last step by the makefiles to construct the
+virtual file system (VFS) containing runtime scripts at the end of every tclkit.
+See the makefile.include file for exact details.
+
+The setupvfs.tcl script is special in that it can only be used by a "raw" kit,
+i.o.w. a tclkit executable which does not yet have the VFS part appended to it.
+It is essentially a way for tclkit to bootstrap itself into becoming usable.
+
+The reason things are done this way is that it avoids the need to have a working
+tclkit around to construct a new one, which'd be a chicken-and-egg situation.
+Furthermore, this approach makes it possible to build a tclkit totally from
+scratch without requiring any binary data files (as "genkit" did).
+
+Some variations in generating the VFS data are configured via the command line:
+
+ * `-d` - output some debugging info from this setup script
+ * `-e` - include all encodings i.s.o. 7 basic ones (encodings/)
+ * `-m` - include all localized message files (tcl 8.5, msgs/)
+ * `-t` - include the thread extension as shared lib in vfs
+ * `-z` - include timezone data files (tcl 8.5, tzdata/)
+
+As with the makefiles, most of these details are dealt with automatically if you
+use the config.sh script to create your configurations.
+
+
+License & support
+-----------------
+
+The Tclkit-specific sources are license free, they just have a copyright. Hold
+the author(s) harmless and any lawful use is permitted.
+
+This does *not* apply to any of the sources of the other major Open Source
+Software used in Tclkit, which each have very liberal BSD/MIT-like licenses:
+
+ * Tcl/Tk, TclVFS, Thread, Vlerq, Zlib
+
+If kitgen does not work right on your platform, please post to the [Starkit][5] mailing list. Or you can use the feedback forum at [FFF][6] to report bugs.
+
+ [5]: http://www.equi4.com/mailman/listinfo/starkit
+ [6]: http://www.equi4.com/fff/Home
+
+
+Acknowledgements
+----------------
+
+With thanks to John Ousterhout for creating Tcl/Tk, Matt Newman and Vince Darley
+for developing the virtual file system, and the members of the Tcl Core Team for
+diligently maintaining and taking forward the Tcl/Tk code base plus extensions.
+
+A special thanks to Daniel Steffen for making Tcl/Tk work so well on Mac OS X.
+
+Thanks also to Eolas Technologies Inc for sponsoring the Vlerq project on which
+Tclkit Lite is based. There'd not be a Tclkit Lite, nor kitgen, without them.
+
+Contributors & testers:
+
+ * Brian Theado (mingw/win32)
+
+Lastly, many thanks to all those who have contributed to the evolution of Tclkit
+over the years, with suggestions, bug reports, encouragement, and enthusiasm.
--- /dev/null
+Swisskit
+========
+
+[Swisskit][1] is an elaborate build of [Tclkit Lite][2] for Mac OS X.
+It was built with the new [Kitgen][3] configuration system.
+
+Swisskit ...
+
+ * ... is based on the latest Tcl/Tk 8.5a6 sources from CVS
+ * ... is a universal threaded build for any PowerPC or Intel 10.4-based Mac
+ * ... can bring up an X11-based Tk if the "DISPLAY" environment var is set
+ * ... will use the Tk Aqua shared library instead if "DISPLAY" is not set
+ * ... includes all available encodings, message catalogs, and timezone files
+ * ... has Tile and the Thread + Ttrace packages, as well as TclVFS and Vlerq
+
+In other words: Swisskit can be the Swiss Army Knife for Tcl/Tk on the Mac.
+
+
+News
+----
+
+ * 2006-11-19 : first release, a 3.7 Mb [download][4] as ZIP archive
+
+
+Acknowledgements
+----------------
+
+Swisskit is a tribute to Daniel Steffen, who has contiously improved the Tcl/Tk
+system for Macintosh, and who has made it possible to load either the Aqua or
+the X11 version of Tk from the same single-file standalone executable.
+
+ [1]: http://www.equi4.com/swisskit.html
+ [2]: http://www.equi4.com/tclkitlite.html
+ [3]: http://www.equi4.com/kitgen.html
+ [4]: http://www.equi4.com/pub/tk/swisskit.zip
--- /dev/null
+#set -x
+
+args="$*"
+
+verbose=0; case $1 in -v) verbose=1; shift ;; esac
+
+root=`dirname $1`
+base=`basename $1`
+shift
+
+case $root in .) root=8.4;; esac
+path=$root/$base
+
+if test ! -d $root
+ then echo "error: directory '$root' does not exist"; exit 1; fi
+
+for v in allenc allmsgs aqua b64 cli dyn gui ppc \
+ gcov gprof sym thread tzdata univ x86
+ do eval $v=0; done
+
+while test $# != 0
+ do eval $1=1; shift; done
+
+#for v in thread allenc allmsgs tzdata cli dyn gui aqua x86 ppc univ
+# do eval val=$`echo $v`; echo $v = "$val"; done
+
+make=$path/Makefile
+mach=`uname`
+plat=unix
+
+echo "Configuring $make for $mach." >&2
+mkdir -p $path
+
+case $cli-$dyn-$gui in 0-0-0) cli=1 dyn=1 gui=1 ;; esac
+
+( echo "# Generated `date`:"
+ echo "# `basename $0` $args"
+ echo
+
+ case $mach in
+
+ Darwin)
+ case $aqua in
+ 1) echo "GUI_OPTS = -framework Carbon -framework IOKit" ;;
+ *) echo "GUI_OPTS = -L/usr/X11R6/lib -lX11 -weak-lXss -lXext" ;;
+ esac
+
+ echo "LDFLAGS = -framework CoreFoundation"
+ echo "LDSTRIP = -x"
+
+ case $b64-$univ-$ppc-$x86 in
+ 0-0-0-0) ;;
+ 0-0-1-0) echo "CFLAGS += -arch ppc" ;;
+ 0-0-0-1) echo "CFLAGS += -arch x86" ;;
+ 0-?-?-?) echo "CFLAGS += -arch ppc -arch i386" ;;
+ 1-0-1-0) echo "CFLAGS += -arch ppc64" ;;
+ 1-0-0-1) echo "CFLAGS += -arch x86_64" ;;
+ 1-?-?-?) echo "CFLAGS += -arch ppc64 -arch x86_64" ;;
+ esac
+ echo "CFLAGS += -isysroot /Developer/SDKs/MacOSX10.4u.sdk" \
+ "-mmacosx-version-min=10.4"
+
+ case $aqua in 1)
+ echo "TK_OPTS = --enable-aqua"
+ echo "TKDYN_OPTS = --enable-aqua" ;;
+ esac
+ ;;
+
+ Linux)
+ echo "LDFLAGS = -ldl -lm"
+ echo "GUI_OPTS = -L/usr/X11R6/lib -lX11 -lXss"
+ case $b64 in 1)
+ echo "CFLAGS += -m64" ;;
+ esac
+ ;;
+
+ *BSD)
+ echo "CFLAGS += -I/usr/X11R6/include"
+ echo "LDFLAGS = -lm"
+ echo "GUI_OPTS = -L/usr/X11R6/lib -lX11 -lXss"
+ case $b64 in 1)
+ echo "CFLAGS += -m64" ;;
+ esac
+ ;;
+
+ MINGW*)
+ echo "LDFLAGS = build/lib/dde1*/tcldde1*.a build/lib/reg1*/tclreg1*.a"
+ echo "GUI_OPTS = -lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32"
+ echo "GUI_OPTS += -lole32 -loleaut32 -luuid"
+ echo "GUI_OPTS += build/tk/wish.res.o -mwindows"
+ echo "EXE = .exe"
+ plat=win
+ ;;
+
+ SunOS)
+ echo "LDFLAGS = -ldl -lsocket -lnsl -lm"
+ echo "GUI_OPTS = -lX11 -lXext"
+ ;;
+
+ *) echo "warning: no settings known for '$mach'" >&2 ;;
+ esac
+
+ echo "PLAT = $plat"
+ case $plat in unix)
+ echo "PRIV = install-private-headers" ;;
+ esac
+ case $b64 in 1)
+ echo "TCL_OPTS += --enable-64bit"
+ echo "TK_OPTS += --enable-64bit"
+ echo "VFS_OPTS += --enable-64bit"
+ echo "VLERQ_OPTS += --enable-64bit" ;;
+ esac
+
+ #case $verbose in 1) kitopts=" -d" ;; esac
+ case $allenc in 1) kitopts="$kitopts -e" ;; esac
+ case $allmsgs in 1) kitopts="$kitopts -m" ;; esac
+ case $tzdata in 1) kitopts="$kitopts -z" ;; esac
+
+ case $thread in
+ 1) case $mach in Linux|SunOS)
+ echo "LDFLAGS += -lpthread" ;;
+ esac
+ echo "TCL_OPTS = --enable-threads"
+ echo "KIT_OPTS = -t$kitopts" ;;
+ 0) echo "KIT_OPTS =$kitopts" ;;
+ esac
+
+ case $tzdata in 1) echo "TCL_OPTS += --with-tzdata" ;; esac
+
+ case $gprof in 1)
+ echo "CFLAGS += -pg"
+ sym=1 ;;
+ esac
+
+ case $gcov in 1)
+ echo "CFLAGS += -fprofile-arcs -ftest-coverage -O0"
+ echo "LDFLAGS += -lgcov"
+ sym=1 ;;
+ esac
+
+ case $sym in 1)
+ echo "STRIP = :"
+ echo
+ echo "TCL_OPTS += --enable-symbols"
+ echo "THREADDYN_OPTS += --enable-symbols"
+ echo "TK_OPTS += --enable-symbols"
+ echo "TKDYN_OPTS += --enable-symbols"
+ echo "VFS_OPTS += --enable-symbols"
+ echo "VLERQ_OPTS += --enable-symbols"
+ echo ;;
+ esac
+
+ case $cli in 1) targets="$targets tclkit-cli" ;; esac
+ case $dyn in 1) targets="$targets tclkit-dyn" ;; esac
+ case $gui in 1) targets="$targets tclkit-gui" ;; esac
+
+ case $thread in
+ 1) echo "all: threaded$targets" ;;
+ 0) echo "all:$targets" ;;
+ esac
+
+ case $mach in MINGW*)
+ echo
+ echo "tclkit-cli: tclkit-cli.exe"
+ echo "tclkit-dyn: tclkit-dyn.exe"
+ echo "tclkit-gui: tclkit-gui.exe"
+ esac
+
+ echo
+ echo "include ../../makefile.include"
+
+) >$make
+
+case $verbose in 1)
+ echo
+ echo "Contents of $make:"
+ echo "======================================================================="
+ cat $make
+ echo "======================================================================="
+ echo
+ echo "To build, run these commands:"
+ echo " cd $path"
+ echo " make"
+ echo
+ echo "This produces the following executable(s):"
+ case $cli in 1) echo " $path/tclkit-cli (command-line)" ;; esac
+ case $dyn in 1) echo " $path/tclkit-dyn (Tk as shared lib)" ;; esac
+ case $gui in 1) echo " $path/tclkit-gui (Tk linked statically)" ;; esac
+ echo
+ echo "To remove all intermediate builds, use 'make clean'."
+ echo "To remove all executables as well, use 'make distclean'."
+ echo
+esac
--- /dev/null
+proc tclInit {} {
+ rename tclInit {}
+
+ global auto_path tcl_library tcl_libPath tcl_version
+
+ set noe [info nameofexecutable]
+
+ 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 if we don't have our exe
+ # already mounted. This should only happen once per thread.
+ # We could use [vfs::filesystem info], but that would require
+ # loading vfs into every interp.
+ if {![file isdirectory $noe]} {
+ load {} vfs
+
+ # lookup and emulate "source" of lib/vfs1*/{vfs*.tcl,mk4vfs.tcl}
+ if {[llength [info command mk::file]]} {
+ set driver mk4
+
+ # 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 -glob name vfs1*]
+
+ foreach x {vfsUtils vfslib mk4vfs} {
+ set n [mk::select exe.dirs!$d.files name $x.tcl]
+ if {[llength $n] != 1} { error "$x: cannot find startup script"}
+
+ 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
+ } else {
+ set driver mkcl
+
+ # use raw Vlerq calls if Mk4tcl is not available
+ # $::vlerq::starkit_root is set in the init script in kitInit.c
+ set rootv [vlerq get $::vlerq::starkit_root 0 dirs]
+ set dname [vlerq get $rootv * name]
+ set prows [vlerq get $rootv * parent]
+ foreach r [lsearch -int -all $prows 0] {
+ if {[lindex $dname $r] eq "lib"} break
+ }
+
+ # glob for a subdir in "lib", then source the specified file inside it
+ foreach {d f} {
+ vfs1* vfsUtils.tcl vfs1* vfslib.tcl vlerqtcl4* mkclvfs.tcl
+ } {
+ foreach z [lsearch -int -all $prows $r] {
+ if {[string match $d [lindex $dname $z]]} break
+ }
+
+ set files [vlerq get $rootv $z files]
+ set names [vlerq get $files * name]
+
+ set n [lsearch $names $f]
+ if {$n < 0} { error "$d/$f: cannot find startup script"}
+
+ set s [vlerq get $files $n contents]
+ catch {set s [zlib decompress $s]}
+ uplevel #0 $s
+ }
+
+ # hack the mkcl info so it will know this mount point as "exe"
+ set vfs::mkcl::v::rootv(exe) $rootv
+ set vfs::mkcl::v::dname(exe) $dname
+ set vfs::mkcl::v::prows(exe) $prows
+ }
+
+ # mount the executable, i.e. make all runtime files available
+ vfs::filesystem mount $noe [list ::vfs::${driver}::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]
+ 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::${driver}::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
+}
--- /dev/null
+set ::vfs::tclkit_version 200611.001
--- /dev/null
+package ifneeded Tk 8.4 \
+ [string map [list @@ [file join $dir .. libtk8.4[info sharedlibext]]] {
+ if {[lsearch -exact [info loaded] {{} Tk}] >= 0} {
+ load "" Tk
+ } else {
+ load @@ Tk
+ }
+ }]
--- /dev/null
+package ifneeded Tk 8.5a6 \
+ [string map [list @@ [file join $dir .. libtk8.5[info sharedlibext]]] {
+ if {[lsearch -exact [info loaded] {{} Tk}] >= 0} {
+ load "" Tk
+ } else {
+ load @@ Tk
+ }
+ }]
--- /dev/null
+namespace eval ::vfs {}
+variable vfs::dll [file join $dir libvfs1.3.dylib]
+
+proc loadvfs {dll} {
+ global auto_path
+ if {![file exists $dll]} { return }
+ set dir [file dirname $dll]
+ if {[lsearch -exact $auto_path $dir] == -1} {
+ lappend auto_path $dir
+ }
+ load $dll
+}
+
+package ifneeded vfs 1.3 [list loadvfs $vfs::dll]
+
+# Allow optional redirect of VFS_LIBRARY components. Only necessary
+# for testing, but could be used elsewhere.
+if {[info exists ::env(VFS_LIBRARY)]} { set dir $::env(VFS_LIBRARY) }
+package ifneeded starkit 1.3.1 [list source [file join $dir starkit.tcl]]
+package ifneeded vfslib 1.3.1 [list source [file join $dir vfslib.tcl]]
+package ifneeded vfs::mk4 1.10 [list source [file join $dir mk4vfs.tcl]]
+package ifneeded vfs::zip 1.0 [list source [file join $dir zipvfs.tcl]]
+
+#compat
+package ifneeded mk4vfs 1.10 [list source [file join $dir mk4vfs.tcl]]
--- /dev/null
+package ifneeded vlerq 4.0 {load "" vlerq}
+
+package ifneeded mklite 0.4 [list source [file join $dir mklite.tcl]]
+package ifneeded vfs::m2m 1.7 [list source [file join $dir m2mvfs.tcl]]
+package ifneeded vfs::mkcl 1.5 [list source [file join $dir mkclvfs.tcl]]
--- /dev/null
+package ifneeded vlerq 4.1 {load "" vlerq}
+
+package ifneeded mklite 0.4 [list source [file join $dir mklite.tcl]]
+package ifneeded vfs::m2m 1.8 [list source [file join $dir m2mvfs.tcl]]
+package ifneeded vfs::mkcl 1.5 [list source [file join $dir mkclvfs.tcl]]
--- /dev/null
+#!/usr/bin/env tclkit
+
+# Generate swisskit from 8.5/kit-large and 8.5/kit-x11, created via:
+#
+# sh config.sh 8.5/kit-large aqua univ thread allenc allmsgs tzdata
+# sh config.sh 8.5/kit-x11 univ thread dyn
+#
+# The result is an 8.5-based threaded universal binary for Mac OS X with all
+# available encodings, message catalogs, and timezone datafiles included.
+#
+# This binary will launch Tk under X11 if $env(DISPLAY) is set, else Tk Aqua.
+#
+# jcw, 2006-11-19
+
+package require vfs::mk4
+
+file copy -force 8.5/kit-large/tclkit-dyn swisskit
+
+vfs::mk4::Mount 8.5/kit-x11/tclkit-dyn x11 -readonly
+vfs::mk4::Mount swisskit swisskit
+
+file copy x11/lib/libtk8.5.dylib swisskit/lib/libtk8.5-x11.dylib
+
+set fd [open swisskit/lib/tk8.5/pkgIndex.tcl w]
+
+puts $fd {
+package ifneeded Tk 8.5a6 \
+ [string map [list @A [file join $dir .. libtk8.5[info sharedlibext]] \
+ @X [file join $dir .. libtk8.5-x11[info sharedlibext]]] {
+ if {[lsearch -exact [info loaded] {{} Tk}] >= 0} {
+ load "" Tk
+ } elseif {[info exists ::env(DISPLAY)]} {
+ load @X Tk
+ } else {
+ load @A Tk
+ }
+ }]
+}
+
+close $fd
+
+vfs::unmount swisskit
+vfs::unmount x11
--- /dev/null
+/*
+ * tclAppInit.c --
+ *
+ * Provides a default version of the main program and Tcl_AppInit
+ * procedure for Tcl applications (without Tk). Note that this
+ * program must be built in Win32 console mode to work properly.
+ *
+ * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 2000-2006 Jean-Claude Wippler <jcw@equi4.com>
+ * Copyright (c) 2003-2006 ActiveState Software Inc.
+ *
+ * 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
+
+#include <string.h>
+
+#ifdef _WIN32
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+#endif
+
+/* defined in tclInt.h */
+extern Tcl_Obj* TclGetStartupScriptPath();
+extern void TclSetStartupScriptPath(Tcl_Obj*);
+
+Tcl_AppInitProc Pwb_Init, Rechan_Init, Vfs_Init, Zlib_Init;
+#ifdef KIT_LITE
+Tcl_AppInitProc Vlerq_Init, Vlerq_SafeInit;
+#else
+Tcl_AppInitProc Mk4tcl_Init;
+#endif
+#ifdef TCL_THREADS
+Tcl_AppInitProc Thread_Init;
+#endif
+#ifdef _WIN32
+Tcl_AppInitProc Dde_Init, Registry_Init;
+#endif
+
+#ifdef WIN32
+#define DEV_NULL "NUL"
+#else
+#define DEV_NULL "/dev/null"
+#endif
+
+static void TclKit_InitStdChannels(void);
+
+/*
+ * Attempt to load a "boot.tcl" entry from the embedded MetaKit file.
+ * This code uses either the Mk4tcl or the vlerq extension (-DKIT_LITE).
+ * 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.
+ *
+ * The appInitCmd will only be run once in the main (initial) interpreter.
+ * The preInitCmd will be registered to run in any created interpreter.
+ */
+
+static char appInitCmd[] =
+"proc tclKitInit {} {\n"
+ "rename tclKitInit {}\n"
+ "catch {load {} zlib}\n"
+ "if {![info exists ::tcl::basekit]} {\n"
+ "namespace eval ::tcl { variable basekit [info nameofexecutable] }\n"
+ "}\n"
+#ifdef KIT_LITE
+ "load {} vlerq\n"
+ "namespace eval ::vlerq {}\n"
+ "if {[catch { vlerq open $::tcl::basekit } ::vlerq::starkit_root]} {\n"
+ "set n -1\n"
+ "} else {\n"
+ "set files [vlerq get $::vlerq::starkit_root 0 dirs 0 files]\n"
+ "set n [lsearch [vlerq get $files * name] boot.tcl]\n"
+ "}\n"
+ "if {$n >= 0} {\n"
+ "array set a [vlerq get $files $n]\n"
+#else
+ "load {} Mk4tcl\n"
+ "mk::file open exe $::tcl::basekit -readonly\n"
+ "set n [mk::select exe.dirs!0.files name boot.tcl]\n"
+ "if {[llength $n] == 1} {\n"
+ "array set a [mk::get exe.dirs!0.files!$n]\n"
+#endif
+ "if {![info exists a(contents)]} { error {no boot.tcl file} }\n"
+ "if {$a(size) != [string length $a(contents)]} {\n"
+ "set a(contents) [zlib decompress $a(contents)]\n"
+ "}\n"
+ "if {$a(contents) eq \"\"} { error {empty boot.tcl} }\n"
+ "uplevel #0 $a(contents)\n"
+ "} elseif {[lindex $::argv 0] eq \"-init-\"} {\n"
+ "uplevel #0 { source [lindex $::argv 1] }\n"
+ "exit\n"
+ "} else {\n"
+ "error \"\n $::tcl::basekit has no VFS data to start up\"\n"
+ "}\n"
+"}\n"
+"tclKitInit"
+;
+
+static char preInitCmd[] =
+"proc tclKitPreInit {} {\n"
+ "rename tclKitPreInit {}\n"
+/*
+ * XXX: We should consider adding mk4tcl, pwb, rechan, zlib, vfs, Thread
+ * XXX: and Tk as pre-defined packages here as well.
+ * XXX: Currently Thread has a special pkgIndex.tcl in the starkit, but
+ * XXX: several of the other packages won't be auto-recognized.
+ */
+#ifdef _WIN32
+ "package ifneeded dde 1.2.3 {load {} dde}\n"
+ "package ifneeded registry 1.1.3 {load {} registry}\n"
+#endif
+"}\n"
+"tclKitPreInit"
+;
+
+static const char initScript[] =
+"if {[file isfile [file join $::tcl::basekit 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 $::tcl::basekit main.tcl]\n"
+"} else continue\n"
+;
+
+/*
+ * If set, this is the path to the base kit
+ */
+static char *tclKitPath = NULL;
+
+#ifdef WIN32
+__declspec(dllexport) int
+#else
+extern int
+#endif
+TclKit_AppInit(Tcl_Interp *interp)
+{
+ /*
+ * Ensure that std channels exist (creating them if necessary)
+ */
+ TclKit_InitStdChannels();
+
+#ifdef KIT_LITE
+ Tcl_StaticPackage(0, "vlerq", Vlerq_Init, Vlerq_SafeInit);
+#else
+ 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
+
+ if (tclKitPath != NULL) {
+ /*
+ * If we have a tclKitPath set, then set that to ::tcl::basekit.
+ * This will be used instead of 'info nameofexecutable' for
+ * determining the location of the base kit. This is necessary
+ * for DLL-based starkits.
+ *
+ * This code equates to:
+ * namespace eval ::tcl [list variable basekit $tclKitPath]
+ * Could consider using Tcl_LinkVar instead.
+ */
+ Tcl_Obj *objPtr;
+ Tcl_Obj *evobjPtr;
+
+ evobjPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(interp, evobjPtr,
+ Tcl_NewStringObj("variable", -1));
+ Tcl_ListObjAppendElement(interp, evobjPtr,
+ Tcl_NewStringObj("basekit", -1));
+ Tcl_ListObjAppendElement(interp, evobjPtr,
+ Tcl_NewStringObj(tclKitPath, -1));
+ Tcl_IncrRefCount(evobjPtr);
+
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("namespace", -1));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("eval", -1));
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj("::tcl", -1));
+ Tcl_ListObjAppendElement(interp, objPtr, evobjPtr);
+ Tcl_IncrRefCount(objPtr);
+ if (Tcl_EvalObjEx(interp, objPtr, TCL_GLOBAL_ONLY) != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(evobjPtr);
+ goto error;
+ }
+ Tcl_DecrRefCount(objPtr);
+ Tcl_DecrRefCount(evobjPtr);
+ }
+
+ TclSetPreInitScript(preInitCmd);
+ if ((Tcl_EvalEx(interp, appInitCmd, -1, TCL_EVAL_GLOBAL) == TCL_ERROR)
+ || (Tcl_Init(interp) == TCL_ERROR))
+ goto error;
+
+#if defined(KIT_INCLUDES_TK) && defined(_WIN32)
+ if (Tk_Init(interp) == TCL_ERROR)
+ goto error;
+ if (Tk_CreateConsoleWindow(interp) == TCL_ERROR)
+ goto error;
+#endif
+
+ /* messy because TclSetStartupScriptPath is called slightly too late */
+ if (Tcl_Eval(interp, initScript) == TCL_OK) {
+ Tcl_Obj* path = TclGetStartupScriptPath();
+ TclSetStartupScriptPath(Tcl_GetObjResult(interp));
+ 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:
+#if defined(KIT_INCLUDES_TK) && defined(_WIN32)
+ MessageBeep(MB_ICONEXCLAMATION);
+ MessageBox(NULL, Tcl_GetStringResult(interp), "Error in Tclkit",
+ MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
+ ExitProcess(1);
+ /* we won't reach this, but we need the return */
+#endif
+ return TCL_ERROR;
+}
+
+#ifdef WIN32
+__declspec(dllexport) char *
+#else
+extern char *
+#endif
+TclKit_SetKitPath(CONST char *kitPath)
+{
+ /*
+ * Allow someone to define an alternate path to the base kit
+ * than 'info nameofexecutable'.
+ */
+ if (kitPath) {
+ int len = strlen(kitPath);
+ if (tclKitPath) {
+ ckfree(tclKitPath);
+ }
+ tclKitPath = (char *) ckalloc(len + 1);
+ memcpy(tclKitPath, kitPath, len);
+ tclKitPath[len] = '\0';
+ }
+ return tclKitPath;
+}
+
+static void
+TclKit_InitStdChannels(void)
+{
+ Tcl_Channel chan;
+
+ /*
+ * We need to verify if we have the standard channels and create them if
+ * not. Otherwise internals channels may get used as standard channels
+ * (like for encodings) and panic.
+ */
+ chan = Tcl_GetStdChannel(TCL_STDIN);
+ if (chan == NULL) {
+ chan = Tcl_OpenFileChannel(NULL, DEV_NULL, "r", 0);
+ if (chan != NULL) {
+ Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(chan, TCL_STDIN);
+ }
+ chan = Tcl_GetStdChannel(TCL_STDOUT);
+ if (chan == NULL) {
+ chan = Tcl_OpenFileChannel(NULL, DEV_NULL, "w", 0);
+ if (chan != NULL) {
+ Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(chan, TCL_STDOUT);
+ }
+ chan = Tcl_GetStdChannel(TCL_STDERR);
+ if (chan == NULL) {
+ chan = Tcl_OpenFileChannel(NULL, DEV_NULL, "w", 0);
+ if (chan != NULL) {
+ Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
+ }
+ Tcl_SetStdChannel(chan, TCL_STDERR);
+ }
+}
--- /dev/null
+#PLAT = unix
+#PRIV = install-private-headers
+#
+# Linux:
+#LDFLAGS = -L/usr/X11R6/lib -lX11 -ldl -lm # -lpthread
+#
+# Mac OS X:
+#LDFLAGS = -framework CoreFoundation -L/usr/X11R6/lib -lX11 -weak-lXss -lXext
+#LDFLAGS = -framework CoreFoundation -framework Carbon -framework IOKit
+#LDSTRIP = -x
+
+KITSRC = ../../kitInit.c ../../pwb.c ../../rechan.c ../../zlib.c \
+ ../tcl/$(PLAT)/tclAppInit.c
+STATIC = --disable-shared
+OUTDIR = $(shell pwd)/build
+TCLDIR = --with-tcl=../lib --prefix=$(OUTDIR) --exec-prefix=$(OUTDIR)
+STRIP ?= strip
+
+tclkit-cli$(EXE): kit-cli$(EXE) ../../setupvfs.tcl build/files
+ cp kit-cli$(EXE) $@ && $(STRIP) $@
+ ./kit-cli -init- ../../setupvfs.tcl $(KIT_OPTS) $@ cli
+
+tclkit-dyn$(EXE): kit-cli$(EXE) build/tkdyn ../../setupvfs.tcl build/files
+ cp kit-cli$(EXE) $@ && $(STRIP) $@
+ ./kit-cli -init- ../../setupvfs.tcl $(KIT_OPTS) $@ dyn
+
+tclkit-gui$(EXE): kit-cli$(EXE) kit-gui$(EXE) ../../setupvfs.tcl build/files
+ cp kit-gui$(EXE) $@ && $(STRIP) $@
+ ./kit-cli -init- ../../setupvfs.tcl $(KIT_OPTS) $@ gui
+
+kit-cli$(EXE): build/tcl build/tclvfs build/vlerq build/zlib $(KITSRC)
+ $(CC) -o $@ $(CFLAGS) $(KITSRC) -Ibuild/include \
+ -DKIT_LITE -DTCL_LOCAL_APPINIT=TclKit_AppInit -DSTATIC_BUILD \
+ build/lib/vfs1*/*vfs1*.a build/lib/vlerqtcl4*/*vlerqtcl4*.a \
+ build/lib/libz.a build/lib/libtcl8*.a $(LDFLAGS)
+
+kit-gui$(EXE): build/tcl build/tk build/tclvfs build/vlerq build/zlib $(KITSRC)
+ $(CC) -o $@ $(CFLAGS) $(KITSRC) -Ibuild/include \
+ -DKIT_LITE -DTCL_LOCAL_APPINIT=TclKit_AppInit -DSTATIC_BUILD \
+ build/lib/vfs1*/*vfs1*.a build/lib/vlerqtcl4*/*vlerqtcl4*.a \
+ -DKIT_INCLUDES_TK build/lib/libtk8*.a \
+ build/lib/libz.a build/lib/libtcl8*.a $(LDFLAGS) $(GUI_OPTS)
+
+build/files:
+ mkdir -p $@ && cd $@ && ln -s ../../../../files/* .
+
+build/tcl:
+ mkdir -p $@ && cd $@ && CFLAGS="$(CFLAGS)" && export CFLAGS && \
+ sh ../../../tcl/$(PLAT)/configure $(STATIC) $(TCL_OPTS) \
+ --prefix=$(OUTDIR) --exec-prefix=$(OUTDIR) && \
+ $(MAKE) install-binaries install-libraries $(PRIV)
+
+threaded: build/threaddyn
+build/threaddyn: build/tcl
+ mkdir -p $@ && cd $@ && CFLAGS="$(CFLAGS)" && export CFLAGS && \
+ sh ../../../thread/configure $(TCLDIR) $(THREADDYN_OPTS) && \
+ $(MAKE) install-binaries install-libraries
+
+build/tk: build/tcl
+ mkdir -p $@ && cd $@ && CFLAGS="$(CFLAGS)" && export CFLAGS && \
+ sh ../../../tk/$(PLAT)/configure $(STATIC) $(TCLDIR) $(TK_OPTS) && \
+ $(MAKE) install-binaries install-libraries
+
+build/tkdyn: build/tcl
+ mkdir -p $@ && cd $@ && CFLAGS="$(CFLAGS)" && export CFLAGS && \
+ sh ../../../tk/$(PLAT)/configure $(TCLDIR) $(TKDYN_OPTS) && \
+ $(MAKE) binaries && $(STRIP) $(LDSTRIP) libtk8.* && \
+ $(MAKE) install-binaries install-libraries
+
+build/tclvfs: build/tcl
+ mkdir -p $@ && cd $@ && CFLAGS="$(CFLAGS)" && export CFLAGS && \
+ sh ../../../tclvfs/configure $(STATIC) $(TCLDIR) $(VFS_OPTS) && \
+ $(MAKE) install
+
+build/vlerq: build/tcl
+ mkdir -p $@ && cd $@ && CFLAGS="$(CFLAGS)" && export CFLAGS && \
+ sh ../../../vlerq/configure $(STATIC) $(TCLDIR) $(VLERQ_OPTS) && \
+ $(MAKE) install
+
+build/zlib: build/tcl
+ cp -R ../zlib/. $@
+ cd $@ && $(MAKE) install prefix=.. CC="$(CC)" CFLAGS="-O $(CFLAGS)"
+
+base: build/tcl build/tk
+ ls -l build/bin
+
+tidy:
+ rm -rf build/{tcl,tclvfs,thread,tk,tkdyn,vlerq,zlib}
+
+clean:
+ rm -rf build kit-{cli,gui}$(EXE)
+
+distclean: clean
+ rm -f tclkit-{cli,dyn,gui}$(EXE)
+
+.PHONY: all base clean distclean threaded tidy
--- /dev/null
+/* Written by Matt Newman and Jean-Claude Wippler, as part of Tclkit.
+ * March 2003 - placed in the public domain by the authors.
+ *
+ * Expose TclSetLibraryPath to scripts (in 8.4 only, 8.5 has "encoding dirs").
+ */
+
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 85
+
+#include <tcl.h>
+
+/* in tclInt.h: */
+Tcl_Obj* TclGetLibraryPath();
+
+/* Support for encodings, from Vince Darley <vince.darley@eurobios.com> */
+static int
+LibraryPathObjCmd(dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ if (objc == 1) {
+ Tcl_SetObjResult(interp, TclGetLibraryPath());
+ } else {
+ Tcl_Obj *path=Tcl_DuplicateObj(objv[1]);
+ TclSetLibraryPath(Tcl_NewListObj(1,&path));
+ TclpSetInitialEncodings();
+ Tcl_FindExecutable(Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY));
+ }
+ return TCL_OK;
+}
+
+/*
+ * Public Entrypoint
+ */
+
+DLLEXPORT int Pwb_Init(Tcl_Interp *interp)
+{
+ Tcl_CreateObjCommand(interp, "librarypath", LibraryPathObjCmd, 0, 0);
+ return Tcl_PkgProvide( interp, "pwb", "1.1");
+}
+
+#endif
--- /dev/null
+/* Written by Matt Newman and Jean-Claude Wippler, as part of Tclkit.
+ * March 2003 - placed in the public domain by the authors.
+ *
+ * Reflecting channel interface
+ */
+
+#include <tcl.h>
+
+#ifndef TCL_DECLARE_MUTEX
+#define TCL_DECLARE_MUTEX(v)
+#define Tcl_MutexLock(v)
+#define Tcl_MutexUnlock(v)
+#endif
+
+ static int mkChanSeq = 0;
+ TCL_DECLARE_MUTEX(rechanMutex)
+
+/* Uncomment for Linux or other non-Solaris OS's for memcpy declaration */
+#include <memory.h>
+
+/* Uncomment for Solaris (and comment above) for memcpy declaration */
+/* #include <string.h> */
+
+#ifndef EINVAL
+#define EINVAL 9
+#endif
+
+typedef struct
+{
+ Tcl_Channel _chan;
+ int _validMask;
+ int _watchMask;
+ Tcl_Interp* _interp;
+ Tcl_Obj* _context;
+ Tcl_Obj* _seek;
+ Tcl_Obj* _read;
+ Tcl_Obj* _write;
+ Tcl_Obj* _name;
+ Tcl_TimerToken _timer;
+} ReflectingChannel;
+
+static ReflectingChannel*
+rcCreate (Tcl_Interp* ip_, Tcl_Obj* context_, int mode_, const char* name_)
+{
+ ReflectingChannel* cp = (ReflectingChannel*) Tcl_Alloc (sizeof *cp);
+
+ cp->_validMask = mode_;
+ cp->_watchMask = 0;
+ cp->_chan = 0;
+ cp->_context = context_;
+ cp->_interp = ip_;
+ cp->_name = Tcl_NewStringObj(name_, -1);
+ cp->_timer = NULL;
+
+ /* support Tcl_GetIndexFromObj by keeping these objectified */
+ cp->_seek = Tcl_NewStringObj("seek", -1);
+ cp->_read = Tcl_NewStringObj("read", -1);
+ cp->_write = Tcl_NewStringObj("write", -1);
+
+ Tcl_IncrRefCount(cp->_context);
+ Tcl_IncrRefCount(cp->_seek);
+ Tcl_IncrRefCount(cp->_read);
+ Tcl_IncrRefCount(cp->_write);
+ Tcl_IncrRefCount(cp->_name);
+
+ return cp;
+}
+
+static Tcl_Obj*
+rcBuildCmdList(ReflectingChannel* chan_, Tcl_Obj* cmd_)
+{
+ Tcl_Obj* vec = Tcl_DuplicateObj(chan_->_context);
+ Tcl_IncrRefCount(vec);
+
+ Tcl_ListObjAppendElement(chan_->_interp, vec, cmd_);
+ Tcl_ListObjAppendElement(chan_->_interp, vec, chan_->_name);
+
+ return vec; /* with refcount 1 */
+}
+
+static int
+rcClose (ClientData cd_, Tcl_Interp* interp)
+{
+ ReflectingChannel* chan = (ReflectingChannel*) cd_;
+ int n = -1;
+
+ Tcl_SavedResult sr;
+ Tcl_Obj* cmd = rcBuildCmdList(chan, Tcl_NewStringObj("close", -1));
+ Tcl_Interp* ip = chan->_interp;
+
+ Tcl_SaveResult(ip, &sr);
+
+ if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK)
+ Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n);
+
+ Tcl_RestoreResult(ip, &sr);
+ Tcl_DecrRefCount(cmd);
+
+ if (chan->_timer != NULL) {
+ Tcl_DeleteTimerHandler(chan->_timer);
+ chan->_timer = NULL;
+ }
+
+ Tcl_DecrRefCount(chan->_context);
+ Tcl_DecrRefCount(chan->_seek);
+ Tcl_DecrRefCount(chan->_read);
+ Tcl_DecrRefCount(chan->_write);
+ Tcl_DecrRefCount(chan->_name);
+ Tcl_Free((char*) chan);
+
+ return TCL_OK;
+}
+
+static int
+rcInput (ClientData cd_, char* buf, int toRead, int* errorCodePtr)
+{
+ ReflectingChannel* chan = (ReflectingChannel*) cd_;
+ int n = -1;
+
+ if (chan->_validMask & TCL_READABLE) {
+ Tcl_SavedResult sr;
+ Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_read);
+ Tcl_Interp* ip = chan->_interp;
+
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(toRead));
+ Tcl_SaveResult(ip, &sr);
+
+ if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) {
+ void* s = Tcl_GetByteArrayFromObj(Tcl_GetObjResult(ip), &n);
+ if (0 <= n && n <= toRead)
+ if (n > 0)
+ memcpy(buf, s, n);
+ else
+ chan->_watchMask &= ~TCL_READABLE;
+ else
+ n = -1;
+ }
+
+ Tcl_RestoreResult(ip, &sr);
+ Tcl_DecrRefCount(cmd);
+ }
+
+ if (n < 0)
+ *errorCodePtr = EINVAL;
+ return n;
+}
+
+static int
+rcOutput (ClientData cd_, const char* buf, int toWrite, int* errorCodePtr)
+{
+ ReflectingChannel* chan = (ReflectingChannel*) cd_;
+ int n = -1;
+
+ if (chan->_validMask & TCL_WRITABLE) {
+ Tcl_SavedResult sr;
+ Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_write);
+ Tcl_Interp* ip = chan->_interp;
+
+ Tcl_ListObjAppendElement(NULL, cmd,
+ Tcl_NewByteArrayObj((unsigned char*) buf, toWrite));
+ Tcl_SaveResult(ip, &sr);
+
+ if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK &&
+ Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK)
+ if (0 <= n && n <= toWrite)
+ chan->_watchMask = chan->_validMask;
+ else
+ n = -1;
+
+ Tcl_RestoreResult(ip, &sr);
+ Tcl_DecrRefCount(cmd);
+ }
+
+ if (n < 0)
+ *errorCodePtr = EINVAL;
+ return n;
+}
+
+static int
+rcSeek (ClientData cd_, long offset, int seekMode, int* errorCodePtr)
+{
+ ReflectingChannel* chan = (ReflectingChannel*) cd_;
+ int n = -1;
+
+ Tcl_SavedResult sr;
+ Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_seek);
+ Tcl_Interp* ip = chan->_interp;
+
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewLongObj(offset));
+ Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(seekMode));
+ Tcl_SaveResult(ip, &sr);
+
+ if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK &&
+ Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK)
+ chan->_watchMask = chan->_validMask;
+
+ Tcl_RestoreResult(ip, &sr);
+ Tcl_DecrRefCount(cmd);
+
+ if (n < 0)
+ *errorCodePtr = EINVAL;
+ return n;
+}
+
+static void
+rcTimerProc (ClientData cd_)
+{
+ ReflectingChannel* chan = (ReflectingChannel*) cd_;
+
+ if (chan->_timer != NULL)
+ Tcl_DeleteTimerHandler(chan->_timer);
+ chan->_timer = NULL;
+ Tcl_NotifyChannel(chan->_chan, chan->_watchMask);
+}
+
+static void
+rcWatchChannel (ClientData cd_, int mask)
+{
+ ReflectingChannel* chan = (ReflectingChannel*) cd_;
+
+ /* Dec 2001: adopting logic used in Andreas Kupries' memchan, i.e. timers */
+
+ if (mask) {
+ chan->_watchMask = mask & chan->_validMask;
+ if (chan->_watchMask && chan->_timer == NULL)
+ chan->_timer = Tcl_CreateTimerHandler(5, rcTimerProc, cd_);
+ } else if (chan->_timer != NULL) {
+ Tcl_DeleteTimerHandler(chan->_timer);
+ chan->_timer = NULL;
+ }
+}
+
+static int
+rcGetFile (ClientData cd_, int direction, ClientData* handlePtr)
+{
+ return TCL_ERROR;
+}
+
+static int
+rcBlock (ClientData cd_, int mode)
+{
+ return 0;
+}
+
+static Tcl_ChannelType reChannelType = {
+ "rechan", /* Type name. */
+ 0/*rcBlock*/, /* Set blocking/nonblocking behaviour. NULL'able */
+ rcClose, /* Close channel, clean instance data */
+ rcInput, /* Handle read request */
+ rcOutput, /* Handle write request */
+ rcSeek, /* Move location of access point. NULL'able */
+ 0, /* Set options. NULL'able */
+ 0, /* Get options. NULL'able */
+ rcWatchChannel, /* Initialize notifier */
+ rcGetFile /* Get OS handle from the channel. */
+};
+
+static int
+cmd_rechan(ClientData cd_, Tcl_Interp* ip_, int objc_, Tcl_Obj*const* objv_)
+{
+ ReflectingChannel *rc;
+ int mode;
+ char buffer [20];
+
+ if (objc_ != 3) {
+ Tcl_WrongNumArgs(ip_, 1, objv_, "command mode");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_ListObjLength(ip_, objv_[1], &mode) == TCL_ERROR ||
+ Tcl_GetIntFromObj(ip_, objv_[2], &mode) == TCL_ERROR)
+ return TCL_ERROR;
+
+ Tcl_MutexLock(&rechanMutex);
+ sprintf(buffer, "rechan%d", ++mkChanSeq);
+ Tcl_MutexUnlock(&rechanMutex);
+
+ rc = rcCreate (ip_, objv_[1], mode, buffer);
+ rc->_chan = Tcl_CreateChannel(&reChannelType, buffer, (ClientData) rc, mode);
+
+ Tcl_RegisterChannel(ip_, rc->_chan);
+ Tcl_SetChannelOption(ip_, rc->_chan, "-buffering", "none");
+ Tcl_SetChannelOption(ip_, rc->_chan, "-blocking", "0");
+
+ Tcl_SetResult(ip_, buffer, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+DLLEXPORT int Rechan_Init(Tcl_Interp* interp)
+{
+ if (!Tcl_InitStubs(interp, "8.4", 0))
+ return TCL_ERROR;
+ Tcl_CreateObjCommand(interp, "rechan", cmd_rechan, 0, 0);
+ return Tcl_PkgProvide(interp, "rechan", "1.0");
+}
--- /dev/null
+# setupvfs.tcl -- new tclkit-{cli,dyn,gui} generation bootstrap
+#
+# jcw, 2006-11-16
+
+proc history {args} {} ;# since this runs so early, all debugging support helps
+
+if {[lindex $argv 0] ne "-init-"} {
+ puts stderr "setupvfs.tcl has to be run by kit-cli with the '-init-' flag"
+ exit 1
+}
+
+set argv [lrange $argv 2 end] ;# strip off the leading "-init- setupvfs.tcl"
+
+set debugOpt 0
+set encOpt 0
+set msgsOpt 0
+set threadOpt 0
+set tzOpt 0
+
+while {1} {
+ switch -- [lindex $argv 0] {
+ -d { incr debugOpt }
+ -e { incr encOpt }
+ -m { incr msgsOpt }
+ -t { incr threadOpt }
+ -z { incr tzOpt }
+ default { break }
+ }
+ set argv [lrange $argv 1 end]
+}
+
+if {[llength $argv] != 2} {
+ puts stderr "Usage: [file tail [info nameofexe]] -init- [info script]\
+ ?-d? ?-e? ?-m? ?-t? ?-z? destfile (cli|dyn|gui)
+ -d output some debugging info from this setup script
+ -e include all encodings i.s.o. 7 basic ones (encodings/)
+ -m include all localized message files (tcl 8.5, msgs/)
+ -t include the thread extension as shared lib in vfs
+ -z include timezone data files (tcl 8.5, tzdata/)"
+ exit 1
+}
+
+load {} vfs ;# vlerq is already loaded by now
+
+# map of proper version numbers to replace @ markers in paths given to vfscopy
+# this relies on having all necessary extensions already loaded at this point
+set versmap [list tcl8@ tcl$tcl_version tk8@ tk$tcl_version \
+ vfs1@ vfs[package require vfs] \
+ vlerqtcl4@ vlerqtcl[package require vlerq]]
+
+if {$debugOpt} {
+ puts "Starting [info script]"
+ puts " exe: [info nameofexe]"
+ puts " argv: $argv"
+ puts " tcltk: $tcl_version"
+ puts " loaded: [info loaded]"
+ puts " versmap: $versmap"
+ puts ""
+}
+
+set tcl_library ../tcl/library
+source ../tcl/library/init.tcl ;# for tcl::CopyDirectory
+source ../tclvfs/library/vfsUtils.tcl
+source ../tclvfs/library/vfslib.tcl ;# overrides vfs::memchan in vfsUtils.tcl
+source ../vlerq/library/m2mvfs.tcl
+
+set clifiles {
+ boot.tcl
+ config.tcl
+ lib/tcl8@/auto.tcl
+ lib/tcl8@/history.tcl
+ lib/tcl8@/init.tcl
+ lib/tcl8@/opt0.4
+ lib/tcl8@/package.tcl
+ lib/tcl8@/parray.tcl
+ lib/tcl8@/safe.tcl
+ lib/tcl8@/tclIndex
+ lib/tcl8@/word.tcl
+ lib/vfs1@/mk4vfs.tcl
+ lib/vfs1@/pkgIndex.tcl
+ lib/vfs1@/starkit.tcl
+ lib/vfs1@/vfslib.tcl
+ lib/vfs1@/vfsUtils.tcl
+ lib/vfs1@/zipvfs.tcl
+ lib/vlerqtcl4@/m2mvfs.tcl
+ lib/vlerqtcl4@/mkclvfs.tcl
+ lib/vlerqtcl4@/mklite.tcl
+ lib/vlerqtcl4@/pkgIndex.tcl
+ lib/vlerqtcl4@/ratcl.tcl
+}
+
+set guifiles {
+ tclkit.ico
+ lib/tk8@/bgerror.tcl
+ lib/tk8@/button.tcl
+ lib/tk8@/choosedir.tcl
+ lib/tk8@/clrpick.tcl
+ lib/tk8@/comdlg.tcl
+ lib/tk8@/console.tcl
+ lib/tk8@/dialog.tcl
+ lib/tk8@/entry.tcl
+ lib/tk8@/focus.tcl
+ lib/tk8@/listbox.tcl
+ lib/tk8@/menu.tcl
+ lib/tk8@/mkpsenc.tcl
+ lib/tk8@/msgbox.tcl
+ lib/tk8@/msgs
+ lib/tk8@/obsolete.tcl
+ lib/tk8@/optMenu.tcl
+ lib/tk8@/palette.tcl
+ lib/tk8@/panedwindow.tcl
+ lib/tk8@/pkgIndex.tcl
+ lib/tk8@/prolog.ps
+ lib/tk8@/safetk.tcl
+ lib/tk8@/scale.tcl
+ lib/tk8@/scrlbar.tcl
+ lib/tk8@/spinbox.tcl
+ lib/tk8@/tclIndex
+ lib/tk8@/tearoff.tcl
+ lib/tk8@/text.tcl
+ lib/tk8@/tk.tcl
+ lib/tk8@/tkfbox.tcl
+ lib/tk8@/unsupported.tcl
+ lib/tk8@/xmfbox.tcl
+}
+
+if {$encOpt} {
+ lappend clifiles lib/tcl8@/encoding
+} else {
+ lappend clifiles lib/tcl8@/encoding/ascii.enc \
+ lib/tcl8@/encoding/cp1252.enc \
+ lib/tcl8@/encoding/iso8859-1.enc \
+ lib/tcl8@/encoding/iso8859-15.enc \
+ lib/tcl8@/encoding/iso8859-2.enc \
+ lib/tcl8@/encoding/koi8-r.enc \
+ lib/tcl8@/encoding/macRoman.enc
+}
+
+if {$threadOpt} {
+ lappend clifiles lib/[glob -tails -dir build/lib thread2*]
+}
+
+if {$tcl_version eq "8.4"} {
+ lappend clifiles lib/tcl8@/http2.5 \
+ lib/tcl8@/ldAout.tcl \
+ lib/tcl8@/msgcat1.3 \
+ lib/tcl8@/tcltest2.2
+} else {
+ lappend clifiles lib/tcl8 \
+ lib/tcl8@/clock.tcl \
+ lib/tcl8@/tm.tcl
+
+ lappend guifiles lib/tk8@/ttk
+
+ if {$msgsOpt} {
+ lappend clifiles lib/tcl8@/msgs
+ }
+ if {$tzOpt} {
+ lappend clifiles lib/tcl8@/tzdata
+ }
+}
+
+# look for a/b/c in three places:
+# 1) build/files/b-c
+# 2) build/files/a/b/c
+# 3) build/a/b/c
+
+proc locatefile {f} {
+ set a [file split $f]
+ set n "build/files/[lindex $a end-1]-[lindex $a end]"
+ if {[file exists $n]} {
+ if {$::debugOpt} {
+ puts " $n ==> \$vfs/$f"
+ }
+ } else {
+ set n build/files/$f
+ if {[file exists $n]} {
+ if {$::debugOpt} {
+ puts " $n ==> \$vfs/$f"
+ }
+ } else {
+ set n build/$f
+ }
+ }
+ return $n
+}
+
+# copy file to m2m-mounted vfs
+proc vfscopy {argv} {
+ global vfs versmap
+
+ foreach f $argv {
+ set f [string map $versmap $f]
+
+ set d $vfs/[file dirname $f]
+ if {![file isdir $d]} {
+ file mkdir $d
+ }
+
+ set n [locatefile $f]
+ file copy $n $vfs/$f
+ }
+}
+
+switch [info sharedlibext] {
+ .dll {
+ catch {
+ # avoid hard-wiring a Thread extension version number in here
+ set dll [glob build/bin/thread2*.dll]
+ load $dll
+ set vsn [package require Thread]
+ file copy -force $dll build/lib/libthread$vsn.dll
+ unset dll vsn
+ }
+ catch {
+ file delete [glob build/lib/libtk8?.a] ;# so only libtk8?s.a will be found
+ }
+ catch {
+ file copy -force [glob build/bin/tk8*.dll] build/lib/libtk$tcl_version.dll
+ }
+ }
+ .so {
+ catch {
+ # for some *BSD's, lib names have no dot and/or end with a version number
+ file rename [glob build/lib/libtk8*.so*] build/lib/libtk$tcl_version.so
+ }
+ }
+}
+
+set vfs [lindex $argv 0]
+vfs::m2m::Mount $vfs $vfs
+
+switch [lindex $argv 1] {
+ cli {
+ vfscopy $clifiles
+ }
+ gui {
+ vfscopy $clifiles
+ vfscopy $guifiles
+ }
+ dyn {
+ vfscopy $clifiles
+ vfscopy $guifiles
+ vfscopy lib/libtk$tcl_version[info sharedlibext]
+ }
+ default {
+ puts stderr "Unknown type, must be one of: cli, dyn, gui"
+ exit 1
+ }
+}
+
+vfs::unmount $vfs
+
+if {$debugOpt} {
+ puts "\nDone with [info script]"
+}
--- /dev/null
+/* Written by Jean-Claude Wippler, as part of Tclkit.
+ * March 2003 - placed in the public domain by the author.
+ *
+ * Interface to the "zlib" compression library
+ */
+
+#include "zlib.h"
+#include <tcl.h>
+
+typedef struct {
+ z_stream stream;
+ Tcl_Obj *indata;
+} zlibstream;
+
+static int
+zstreamincmd(ClientData cd, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[])
+{
+ zlibstream *zp = (zlibstream*) cd;
+ int count = 0;
+ int e, index;
+ Tcl_Obj *obj;
+
+ static CONST84 char* cmds[] = { "fill", "drain", NULL, };
+
+ if (Tcl_GetIndexFromObj(ip, objv[1], cmds, "option", 0, &index) != TCL_OK)
+ return TCL_ERROR;
+
+ switch (index) {
+
+ case 0: /* fill ?data? */
+ if (objc >= 3) {
+ Tcl_IncrRefCount(objv[2]);
+ Tcl_DecrRefCount(zp->indata);
+ zp->indata = objv[2];
+ zp->stream.next_in = Tcl_GetByteArrayFromObj(zp->indata,
+ (int*) &zp->stream.avail_in);
+ }
+ Tcl_SetObjResult(ip, Tcl_NewIntObj(zp->stream.avail_in));
+ break;
+
+ case 1: /* drain count */
+ if (objc != 3) {
+ Tcl_WrongNumArgs(ip, 2, objv, "count");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(ip, objv[2], &count) != TCL_OK)
+ return TCL_ERROR;
+ obj = Tcl_GetObjResult(ip);
+ Tcl_SetByteArrayLength(obj, count);
+ zp->stream.next_out = Tcl_GetByteArrayFromObj(obj,
+ (int*) &zp->stream.avail_out);
+ e = inflate(&zp->stream, Z_NO_FLUSH);
+ if (e != 0 && e != Z_STREAM_END) {
+ Tcl_SetResult(ip, (char*) zError(e), TCL_STATIC);
+ return TCL_ERROR;
+ }
+ Tcl_SetByteArrayLength(obj, count - zp->stream.avail_out);
+ break;
+ }
+ return TCL_OK;
+}
+
+void zstreamdelproc(ClientData cd)
+{
+ zlibstream *zp = (zlibstream*) cd;
+ inflateEnd(&zp->stream);
+ Tcl_DecrRefCount(zp->indata);
+ Tcl_Free((void*) zp);
+}
+
+static int
+ZlibCmd(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[])
+{
+ int e = TCL_OK, index, dlen, wbits = -MAX_WBITS;
+ long flag;
+ Byte *data;
+ z_stream stream;
+ Tcl_Obj *obj = Tcl_GetObjResult(ip);
+
+ static CONST84 char* cmds[] = {
+ "adler32", "crc32", "compress", "deflate", "decompress", "inflate",
+ "sdecompress", "sinflate", NULL,
+ };
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(ip, 1, objv, "option data ?...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(ip, objv[1], cmds, "option", 0, &index) != TCL_OK ||
+ objc > 3 && Tcl_GetLongFromObj(ip, objv[3], &flag) != TCL_OK)
+ return TCL_ERROR;
+
+ data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
+
+ switch (index) {
+
+ case 0: /* adler32 str ?start? -> checksum */
+ if (objc < 4)
+ flag = (long) adler32(0, 0, 0);
+ Tcl_SetLongObj(obj, (long) adler32((uLong) flag, data, dlen));
+ return TCL_OK;
+
+ case 1: /* crc32 str ?start? -> checksum */
+ if (objc < 4)
+ flag = (long) crc32(0, 0, 0);
+ Tcl_SetLongObj(obj, (long) crc32((uLong) flag, data, dlen));
+ return TCL_OK;
+
+ case 2: /* compress data ?level? -> data */
+ wbits = MAX_WBITS;
+ case 3: /* deflate data ?level? -> data */
+ if (objc < 4)
+ flag = Z_DEFAULT_COMPRESSION;
+
+ stream.avail_in = (uInt) dlen;
+ stream.next_in = data;
+
+ stream.avail_out = (uInt) dlen + dlen / 1000 + 12;
+ Tcl_SetByteArrayLength(obj, stream.avail_out);
+ stream.next_out = Tcl_GetByteArrayFromObj(obj, NULL);
+
+ stream.zalloc = 0;
+ stream.zfree = 0;
+ stream.opaque = 0;
+
+ e = deflateInit2(&stream, (int) flag, Z_DEFLATED, wbits,
+ MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
+ if (e != Z_OK)
+ break;
+
+ e = deflate(&stream, Z_FINISH);
+ if (e != Z_STREAM_END) {
+ deflateEnd(&stream);
+ if (e == Z_OK) e = Z_BUF_ERROR;
+ } else
+ e = deflateEnd(&stream);
+ break;
+
+ case 4: /* decompress data ?bufsize? -> data */
+ wbits = MAX_WBITS;
+ case 5: /* inflate data ?bufsize? -> data */
+ {
+ if (objc < 4)
+ flag = 16 * 1024;
+
+ for (;;) {
+ stream.zalloc = 0;
+ stream.zfree = 0;
+
+ /* +1 because ZLIB can "over-request" input (but ignore it) */
+ stream.avail_in = (uInt) dlen + 1;
+ stream.next_in = data;
+
+ stream.avail_out = (uInt) flag;
+ Tcl_SetByteArrayLength(obj, stream.avail_out);
+ stream.next_out = Tcl_GetByteArrayFromObj(obj, NULL);
+
+ /* Negative value suppresses ZLIB header */
+ e = inflateInit2(&stream, wbits);
+ if (e == Z_OK) {
+ e = inflate(&stream, Z_FINISH);
+ if (e != Z_STREAM_END) {
+ inflateEnd(&stream);
+ if (e == Z_OK) e = Z_BUF_ERROR;
+ } else
+ e = inflateEnd(&stream);
+ }
+
+ if (e == Z_OK || e != Z_BUF_ERROR) break;
+
+ Tcl_SetByteArrayLength(obj, 0);
+ flag *= 2;
+ }
+
+ break;
+ }
+
+ case 6: /* sdecompress cmdname -> */
+ wbits = MAX_WBITS;
+ case 7: /* sinflate cmdname -> */
+ {
+ zlibstream *zp = (zlibstream*) Tcl_Alloc(sizeof (zlibstream));
+ zp->indata = Tcl_NewObj();
+ Tcl_IncrRefCount(zp->indata);
+ zp->stream.zalloc = 0;
+ zp->stream.zfree = 0;
+ zp->stream.opaque = 0;
+ zp->stream.next_in = 0;
+ zp->stream.avail_in = 0;
+ inflateInit2(&zp->stream, wbits);
+ Tcl_CreateObjCommand(ip, Tcl_GetStringFromObj(objv[2], 0), zstreamincmd,
+ (ClientData) zp, zstreamdelproc);
+ return TCL_OK;
+ }
+ }
+
+ if (e != Z_OK) {
+ Tcl_SetResult(ip, (char*) zError(e), TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetByteArrayLength(obj, stream.total_out);
+ return TCL_OK;
+}
+
+int Zlib_Init(Tcl_Interp *interp)
+{
+ Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
+ return Tcl_PkgProvide( interp, "zlib", "1.1");
+}
projects / kitgen / commitdiff