From: Jean-Claude Wippler Date: Wed, 28 Mar 2007 08:12:09 +0000 (+0000) Subject: Oops, move contents to trunk. X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=b81972b1173b17ea49fd259bcda8630b25c29a92;p=kitgen Oops, move contents to trunk. git-svn-id: svn://svn.equi4.com/kitgen/trunk@1319 9e558909-932a-0410-a563-af77432da1eb --- b81972b1173b17ea49fd259bcda8630b25c29a92 diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..e400e8d --- /dev/null +++ b/Makefile @@ -0,0 +1,57 @@ +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' \ + ~/Sites/www.equi4.com/kitgen.html + markdown-tm 'Swisskit - a big single-file Tcl/Tk for Mac OS X' \ + ~/Sites/www.equi4.com/swisskit.html + +.PHONY: all base tidy clean distclean cvs small large docs diff --git a/README b/README new file mode 100644 index 0000000..65a6671 --- /dev/null +++ b/README @@ -0,0 +1,328 @@ +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 + (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 + 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. diff --git a/README.swisskit b/README.swisskit new file mode 100644 index 0000000..f1ec489 --- /dev/null +++ b/README.swisskit @@ -0,0 +1,35 @@ +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 diff --git a/config.sh b/config.sh new file mode 100755 index 0000000..8604b29 --- /dev/null +++ b/config.sh @@ -0,0 +1,193 @@ +#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 diff --git a/files/boot.tcl b/files/boot.tcl new file mode 100644 index 0000000..ccd484e --- /dev/null +++ b/files/boot.tcl @@ -0,0 +1,115 @@ +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 +} diff --git a/files/config.tcl b/files/config.tcl new file mode 100644 index 0000000..1069b03 --- /dev/null +++ b/files/config.tcl @@ -0,0 +1 @@ +set ::vfs::tclkit_version 200611.001 diff --git a/files/tclkit.ico b/files/tclkit.ico new file mode 100644 index 0000000..d7850ff Binary files /dev/null and b/files/tclkit.ico differ diff --git a/files/tk8.4-pkgIndex.tcl b/files/tk8.4-pkgIndex.tcl new file mode 100644 index 0000000..4be192a --- /dev/null +++ b/files/tk8.4-pkgIndex.tcl @@ -0,0 +1,8 @@ +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 + } + }] diff --git a/files/tk8.5-pkgIndex.tcl b/files/tk8.5-pkgIndex.tcl new file mode 100644 index 0000000..85b51da --- /dev/null +++ b/files/tk8.5-pkgIndex.tcl @@ -0,0 +1,8 @@ +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 + } + }] diff --git a/files/vfs1.3-pkgIndex.tcl b/files/vfs1.3-pkgIndex.tcl new file mode 100644 index 0000000..928659a --- /dev/null +++ b/files/vfs1.3-pkgIndex.tcl @@ -0,0 +1,25 @@ +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]] diff --git a/files/vlerqtcl4.0-pkgIndex.tcl b/files/vlerqtcl4.0-pkgIndex.tcl new file mode 100644 index 0000000..4f57ce9 --- /dev/null +++ b/files/vlerqtcl4.0-pkgIndex.tcl @@ -0,0 +1,5 @@ +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]] diff --git a/files/vlerqtcl4.1-pkgIndex.tcl b/files/vlerqtcl4.1-pkgIndex.tcl new file mode 100644 index 0000000..28d384b --- /dev/null +++ b/files/vlerqtcl4.1-pkgIndex.tcl @@ -0,0 +1,5 @@ +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]] diff --git a/genswiss.tcl b/genswiss.tcl new file mode 100755 index 0000000..ab3b2ec --- /dev/null +++ b/genswiss.tcl @@ -0,0 +1,43 @@ +#!/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 diff --git a/kitInit.c b/kitInit.c new file mode 100644 index 0000000..931bce7 --- /dev/null +++ b/kitInit.c @@ -0,0 +1,315 @@ +/* + * 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 + * 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 +#else +#include +#endif + +#include + +#ifdef _WIN32 +#define WIN32_LEAN_AND_MEAN +#include +#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); + } +} diff --git a/makefile.include b/makefile.include new file mode 100644 index 0000000..4e5f451 --- /dev/null +++ b/makefile.include @@ -0,0 +1,96 @@ +#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 diff --git a/pwb.c b/pwb.c new file mode 100644 index 0000000..d6b859f --- /dev/null +++ b/pwb.c @@ -0,0 +1,43 @@ +/* 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 + +/* in tclInt.h: */ +Tcl_Obj* TclGetLibraryPath(); + +/* Support for encodings, from Vince Darley */ +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 diff --git a/rechan.c b/rechan.c new file mode 100644 index 0000000..658e301 --- /dev/null +++ b/rechan.c @@ -0,0 +1,295 @@ +/* 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 + +#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 + +/* Uncomment for Solaris (and comment above) for memcpy declaration */ +/* #include */ + +#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"); +} diff --git a/setupvfs.tcl b/setupvfs.tcl new file mode 100644 index 0000000..70d8f5d --- /dev/null +++ b/setupvfs.tcl @@ -0,0 +1,256 @@ +# 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]" +} diff --git a/zlib.c b/zlib.c new file mode 100644 index 0000000..afbadbb --- /dev/null +++ b/zlib.c @@ -0,0 +1,211 @@ +/* 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 + +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"); +}