Update TEA

generic/*.c: Eliminate some unnecessary type-casts
Rename "trunk" to "main", add "trunk" tag, as done with other Tcl-related fossil repositories.

.cvsignore

@@ -1,3 +0,0 @@
-Makefile
-config.log
-confdefs.h

.fossil-settings/binary-glob

@@ -0,0 +1,12 @@
+*.a
+*.bmp
+*.dll
+*.exe
+*.gif
+*.gz
+*.jpg
+*.lib
+*.pdf
+*.png
+*.xlsx
+*.zip

.fossil-settings/crlf-glob

@@ -0,0 +1,18 @@
+compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
+compat/zlib/contrib/vstudio/readme.txt
+compat/zlib/contrib/vstudio/*/zlib.rc
+compat/zlib/contrib/vstudio/*/*.sln
+compat/zlib/win32/*.txt
+compat/zlib/win64/*.txt
+libtommath/*.dsp
+libtommath/*.sln
+libtommath/*.vcproj
+tools/tcl.wse.in
+win/buildall.vc.bat
+win/coffbase.txt
+win/makefile.vc
+win/rules.vc
+win/rules-ext.vc
+win/targets.vc
+win/tcl.dsp
+win/tcl.dsw

.fossil-settings/encoding-glob

@@ -0,0 +1,7 @@
+tools/tcl.wse.in
+win/buildall.vc.bat
+win/coffbase.txt
+win/makefile.vc
+win/rules.vc
+win/tcl.dsp
+win/tcl.dsw

.fossil-settings/ignore-glob

@@ -0,0 +1,29 @@
+*.a
+*.dll
+*.dylib
+*.dylib.E
+*.exe
+*.exp
+*.la
+*.lib
+*.lo
+*.o
+*.obj
+*.pdb
+*.res
+*.sl
+*.so
+Makefile
+autom4te.cache
+config.cache
+config.log
+config.status
+itkConfig.sh
+pkgIndex.tcl
+versions.vc
+version.vc
+libitk.vfs
+libitk_*.zip
+html
+win/nmakehlp.out
+win/nmhlp-out.txt

.fossil-settings/manifest

@@ -0,0 +1 @@
+u

.gitattributes

@@ -0,0 +1,40 @@
+# Set the default behavior, in case people don't have core.autocrlf set.
+* eol=lf
+* text=auto
+
+# Explicitly declare text files you want to always be normalized and converted
+# to native line endings on checkout.
+*.3 text
+*.c text
+*.css text
+*.enc text
+*.h text
+*.htm text
+*.html text
+*.java text
+*.js text
+*.json text
+*.n text
+*.svg text
+*.ts text
+*.tcl text
+*.test text
+
+# Declare files that will always have CRLF line endings on checkout.
+*.bat eol=crlf
+*.sln eol=crlf
+*.vc eol=crlf
+
+# Denote all files that are truly binary and should not be modified.
+*.a binary
+*.bmp binary
+*.dll binary
+*.exe binary
+*.gif binary
+*.gz binary
+*.jpg binary
+*.lib binary
+*.pdf binary
+*.png binary
+*.xlsx binary
+*.zip binary

.gitignore

@@ -0,0 +1,33 @@
+*.a
+*.bundle
+*.dll
+*.dylib
+*.dylib.E
+*.exe
+*.exp
+*.lib
+*.o
+*.obj
+*.pdb
+*.res
+*.sl
+*.so
+.fslckout
+Makefile
+autom4te.cache
+config.cache
+config.log
+config.status
+config.status.lineno
+html
+manifest.uuid
+_FOSSIL_
+itkConfig.sh
+pkgIndex.tcl
+versions.vc
+version.vc
+libitk.vfs
+libitk_*.zip
+html
+win/nmakehlp.out
+win/nmhlp-out.txt

ChangeLog

@@ -0,0 +1,27 @@
+NOTICE: This ChangeLog is no longer being maintained. To examine
+the series of changes checked into Itk sources, follow the Timeline
+
+https://core.tcl.tk/itk/timeline
+
+2014-09-07 Arnulf P. Wiedemann <wiede@users.sf.net>
+	* generic/itkArchetype.c: Fix for SF bug #253.
+
+2013-02-03 Arnulf P. Wiedemann <wiede@users.sf.net>
+	* bumped version to 4.0.0 for release
+	* added tools directory
+	* Makefile.in: added genstubs tag for generating stubs entries
+	* generic/itkArchBase.c: fixed some param types to fit to itcl changes
+
+2011-04-29 Arnulf P. Wiedemann <wiede@users.sf.net>
+	* configure, configure.in, generic/itk.h: Bump version to 4.0b6
+
+2010-08-17  Jeff Hobbs  <jeffh@ActiveState.com>
+
+	* configure, configure.in, generic/itk.h: Bump version to 4.0b5
+	* tclconfig/tcl.m4: full update to TEA 3.9
+
+2007-09-08 Arnulf P. Wiedemann <wiede@users.sf.net>
+	* all new modules installed and added
+This is the ChangeLog file for itcl-ng/itk
+it is here as Itk and itcl-ng/itk will be different modules in the future
+

Makefile.in

@@ -7,12 +7,23 @@
 #	replaced in the actual Makefile.
 #
 # Copyright (c) 1999 Scriptics Corporation.
-# Copyright (c) 2002-2004 ActiveState Corporation.
+# Copyright (c) 2002-2005 ActiveState Corporation.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: Makefile.in,v 1.30 2007/07/03 20:47:56 hobbs Exp $
+
+#========================================================================
+# Add additional lines to handle any additional AC_SUBST cases that
+# have been added in a customized configure script.
+#========================================================================
+
+#SAMPLE_NEW_VAR	= @SAMPLE_NEW_VAR@
+
+#========================================================================
+# Nothing of the variables below this line should need to be changed.
+# Please check the TARGETS section below to make sure the make targets
+# are correct.
+#========================================================================
 
 #========================================================================
 # The names of the source files is defined in the configure script.
@@ -44,40 +55,16 @@ PKG_TCL_SOURCES = @PKG_TCL_SOURCES@
 PKG_HEADERS	= @PKG_HEADERS@
 
 #========================================================================
-# Nothing of the variables below this line should need to be changed.
-# Please check the TARGETS section below to make sure the make targets
-# are correct.
-#========================================================================
-
-itk_LIB_FILE	= @itk_LIB_FILE@
-itkstub_LIB_FILE = @itkstub_LIB_FILE@
-itclstub_LIB_FILE = @itclstub_LIB_FILE@
-
-#========================================================================
-# Add additional lines to handle any additional AC_SUBST cases that
-# have been added to the configure script.
-#========================================================================
-
-ITK_GENERIC_DIR_NATIVE	= @ITK_GENERIC_DIR_NATIVE@
-ITK_UNIX_DIR_NATIVE	= @ITK_UNIX_DIR_NATIVE@
-ITK_WIN_DIR_NATIVE	= @ITK_WIN_DIR_NATIVE@
-
-#========================================================================
-# Nothing of the variables below this line need to be changed.  Please
-# check the TARGETS section below to make sure the make targets are
-# correct.
-#========================================================================
-
-#========================================================================
-# Change the name of the variable "exampleA_LIB_FILE" to match the one
-# used in the configure script.  This is the parameterized name of the
-# library that we are building.
+# "PKG_LIB_FILE" refers to the library (dynamic or static as per
+# configuration options) composed of the named objects.
 #========================================================================
 
 PKG_LIB_FILE	= @PKG_LIB_FILE@
+PKG_LIB_FILE8	= @PKG_LIB_FILE8@
+PKG_LIB_FILE9	= @PKG_LIB_FILE9@
 PKG_STUB_LIB_FILE = @PKG_STUB_LIB_FILE@
 
-lib_BINARIES	= $(PKG_LIB_FILE)
+lib_BINARIES	= $(PKG_LIB_FILE) $(PKG_STUB_LIB_FILE)
 BINARIES	= $(lib_BINARIES)
 
 SHELL		= @SHELL@
@@ -88,9 +75,11 @@ exec_prefix	= @exec_prefix@
 
 bindir		= @bindir@
 libdir		= @libdir@
+includedir	= @includedir@
+datarootdir	= @datarootdir@
+runstatedir	= @runstatedir@
 datadir		= @datadir@
 mandir		= @mandir@
-includedir	= @includedir@
 
 DESTDIR		=
 
@@ -99,19 +88,21 @@ pkgdatadir	= $(datadir)/$(PKG_DIR)
 pkglibdir	= $(libdir)/$(PKG_DIR)
 pkgincludedir	= $(includedir)/$(PKG_DIR)
 
-top_builddir	= .
+top_builddir	= @abs_top_builddir@
 
-INSTALL		= @INSTALL@
-INSTALL_PROGRAM	= @INSTALL_PROGRAM@
+INSTALL_OPTIONS	=
+INSTALL		= @INSTALL@ $(INSTALL_OPTIONS)
+INSTALL_DATA_DIR = @INSTALL_DATA_DIR@
 INSTALL_DATA	= @INSTALL_DATA@
+INSTALL_PROGRAM	= @INSTALL_PROGRAM@
 INSTALL_SCRIPT	= @INSTALL_SCRIPT@
+INSTALL_LIBRARY	= @INSTALL_LIBRARY@
 
 PACKAGE_NAME	= @PACKAGE_NAME@
 PACKAGE_VERSION	= @PACKAGE_VERSION@
 CC		= @CC@
 CFLAGS_DEFAULT	= @CFLAGS_DEFAULT@
 CFLAGS_WARNING	= @CFLAGS_WARNING@
-CLEANFILES	= @CLEANFILES@
 EXEEXT		= @EXEEXT@
 LDFLAGS_DEFAULT	= @LDFLAGS_DEFAULT@
 MAKE_LIB	= @MAKE_LIB@
@@ -123,20 +114,17 @@ RANLIB		= @RANLIB@
 RANLIB_STUB	= @RANLIB_STUB@
 SHLIB_CFLAGS	= @SHLIB_CFLAGS@
 SHLIB_LD	= @SHLIB_LD@
-SHLIB_LD_FLAGS	= @SHLIB_LD_FLAGS@
 SHLIB_LD_LIBS	= @SHLIB_LD_LIBS@
 STLIB_LD	= @STLIB_LD@
-TCL_DEFS	= @TCL_DEFS@
+#TCL_DEFS	= @TCL_DEFS@
 TCL_BIN_DIR	= @TCL_BIN_DIR@
 TCL_SRC_DIR	= @TCL_SRC_DIR@
 TK_SRC_DIR	= @TK_SRC_DIR@
 TK_BIN_DIR	= @TK_BIN_DIR@
-# This is necessary for packages that use private headers
-TCL_TOP_DIR_NATIVE = @TCL_TOP_DIR_NATIVE@
-TK_TOP_DIR_NATIVE = @TK_TOP_DIR_NATIVE@
+ITCL_TOOLS_DIR	= @itcl_SRC_DIR@/tools
 
 # Not used, but retained for reference of what libs Tcl required
-TCL_LIBS	= @TCL_LIBS@
+#TCL_LIBS	= @TCL_LIBS@
 
 #========================================================================
 # TCLLIBPATH seeds the auto_path in Tcl's init.tcl so we can test our
@@ -145,27 +133,40 @@ TCL_LIBS	= @TCL_LIBS@
 # require for testing here (like TCLX_LIBRARY).
 #========================================================================
 
+#EXTRA_PATH	= $(top_builddir):$(TCL_BIN_DIR)
 EXTRA_PATH	= $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR)
-TCLSH_ENV	= TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library` \
-		  TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library` \
+TCLLIBPATH	= $(top_builddir) @itcl_BIN_DIR@
+TCLSH_ENV	= TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library`
+PKG_ENV		= @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \
+		  PATH="$(EXTRA_PATH):$(PATH)" \
 		  ITCL_LIBRARY=`@CYGPATH@ @itcl_SRC_DIR@/library` \
 		  ITK_LIBRARY=`@CYGPATH@ $(srcdir)/library` \
-		  @LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \
-		  PATH="$(EXTRA_PATH):$(PATH)" \
-		  TCLLIBPATH="$(top_builddir) @itcl_BIN_DIR@"
-TCLSH_PROG	= @TCLSH_PROG@
-WISH_PROG	= @WISH_PROG@
-TCLSH		= $(TCLSH_ENV) $(TCLSH_PROG)
-WISH		= $(TCLSH_ENV) $(WISH_PROG)
+		  TCLLIBPATH="$(TCLLIBPATH)"
 
+TCLSH_PROG	= @TCLSH_PROG@
+TCLSH		= $(TCLSH_ENV) $(PKG_ENV) $(TCLSH_PROG)
+
+WISH_ENV	= TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library`
+WISH_PROG	= @WISH_PROG@
+WISH		= $(PKG_ENV) $(TCLSH_ENV) $(WISH_ENV) $(WISH_PROG)
+
+SHARED_BUILD	= @SHARED_BUILD@
+
+#INCLUDES	= @PKG_INCLUDES@ @TCL_INCLUDES@
 INCLUDES	= @PKG_INCLUDES@ @TCL_INCLUDES@ @TK_INCLUDES@ @TK_XINCLUDES@
 
 PKG_CFLAGS	= @PKG_CFLAGS@
 
-DEFS		= @DEFS@ $(PKG_CFLAGS) \
-		  -DITK_LIBRARY=\"$(pkglibdir)\" -DUSE_NON_CONST
+# TCL_DEFS is not strictly need here, but if you remove it, then you
+# must make sure that configure.ac checks for the necessary components
+# that your library may use.  TCL_DEFS can actually be a problem if
+# you do not compile with a similar machine setup as the Tcl core was
+# compiled with.
+#DEFS		= $(TCL_DEFS) @DEFS@ $(PKG_CFLAGS)
+DEFS		= @DEFS@ $(PKG_CFLAGS) -DITK_LIBRARY=\"$(pkglibdir)\"
 
 CONFIG_CLEAN_FILES = @CONFIG_CLEAN_FILES@ Makefile itkConfig.sh pkgIndex.tcl
+CLEANFILES	= @CLEANFILES@
 
 CPPFLAGS	= @CPPFLAGS@
 LIBS		= @PKG_LIBS@ @LIBS@
@@ -173,13 +174,20 @@ AR		= @AR@
 CFLAGS		= @CFLAGS@
 COMPILE		= $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
 
+GDB		= gdb
+VALGRIND	= valgrind
+VALGRINDARGS	= --tool=memcheck --num-callers=8 --leak-resolution=high \
+		  --leak-check=yes --show-reachable=yes -v
+
+.SUFFIXES: .c .$(OBJEXT)
+
 #========================================================================
 # Start of user-definable TARGETS section
 #========================================================================
 
 #========================================================================
 # TEA TARGETS.  Please note that the "libraries:" target refers to platform
-# independent files, and the "binaries:" target inclues executable programs and
+# independent files, and the "binaries:" target includes executable programs and
 # platform-dependent libraries.  Modify these targets so that they install
 # the various pieces of your package.  The make and install rules
 # for the BINARIES that you specified above have already been done.
@@ -198,6 +206,12 @@ binaries: $(BINARIES)
 
 libraries:
 
+#========================================================================
+# Your doc target should differentiate from doc builds (by the developer)
+# and doc installs (see install-doc), which just install the docs on the
+# end user machine when building from source.
+#========================================================================
+
 doc:
 
 install: all install-binaries install-libraries install-doc
@@ -206,14 +220,15 @@ install-binaries: binaries install-lib-binaries install-bin-binaries
 
 #========================================================================
 # This rule installs platform-independent files, such as header files.
+# The list=...; for p in $$list handles the empty list case x-platform.
 #========================================================================
 
 install-libraries: libraries
-	@mkdir -p $(DESTDIR)$(includedir)
+	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(includedir)"
 	@echo "Installing header files in $(DESTDIR)$(includedir)"
 	@list='$(PKG_HEADERS)'; for i in $$list; do \
 	    echo "Installing $(srcdir)/$$i" ; \
-	    $(INSTALL_DATA) $(srcdir)/$$i $(DESTDIR)$(includedir) ; \
+	    $(INSTALL_DATA) $(srcdir)/$$i "$(DESTDIR)$(includedir)" ; \
 	done;
 
 #========================================================================
@@ -222,27 +237,45 @@ install-libraries: libraries
 #========================================================================
 
 install-doc: doc
-	@mkdir -p $(DESTDIR)$(mandir)/mann
-	@echo "Installing man pages in $(DESTDIR)$(mandir)"
-	@cd $(srcdir)/doc; for i in *.n; do \
-	    echo "Installing $$i"; \
-	    rm -f $(DESTDIR)$(mandir)/mann/`basename $$i`; \
-	    sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
-		$$i > $(DESTDIR)$(mandir)/mann/$$i; \
-	    chmod 444 $(DESTDIR)$(mandir)/mann/$$i; \
+	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(mandir)/mann"
+	@echo "Installing documentation in $(DESTDIR)$(mandir)"
+	@list='$(srcdir)/doc/*.n'; for i in $$list; do \
+	    if test X"$$i" = X'$(srcdir)/doc/*.n'; then break; fi; \
+	    bi=`basename $$i`; \
+	    echo "Installing $$bi"; \
+	    sed -e '/man\.macros/r $(srcdir)/doc/man.macros' -e '/man\.macros/d' $$i > $$bi.tmp \
+	    && $(INSTALL_DATA) $$bi.tmp "$(DESTDIR)$(mandir)/mann/$$bi" \
+	    && rm -f $$bi.tmp; \
 	done
 
 test: binaries libraries
-	$(WISH) `@CYGPATH@ $(srcdir)/tests/all.tcl` -load "package require Itk" $(TESTFLAGS) | cat
+	$(WISH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) -load "package require -exact itk $(PACKAGE_VERSION)"
 
 shell: binaries libraries
 	@$(WISH) $(SCRIPT)
 
 gdb:
-	$(TCLSH_ENV) gdb $(WISH_PROG) $(SCRIPT)
+	$(TCLSH_ENV) $(PKG_ENV) $(GDB) $(WISH_PROG) $(SCRIPT)
+
+gdb-test: binaries libraries
+	$(TCLSH_ENV) $(PKG_ENV) $(GDB) \
+	    --args $(WISH_PROG) `@CYGPATH@ $(srcdir)/tests/all.tcl` \
+	    $(TESTFLAGS) -singleproc 1 \
+	    -load "package ifneeded $(PACKAGE_NAME) $(PACKAGE_VERSION) \
+		[list load `@CYGPATH@ $(PKG_LIB_FILE)` $(PACKAGE_NAME)]"
+
+valgrind: binaries libraries
+	$(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(WISH_PROG) \
+	    `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS)
+
+valgrindshell: binaries libraries
+	$(TCLSH_ENV) $(PKG_ENV) $(VALGRIND) $(VALGRINDARGS) $(WISH_PROG) $(SCRIPT)
 
 depend:
 
+genstubs: $(ITCL_TOOLS_DIR)/genStubs.tcl $(srcdir)/generic/itk.decls
+	$(TCLSH) $(ITCL_TOOLS_DIR)/genStubs.tcl $(srcdir)/generic $(srcdir)/generic/itk.decls
+
 #========================================================================
 # $(PKG_LIB_FILE) should be listed as part of the BINARIES variable
 # mentioned above.  That will ensure that this target is built when you
@@ -270,63 +303,79 @@ $(PKG_STUB_LIB_FILE): $(PKG_STUB_OBJECTS)
 # containing your extension.  If your sources are in a subdirectory,
 # you will have to modify the paths to reflect this:
 #
-# exampleA.$(OBJEXT): $(srcdir)/src/win/exampleA.c
-# 	$(COMPILE) -c `@CYGPATH@ $(srcdir)/src/win/exampleA.c` -o $@
+# sample.$(OBJEXT): $(srcdir)/generic/sample.c
+#	$(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
 #
 # Setting the VPATH variable to a list of paths will cause the makefile
 # to look into these paths when resolving .c to .obj dependencies.
 # As necessary, add $(srcdir):$(srcdir)/compat:....
 #========================================================================
 
-VPATH = $(srcdir)/unix:$(srcdir)/generic:$(srcdir)/win
+VPATH = $(srcdir):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx
 
-.c.$(OBJEXT):
-	$(COMPILE) -c `@CYGPATH@ $<` -o $@
+.c.@OBJEXT@:
+	$(COMPILE) -c `@CYGPATH@ $<` -I. -o $@
+
+itkBase.@OBJEXT@:	itkUuid.h
+
+$(srcdir)/manifest.uuid:
+	printf "git-" >$(srcdir)/manifest.uuid
+	(cd $(srcdir); git rev-parse HEAD >>$(srcdir)/manifest.uuid || \
+	    (printf "svn-r" >$(srcdir)/manifest.uuid ; \
+	    svn info --show-item last-changed-revision >>$(srcdir)/manifest.uuid) || \
+	    printf "unknown" >$(srcdir)/manifest.uuid)
+
+itkUuid.h:	$(srcdir)/manifest.uuid
+	echo "#define ITK_VERSION_UUID \\" >$@
+	cat $(srcdir)/manifest.uuid >>$@
+	echo "" >>$@
 
 #========================================================================
 # Distribution creation
 # You may need to tweak this target to make it work correctly.
 #========================================================================
 
-TAR		= tar
-#COMPRESS       = tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar
-COMPRESS        = $(TAR) zcvf $(PKG_DIR).tar.gz $(PKG_DIR)
-DIST_ROOT       = /tmp/dist
-DIST_DIR        = $(DIST_ROOT)/$(PKG_DIR)
+#COMPRESS	= tar cvf $(PKG_DIR).tar $(PKG_DIR); compress $(PKG_DIR).tar
+COMPRESS	= tar zcvf $(PKG_DIR).tar.gz $(PKG_DIR)
+DIST_ROOT	= /tmp/dist
+DIST_DIR	= $(DIST_ROOT)/$(PKG_DIR)
+
+DIST_INSTALL_DATA	= CPPROG='cp -p' $(INSTALL) -m 644
+DIST_INSTALL_SCRIPT	= CPPROG='cp -p' $(INSTALL) -m 755
 
 dist-clean:
 	rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.*
 
-dist: dist-clean doc
-	mkdir -p $(DIST_DIR)
-	cp -p $(srcdir)/license* $(srcdir)/aclocal.m4 $(srcdir)/configure \
-		$(srcdir)/*.in  $(DIST_DIR)/
-	chmod 664 $(DIST_DIR)/Makefile.in $(DIST_DIR)/aclocal.m4
-	chmod 775 $(DIST_DIR)/configure $(DIST_DIR)/configure.in
+dist: dist-clean $(srcdir)/manifest.uuid
+	$(INSTALL_DATA_DIR) $(DIST_DIR)
 
-	mkdir $(DIST_DIR)/tclconfig
-	cp $(srcdir)/tclconfig/install-sh $(srcdir)/tclconfig/tcl.m4 \
-		$(DIST_DIR)/tclconfig/
-	chmod 664 $(DIST_DIR)/tclconfig/tcl.m4
-	chmod +x $(DIST_DIR)/tclconfig/install-sh
+	# TEA files
+	$(DIST_INSTALL_DATA) $(srcdir)/Makefile.in \
+	    $(srcdir)/manifest.uuid $(DISTDIR) \
+	    $(srcdir)/aclocal.m4 $(srcdir)/configure.ac \
+	    $(DIST_DIR)/
+	$(DIST_INSTALL_SCRIPT) $(srcdir)/configure $(DIST_DIR)/
+
+	$(INSTALL_DATA_DIR) $(DIST_DIR)/tclconfig
+	$(DIST_INSTALL_DATA) $(srcdir)/tclconfig/README.txt \
+	    $(srcdir)/tclconfig/tcl.m4 $(srcdir)/tclconfig/install-sh \
+	    $(DIST_DIR)/tclconfig/
+
+	# Extension files
+	$(DIST_INSTALL_DATA) \
+	    $(srcdir)/ChangeLog \
+	    $(srcdir)/license.terms \
+	    $(srcdir)/pkgIndex.tcl.in \
+	    $(srcdir)/itkConfig.sh.in \
+	    $(DIST_DIR)/
 
 	list='demos doc examples generic library tests win win/rc'; \
 	for p in $$list; do \
-	    if test -d $(srcdir)/$$p ; then \
-		mkdir $(DIST_DIR)/$$p; \
-		for q in $(srcdir)/$$p/*; do \
-		    if test -f $$q ; then \
-			cp -p $$q $(DIST_DIR)/$$p/; \
-		    fi; \
-		done; \
-	    fi; \
-	done
-
-	list='CHANGES ChangeLog INCOMPATIBLE README TODO'; \
-	for p in $$list; do \
-	    if test -f $(srcdir)/../$$p ; then \
-		cp -p $(srcdir)/../$$p $(DIST_DIR)/; \
-	    fi; \
+	    $(INSTALL_DATA_DIR) $(DIST_DIR)/$$p; \
+	    for f in $(srcdir)/$$p/*; do \
+		if ! test -f $$f; then continue; fi; \
+		$(DIST_INSTALL_DATA) $$f $(DIST_DIR)/$$p/; \
+	    done; \
 	done
 
 	(cd $(DIST_ROOT); $(COMPRESS);)
@@ -337,13 +386,12 @@ dist: dist-clean doc
 
 #========================================================================
 # Don't modify the file to clean here.  Instead, set the "CLEANFILES"
-# variable in configure.in
+# variable in configure.ac
 #========================================================================
 
-clean:  
+clean:
 	-test -z "$(BINARIES)" || rm -f $(BINARIES)
-	-rm -f *.o core *.core
-	-rm -f *.$(OBJEXT)
+	-rm -f *.$(OBJEXT) core *.core
 	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
 
 distclean: clean
@@ -355,34 +403,25 @@ distclean: clean
 # Install binary object libraries.  On Windows this includes both .dll and
 # .lib files.  Because the .lib files are not explicitly listed anywhere,
 # we need to deduce their existence from the .dll file of the same name.
-# Additionally, the .dll files go into the bin directory, but the .lib
-# files go into the lib directory.  On Unix platforms, all library files
-# go into the lib directory.  In addition, this will generate the pkgIndex.tcl
-# file in the install location (assuming it can find a usable tclsh8.2 shell)
+# Library files go into the lib directory.
+# In addition, this will generate the pkgIndex.tcl
+# file in the install location (assuming it can find a usable tclsh shell)
 #
 # You should not have to modify this target.
 #========================================================================
 
-install-lib-binaries:
-	@mkdir -p $(DESTDIR)$(pkglibdir)
+install-lib-binaries: binaries
+	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(pkglibdir)"
 	@list='$(lib_BINARIES)'; for p in $$list; do \
 	  if test -f $$p; then \
-	    echo " $(INSTALL_PROGRAM) $$p $(DESTDIR)$(pkglibdir)/$$p"; \
-	    $(INSTALL_PROGRAM) $$p $(DESTDIR)$(pkglibdir)/$$p; \
-	    stub=`echo $$p|sed -e "s/.*\(stub\).*/\1/"`; \
-	    if test "x$$stub" = "xstub"; then \
-		echo " $(RANLIB_STUB) $(DESTDIR)$(pkglibdir)/$$p"; \
-		$(RANLIB_STUB) $(DESTDIR)$(pkglibdir)/$$p; \
-	    else \
-		echo " $(RANLIB) $(DESTDIR)$(pkglibdir)/$$p"; \
-		$(RANLIB) $(DESTDIR)$(pkglibdir)/$$p; \
-	    fi; \
+	    echo " $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p"; \
+	    $(INSTALL_LIBRARY) $$p "$(DESTDIR)$(pkglibdir)/$$p"; \
 	    ext=`echo $$p|sed -e "s/.*\.//"`; \
 	    if test "x$$ext" = "xdll"; then \
 		lib=`basename $$p|sed -e 's/.[^.]*$$//'`.lib; \
 		if test -f $$lib; then \
 		    echo " $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib"; \
-	            $(INSTALL_DATA) $$lib $(DESTDIR)$(pkglibdir)/$$lib; \
+		    $(INSTALL_DATA) $$lib "$(DESTDIR)$(pkglibdir)/$$lib"; \
 		fi; \
 	    fi; \
 	  fi; \
@@ -391,46 +430,52 @@ install-lib-binaries:
 	  if test -f $(srcdir)/$$p; then \
 	    destp=`basename $$p`; \
 	    echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \
-	    $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(pkglibdir)/$$destp; \
+	    $(INSTALL_DATA) $(srcdir)/$$p "$(DESTDIR)$(pkglibdir)/$$destp"; \
 	  fi; \
 	done
-	$(INSTALL_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir)
-	: $(INSTALL_DATA) itkConfig.sh $(DESTDIR)$(libdir)
+	@if test "x$(SHARED_BUILD)" = "x1"; then \
+	    echo " Install pkgIndex.tcl $(DESTDIR)$(pkglibdir)"; \
+	    $(INSTALL_DATA) pkgIndex.tcl "$(DESTDIR)$(pkglibdir)"; \
+	fi
+	$(INSTALL_DATA) itkConfig.sh "$(DESTDIR)$(pkglibdir)"
 
 #========================================================================
-# Install binary executables (e.g. .exe files)
+# Install binary executables (e.g. .exe files and dependent .dll files)
+# This is for files that must go in the bin directory (located next to
+# wish and tclsh), like dependent .dll files on Windows.
 #
-# You should not have to modify this target.
+# You should not have to modify this target, except to define bin_BINARIES
+# above if necessary.
 #========================================================================
 
-install-bin-binaries:
-	@mkdir -p $(DESTDIR)$(bindir)
+install-bin-binaries: binaries
+	@$(INSTALL_DATA_DIR) "$(DESTDIR)$(bindir)"
 	@list='$(bin_BINARIES)'; for p in $$list; do \
 	  if test -f $$p; then \
 	    echo " $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p"; \
-	    $(INSTALL_PROGRAM) $$p $(DESTDIR)$(bindir)/$$p; \
+	    $(INSTALL_PROGRAM) $$p "$(DESTDIR)$(bindir)/$$p"; \
 	  fi; \
 	done
 
-.SUFFIXES: .c .$(OBJEXT)
-
 Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
 	cd $(top_builddir) \
 	  && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status
 
 uninstall-binaries:
 	list='$(lib_BINARIES)'; for p in $$list; do \
-	  rm -f $(DESTDIR)$(pkglibdir)/$$p; \
+	  rm -f "$(DESTDIR)$(pkglibdir)/$$p"; \
 	done
 	list='$(PKG_TCL_SOURCES)'; for p in $$list; do \
 	  p=`basename $$p`; \
-	  rm -f $(DESTDIR)$(pkglibdir)/$$p; \
+	  rm -f "$(DESTDIR)$(pkglibdir)/$$p"; \
 	done
 	list='$(bin_BINARIES)'; for p in $$list; do \
-	  rm -f $(DESTDIR)$(bindir)/$$p; \
+	  rm -f "$(DESTDIR)$(bindir)/$$p"; \
 	done
 
 .PHONY: all binaries clean depend distclean doc install libraries test
+.PHONY: gdb gdb-test valgrind valgrindshell
+.PHONY: genstubs
 
 # Tell versions [3.59,3.63) of GNU make to not export all variables.
 # Otherwise a system limit (for SysV at least) may be exceeded.

aclocal.m4

@@ -1 +1,9 @@
+#
+# Include the TEA standard macro set
+#
+
 builtin(include,tclconfig/tcl.m4)
+
+#
+# Add here whatever m4 macros you want to define for your package
+#

configure.ac

@@ -1,16 +1,25 @@
 #!/bin/bash -norc
-#--------------------------------------------------------------------
-# Sample configure.in for Tcl Extensions.  The only places you should
-# need to modify this file are marked by the string __CHANGE__
-#--------------------------------------------------------------------
+dnl	This file is an input file used by the GNU "autoconf" program to
+dnl	generate the file "configure", which is run during Tcl installation
+dnl	to configure the system for the local environment.
 
 #-----------------------------------------------------------------------
+# Sample configure.ac for Tcl Extensions.  The only places you should
+# need to modify this file are marked by the string __CHANGE__
+#-----------------------------------------------------------------------
+
+#-----------------------------------------------------------------------
+# __CHANGE__
+# Set your package name and version numbers here.
+#
 # This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
 # set as provided.  These will also be added as -D defs in your Makefile
 # so you can encode the package version directly into the source files.
+# This will also define a special symbol for Windows (BUILD_<PACKAGE_NAME>
+# so that we create the export library with the dll.
 #-----------------------------------------------------------------------
 
-AC_INIT([itk], [3.4])
+AC_INIT([itk],[4.2.7])
 
 #--------------------------------------------------------------------
 # Call TEA_INIT as the first TEA_ macro to set up initial vars.
@@ -18,18 +27,29 @@ AC_INIT([itk], [3.4])
 # as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
 #--------------------------------------------------------------------
 
-TEA_INIT([3.6])
+TEA_INIT()
+
+#--------------------------------------------------------------------
+# Try to ensure the existence of a tclconfig directory in either
+# $srcdir or the current dir, if one can't be found in $srcdir.
+# If this package is being built as part of a bundle then a tclconfig
+# directory might exist in $srcdir's parent directory.
+#--------------------------------------------------------------------
 
 AC_PROG_LN_S
 CONFIG_CLEAN_FILES=
 if test ! -d $srcdir/tclconfig ; then
     if test -d $srcdir/../tclconfig ; then
-        $LN_S $srcdir/../tclconfig tclconfig
+	$LN_S $srcdir/../tclconfig tclconfig
 	CONFIG_CLEAN_FILES=tclconfig
     fi
 fi
 AC_SUBST(CONFIG_CLEAN_FILES)
 
+#--------------------------------------------------------------------
+# Tell autoconf where to find tcl.m4 and install.sh.
+#--------------------------------------------------------------------
+
 AC_CONFIG_AUX_DIR(tclconfig)
 
 #--------------------------------------------------------------------
@@ -40,30 +60,34 @@ TEA_PATH_TCLCONFIG
 TEA_LOAD_TCLCONFIG
 
 #--------------------------------------------------------------------
-# Load the tkConfig.sh file
+# Load the tkConfig.sh file if necessary (Tk extension)
 #--------------------------------------------------------------------
 
 TEA_PATH_TKCONFIG
 TEA_LOAD_TKCONFIG
 
+#--------------------------------------------------------------------
+# Load the itclConfig.sh file
+#--------------------------------------------------------------------
+
 TEA_PATH_CONFIG(itcl)
 TEA_LOAD_CONFIG(itcl)
 
 ITCL_INCLUDES="-I\"`${CYGPATH} ${itcl_SRC_DIR}/generic`\""
 
-#--------------------------------------------------------------------
+#-----------------------------------------------------------------------
 # Handle the --prefix=... option by defaulting to what Tcl gave.
-# Must be called after TEA_LOAD_TCLCONFIG and before $prefix is used.
-#--------------------------------------------------------------------
+# Must be called after TEA_LOAD_TCLCONFIG and before TEA_SETUP_COMPILER.
+#-----------------------------------------------------------------------
 
 TEA_PREFIX
 
-#------------------------------------------------------------------------
+#-----------------------------------------------------------------------
 # Standard compiler checks.
 # This sets up CC by using the CC env var, or looks for gcc otherwise.
-# This also calls AC_PROG_CC, AC_PROG_INSTALL and a few others to create
-# the basic setup necessary to compile executables.
-#------------------------------------------------------------------------
+# This also calls AC_PROG_CC and a few others to create the basic setup
+# necessary to compile executables.
+#-----------------------------------------------------------------------
 
 TEA_SETUP_COMPILER
 
@@ -77,16 +101,21 @@ TEA_SETUP_COMPILER
 # and PKG_TCL_SOURCES.
 #-----------------------------------------------------------------------
 
-TEA_ADD_SOURCES([itk_cmds.c
-		itk_option.c
-		itk_archetype.c
-		itk_util.c
-		itkStubInit.c])
-TEA_ADD_HEADERS([generic/itk.h generic/itkDecls.h])
+TEA_ADD_SOURCES([
+		itkArchBase.c
+		itkArchetype.c
+		itkBase.c
+		itkCmd.c
+		itkHelpers.c
+		itkOption.c
+		itkUtil.c
+		itkStubInit.c
+		])
+TEA_ADD_HEADERS([generic/itk.h generic/itkInt.h])
 TEA_ADD_INCLUDES([${ITCL_INCLUDES} -I\"`${CYGPATH} ${srcdir}/generic`\"])
 TEA_ADD_LIBS([])
 TEA_ADD_CFLAGS([])
-#TEA_ADD_STUB_SOURCES([itkStubLib.c])
+TEA_ADD_STUB_SOURCES([itkStubLib.c])
 TEA_ADD_TCL_SOURCES([library/Archetype.itk
 		library/Toplevel.itk
 		library/Widget.itk
@@ -95,52 +124,44 @@ TEA_ADD_TCL_SOURCES([library/Archetype.itk
 
 #--------------------------------------------------------------------
 # __CHANGE__
-# A few miscellaneous platform-specific items:
 #
-# Define a special symbol for Windows (BUILD_itk in this case) so
-# that we create the export library with the dll.  See sha1.h on how
-# to use this.
-#
-# Windows creates a few extra files that need to be cleaned up.
 # You can add more files to clean if your extension creates any extra
-# files.
+# files by extending CLEANFILES.
+# Add pkgIndex.tcl if it is generated in the Makefile instead of ./configure
+# and change Makefile.in to move it from CONFIG_CLEAN_FILES to BINARIES var.
 #
-# Define any extra compiler flags in the PACKAGE_CFLAGS variable.
-# These will be appended to the current set of compiler flags for
-# your system.
+# A few miscellaneous platform-specific items:
+# TEA_ADD_* any platform specific compiler/build info here.
 #--------------------------------------------------------------------
 
+#CLEANFILES="$CLEANFILES pkgIndex.tcl"
 if test "${TEA_PLATFORM}" = "windows" ; then
-    AC_DEFINE(BUILD_itk)
-    CLEANFILES="*.lib *.dll *.exp *.ilk *.pdb vc*.pch"
+    # Ensure no empty if clauses
+    :
+    #TEA_ADD_SOURCES([win/winFile.c])
+    #TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
     TEA_ADD_SOURCES([dllEntryPoint.c])
 else
-    CLEANFILES=
+    # Ensure no empty else clauses
+    :
+    #TEA_ADD_SOURCES([unix/unixFile.c])
+    #TEA_ADD_LIBS([-lsuperfly])
 fi
 
-AC_SUBST(CLEANFILES)
-
 #--------------------------------------------------------------------
 # __CHANGE__
 # Choose which headers you need.  Extension authors should try very
 # hard to only rely on the Tcl public header files.  Internal headers
 # contain private data structures and are subject to change without
 # notice.
-# This must be done AFTER calling TEA_PATH_TCLCONFIG/TEA_LOAD_TCLCONFIG
-# so that we can extract TCL_SRC_DIR from the config file (in the case
-# of private headers
+# This MUST be called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG
 #--------------------------------------------------------------------
 
 #TEA_PUBLIC_TCL_HEADERS
 TEA_PRIVATE_TCL_HEADERS
 
-#TEA_PUBLIC_TK_HEADERS
-TEA_PRIVATE_TK_HEADERS
-
-#--------------------------------------------------------------------
-# For Unix/Tk builds, make sure that the X libraries/headers are found.
-#--------------------------------------------------------------------
-
+TEA_PUBLIC_TK_HEADERS
+#TEA_PRIVATE_TK_HEADERS
 TEA_PATH_X
 
 #--------------------------------------------------------------------
@@ -151,6 +172,7 @@ TEA_PATH_X
 #--------------------------------------------------------------------
 
 AC_DEFINE(TCL_THREADS)
+
 #--------------------------------------------------------------------
 # Check whether --enable-threads or --disable-threads was given.
 # This auto-enables if Tcl was compiled threaded.
@@ -174,22 +196,16 @@ TEA_ENABLE_SHARED
 TEA_CONFIG_CFLAGS
 
 #--------------------------------------------------------------------
-# Set the default compiler switches based on the --enable-symbols 
-# option.
+# Set the default compiler switches based on the --enable-symbols option.
 #--------------------------------------------------------------------
 
 TEA_ENABLE_SYMBOLS
 
 #--------------------------------------------------------------------
-# Everyone should be linking against the Tcl stub library.  If you
-# can't for some reason, remove this definition.  If you aren't using
-# stubs, you also need to modify the SHLIB_LD_LIBS setting below to
-# link against the non-stubbed Tcl library.
+# Itcl stubs
 #--------------------------------------------------------------------
 
 if test "${SHARED_BUILD}" = "1" ; then
-    AC_DEFINE(USE_TCL_STUBS)
-    AC_DEFINE(USE_TK_STUBS)
     AC_DEFINE(USE_ITCL_STUBS)
 fi
 
@@ -202,39 +218,45 @@ fi
 TEA_MAKE_LIB
 
 #--------------------------------------------------------------------
-# __CHANGE__
-# Add platform libs to LIBS or SHLIB_LD_LIBS as necessary.
-#--------------------------------------------------------------------
-
-if test "${TEA_PLATFORM}" = "windows" -a "$GCC" != "yes" ; then
-    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${itcl_STUB_LIB_PATH}`\""
-else
-    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${itcl_STUB_LIB_SPEC}"
-fi
-
-#--------------------------------------------------------------------
-# __CHANGE__
-# Change the name from exampeA_LIB_FILE to match your package name.
-# Use the stub_LIB_FILE substitution if your package creates a stub
-# library.
-#--------------------------------------------------------------------
-
-AC_SUBST(itkstub_LIB_FILE)
-AC_SUBST(itk_LIB_FILE)
-
-#--------------------------------------------------------------------
-# Find tclsh so that we can run pkg_mkIndex to generate the pkgIndex.tcl
-# file during the install process.  Don't run the TCLSH_PROG through
-# ${CYGPATH} because it's being used directly by make.
-# Require that we use a tclsh shell version 8.2 or later since earlier
-# versions have bugs in the pkg_mkIndex routine.
+# Determine the name of the tclsh and/or wish executables in the
+# Tcl and Tk build directories or the location they were installed
+# into. These paths are used to support running test cases only,
+# the Makefile should not be making use of these paths to generate
+# a pkgIndex.tcl file or anything else at extension build time.
 #--------------------------------------------------------------------
 
 TEA_PROG_TCLSH
 TEA_PROG_WISH
 
 #--------------------------------------------------------------------
-# Finally, substitute all of the various values into the Makefile.
+# Setup a *Config.sh.in configuration file.
 #--------------------------------------------------------------------
 
-AC_OUTPUT([Makefile pkgIndex.tcl itkConfig.sh])
+# itk_SRC_DIR must be a fully qualified path
+eval itk_SRC_DIR="$srcdir"
+itk_SRC_DIR="`(cd "${itk_SRC_DIR}"; pwd)`"
+
+itk_LIB_FILE="${PKG_LIB_FILE}"
+itk_STUB_LIB_FILE="${PKG_STUB_LIB_FILE}"
+
+TEA_EXPORT_CONFIG([itk])
+AC_SUBST(ITCL_VERSION)
+AC_SUBST(itk_SRC_DIR)
+AC_SUBST(itk_LIB_FILE)
+AC_SUBST(itk_STUB_LIB_FILE)
+
+#--------------------------------------------------------------------
+# Specify files to substitute AC variables in. You may alternatively
+# have a special pkgIndex.tcl.in or other files which require
+# substituting the AC variables in. Include these here.
+#--------------------------------------------------------------------
+
+AC_CONFIG_FILES([Makefile pkgIndex.tcl])
+AC_CONFIG_FILES([itkConfig.sh])
+
+#--------------------------------------------------------------------
+# Finally, substitute all of the various values into the files
+# specified with AC_CONFIG_FILES.
+#--------------------------------------------------------------------
+
+AC_OUTPUT

demos/itkedit

@@ -53,26 +53,26 @@ proc file_load {} {
 
     .files buttonconfigure OK -text "Load"
     if {[.files activate]} {
-        set fname [.files get]
-        set cmd {
-            set fid [open $fname r]
-            set text [read $fid]
-            close $fid
-        }
-        if {[catch $cmd err] != 0} {
-            .notice configure -bitmap error \
-                -text "Cannot load file \"$fname\":\n$err"
-            .notice activate
-            return
-        }
+	set fname [.files get]
+	set cmd {
+	    set fid [open $fname r]
+	    set text [read $fid]
+	    close $fid
+	}
+	if {[catch $cmd err] != 0} {
+	    .notice configure -bitmap error \
+		-text "Cannot load file \"$fname\":\n$err"
+	    .notice activate
+	    return
+	}
 
-        set pane [$PaneMenu get]
-        set win [.edit childsite $pane]
-        clear_text $win
-        $win.text insert end $text
-        $win.text configure -labeltext "file: $fname"
+	set pane [$PaneMenu get]
+	set win [.edit childsite $pane]
+	clear_text $win
+	$win.text insert end $text
+	$win.text configure -labeltext "file: $fname"
 
-        set FileName($win) $fname
+	set FileName($win) $fname
     }
 }
 
@@ -89,12 +89,12 @@ proc file_save_as {} {
 
     .files buttonconfigure OK -text "Save"
     if {[.files activate]} {
-        set pane [$PaneMenu get]
-        set win [.edit childsite $pane]
+	set pane [$PaneMenu get]
+	set win [.edit childsite $pane]
 
-        set FileName($win) [.files get]
+	set FileName($win) [.files get]
 
-        file_save $win
+	file_save $win
     }
 }
 
@@ -108,16 +108,16 @@ proc file_save {win} {
     global FileName FileChanged
 
     set cmd {
-        set fid [open $FileName($win) w]
-        puts $fid [$win.text get 1.0 end]
-        close $fid
-        set FileChanged($win) 0
-        $win.text configure -labeltext "file: $FileName($win)"
+	set fid [open $FileName($win) w]
+	puts $fid [$win.text get 1.0 end]
+	close $fid
+	set FileChanged($win) 0
+	$win.text configure -labeltext "file: $FileName($win)"
     }
     if {[catch $cmd err] != 0} {
-        .notice configure -bitmap error \
-            -text "Cannot save file \"$FileName($win)\":\n$err"
-        .notice activate
+	.notice configure -bitmap error \
+	    -text "Cannot save file \"$FileName($win)\":\n$err"
+	.notice activate
     }
 }
 
@@ -132,22 +132,22 @@ proc clear_text {{areas ""}} {
     global FileName FileChanged FileWindows
 
     if {$areas == ""} {
-        for {set i 0} {$i < $FileWindows} {incr i} {
-            set pane "area #[expr $i+1]"
-            lappend areas [.edit childsite $pane]
-        }
+	for {set i 0} {$i < $FileWindows} {incr i} {
+	    set pane "area #[expr $i+1]"
+	    lappend areas [.edit childsite $pane]
+	}
     }
 
     foreach win $areas {
-        if {$FileChanged($win)} {
-            set fname [file tail $FileName($win)]
-            .confirm configure -text "File \"$fname\" has changed.\nSave changes?"
-            if {[.confirm activate]} {
-                file_save $win
-            }
-        }
-        $win.text delete 1.0 end
-        set FileChanged($win) 0
+	if {$FileChanged($win)} {
+	    set fname [file tail $FileName($win)]
+	    .confirm configure -text "File \"$fname\" has changed.\nSave changes?"
+	    if {[.confirm activate]} {
+		file_save $win
+	    }
+	}
+	$win.text delete 1.0 end
+	set FileChanged($win) 0
     }
 }
 
@@ -169,11 +169,11 @@ proc split_view {} {
     set FileChanged($win) 0
 
     iwidgets::scrolledtext $win.text -wrap none -labeltext "file: $FileName($win)" \
-        -hscrollmode none -vscrollmode dynamic -visibleitems 1x1
+	-hscrollmode none -vscrollmode dynamic -visibleitems 1x1
     pack $win.text -expand yes -fill both
 
     bind [$win.text component text] <KeyPress> "
-        set FileChanged($win) 1
+	set FileChanged($win) 1
     "
 }
 

doc/Archetype.n

@@ -4,8 +4,6 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" RCS: $Id: Archetype.n,v 1.2 2004/09/01 04:23:10 davygrvy Exp $
-'\"
 .so man.macros
 .TH Archetype n 3.0 itk "[incr\ Tk]"
 .BS
@@ -50,7 +48,7 @@ inherits from \fBArchetype\fR, but adds a Tk toplevel which acts
 as the "hull".
 .PP
 \fIEach derived class must invoke the \fBitk_initialize\fP method
-within its constructor\fR, so that all options are properly
+within its constructor, so that all options are properly
 integrated and initialized in the composite list.
 
 

doc/Toplevel.n

@@ -4,8 +4,6 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" RCS: $Id: Toplevel.n,v 1.4 2004/09/01 04:23:10 davygrvy Exp $
-'\"
 .so man.macros
 .TH Toplevel n 3.0 itk "[incr\ Tk]"
 .BS

doc/Widget.n

@@ -4,8 +4,6 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" RCS: $Id: Widget.n,v 1.2 2004/09/01 04:23:10 davygrvy Exp $
-'\"
 .so man.macros
 .TH Widget n 3.0 itk "[incr\ Tk]"
 .BS

doc/itk.n

@@ -4,8 +4,6 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" RCS: $Id: itk.n,v 1.1 1998/07/27 18:45:36 stanton Exp $
-'\"
 .so man.macros
 .TH itk n 3.0 itk "[incr\ Tk]"
 .BS

doc/itkvars.n

@@ -4,8 +4,6 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" RCS: $Id: itkvars.n,v 1.1 1998/07/27 18:45:37 stanton Exp $
-'\"
 .so man.macros
 .TH itkvars n 3.0 itk "[incr\ Tk]"
 .BS
@@ -30,9 +28,9 @@ or from a compiled-in value otherwise.
 .sp
 When \fB[incr\ Tk]\fR is added to an interpreter, it executes
 the script "\fCinit.itk\fR" in this directory.  This script,
-in turn, looks for other script files with the name "\fCinit.\fIxxx\fR".
+in turn, looks for other script files with the name "\fCinit.\fR\fIxxx\fR".
 Mega-widget libraries will be automatically initialized if they
-install a script named "\fCinit.\fIxxx\fR" in this directory,
+install a script named "\fCinit.\fR\fIxxx\fR" in this directory,
 where "\fIxxx\fR" is the name of the mega-widget library.
 For example, the \fB[incr\ Widgets]\fR library installs
 the script "\fCinit.iwidgets\fR" in this directory.

doc/man.macros

@@ -1,80 +1,86 @@
-'\" The definitions below are for supplemental macros used in Tcl/Tk
-'\" manual entries.
-'\"
-'\" .AP type name in/out ?indent?
-'\"	Start paragraph describing an argument to a library procedure.
-'\"	type is type of argument (int, etc.), in/out is either "in", "out",
-'\"	or "in/out" to describe whether procedure reads or modifies arg,
-'\"	and indent is equivalent to second arg of .IP (shouldn't ever be
-'\"	needed;  use .AS below instead)
-'\"
-'\" .AS ?type? ?name?
-'\"	Give maximum sizes of arguments for setting tab stops.  Type and
-'\"	name are examples of largest possible arguments that will be passed
-'\"	to .AP later.  If args are omitted, default tab stops are used.
-'\"
-'\" .BS
-'\"	Start box enclosure.  From here until next .BE, everything will be
-'\"	enclosed in one large box.
-'\"
-'\" .BE
-'\"	End of box enclosure.
-'\"
-'\" .CS
-'\"	Begin code excerpt.
-'\"
-'\" .CE
-'\"	End code excerpt.
-'\"
-'\" .VS ?version? ?br?
-'\"	Begin vertical sidebar, for use in marking newly-changed parts
-'\"	of man pages.  The first argument is ignored and used for recording
-'\"	the version when the .VS was added, so that the sidebars can be
-'\"	found and removed when they reach a certain age.  If another argument
-'\"	is present, then a line break is forced before starting the sidebar.
-'\"
-'\" .VE
-'\"	End of vertical sidebar.
-'\"
-'\" .DS
-'\"	Begin an indented unfilled display.
-'\"
-'\" .DE
-'\"	End of indented unfilled display.
-'\"
-'\" .SO
-'\"	Start of list of standard options for a Tk widget.  The
-'\"	options follow on successive lines, in four columns separated
-'\"	by tabs.
-'\"
-'\" .SE
-'\"	End of list of standard options for a Tk widget.
-'\"
-'\" .OP cmdName dbName dbClass
-'\"	Start of description of a specific option.  cmdName gives the
-'\"	option's name as specified in the class command, dbName gives
-'\"	the option's name in the option database, and dbClass gives
-'\"	the option's class in the option database.
-'\"
-'\" .UL arg1 arg2
-'\"	Print arg1 underlined, then print arg2 normally.
-'\"
-'\" SCCS: @(#) man.macros 1.9 97/08/22 18:50:59
-'\"
-'\"	# Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.\" The -*- nroff -*- definitions below are for supplemental macros used
+.\" in Tcl/Tk manual entries.
+.\"
+.\" .AP type name in/out ?indent?
+.\"	Start paragraph describing an argument to a library procedure.
+.\"	type is type of argument (int, etc.), in/out is either "in", "out",
+.\"	or "in/out" to describe whether procedure reads or modifies arg,
+.\"	and indent is equivalent to second arg of .IP (shouldn't ever be
+.\"	needed;  use .AS below instead)
+.\"
+.\" .AS ?type? ?name?
+.\"	Give maximum sizes of arguments for setting tab stops.  Type and
+.\"	name are examples of largest possible arguments that will be passed
+.\"	to .AP later.  If args are omitted, default tab stops are used.
+.\"
+.\" .BS
+.\"	Start box enclosure.  From here until next .BE, everything will be
+.\"	enclosed in one large box.
+.\"
+.\" .BE
+.\"	End of box enclosure.
+.\"
+.\" .CS
+.\"	Begin code excerpt.
+.\"
+.\" .CE
+.\"	End code excerpt.
+.\"
+.\" .VS ?version? ?br?
+.\"	Begin vertical sidebar, for use in marking newly-changed parts
+.\"	of man pages.  The first argument is ignored and used for recording
+.\"	the version when the .VS was added, so that the sidebars can be
+.\"	found and removed when they reach a certain age.  If another argument
+.\"	is present, then a line break is forced before starting the sidebar.
+.\"
+.\" .VE
+.\"	End of vertical sidebar.
+.\"
+.\" .DS
+.\"	Begin an indented unfilled display.
+.\"
+.\" .DE
+.\"	End of indented unfilled display.
+.\"
+.\" .SO ?manpage?
+.\"	Start of list of standard options for a Tk widget. The manpage
+.\"	argument defines where to look up the standard options; if
+.\"	omitted, defaults to "options". The options follow on successive
+.\"	lines, in three columns separated by tabs.
+.\"
+.\" .SE
+.\"	End of list of standard options for a Tk widget.
+.\"
+.\" .OP cmdName dbName dbClass
+.\"	Start of description of a specific option.  cmdName gives the
+.\"	option's name as specified in the class command, dbName gives
+.\"	the option's name in the option database, and dbClass gives
+.\"	the option's class in the option database.
+.\"
+.\" .UL arg1 arg2
+.\"	Print arg1 underlined, then print arg2 normally.
+.\"
+.\" .QW arg1 ?arg2?
+.\"	Print arg1 in quotes, then arg2 normally (for trailing punctuation).
+.\"
+.\" .PQ arg1 ?arg2?
+.\"	Print an open parenthesis, arg1 in quotes, then arg2 normally
+.\"	(for trailing punctuation) and then a closing parenthesis.
+.\"
+.\"	# Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
 .if t .wh -1.3i ^B
 .nr ^l \n(.l
 .ad b
-'\"	# Start an argument description
+.\"	# Start an argument description
 .de AP
 .ie !"\\$4"" .TP \\$4
 .el \{\
 .   ie !"\\$2"" .TP \\n()Cu
 .   el          .TP 15
 .\}
-.ie !"\\$3"" \{\
 .ta \\n()Au \\n()Bu
-\&\\$1	\\fI\\$2\\fP	(\\$3)
+.ie !"\\$3"" \{\
+\&\\$1 \\fI\\$2\\fP (\\$3)
 .\".b
 .\}
 .el \{\
@@ -87,7 +93,7 @@
 .\}
 .\}
 ..
-'\"	# define tabbing values for .AP
+.\"	# define tabbing values for .AP
 .de AS
 .nr )A 10n
 .if !"\\$1"" .nr )A \\w'\\$1'u+3n
@@ -97,9 +103,9 @@
 .nr )C \\n()Bu+\\w'(in/out)'u+2n
 ..
 .AS Tcl_Interp Tcl_CreateInterp in/out
-'\"	# BS - start boxed text
-'\"	# ^y = starting y location
-'\"	# ^b = 1
+.\"	# BS - start boxed text
+.\"	# ^y = starting y location
+.\"	# ^b = 1
 .de BS
 .br
 .mk ^y
@@ -109,7 +115,7 @@
 .if n \l'\\n(.lu\(ul'
 .if n .fi
 ..
-'\"	# BE - end boxed text (draw box now)
+.\"	# BE - end boxed text (draw box now)
 .de BE
 .nf
 .ti 0
@@ -129,16 +135,16 @@
 .br
 .nr ^b 0
 ..
-'\"	# VS - start vertical sidebar
-'\"	# ^Y = starting y location
-'\"	# ^v = 1 (for troff;  for nroff this doesn't matter)
+.\"	# VS - start vertical sidebar
+.\"	# ^Y = starting y location
+.\"	# ^v = 1 (for troff;  for nroff this doesn't matter)
 .de VS
 .if !"\\$2"" .br
 .mk ^Y
 .ie n 'mc \s12\(br\s0
 .el .nr ^v 1u
 ..
-'\"	# VE - end of vertical sidebar
+.\"	# VE - end of vertical sidebar
 .de VE
 .ie n 'mc
 .el \{\
@@ -153,9 +159,9 @@
 .\}
 .nr ^v 0
 ..
-'\"	# Special macro to handle page bottom:  finish off current
-'\"	# box/sidebar if in box/sidebar mode, then invoked standard
-'\"	# page bottom macro.
+.\"	# Special macro to handle page bottom:  finish off current
+.\"	# box/sidebar if in box/sidebar mode, then invoked standard
+.\"	# page bottom macro.
 .de ^B
 .ev 2
 'ti 0
@@ -182,34 +188,36 @@
 .mk ^Y
 .\}
 ..
-'\"	# DS - begin display
+.\"	# DS - begin display
 .de DS
 .RS
 .nf
 .sp
 ..
-'\"	# DE - end display
+.\"	# DE - end display
 .de DE
 .fi
 .RE
 .sp
 ..
-'\"	# SO - start of list of standard options
+.\"	# SO - start of list of standard options
 .de SO
+'ie '\\$1'' .ds So \\fBoptions\\fR
+'el .ds So \\fB\\$1\\fR
 .SH "STANDARD OPTIONS"
 .LP
 .nf
-.ta 4c 8c 12c
+.ta 5.5c 11c
 .ft B
 ..
-'\"	# SE - end of list of standard options
+.\"	# SE - end of list of standard options
 .de SE
 .fi
 .ft R
 .LP
-See the \\fBoptions\\fR manual entry for details on the standard options.
+See the \\*(So manual entry for details on the standard options.
 ..
-'\"	# OP - start of full description for a single option
+.\"	# OP - start of full description for a single option
 .de OP
 .LP
 .nf
@@ -220,17 +228,40 @@ Database Class:	\\fB\\$3\\fR
 .fi
 .IP
 ..
-'\"	# CS - begin code excerpt
+.\"	# CS - begin code excerpt
 .de CS
 .RS
 .nf
 .ta .25i .5i .75i 1i
 ..
-'\"	# CE - end code excerpt
+.\"	# CE - end code excerpt
 .de CE
 .fi
 .RE
 ..
+.\"	# UL - underline word
 .de UL
 \\$1\l'|0\(ul'\\$2
 ..
+.\"	# QW - apply quotation marks to word
+.de QW
+.ie '\\*(lq'"' ``\\$1''\\$2
+.\"" fix emacs highlighting
+.el \\*(lq\\$1\\*(rq\\$2
+..
+.\"	# PQ - apply parens and quotation marks to word
+.de PQ
+.ie '\\*(lq'"' (``\\$1''\\$2)\\$3
+.\"" fix emacs highlighting
+.el (\\*(lq\\$1\\*(rq\\$2)\\$3
+..
+.\"	# QR - quoted range
+.de QR
+.ie '\\*(lq'"' ``\\$1''\\-``\\$2''\\$3
+.\"" fix emacs highlighting
+.el \\*(lq\\$1\\*(rq\\-\\*(lq\\$2\\*(rq\\$3
+..
+.\"	# MT - "empty" string
+.de MT
+.QW ""
+..

doc/usual.n

@@ -4,8 +4,6 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-'\" RCS: $Id: usual.n,v 1.2 2004/09/01 04:23:10 davygrvy Exp $
-'\"
 .so man.macros
 .TH usual n 3.0 itk "[incr\ Tk]"
 .BS

examples/Info.itk

@@ -13,42 +13,42 @@ class Info {
     inherit itk::Toplevel
 
     constructor {args} {
-        itk_component add dismiss {
-            button $itk_interior.dismiss -text "Dismiss" \
-                -command "destroy $itk_component(hull)"
-        }
-        pack $itk_component(dismiss) -side bottom -pady 4
+	itk_component add dismiss {
+	    button $itk_interior.dismiss -text "Dismiss" \
+		-command "destroy $itk_component(hull)"
+	}
+	pack $itk_component(dismiss) -side bottom -pady 4
 
-        itk_component add separator {
-            frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken
-        }
-        pack $itk_component(separator) -side bottom -fill x -padx 4
+	itk_component add separator {
+	    frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken
+	}
+	pack $itk_component(separator) -side bottom -fill x -padx 4
 
-        itk_component add icon {
-            label $itk_interior.icon -bitmap info
-        }
-        pack $itk_component(icon) -side left -padx 8 -pady 8
+	itk_component add icon {
+	    label $itk_interior.icon -bitmap info
+	}
+	pack $itk_component(icon) -side left -padx 8 -pady 8
 
-        itk_component add infoFrame {
-            frame $itk_interior.info
-        }
-        pack $itk_component(infoFrame) -side left -expand yes \
-            -fill both -padx 4 -pady 4
+	itk_component add infoFrame {
+	    frame $itk_interior.info
+	}
+	pack $itk_component(infoFrame) -side left -expand yes \
+	    -fill both -padx 4 -pady 4
 
-        set itk_interior $itk_component(infoFrame)
+	set itk_interior $itk_component(infoFrame)
 
-        eval itk_initialize $args
+	eval itk_initialize $args
 
-        after idle [code $this centerOnScreen]
+	after idle [code $this centerOnScreen]
     }
 
     protected method centerOnScreen {} {
-        update idletasks
-        set wd [winfo reqwidth $itk_component(hull)]
-        set ht [winfo reqheight $itk_component(hull)]
-        set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2]
-        set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2]
-        wm geometry $itk_component(hull) +$x+$y
+	update idletasks
+	set wd [winfo reqwidth $itk_component(hull)]
+	set ht [winfo reqheight $itk_component(hull)]
+	set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2]
+	set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2]
+	wm geometry $itk_component(hull) +$x+$y
     }
 }
 

examples/MessageInfo.itk

@@ -13,23 +13,23 @@ class MessageInfo {
     inherit Info
 
     constructor {args} {
-        itk_component add message {
-            label $itk_interior.mesg -width 20
-        } {
-            usual
-            rename -text -message message Text
-        }
-        pack $itk_component(message) -expand yes -fill both
-        bind $itk_component(message) <Configure> [code $this resize]
+	itk_component add message {
+	    label $itk_interior.mesg -width 20
+	} {
+	    usual
+	    rename -text -message message Text
+	}
+	pack $itk_component(message) -expand yes -fill both
+	bind $itk_component(message) <Configure> [code $this resize]
 
-        eval itk_initialize $args
+	eval itk_initialize $args
     }
 
     private method resize {} {
-        set w [winfo width $itk_component(message)]
-        if {$w > 1} {
-            $itk_component(message) configure -wraplength $w
-        }
+	set w [winfo width $itk_component(message)]
+	if {$w > 1} {
+	    $itk_component(message) configure -wraplength $w
+	}
     }
 }
 

examples/TextDisplay.itk

@@ -18,36 +18,36 @@ class TextDisplay {
     inherit itk::Widget
 
     constructor {args} {
-        itk_option add hull.width hull.height
+	itk_option add hull.width hull.height
 
-        itk_component add text {
-            text $itk_interior.info -state disabled -width 1 -height 1 \
-                -yscrollcommand [code $itk_interior.sbar set]
-        } {
-            usual
-            keep -wrap -tabs
-            rename -background -textbackground textBackground Background
-        }
-        pack $itk_component(text) -side left -expand yes -fill both
+	itk_component add text {
+	    text $itk_interior.info -state disabled -width 1 -height 1 \
+		-yscrollcommand [code $itk_interior.sbar set]
+	} {
+	    usual
+	    keep -wrap -tabs
+	    rename -background -textbackground textBackground Background
+	}
+	pack $itk_component(text) -side left -expand yes -fill both
 
-        itk_component add scrollbar {
-            scrollbar $itk_interior.sbar \
-                -command [code $itk_interior.info yview]
-        }
-        pack $itk_component(scrollbar) -side right -fill y
+	itk_component add scrollbar {
+	    scrollbar $itk_interior.sbar \
+		-command [code $itk_interior.info yview]
+	}
+	pack $itk_component(scrollbar) -side right -fill y
 
-        eval itk_initialize $args
+	eval itk_initialize $args
 
-        pack propagate $itk_component(hull) 0
+	pack propagate $itk_component(hull) 0
 
-        fixScrollbar
-        bind $itk_component(text) <Configure> [code $this fixScrollbar]
+	fixScrollbar
+	bind $itk_component(text) <Configure> [code $this fixScrollbar]
 
-        $itk_component(text) tag configure bold \
-            -font -*-courier-bold-r-normal--*-120-*
+	$itk_component(text) tag configure bold \
+	    -font -*-courier-bold-r-normal--*-120-*
 
-        $itk_component(text) tag configure italic \
-            -font -*-courier-medium-o-normal--*-120-*
+	$itk_component(text) tag configure italic \
+	    -font -*-courier-medium-o-normal--*-120-*
     }
 
     public method display {info}
@@ -55,14 +55,14 @@ class TextDisplay {
     public method substitute {word newword}
 
     itk_option define -scrollbar scrollbar Scrollbar "on" {
-        switch -- $itk_option(-scrollbar) {
-            on - off - auto {
-                fixScrollbar
-            }
-            default {
-                error "bad value \"$itk_option(-scollbar)\""
-            }
-        }
+	switch -- $itk_option(-scrollbar) {
+	    on - off - auto {
+		fixScrollbar
+	    }
+	    default {
+		error "bad value \"$itk_option(-scollbar)\""
+	    }
+	}
     }
 
     protected method fixScrollbar {}
@@ -89,13 +89,13 @@ body TextDisplay::substitute {word newword} {
 
     set index 1.0
     while {1} {
-        set index [$itk_component(text) search -count len $word $index]
-        if {$index != ""} {
-            $itk_component(text) delete $index "$index + $len chars"
-            $itk_component(text) insert $index $newword
-        } else {
-            break
-        }
+	set index [$itk_component(text) search -count len $word $index]
+	if {$index != ""} {
+	    $itk_component(text) delete $index "$index + $len chars"
+	    $itk_component(text) insert $index $newword
+	} else {
+	    break
+	}
     }
     $itk_component(text) configure -state disabled
     fixScrollbar
@@ -103,25 +103,25 @@ body TextDisplay::substitute {word newword} {
 
 body TextDisplay::fixScrollbar {} {
     switch $itk_option(-scrollbar) {
-        on  { set sbstate 1 }
-        off { set sbstate 0 }
+	on  { set sbstate 1 }
+	off { set sbstate 0 }
 
-        auto {
-            if {[$itk_component(text) bbox 1.0] == "" ||
-                [$itk_component(text) bbox end-1char] == ""} {
-                set sbstate 1
-            } else {
-                set sbstate 0
-            }
-        }
+	auto {
+	    if {[$itk_component(text) bbox 1.0] == "" ||
+		[$itk_component(text) bbox end-1char] == ""} {
+		set sbstate 1
+	    } else {
+		set sbstate 0
+	    }
+	}
     }
     if {$sbstate != $sbvisible} {
-        if {$sbstate} {
-            pack $itk_component(scrollbar) -side right -fill y
-        } else {
-            pack forget $itk_component(scrollbar)
-        }
-        set sbvisible $sbstate
+	if {$sbstate} {
+	    pack $itk_component(scrollbar) -side right -fill y
+	} else {
+	    pack forget $itk_component(scrollbar)
+	}
+	set sbvisible $sbstate
     }
 }
 

examples/TextInfo.itk

@@ -13,24 +13,24 @@ class TextInfo {
     inherit Info
 
     constructor {args} {
-        itk_component add textArea {
-            TextDisplay $itk_interior.txt -scrollbar auto
-        } {
-            usual
-            keep -wrap -tabs
-            rename -font -textfont textFont Font
-        }
-        pack $itk_component(textArea) -expand yes -fill both
+	itk_component add textArea {
+	    TextDisplay $itk_interior.txt -scrollbar auto
+	} {
+	    usual
+	    keep -wrap -tabs
+	    rename -font -textfont textFont Font
+	}
+	pack $itk_component(textArea) -expand yes -fill both
 
-        eval itk_initialize $args
+	eval itk_initialize $args
     }
 
     public method display {args} {
-        eval $itk_component(textArea) display $args
+	eval $itk_component(textArea) display $args
     }
 
     public method append {args} {
-        eval $itk_component(textArea) append $args
+	eval $itk_component(textArea) append $args
     }
 }
 

examples/viewfile

@@ -31,14 +31,14 @@ bind .file <KeyPress-Return> {show_file [.file get]}
 
 proc show_file {file} {
     set cmd {
-        set fid [open $file r]
-        set info [read $fid]
-        close $fid
+	set fid [open $file r]
+	set info [read $fid]
+	close $fid
     }
     if {[catch $cmd] == 0} {
-        set win [TextInfo .#auto -wrap none]
-        $win display $info
+	set win [TextInfo .#auto -wrap none]
+	$win display $info
     } else {
-        MessageInfo .#auto -message "Cannot read file:\n$file"
+	MessageInfo .#auto -message "Cannot read file:\n$file"
     }
 }

generic/itk.decls

@@ -1,16 +1,20 @@
+# -*- tcl -*-
+
 # itk.decls --
 #
 #	This file contains the declarations for all supported public
 #	functions that are exported by the Itk library via the stubs table.
 #	This file is used to generate the itkDecls.h file.
-#	
+#
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-# 
-# RCS: $Id: itk.decls,v 1.5 2002/03/03 01:57:11 andreas_kupries Exp $
 
+# public API
 library itk
 interface itk
+hooks {itkInt}
+epoch 0
+scspec ITKAPI
 
 # Declare each of the functions in the public Itk interface.  Note that
 # the an index should never be reused for a different function in order
@@ -21,64 +25,11 @@ interface itk
 #  Exported functions:
 #
 
-declare 0 generic {
-    int Itk_Init (Tcl_Interp *interp)
+declare 0 {
+    int Itk_Init(Tcl_Interp *interp)
 }
-declare 1 generic {
-    int Itk_SafeInit (Tcl_Interp *interp)
-}
-
-
-#
-#  Functions used internally by this package:
-#
-
-declare 2 generic {
-    int Itk_ConfigBodyCmd (ClientData cdata, Tcl_Interp *interp, \
-        int objc, Tcl_Obj *CONST objv[])
-}
-declare 3 generic {
-    int Itk_UsualCmd (ClientData cdata, Tcl_Interp *interp, int objc, \
-        Tcl_Obj *CONST objv[])
-}
-
-
-#
-#  Functions for managing options included in class definitions:
-#
-
-declare 4 generic {
-    int Itk_ClassOptionDefineCmd (ClientData cdata, Tcl_Interp *interp, \
-        int objc, Tcl_Obj *CONST objv[])
-}
-declare 5 generic {
-    int Itk_ClassOptionIllegalCmd (ClientData cdata, Tcl_Interp *interp, \
-        int objc, Tcl_Obj *CONST objv[])
-}
-declare 6 generic {
-    int Itk_ConfigClassOption (Tcl_Interp *interp, ItclObject *contextObj, \
-        ClientData cdata, CONST char* newVal)
-}
-declare 7 generic {
-    ItkClassOptTable* Itk_CreateClassOptTable( Tcl_Interp *interp, \
-        ItclClass *cdefn)
-}
-declare 8 generic {
-    ItkClassOptTable* Itk_FindClassOptTable (ItclClass *cdefn)
-}
-#declare 9 generic {
-#    void Itk_DeleteClassOptTable (Tcl_Interp *interp, ItclClass *cdefn)
-#}
-declare 10 generic {
-    int Itk_CreateClassOption (Tcl_Interp *interp, ItclClass *cdefn, \
-        char *switchName, char *resName, char *resClass, char *defVal, \
-        char *config, ItkClassOption **optPtr)
-}
-declare 11 generic {
-    ItkClassOption* Itk_FindClassOption (ItclClass *cdefn, char *switchName)
-}
-declare 12 generic {
-    void Itk_DelClassOption (ItkClassOption *opt)
+declare 1 {
+    int Itk_SafeInit(Tcl_Interp *interp)
 }
 
 
@@ -86,24 +37,85 @@ declare 12 generic {
 #  Functions needed for the Archetype base class:
 #
 
-declare 13 generic {
-    int Itk_ArchetypeInit (Tcl_Interp* interp)
+declare 13 {
+    int Itk_ArchetypeInit(Tcl_Interp *interp)
 }
 
 
+
+# private API
+interface itkInt
+
+#
+# Functions used within the package, but not considered "public"
+#
+
+#
+#  Functions used internally by this package:
+#
+
+declare 2 {
+    int Itk_ConfigBodyCmd(void *cdata, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const objv[])
+}
+declare 3 {
+    int Itk_UsualCmd(void *cdata, Tcl_Interp *interp, int objc,
+	Tcl_Obj *const objv[])
+}
+
+#
+#  Functions for managing options included in class definitions:
+#
+
+declare 4 {
+    int Itk_ClassOptionDefineCmd(void *cdata, Tcl_Interp *interp,
+	int objc, Tcl_Obj *const objv[])
+}
+declare 5 {
+    int Itk_ClassOptionIllegalCmd(void *cdata, Tcl_Interp *interp, \
+	int objc, Tcl_Obj *const objv[])
+}
+declare 6 {
+    int Itk_ConfigClassOption(Tcl_Interp *interp, ItclObject *contextObj, \
+	void *cdata, const char *newVal)
+}
+declare 7 {
+    ItkClassOptTable* Itk_CreateClassOptTable(Tcl_Interp *interp, \
+	ItclClass *cdefn)
+}
+declare 8 {
+    ItkClassOptTable* Itk_FindClassOptTable(ItclClass *cdefn)
+}
+#declare 9 {
+#    void Itk_DeleteClassOptTable(Tcl_Interp *interp, ItclClass *cdefn)
+#}
+declare 10 {
+    int Itk_CreateClassOption(Tcl_Interp *interp, ItclClass *cdefn,
+	const char *switchName, const char *resName, const char *resClass, const char *defVal,
+	const char *config, ItkClassOption **optPtr)
+}
+declare 11 {
+    ItkClassOption* Itk_FindClassOption(ItclClass *cdefn, const char *switchName)
+}
+declare 12 {
+    void Itk_DelClassOption(ItkClassOption *opt)
+}
+
 #
 #  Functions for maintaining the ordered option list:
 #
 
-declare 14 generic {
-    void Itk_OptListInit (ItkOptList* olist, Tcl_HashTable *options)
+declare 14 {
+    void Itk_OptListInit(ItkOptList *olist, Tcl_HashTable *options)
 }
-declare 15 generic {
-    void Itk_OptListFree (ItkOptList* olist)
+declare 15 {
+    void Itk_OptListFree(ItkOptList *olist)
 }
-declare 16 generic {
-    void Itk_OptListAdd (ItkOptList* olist, Tcl_HashEntry *entry)
+declare 16 {
+    void Itk_OptListAdd(ItkOptList *olist, Tcl_HashEntry *entry)
 }
-declare 17 generic {
-    void Itk_OptListRemove (ItkOptList* olist, Tcl_HashEntry *entry)
+declare 17 {
+    void Itk_OptListRemove(ItkOptList *olist, Tcl_HashEntry *entry)
 }
+
+

generic/itk.h

@@ -37,8 +37,6 @@
  *           Bell Labs Innovations for Lucent Technologies
  *           mmclennan@lucent.com
  *           http://www.tcltk.com/itcl
- *
- *     RCS:  $Id: itk.h,v 1.18 2007/05/24 22:15:41 hobbs Exp $
  * ========================================================================
  *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
  * ------------------------------------------------------------------------
@@ -48,24 +46,21 @@
 #ifndef ITK_H
 #define ITK_H
 
-#ifndef TCL_ALPHA_RELEASE
-#   define TCL_ALPHA_RELEASE	0
-#endif
-#ifndef TCL_BETA_RELEASE
-#   define TCL_BETA_RELEASE	1
-#endif
-#ifndef TCL_FINAL_RELEASE
-#   define TCL_FINAL_RELEASE	2
+#if defined(BUILD_itk)
+#       define ITKAPI DLLEXPORT
+#       undef USE_ITK_STUBS
+#       undef USE_ITCL_STUBS
+#else
+#       define ITKAPI DLLIMPORT
 #endif
 
-
-#define ITK_MAJOR_VERSION	3
-#define ITK_MINOR_VERSION	4
+#define ITK_MAJOR_VERSION	4
+#define ITK_MINOR_VERSION	2
 #define ITK_RELEASE_LEVEL	TCL_FINAL_RELEASE
-#define ITK_RELEASE_SERIAL	0
+#define ITK_RELEASE_SERIAL	7
 
-#define ITK_VERSION		"3.4"
-#define ITK_PATCH_LEVEL		"3.4.0"
+#define ITK_VERSION		"4.2"
+#define ITK_PATCH_LEVEL		"4.2.7"
 
 
 /*
@@ -77,8 +72,7 @@
 
 #ifndef RC_INVOKED
 
-#include "tk.h"
-#include "itclInt.h"
+#include <tk.h>
 
 #undef TCL_STORAGE_CLASS
 #ifdef BUILD_itk
@@ -91,49 +85,21 @@
 #   endif
 #endif
 
-/*
- *  List of options in alphabetical order:
- */
-typedef struct ItkOptList {
-    Tcl_HashTable *options;     /* list containing the real options */
-    Tcl_HashEntry **list;       /* gives ordering of options */
-    int len;                    /* number of entries in order list */
-    int max;                    /* maximum size of order list */
-} ItkOptList;
-
-/*
- *  List of options created in the class definition:
- */
-typedef struct ItkClassOptTable {
-    Tcl_HashTable options;        /* option storage with fast lookup */
-    ItkOptList order;             /* gives ordering of options */
-} ItkClassOptTable;
-
-/*
- *  Each option created in the class definition:
- */
-typedef struct ItkClassOption {
-    ItclMember *member;           /* info about this option */
-    char *resName;                /* resource name in X11 database */
-    char *resClass;               /* resource class name in X11 database */
-    char *init;                   /* initial value for option */
-} ItkClassOption;
-
-#include "itkDecls.h"
-
 /*
  *  This function is contained in the itkstub static library
  */
 
 #ifdef USE_ITK_STUBS
-TCL_EXTERNC CONST char *
-	Itk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
-			    CONST char *version, int exact));
+EXTERN const char *
+	Itk_InitStubs(Tcl_Interp *interp,
+			    const char *version, int exact);
 #else
 #define Itk_InitStubs(interp, version, exact) \
       Tcl_PkgRequire(interp, "Itk", version, exact)
 #endif
 
+#include "itkDecls.h"
+
 /*
  * Public functions that are not accessible via the stubs table.
  */

generic/itkBase.c

@@ -0,0 +1,329 @@
+/*
+ * ------------------------------------------------------------------------
+ *      PACKAGE:  [incr Tk]
+ *  DESCRIPTION:  Building mega-widgets with [incr Tcl]
+ *
+ *  [incr Tk] provides a framework for building composite "mega-widgets"
+ *  using [incr Tcl] classes.  It defines a set of base classes that are
+ *  specialized to create all other widgets.
+ *
+ *  This file defines the initialization and facilities common to all
+ *  mega-widgets.
+ *
+ * ========================================================================
+ *  AUTHOR:  Michael J. McLennan
+ *           Bell Labs Innovations for Lucent Technologies
+ *           mmclennan@lucent.com
+ *           http://www.tcltk.com/itcl
+ * ========================================================================
+ *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itkInt.h"
+#include "itkUuid.h"
+
+MODULE_SCOPE const ItkStubs itkStubs;
+/*
+ * The following script is used to initialize Itcl in a safe interpreter.
+ */
+
+static char safeInitScript[] =
+"proc ::itcl::local {class name args} {\n\
+    set ptr [uplevel [list $class $name] $args]\n\
+    uplevel [list set itcl-local-$ptr $ptr]\n\
+    set cmd [uplevel namespace which -command $ptr]\n\
+    uplevel [list trace variable itcl-local-$ptr u \"::itcl::delete object $cmd; list\"]\n\
+    return $ptr\n\
+}";
+
+/*
+ *  FORWARD DECLARATIONS
+ */
+static int Initialize (Tcl_Interp *interp);
+/*
+ * The following string is the startup script executed in new
+ * interpreters.  It looks on disk in several different directories
+ * for a script "init.tcl" that is compatible with this version
+ * of Tcl.  The init.tcl script does all of the real work of
+ * initialization.
+ */
+
+static char initScript[] = "\n\
+namespace eval ::itk {\n\
+    proc _find_init {} {\n\
+	global env tcl_library\n\
+	variable library\n\
+	variable patchLevel\n\
+	rename _find_init {}\n\
+	if {[info exists library]} {\n\
+	    lappend dirs $library\n\
+	} else {\n\
+	    set dirs {}\n\
+	    if {[info exists env(ITK_LIBRARY)]} {\n\
+		lappend dirs $env(ITK_LIBRARY)\n\
+	    }\n\
+	    lappend dirs [file join [file dirname $tcl_library] itk$patchLevel]\n\
+	    set bindir [file dirname [info nameofexecutable]]\n\
+	    lappend dirs [file join $bindir .. lib itk$patchLevel]\n\
+	    lappend dirs [file join $bindir .. library]\n\
+	    lappend dirs [file join $bindir .. .. library]\n\
+	    lappend dirs [file join $bindir .. .. itk library]\n\
+	    # On MacOSX, check the directories in the tcl_pkgPath\n\
+	    if {[string equal $::tcl_platform(platform) \"unix\"] && \
+		    [string equal $::tcl_platform(os) \"Darwin\"]} {\n\
+		foreach d $::tcl_pkgPath {\n\
+		    lappend dirs [file join $d itk$patchLevel]\n\
+		}\n\
+	    }\n\
+	}\n\
+	foreach i $dirs {\n\
+	    set library $i\n\
+	    set itkfile [file join $i itk.tcl]\n\
+	    if {![catch {uplevel #0 [list source $itkfile]} msg]} {\n\
+		return\n\
+	    }\n\
+	}\n\
+	set msg \"Can't find a usable itk.tcl in the following directories:\n\"\n\
+	append msg \"    $dirs\n\"\n\
+	append msg \"This probably means that Itcl/Itk weren't installed properly.\n\"\n\
+	append msg \"If you know where the Itk library directory was installed,\n\"\n\
+	append msg \"you can set the environment variable ITK_LIBRARY to point\n\"\n\
+	append msg \"to the library directory.\n\"\n\
+	error $msg\n\
+    }\n\
+    _find_init\n\
+}";
+
+/*
+ * ------------------------------------------------------------------------
+ *  Initialize()
+ *
+ *  Invoked whenever a new interpeter is created to install the
+ *  [incr Tk] package.
+ *
+ *  Creates the "::itk" namespace and installs access commands.
+ *
+ *  Returns TCL_OK on success, or TCL_ERROR (along with an error
+ *  message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+
+#ifndef STRINGIFY
+#  define STRINGIFY(x) STRINGIFY1(x)
+#  define STRINGIFY1(x) #x
+#endif
+
+static int
+Initialize(
+    Tcl_Interp *interp)  /* interpreter to be updated */
+{
+    Tcl_Namespace *itkNs, *parserNs;
+    void *parserInfo;
+    Tcl_CmdInfo info;
+
+    if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) {
+      return TCL_ERROR;
+    }
+    if (Tk_InitStubs(interp, "8.6-", 0) == NULL) {
+	return TCL_ERROR;
+    };
+    if (Itcl_InitStubs(interp, "4.1", 0) == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     *  Add the "itk_option" ensemble to the itcl class definition parser.
+     */
+    parserNs = Tcl_FindNamespace(interp, "::itcl::parser",
+	(Tcl_Namespace*)NULL, /* flags */ 0);
+
+    if (!parserNs) {
+	Tcl_AppendResult(interp,
+	    "cannot initialize [incr Tk]: [incr Tcl] has not been installed\n",
+	    "Make sure that Itcl_Init() is called before Itk_Init()",
+	    (char*)NULL);
+	return TCL_ERROR;
+    }
+    parserInfo = parserNs->clientData;
+
+    if (Itcl_CreateEnsemble(interp, "::itcl::parser::itk_option") != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
+	    "define", "-switch resourceName resourceClass init ?config?",
+	    Itk_ClassOptionDefineCmd,
+	    parserInfo, Itcl_ReleaseData) != TCL_OK) {
+
+	return TCL_ERROR;
+    }
+    Itcl_PreserveData(parserInfo);
+
+    if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
+	    "add", "name ?name name...?",
+	    Itk_ClassOptionIllegalCmd,
+	    (void *)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+	Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
+	    "remove", "name ?name name...?",
+	    Itk_ClassOptionIllegalCmd,
+	    (void *)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
+
+	return TCL_ERROR;
+    }
+
+    /*
+     *  Install [incr Tk] facilities if not already installed.
+     */
+    itkNs = Tcl_FindNamespace(interp, "::itk", (Tcl_Namespace*)NULL,
+	/* flags */ 0);
+
+    if (itkNs == NULL) {
+	/*
+	 *  Create the "itk" namespace.  Export all the commands in
+	 *  the namespace so that they can be imported by a command
+	 *  such as "namespace import itk::*"
+	 */
+	itkNs = Tcl_CreateNamespace(interp, "::itk",
+	    (void *)NULL, (Tcl_NamespaceDeleteProc*)NULL);
+    }
+
+    if (!itkNs ||
+	Tcl_Export(interp, itkNs, "*", /* resetListFirst */ 1) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     *  Setup things for itk::Archetype base class.
+     */
+    if (Itk_ArchetypeInit(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /*
+     *  Fix the "itcl::configbody" command to recognize mega-widget
+     *  options.
+     */
+    Tcl_CreateObjCommand(interp, "::itcl::configbody", Itk_ConfigBodyCmd,
+	(void *)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+    Tcl_SetVar(interp, "::itk::version", ITK_VERSION, TCL_NAMESPACE_ONLY);
+    Tcl_SetVar(interp, "::itk::patchLevel", ITK_PATCH_LEVEL,
+	    TCL_NAMESPACE_ONLY);
+
+    /*
+     *  Signal that the package has been loaded and provide the Itk Stubs table
+     *  for dependent modules.  I know this is unlikely, but possible that
+     *  someone could be extending Itk.  Who is to say that Itk is the
+     *  end-of-the-line?
+     */
+
+    if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
+	Tcl_CreateObjCommand(interp, "::itk::build-info",
+		info.objProc, (void *)(PACKAGE_VERSION "+" STRINGIFY(ITK_VERSION_UUID)
+#if defined(__clang__) && defined(__clang_major__)
+	    ".clang-" STRINGIFY(__clang_major__)
+#if __clang_minor__ < 10
+	    "0"
+#endif
+	    STRINGIFY(__clang_minor__)
+#endif
+#if defined(__cplusplus) && !defined(__OBJC__)
+	    ".cplusplus"
+#endif
+#ifndef NDEBUG
+	    ".debug"
+#endif
+#if !defined(__clang__) && !defined(__INTEL_COMPILER) && defined(__GNUC__)
+	    ".gcc-" STRINGIFY(__GNUC__)
+#if __GNUC_MINOR__ < 10
+	    "0"
+#endif
+	    STRINGIFY(__GNUC_MINOR__)
+#endif
+#ifdef __INTEL_COMPILER
+	    ".icc-" STRINGIFY(__INTEL_COMPILER)
+#endif
+#ifdef TCL_MEM_DEBUG
+	    ".memdebug"
+#endif
+#if defined(_MSC_VER)
+	    ".msvc-" STRINGIFY(_MSC_VER)
+#endif
+#ifdef USE_NMAKE
+	    ".nmake"
+#endif
+#ifndef TCL_CFG_OPTIMIZED
+	    ".no-optimize"
+#endif
+#ifdef __OBJC__
+	    ".objective-c"
+#if defined(__cplusplus)
+	    "plusplus"
+#endif
+#endif
+#ifdef TCL_CFG_PROFILED
+	    ".profile"
+#endif
+#ifdef PURIFY
+	    ".purify"
+#endif
+#ifdef STATIC_BUILD
+	    ".static"
+#endif
+		), NULL);
+    }
+    Tcl_PkgProvideEx(interp, "Itk", ITK_PATCH_LEVEL, (void *) &itkStubs);
+    return Tcl_PkgProvideEx(interp, "itk", ITK_PATCH_LEVEL,
+	    (void *) &itkStubs);
+}
+
+/*
+ * ------------------------------------------------------------------------
+ *  Itk_Init()
+ *
+ *  Invoked whenever a new interpreter is created to install the
+ *  [incr Tcl] package.  Usually invoked within Tcl_AppInit() at
+ *  the start of execution.
+ *
+ *  Creates the "::itk" namespace and installs access commands.
+ *
+ *  Returns TCL_OK on success, or TCL_ERROR (along with an error
+ *  message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itk_Init(
+    Tcl_Interp *interp)  /* interpreter to be updated */
+{
+    if (Initialize(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    return Tcl_EvalEx(interp, initScript, -1, 0);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ *  Itk_SafeInit()
+ *
+ *  Invoked whenever a new SAFE INTERPRETER is created to install
+ *  the [incr Tcl] package.
+ *
+ *  Creates the "::itk" namespace and installs access commands for
+ *  creating classes and querying info.
+ *
+ *  Returns TCL_OK on success, or TCL_ERROR (along with an error
+ *  message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itk_SafeInit(
+    Tcl_Interp *interp)  /* interpreter to be updated */
+{
+    if (Initialize(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    return Tcl_EvalEx(interp, safeInitScript, -1, 0);
+}

generic/itkCmd.c

@@ -0,0 +1,148 @@
+/*
+ * ------------------------------------------------------------------------
+ *      PACKAGE:  [incr Tk]
+ *  DESCRIPTION:  Building mega-widgets with [incr Tcl]
+ *
+ *  [incr Tk] provides a framework for building composite "mega-widgets"
+ *  using [incr Tcl] classes.  It defines a set of base classes that are
+ *  specialized to create all other widgets.
+ *
+ *  This file defines the initialization and facilities common to all
+ *  mega-widgets.
+ *
+ * ========================================================================
+ *  AUTHOR:  Michael J. McLennan
+ *           Bell Labs Innovations for Lucent Technologies
+ *           mmclennan@lucent.com
+ *           http://www.tcltk.com/itcl
+ * ========================================================================
+ *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itkInt.h"
+
+/*
+ * ------------------------------------------------------------------------
+ *  Itk_ConfigBodyCmd()
+ *
+ *  Replacement for the usual "itcl::configbody" command.  Recognizes
+ *  mega-widget options included in a class definition.  Options are
+ *  identified by their "switch" name, but without the "-" prefix:
+ *
+ *    itcl::configbody <class>::<itkOption> <body>
+ *
+ *  Handles bodies for public variables as well:
+ *
+ *    itcl::configbody <class>::<publicVar> <body>
+ *
+ *  If an <itkOption> is found, it has priority over public variables.
+ *  If <body> has the form "@name" then it is treated as a reference
+ *  to a C handling procedure; otherwise, it is taken as a body of
+ *  Tcl statements.
+ *
+ *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+int
+Itk_ConfigBodyCmd(
+    void *dummy,             /* unused */
+    Tcl_Interp *interp,      /* current interpreter */
+    int objc,                /* number of arguments */
+    Tcl_Obj *const objv[])   /* argument objects */
+{
+    int result = TCL_OK;
+
+    char *token;
+    const char *head;
+    const char *tail;
+    ItclClass *iclsPtr;
+    ItclMemberCode *mcode;
+    ItkClassOptTable *optTable;
+    Tcl_HashEntry *entry;
+    ItkClassOption *opt;
+    Tcl_DString buffer;
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "class::option body");
+	return TCL_ERROR;
+    }
+
+    /*
+     *  Parse the member name "namesp::namesp::class::option".
+     *  Make sure that a class name was specified, and that the
+     *  class exists.
+     */
+    token = Tcl_GetString(objv[1]);
+    Itcl_ParseNamespPath(token, &buffer, &head, &tail);
+
+    if (!head || *head == '\0') {
+	Tcl_AppendResult(interp,
+		"missing class specifier for body declaration \"", token, "\"",
+		(char*)NULL);
+	result = TCL_ERROR;
+	goto configBodyCmdDone;
+    }
+
+    iclsPtr = Itcl_FindClass(interp, head, /* autoload */ 1);
+    if (iclsPtr == NULL) {
+	result = TCL_ERROR;
+	goto configBodyCmdDone;
+    }
+
+    /*
+     *  Look first for a configuration option with that name.
+     *  If it is not found, assume the reference is for a public
+     *  variable, and use the usual "configbody" implementation
+     *  to handle it.
+     */
+    optTable = Itk_FindClassOptTable(iclsPtr);
+    opt = NULL;
+
+    if (optTable) {
+	Tcl_DString optName;
+
+	Tcl_DStringInit(&optName);
+	Tcl_DStringAppend(&optName, "-", -1);
+	Tcl_DStringAppend(&optName, tail, -1);
+	entry = Tcl_FindHashEntry(&optTable->options,
+	    Tcl_DStringValue(&optName));
+
+	if (entry) {
+	    opt = (ItkClassOption*)Tcl_GetHashValue(entry);
+	}
+	Tcl_DStringFree(&optName);
+    }
+
+    if (opt == NULL) {
+	result = Itcl_ConfigBodyCmd(dummy, interp, objc, objv);
+	goto configBodyCmdDone;
+    }
+
+    /*
+     *  Otherwise, change the implementation for this option.
+     */
+    token = Tcl_GetString(objv[2]);
+
+    if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, token,
+	&mcode) != TCL_OK) {
+
+	result = TCL_ERROR;
+	goto configBodyCmdDone;
+    }
+
+    Itcl_PreserveData((void *)mcode);
+#ifdef NOTDEF
+    Itcl_EventuallyFree((void *)mcode, (Tcl_FreeProc *)Itcl_DeleteMemberCode);
+#endif
+
+    if (opt->codePtr) {
+	Itcl_ReleaseData((void *)opt->codePtr);
+    }
+    opt->codePtr = mcode;
+
+configBodyCmdDone:
+    Tcl_DStringFree(&buffer);
+    return result;
+}

generic/itkDecls.h

@@ -1,249 +1,91 @@
-/*
- * itkDecls.h --
- *
- *	Declarations of functions in the platform independent public Itk API.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: $Id: itkDecls.h,v 1.8 2003/12/23 05:22:45 davygrvy Exp $
- */
-
-#ifndef _ITKDECLS
-#define _ITKDECLS
-
-#ifdef BUILD_itk
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-#endif
-
-/*
- * WARNING: This file is automatically generated by the tools/genStubs.tcl
- * script.  Any modifications to the function declarations below should be made
- * in the generic/tk.decls script.
- */
 
 /* !BEGIN!: Do not edit below this line. */
 
+#define ITK_STUBS_EPOCH 0
+#define ITK_STUBS_REVISION 17
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
 /*
  * Exported function declarations:
  */
 
-#ifndef Itk_Init_TCL_DECLARED
-#define Itk_Init_TCL_DECLARED
 /* 0 */
-TCL_EXTERN(int)		Itk_Init _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Itk_SafeInit_TCL_DECLARED
-#define Itk_SafeInit_TCL_DECLARED
+ITKAPI int		Itk_Init(Tcl_Interp *interp);
 /* 1 */
-TCL_EXTERN(int)		Itk_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
-#endif
-#ifndef Itk_ConfigBodyCmd_TCL_DECLARED
-#define Itk_ConfigBodyCmd_TCL_DECLARED
-/* 2 */
-TCL_EXTERN(int)		Itk_ConfigBodyCmd _ANSI_ARGS_((ClientData cdata, 
-				Tcl_Interp * interp, int objc, 
-				Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Itk_UsualCmd_TCL_DECLARED
-#define Itk_UsualCmd_TCL_DECLARED
-/* 3 */
-TCL_EXTERN(int)		Itk_UsualCmd _ANSI_ARGS_((ClientData cdata, 
-				Tcl_Interp * interp, int objc, 
-				Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Itk_ClassOptionDefineCmd_TCL_DECLARED
-#define Itk_ClassOptionDefineCmd_TCL_DECLARED
-/* 4 */
-TCL_EXTERN(int)		Itk_ClassOptionDefineCmd _ANSI_ARGS_((
-				ClientData cdata, Tcl_Interp * interp, 
-				int objc, Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Itk_ClassOptionIllegalCmd_TCL_DECLARED
-#define Itk_ClassOptionIllegalCmd_TCL_DECLARED
-/* 5 */
-TCL_EXTERN(int)		Itk_ClassOptionIllegalCmd _ANSI_ARGS_((
-				ClientData cdata, Tcl_Interp * interp, 
-				int objc, Tcl_Obj *CONST objv[]));
-#endif
-#ifndef Itk_ConfigClassOption_TCL_DECLARED
-#define Itk_ConfigClassOption_TCL_DECLARED
-/* 6 */
-TCL_EXTERN(int)		Itk_ConfigClassOption _ANSI_ARGS_((
-				Tcl_Interp * interp, ItclObject * contextObj, 
-				ClientData cdata, CONST char* newVal));
-#endif
-#ifndef Itk_CreateClassOptTable_TCL_DECLARED
-#define Itk_CreateClassOptTable_TCL_DECLARED
-/* 7 */
-TCL_EXTERN(ItkClassOptTable*) Itk_CreateClassOptTable _ANSI_ARGS_((
-				Tcl_Interp * interp, ItclClass * cdefn));
-#endif
-#ifndef Itk_FindClassOptTable_TCL_DECLARED
-#define Itk_FindClassOptTable_TCL_DECLARED
-/* 8 */
-TCL_EXTERN(ItkClassOptTable*) Itk_FindClassOptTable _ANSI_ARGS_((
-				ItclClass * cdefn));
-#endif
+ITKAPI int		Itk_SafeInit(Tcl_Interp *interp);
+/* Slot 2 is reserved */
+/* Slot 3 is reserved */
+/* Slot 4 is reserved */
+/* Slot 5 is reserved */
+/* Slot 6 is reserved */
+/* Slot 7 is reserved */
+/* Slot 8 is reserved */
 /* Slot 9 is reserved */
-#ifndef Itk_CreateClassOption_TCL_DECLARED
-#define Itk_CreateClassOption_TCL_DECLARED
-/* 10 */
-TCL_EXTERN(int)		Itk_CreateClassOption _ANSI_ARGS_((
-				Tcl_Interp * interp, ItclClass * cdefn, 
-				char * switchName, char * resName, 
-				char * resClass, char * defVal, 
-				char * config, ItkClassOption ** optPtr));
-#endif
-#ifndef Itk_FindClassOption_TCL_DECLARED
-#define Itk_FindClassOption_TCL_DECLARED
-/* 11 */
-TCL_EXTERN(ItkClassOption*) Itk_FindClassOption _ANSI_ARGS_((
-				ItclClass * cdefn, char * switchName));
-#endif
-#ifndef Itk_DelClassOption_TCL_DECLARED
-#define Itk_DelClassOption_TCL_DECLARED
-/* 12 */
-TCL_EXTERN(void)	Itk_DelClassOption _ANSI_ARGS_((ItkClassOption * opt));
-#endif
-#ifndef Itk_ArchetypeInit_TCL_DECLARED
-#define Itk_ArchetypeInit_TCL_DECLARED
+/* Slot 10 is reserved */
+/* Slot 11 is reserved */
+/* Slot 12 is reserved */
 /* 13 */
-TCL_EXTERN(int)		Itk_ArchetypeInit _ANSI_ARGS_((Tcl_Interp* interp));
-#endif
-#ifndef Itk_OptListInit_TCL_DECLARED
-#define Itk_OptListInit_TCL_DECLARED
-/* 14 */
-TCL_EXTERN(void)	Itk_OptListInit _ANSI_ARGS_((ItkOptList* olist, 
-				Tcl_HashTable * options));
-#endif
-#ifndef Itk_OptListFree_TCL_DECLARED
-#define Itk_OptListFree_TCL_DECLARED
-/* 15 */
-TCL_EXTERN(void)	Itk_OptListFree _ANSI_ARGS_((ItkOptList* olist));
-#endif
-#ifndef Itk_OptListAdd_TCL_DECLARED
-#define Itk_OptListAdd_TCL_DECLARED
-/* 16 */
-TCL_EXTERN(void)	Itk_OptListAdd _ANSI_ARGS_((ItkOptList* olist, 
-				Tcl_HashEntry * entry));
-#endif
-#ifndef Itk_OptListRemove_TCL_DECLARED
-#define Itk_OptListRemove_TCL_DECLARED
-/* 17 */
-TCL_EXTERN(void)	Itk_OptListRemove _ANSI_ARGS_((ItkOptList* olist, 
-				Tcl_HashEntry * entry));
-#endif
+ITKAPI int		Itk_ArchetypeInit(Tcl_Interp *interp);
+
+typedef struct {
+    const struct ItkIntStubs *itkIntStubs;
+} ItkStubHooks;
 
 typedef struct ItkStubs {
     int magic;
-    struct ItkStubHooks *hooks;
+    int epoch;
+    int revision;
+    const ItkStubHooks *hooks;
 
-    int (*itk_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 0 */
-    int (*itk_SafeInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 1 */
-    int (*itk_ConfigBodyCmd) _ANSI_ARGS_((ClientData cdata, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 2 */
-    int (*itk_UsualCmd) _ANSI_ARGS_((ClientData cdata, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 3 */
-    int (*itk_ClassOptionDefineCmd) _ANSI_ARGS_((ClientData cdata, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 4 */
-    int (*itk_ClassOptionIllegalCmd) _ANSI_ARGS_((ClientData cdata, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 5 */
-    int (*itk_ConfigClassOption) _ANSI_ARGS_((Tcl_Interp * interp, ItclObject * contextObj, ClientData cdata, CONST char* newVal)); /* 6 */
-    ItkClassOptTable* (*itk_CreateClassOptTable) _ANSI_ARGS_((Tcl_Interp * interp, ItclClass * cdefn)); /* 7 */
-    ItkClassOptTable* (*itk_FindClassOptTable) _ANSI_ARGS_((ItclClass * cdefn)); /* 8 */
-    void *reserved9;
-    int (*itk_CreateClassOption) _ANSI_ARGS_((Tcl_Interp * interp, ItclClass * cdefn, char * switchName, char * resName, char * resClass, char * defVal, char * config, ItkClassOption ** optPtr)); /* 10 */
-    ItkClassOption* (*itk_FindClassOption) _ANSI_ARGS_((ItclClass * cdefn, char * switchName)); /* 11 */
-    void (*itk_DelClassOption) _ANSI_ARGS_((ItkClassOption * opt)); /* 12 */
-    int (*itk_ArchetypeInit) _ANSI_ARGS_((Tcl_Interp* interp)); /* 13 */
-    void (*itk_OptListInit) _ANSI_ARGS_((ItkOptList* olist, Tcl_HashTable * options)); /* 14 */
-    void (*itk_OptListFree) _ANSI_ARGS_((ItkOptList* olist)); /* 15 */
-    void (*itk_OptListAdd) _ANSI_ARGS_((ItkOptList* olist, Tcl_HashEntry * entry)); /* 16 */
-    void (*itk_OptListRemove) _ANSI_ARGS_((ItkOptList* olist, Tcl_HashEntry * entry)); /* 17 */
+    int (*itk_Init) (Tcl_Interp *interp); /* 0 */
+    int (*itk_SafeInit) (Tcl_Interp *interp); /* 1 */
+    void (*reserved2)(void);
+    void (*reserved3)(void);
+    void (*reserved4)(void);
+    void (*reserved5)(void);
+    void (*reserved6)(void);
+    void (*reserved7)(void);
+    void (*reserved8)(void);
+    void (*reserved9)(void);
+    void (*reserved10)(void);
+    void (*reserved11)(void);
+    void (*reserved12)(void);
+    int (*itk_ArchetypeInit) (Tcl_Interp *interp); /* 13 */
 } ItkStubs;
 
-TCL_EXTERNC ItkStubs *itkStubsPtr;
+extern const ItkStubs *itkStubsPtr;
 
-#if defined(USE_ITK_STUBS) && !defined(USE_ITK_STUB_PROCS)
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_ITK_STUBS)
 
 /*
  * Inline function declarations:
  */
 
-#ifndef Itk_Init
 #define Itk_Init \
 	(itkStubsPtr->itk_Init) /* 0 */
-#endif
-#ifndef Itk_SafeInit
 #define Itk_SafeInit \
 	(itkStubsPtr->itk_SafeInit) /* 1 */
-#endif
-#ifndef Itk_ConfigBodyCmd
-#define Itk_ConfigBodyCmd \
-	(itkStubsPtr->itk_ConfigBodyCmd) /* 2 */
-#endif
-#ifndef Itk_UsualCmd
-#define Itk_UsualCmd \
-	(itkStubsPtr->itk_UsualCmd) /* 3 */
-#endif
-#ifndef Itk_ClassOptionDefineCmd
-#define Itk_ClassOptionDefineCmd \
-	(itkStubsPtr->itk_ClassOptionDefineCmd) /* 4 */
-#endif
-#ifndef Itk_ClassOptionIllegalCmd
-#define Itk_ClassOptionIllegalCmd \
-	(itkStubsPtr->itk_ClassOptionIllegalCmd) /* 5 */
-#endif
-#ifndef Itk_ConfigClassOption
-#define Itk_ConfigClassOption \
-	(itkStubsPtr->itk_ConfigClassOption) /* 6 */
-#endif
-#ifndef Itk_CreateClassOptTable
-#define Itk_CreateClassOptTable \
-	(itkStubsPtr->itk_CreateClassOptTable) /* 7 */
-#endif
-#ifndef Itk_FindClassOptTable
-#define Itk_FindClassOptTable \
-	(itkStubsPtr->itk_FindClassOptTable) /* 8 */
-#endif
+/* Slot 2 is reserved */
+/* Slot 3 is reserved */
+/* Slot 4 is reserved */
+/* Slot 5 is reserved */
+/* Slot 6 is reserved */
+/* Slot 7 is reserved */
+/* Slot 8 is reserved */
 /* Slot 9 is reserved */
-#ifndef Itk_CreateClassOption
-#define Itk_CreateClassOption \
-	(itkStubsPtr->itk_CreateClassOption) /* 10 */
-#endif
-#ifndef Itk_FindClassOption
-#define Itk_FindClassOption \
-	(itkStubsPtr->itk_FindClassOption) /* 11 */
-#endif
-#ifndef Itk_DelClassOption
-#define Itk_DelClassOption \
-	(itkStubsPtr->itk_DelClassOption) /* 12 */
-#endif
-#ifndef Itk_ArchetypeInit
+/* Slot 10 is reserved */
+/* Slot 11 is reserved */
+/* Slot 12 is reserved */
 #define Itk_ArchetypeInit \
 	(itkStubsPtr->itk_ArchetypeInit) /* 13 */
-#endif
-#ifndef Itk_OptListInit
-#define Itk_OptListInit \
-	(itkStubsPtr->itk_OptListInit) /* 14 */
-#endif
-#ifndef Itk_OptListFree
-#define Itk_OptListFree \
-	(itkStubsPtr->itk_OptListFree) /* 15 */
-#endif
-#ifndef Itk_OptListAdd
-#define Itk_OptListAdd \
-	(itkStubsPtr->itk_OptListAdd) /* 16 */
-#endif
-#ifndef Itk_OptListRemove
-#define Itk_OptListRemove \
-	(itkStubsPtr->itk_OptListRemove) /* 17 */
-#endif
 
-#endif /* defined(USE_ITK_STUBS) && !defined(USE_ITK_STUB_PROCS) */
+#endif /* defined(USE_ITK_STUBS) */
 
 /* !END!: Do not edit above this line. */
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLIMPORT
-
-#endif /* _ITKDECLS */
-

generic/itkHelpers.c

@@ -0,0 +1,195 @@
+/*
+ * ------------------------------------------------------------------------
+ *      PACKAGE:  [incr Tk]
+ *  DESCRIPTION:  Building mega-widgets with [incr Tcl]
+ *
+ *  [incr Tk] provides a framework for building composite "mega-widgets"
+ *  using [incr Tcl] classes.  It defines a set of base classes that are
+ *  specialized to create all other widgets.
+ *
+ *  This part adds C implementations for some helxeper methods in the
+ *  base class itk::Archetype.
+ *
+ * ========================================================================
+ *  AUTHOR:  Michael J. McLennan
+ *           Bell Labs Innovations for Lucent Technologies
+ *           mmclennan@lucent.com
+ *           http://www.tcltk.com/itcl
+ * ========================================================================
+ *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include <assert.h>
+#include "itkInt.h"
+
+
+/*
+ * ------------------------------------------------------------------------
+ *  Itk_ArchOptConfigError()
+ *
+ *  Simply utility which adds error information after a option
+ *  configuration fails.  Adds traceback information to the given
+ *  interpreter.
+ * ------------------------------------------------------------------------
+ */
+void
+Itk_ArchOptConfigError(
+    Tcl_Interp *interp,            /* interpreter handling this object */
+    ArchInfo *info,                /* info associated with mega-widget */
+    ArchOption *archOpt)           /* configuration option that failed */
+{
+    Tcl_Obj *objPtr;
+
+    objPtr = Tcl_NewStringObj((char*)NULL, 0);
+    Tcl_IncrRefCount(objPtr);
+
+    Tcl_AppendToObj(objPtr, "\n    (while configuring option \"", -1);
+    Tcl_AppendToObj(objPtr, archOpt->switchName, -1);
+    Tcl_AppendToObj(objPtr, "\"", -1);
+
+    if (info->itclObj && info->itclObj->accessCmd) {
+	Tcl_AppendToObj(objPtr, " for widget \"", -1);
+	Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, objPtr);
+	Tcl_AppendToObj(objPtr, "\")", -1);
+    }
+    Tcl_AddErrorInfo(interp, Tcl_GetString(objPtr));
+    Tcl_DecrRefCount(objPtr);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ *  Itk_ArchOptAccessError()
+ *
+ *  Simply utility which adds error information after an option
+ *  value access fails.  Adds traceback information to the given
+ *  interpreter.
+ * ------------------------------------------------------------------------
+ */
+void
+Itk_ArchOptAccessError(
+    Tcl_Interp *interp,            /* interpreter handling this object */
+    ArchInfo *info,                /* info associated with mega-widget */
+    ArchOption *archOpt)           /* option that couldn't be accessed */
+{
+    Tcl_ResetResult(interp);
+
+    Tcl_AppendResult(interp,
+	"internal error: cannot access itk_option(", archOpt->switchName, ")",
+	(char*)NULL);
+
+    if (info->itclObj->accessCmd) {
+	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+	Tcl_AppendToObj(resultPtr, " in widget \"", -1);
+	Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, resultPtr);
+	Tcl_AppendToObj(resultPtr, "\"", -1);
+    }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ *  Itk_GetArchInfo()
+ *
+ *  Finds the extra Archetype info associated with the given object.
+ *  Returns TCL_OK and a pointer to the info if found.  Returns
+ *  TCL_ERROR along with an error message in interp->result if not.
+ * ------------------------------------------------------------------------
+ */
+int
+Itk_GetArchInfo(
+    Tcl_Interp *interp,            /* interpreter handling this object */
+    ItclObject *contextObj,        /* object with desired data */
+    ArchInfo **infoPtr)            /* returns:  pointer to extra info */
+{
+    Tcl_HashTable *objsWithArchInfo;
+    Tcl_HashEntry *entry;
+
+
+    /*
+     *  If there is any problem finding the info, return an error.
+     */
+    objsWithArchInfo = ItkGetObjsWithArchInfo(interp);
+    entry = Tcl_FindHashEntry(objsWithArchInfo, (char*)contextObj);
+
+    if (!entry) {
+	Tcl_AppendResult(interp,
+	    "internal error: no Archetype information for widget",
+	    (char*)NULL);
+
+	if (contextObj->accessCmd) {
+	    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+	    Tcl_AppendToObj(resultPtr, " \"", -1);
+	    Tcl_GetCommandFullName(interp, contextObj->accessCmd, resultPtr);
+	    Tcl_AppendToObj(resultPtr, "\"", -1);
+	}
+	return TCL_ERROR;
+    }
+
+    /*
+     *  Otherwise, return the requested info.
+     */
+    *infoPtr = (ArchInfo*)Tcl_GetHashValue(entry);
+    return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ *  ItkGetObjsWithArchInfo()
+ *
+ *  Returns a pointer to a hash table containing the list of registered
+ *  objects in the specified interpreter.  If the hash table does not
+ *  already exist, it is created.
+ * ------------------------------------------------------------------------
+ */
+Tcl_HashTable*
+ItkGetObjsWithArchInfo(
+    Tcl_Interp *interp)  /* interpreter handling this registration */
+{
+    Tcl_HashTable* objTable;
+
+    /*
+     *  If the registration table does not yet exist, then create it.
+     */
+    objTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
+	"itk_objsWithArchInfo", (Tcl_InterpDeleteProc**)NULL);
+
+    if (!objTable) {
+	objTable = (Tcl_HashTable*)Tcl_Alloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(objTable, TCL_ONE_WORD_KEYS);
+	Tcl_SetAssocData(interp, "itk_objsWithArchInfo",
+	    ItkFreeObjsWithArchInfo, (void *)objTable);
+    }
+    return objTable;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ *  ItkFreeObjsWithArchInfo()
+ *
+ *  When an interpreter is deleted, this procedure is called to
+ *  free up the associated data created by ItkGetObjsWithArchInfo.
+ * ------------------------------------------------------------------------
+ */
+void
+ItkFreeObjsWithArchInfo(
+    void *clientData,       /* associated data */
+    TCL_UNUSED(Tcl_Interp *))          /* interpreter being freed */
+{
+    Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
+    Tcl_HashSearch place;
+    Tcl_HashEntry *entry;
+
+    entry = Tcl_FirstHashEntry(tablePtr, &place);
+    while (entry) {
+	Itk_DelArchInfo( Tcl_GetHashValue(entry) );
+	entry = Tcl_NextHashEntry(&place);
+    }
+
+    Tcl_DeleteHashTable(tablePtr);
+    Tcl_Free(tablePtr);
+}
+

generic/itkInt.h

@@ -0,0 +1,233 @@
+/*
+ * ------------------------------------------------------------------------
+ *      PACKAGE:  [incr Tk]
+ *  DESCRIPTION:  Building mega-widgets with [incr Tcl]
+ *
+ *  [incr Tk] provides a framework for building composite "mega-widgets"
+ *  using [incr Tcl] classes.  It defines a set of base classes that are
+ *  specialized to create all other widgets.
+ *
+ *
+ * ========================================================================
+ *  AUTHOR:  Michael J. McLennan
+ *           Bell Labs Innovations for Lucent Technologies
+ *           mmclennan@lucent.com
+ *           http://www.tcltk.com/itcl
+ * ========================================================================
+ *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include <itclInt.h>
+#include "itk.h"
+
+#if (TCL_MAJOR_VERSION == 8)
+#undef Tcl_Free
+#undef Tcl_Realloc
+#if defined(USE_TCL_STUBS)
+#   define Tcl_Free(p) tclStubsPtr->tcl_Free((char *)(p))
+#   define Tcl_Realloc(p,m) tclStubsPtr->tcl_Realloc((char *)(p),(m))
+#else
+#   define Tcl_Free(p) Tcl_Free((char *)(p))
+#   define Tcl_Realloc(p,m) Tcl_Realloc((char *)(p),(m))
+#endif
+#endif
+
+/*
+ *  List of options in alphabetical order:
+ */
+typedef struct ItkOptList {
+    Tcl_HashTable *options;     /* list containing the real options */
+    Tcl_HashEntry **list;       /* gives ordering of options */
+    int len;                    /* number of entries in order list */
+    int max;                    /* maximum size of order list */
+} ItkOptList;
+
+/*
+ *  List of options created in the class definition:
+ */
+typedef struct ItkClassOptTable {
+    Tcl_HashTable options;        /* option storage with fast lookup */
+    ItkOptList order;             /* gives ordering of options */
+} ItkClassOptTable;
+
+/*
+ *  Each option created in the class definition:
+ */
+typedef struct ItkClassOption {
+    Tcl_Obj* namePtr;           /* member name */
+    Tcl_Obj* fullNamePtr;       /* member name with "class::" qualifier */
+    ItclClass* iclsPtr;         /* class containing this member */
+    int protection;             /* protection level */
+    int flags;                  /* flags describing member (see above) */
+    ItclMemberCode *codePtr;    /* code associated with member */
+    char *resName;                /* resource name in X11 database */
+    char *resClass;               /* resource class name in X11 database */
+    char *init;                   /* initial value for option */
+} ItkClassOption;
+
+
+/*
+ *  Info associated with each Archetype mega-widget:
+ */
+typedef struct ArchInfo {
+    ItclObject *itclObj;        /* object containing this info */
+    Tk_Window tkwin;            /* window representing this mega-widget */
+    Tcl_HashTable components;   /* list of all mega-widget components */
+    Tcl_HashTable options;      /* list of all mega-widget options */
+    ItkOptList order;           /* gives ordering of options */
+} ArchInfo;
+
+/*
+ *  Each component widget in an Archetype mega-widget:
+ */
+typedef struct ArchComponent {
+    Tcl_Obj* namePtr;           /* member name */
+    Tcl_Obj* fullNamePtr;       /* member name with "class::" qualifier */
+    ItclClass* iclsPtr;         /* class containing this member */
+    int protection;             /* protection level */
+    int flags;                  /* flags describing member (see above) */
+    ItclMemberCode *codePtr;    /* code associated with member */
+    Tcl_Command accessCmd;      /* access command for component widget */
+    Tk_Window tkwin;            /* Tk window for this component widget */
+    char *pathName;             /* Tk path name for this component widget.
+				   We can't use the tkwin pointer after
+				   the window has been destroyed so we
+				   need to save a copy for use in
+				   Itk_ArchCompDeleteCmd() */
+} ArchComponent;
+
+/*
+ *  Each option in an Archetype mega-widget:
+ */
+typedef struct ArchOption {
+    char *switchName;           /* command-line switch for this option */
+    char *resName;              /* resource name in X11 database */
+    char *resClass;             /* resource class name in X11 database */
+    char *init;                 /* initial value for option */
+    int flags;                  /* flags representing option state */
+    Itcl_List parts;            /* parts relating to this option */
+} ArchOption;
+
+/*
+ *  Flag bits for ArchOption state:
+ */
+#define ITK_ARCHOPT_INIT  0x01  /* option has been initialized */
+
+/*
+ *  Various parts of a composite option in an Archetype mega-widget:
+ */
+typedef int (Itk_ConfigOptionPartProc) (Tcl_Interp *interp,
+    ItclObject *contextObj, void *cdata, const char* newVal);
+
+typedef struct ArchOptionPart {
+    void *clientData;                 /* data associated with this part */
+    Itk_ConfigOptionPartProc *configProc;  /* update when new vals arrive */
+    Tcl_CmdDeleteProc *deleteProc;         /* clean up after clientData */
+
+    void *from;                       /* token that indicates who
+					    * contributed this option part */
+} ArchOptionPart;
+
+
+/*
+ *  Info kept by the itk::option-parser namespace and shared by
+ *  all option processing commands:
+ */
+typedef struct ArchMergeInfo {
+    Tcl_HashTable usualCode;      /* usual option handling code for the
+				   * various widget classes */
+
+    ArchInfo *archInfo;           /* internal option info for mega-widget */
+    ArchComponent *archComp;      /* component being merged into mega-widget */
+    Tcl_HashTable *optionTable;   /* table of valid configuration options
+				   * for component being merged */
+} ArchMergeInfo;
+
+/*
+ *  Used to capture component widget configuration options when a
+ *  new component is being merged into a mega-widget:
+ */
+typedef struct GenericConfigOpt {
+    char *switchName;             /* command-line switch for this option */
+    char *resName;                /* resource name in X11 database */
+    char *resClass;               /* resource class name in X11 database */
+    char *init;                   /* initial value for this option */
+    char *value;                  /* current value for this option */
+    char **storage;               /* storage for above strings */
+
+    ArchOption *integrated;       /* integrated into this mega-widget option */
+    ArchOptionPart *optPart;      /* integrated as this option part */
+} GenericConfigOpt;
+
+/*
+ *  Options that are propagated by a "configure" method:
+ */
+typedef struct ConfigCmdline {
+    Tcl_Obj *objv[4];           /* objects representing "configure" command */
+} ConfigCmdline;
+
+MODULE_SCOPE int Itk_ArchInitOptsCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchDeleteOptsCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchComponentCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchInitCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchOptionCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchCompAccessCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchConfigureCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchCgetCmd (void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+
+MODULE_SCOPE int Itk_ArchCompAddCmd(void *cdata,
+    Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchCompDeleteCmd(void *cdata,
+    Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchConfigOption(Tcl_Interp *interp,
+    ArchInfo *info, char *name, char *value);
+MODULE_SCOPE int Itk_ArchOptionAddCmd(void *cdata,
+    Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchOptionRemoveCmd(void *cdata,
+    Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_PropagatePublicVar(Tcl_Interp *interp,
+    ItclObject *contextObj, void *cdata, const char *newval);
+MODULE_SCOPE int Itk_GetArchInfo(Tcl_Interp *interp,
+    ItclObject* contextObj, ArchInfo **infoPtr);
+MODULE_SCOPE void Itk_ArchOptConfigError(Tcl_Interp *interp,
+    ArchInfo *info, ArchOption *archOpt);
+MODULE_SCOPE void Itk_ArchOptAccessError(Tcl_Interp *interp,
+    ArchInfo *info, ArchOption *archOpt);
+MODULE_SCOPE ArchOptionPart* Itk_CreateOptionPart(
+    Tcl_Interp *interp, void *cdata, Itk_ConfigOptionPartProc* cproc,
+    Tcl_CmdDeleteProc *dproc, void *from);
+MODULE_SCOPE int Itk_AddOptionPart(Tcl_Interp *interp,
+    ArchInfo *info, char *switchName, char *resName, char *resClass,
+    const char *defVal, char *currVal, ArchOptionPart *optPart,
+    ArchOption **raOpt);
+MODULE_SCOPE ArchOptionPart* Itk_FindArchOptionPart(
+    ArchInfo *info, char *switchName, void *from);
+MODULE_SCOPE void Itk_DelOptionPart(ArchOptionPart *optPart);
+MODULE_SCOPE void Itk_DelArchInfo(void *cdata);
+MODULE_SCOPE Tcl_HashTable* ItkGetObjsWithArchInfo
+    (Tcl_Interp *interp);
+MODULE_SCOPE void ItkFreeObjsWithArchInfo(void *cdata,
+    Tcl_Interp *interp);
+MODULE_SCOPE void Itk_DelMergeInfo(void *cdata);
+MODULE_SCOPE int Itk_ArchOptKeepCmd(void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchOptIgnoreCmd(void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchOptRenameCmd(void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+MODULE_SCOPE int Itk_ArchOptUsualCmd(void *cdata,
+    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+
+
+#include "itkIntDecls.h"

generic/itkIntDecls.h

@@ -0,0 +1,144 @@
+
+/* !BEGIN!: Do not edit below this line. */
+
+#define ITKINT_STUBS_EPOCH 0
+#define ITKINT_STUBS_REVISION 17
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+ * Exported function declarations:
+ */
+
+/* Slot 0 is reserved */
+/* Slot 1 is reserved */
+/* 2 */
+ITKAPI int		Itk_ConfigBodyCmd(void *cdata, Tcl_Interp *interp,
+				int objc, Tcl_Obj *const objv[]);
+/* 3 */
+ITKAPI int		Itk_UsualCmd(void *cdata, Tcl_Interp *interp,
+				int objc, Tcl_Obj *const objv[]);
+/* 4 */
+ITKAPI int		Itk_ClassOptionDefineCmd(void *cdata,
+				Tcl_Interp *interp, int objc,
+				Tcl_Obj *const objv[]);
+/* 5 */
+ITKAPI int		Itk_ClassOptionIllegalCmd(void *cdata,
+				Tcl_Interp *interp, int objc,
+				Tcl_Obj *const objv[]);
+/* 6 */
+ITKAPI int		Itk_ConfigClassOption(Tcl_Interp *interp,
+				ItclObject *contextObj, void *cdata,
+				const char *newVal);
+/* 7 */
+ITKAPI ItkClassOptTable* Itk_CreateClassOptTable(Tcl_Interp *interp,
+				ItclClass *cdefn);
+/* 8 */
+ITKAPI ItkClassOptTable* Itk_FindClassOptTable(ItclClass *cdefn);
+/* Slot 9 is reserved */
+/* 10 */
+ITKAPI int		Itk_CreateClassOption(Tcl_Interp *interp,
+				ItclClass *cdefn, const char *switchName,
+				const char *resName, const char *resClass,
+				const char *defVal, const char *config,
+				ItkClassOption **optPtr);
+/* 11 */
+ITKAPI ItkClassOption*	Itk_FindClassOption(ItclClass *cdefn,
+				const char *switchName);
+/* 12 */
+ITKAPI void		Itk_DelClassOption(ItkClassOption *opt);
+/* Slot 13 is reserved */
+/* 14 */
+ITKAPI void		Itk_OptListInit(ItkOptList *olist,
+				Tcl_HashTable *options);
+/* 15 */
+ITKAPI void		Itk_OptListFree(ItkOptList *olist);
+/* 16 */
+ITKAPI void		Itk_OptListAdd(ItkOptList *olist,
+				Tcl_HashEntry *entry);
+/* 17 */
+ITKAPI void		Itk_OptListRemove(ItkOptList *olist,
+				Tcl_HashEntry *entry);
+
+typedef struct ItkIntStubs {
+    int magic;
+    int epoch;
+    int revision;
+    void *hooks;
+
+    void (*reserved0)(void);
+    void (*reserved1)(void);
+    int (*itk_ConfigBodyCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 2 */
+    int (*itk_UsualCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 3 */
+    int (*itk_ClassOptionDefineCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 4 */
+    int (*itk_ClassOptionIllegalCmd) (void *cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 5 */
+    int (*itk_ConfigClassOption) (Tcl_Interp *interp, ItclObject *contextObj, void *cdata, const char *newVal); /* 6 */
+    ItkClassOptTable* (*itk_CreateClassOptTable) (Tcl_Interp *interp, ItclClass *cdefn); /* 7 */
+    ItkClassOptTable* (*itk_FindClassOptTable) (ItclClass *cdefn); /* 8 */
+    void (*reserved9)(void);
+    int (*itk_CreateClassOption) (Tcl_Interp *interp, ItclClass *cdefn, const char *switchName, const char *resName, const char *resClass, const char *defVal, const char *config, ItkClassOption **optPtr); /* 10 */
+    ItkClassOption* (*itk_FindClassOption) (ItclClass *cdefn, const char *switchName); /* 11 */
+    void (*itk_DelClassOption) (ItkClassOption *opt); /* 12 */
+    void (*reserved13)(void);
+    void (*itk_OptListInit) (ItkOptList *olist, Tcl_HashTable *options); /* 14 */
+    void (*itk_OptListFree) (ItkOptList *olist); /* 15 */
+    void (*itk_OptListAdd) (ItkOptList *olist, Tcl_HashEntry *entry); /* 16 */
+    void (*itk_OptListRemove) (ItkOptList *olist, Tcl_HashEntry *entry); /* 17 */
+} ItkIntStubs;
+
+extern const ItkIntStubs *itkIntStubsPtr;
+
+#ifdef __cplusplus
+}
+#endif
+
+#if defined(USE_ITK_STUBS)
+
+/*
+ * Inline function declarations:
+ */
+
+/* Slot 0 is reserved */
+/* Slot 1 is reserved */
+#define Itk_ConfigBodyCmd \
+	(itkIntStubsPtr->itk_ConfigBodyCmd) /* 2 */
+#define Itk_UsualCmd \
+	(itkIntStubsPtr->itk_UsualCmd) /* 3 */
+#define Itk_ClassOptionDefineCmd \
+	(itkIntStubsPtr->itk_ClassOptionDefineCmd) /* 4 */
+#define Itk_ClassOptionIllegalCmd \
+	(itkIntStubsPtr->itk_ClassOptionIllegalCmd) /* 5 */
+#define Itk_ConfigClassOption \
+	(itkIntStubsPtr->itk_ConfigClassOption) /* 6 */
+#define Itk_CreateClassOptTable \
+	(itkIntStubsPtr->itk_CreateClassOptTable) /* 7 */
+#define Itk_FindClassOptTable \
+	(itkIntStubsPtr->itk_FindClassOptTable) /* 8 */
+/* Slot 9 is reserved */
+#define Itk_CreateClassOption \
+	(itkIntStubsPtr->itk_CreateClassOption) /* 10 */
+#define Itk_FindClassOption \
+	(itkIntStubsPtr->itk_FindClassOption) /* 11 */
+#define Itk_DelClassOption \
+	(itkIntStubsPtr->itk_DelClassOption) /* 12 */
+/* Slot 13 is reserved */
+#define Itk_OptListInit \
+	(itkIntStubsPtr->itk_OptListInit) /* 14 */
+#define Itk_OptListFree \
+	(itkIntStubsPtr->itk_OptListFree) /* 15 */
+#define Itk_OptListAdd \
+	(itkIntStubsPtr->itk_OptListAdd) /* 16 */
+#define Itk_OptListRemove \
+	(itkIntStubsPtr->itk_OptListRemove) /* 17 */
+
+#endif /* defined(USE_ITK_STUBS) */
+
+/* !END!: Do not edit above this line. */
+
+struct ItkStubAPI {
+    ItkStubs *stubsPtr;
+    ItkIntStubs *intStubsPtr;
+};
+

generic/itkOption.c

@@ -15,25 +15,23 @@
  *           Bell Labs Innovations for Lucent Technologies
  *           mmclennan@lucent.com
  *           http://www.tcltk.com/itcl
- *
- *     RCS:  $Id: itk_option.c,v 1.7 2007/05/24 23:23:59 hobbs Exp $
  * ========================================================================
  *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
  * ------------------------------------------------------------------------
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
-#include "itk.h"
+#include "itkInt.h"
 
 /*
  *  FORWARD DECLARATIONS
  */
-static char* ItkTraceClassDestroy _ANSI_ARGS_((ClientData cdata,
-    Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags));
-static Tcl_HashTable* ItkGetClassesWithOptInfo _ANSI_ARGS_((
-    Tcl_Interp *interp));
-static void ItkFreeClassesWithOptInfo _ANSI_ARGS_((ClientData cdata,
-    Tcl_Interp *interp));
+static char* ItkTraceClassDestroy (void *cdata,
+    Tcl_Interp *interp, const char *name1, const char *name2, int flags);
+static Tcl_HashTable* ItkGetClassesWithOptInfo (
+    Tcl_Interp *interp);
+static void ItkFreeClassesWithOptInfo (void *cdata,
+    Tcl_Interp *interp);
 
 
 /*
@@ -55,65 +53,74 @@ static void ItkFreeClassesWithOptInfo _ANSI_ARGS_((ClientData cdata,
  *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
  * ------------------------------------------------------------------------
  */
-/* ARGSUSED */
 int
-Itk_ClassOptionDefineCmd(clientData, interp, objc, objv)
-    ClientData clientData;   /* class parser info */
-    Tcl_Interp *interp;      /* current interpreter */
-    int objc;                /* number of arguments */
-    Tcl_Obj *CONST objv[];   /* argument objects */
+Itk_ClassOptionDefineCmd(
+    void *clientData,        /* class parser info */
+    Tcl_Interp *interp,      /* current interpreter */
+    int objc,                /* number of arguments */
+    Tcl_Obj *const objv[])   /* argument objects */
 {
     ItclObjectInfo *info = (ItclObjectInfo*)clientData;
-    ItclClass *cdefn = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+    ItclClass *iclsPtr = (ItclClass*)Itcl_PeekStack(&info->clsStack);
 
     int newEntry;
-    char *switchName, *resName, *resClass, *init, *config;
+    const char *switchName;
+    const char *resName;
+    const char *resClass;
+    const char *init;
+    const char *config;
     ItkClassOptTable *optTable;
     Tcl_HashEntry *entry;
     ItkClassOption *opt;
 
+    ItclShowArgs(1, "Itk_ClassOptionDefineCmd", objc, objv);
     /*
      *  Make sure that the arguments look right.  The option switch
      *  name must start with a '-'.
      */
     if (objc < 5 || objc > 6) {
-        Tcl_WrongNumArgs(interp, 1, objv,
-            "-switch resourceName resourceClass init ?config?");
-        return TCL_ERROR;
+	Tcl_WrongNumArgs(interp, 1, objv,
+		"-switch resourceName resourceClass init ?config?");
+	return TCL_ERROR;
     }
 
-    switchName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+    switchName = Tcl_GetString(objv[1]);
     if (*switchName != '-') {
-        Tcl_AppendResult(interp,
-            "bad option name \"", switchName, "\": should be -", switchName,
-            (char*)NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"bad option name \"", switchName, "\": should be -",
+		switchName, (char*)NULL);
+	return TCL_ERROR;
     }
     if (strstr(switchName, ".")) {
-        Tcl_AppendResult(interp,
-            "bad option name \"", switchName, "\": illegal character \".\"",
-            (char*)NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"bad option name \"", switchName,
+		"\": illegal character \".\"", (char*)NULL);
+	return TCL_ERROR;
     }
 
-    resName = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+    resName = Tcl_GetString(objv[2]);
     if (!islower((int)*resName)) {
-        Tcl_AppendResult(interp,
-            "bad resource name \"", resName,
-            "\": should start with a lower case letter",
-            (char*)NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"bad resource name \"", resName,
+		"\": should start with a lower case letter",
+		(char*)NULL);
+	return TCL_ERROR;
     }
 
-    resClass = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+    resClass = Tcl_GetString(objv[3]);
     if (!isupper((int)*resClass)) {
-        Tcl_AppendResult(interp,
-            "bad resource class \"", resClass,
-            "\": should start with an upper case letter",
-            (char*)NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp,
+	       "bad resource class \"", resClass,
+	       "\": should start with an upper case letter",
+	       (char*)NULL);
+	return TCL_ERROR;
     }
 
+    if (iclsPtr == NULL) {
+	Tcl_AppendResult(interp, "can only handle options on class level",
+		NULL);
+	return TCL_ERROR;
+    }
     /*
      *  Make sure that this option has not already been defined in
      *  the context of this class.  Options can be redefined in
@@ -122,35 +129,35 @@ Itk_ClassOptionDefineCmd(clientData, interp, objc, objv)
      *  which option is being referenced if the configuration code
      *  is redefined by a subsequent "body" command.
      */
-    optTable = Itk_CreateClassOptTable(interp, cdefn);
+    optTable = Itk_CreateClassOptTable(interp, iclsPtr);
     entry = Tcl_CreateHashEntry(&optTable->options, switchName, &newEntry);
 
     if (!newEntry) {
-        Tcl_AppendResult(interp,
-            "option \"", switchName, "\" already defined in class \"",
-            cdefn->fullname, "\"",
-            (char*)NULL);
-        return TCL_ERROR;
+	Tcl_AppendResult(interp,
+		"option \"", switchName, "\" already defined in class \"",
+		Tcl_GetString(iclsPtr->fullNamePtr), "\"",
+		(char*)NULL);
+	return TCL_ERROR;
     }
 
     /*
      *  Create a new option record and add it to the table for this
      *  class.
      */
-    init = Tcl_GetStringFromObj(objv[4], (int*)NULL);
+    init = Tcl_GetString(objv[4]);
 
     if (objc == 6) {
-        config = Tcl_GetStringFromObj(objv[5], (int*)NULL);
+	config = Tcl_GetString(objv[5]);
     } else {
-        config = NULL;
+	config = NULL;
     }
 
-    if (Itk_CreateClassOption(interp, cdefn, switchName, resName, resClass,
-        init, config, &opt) != TCL_OK) {
-        return TCL_ERROR;
+    if (Itk_CreateClassOption(interp, iclsPtr, switchName, resName, resClass,
+	    init, config, &opt) != TCL_OK) {
+	return TCL_ERROR;
     }
 
-    Tcl_SetHashValue(entry, (ClientData)opt);
+    Tcl_SetHashValue(entry, (void *)opt);
     Itk_OptListAdd(&optTable->order, entry);
     return TCL_OK;
 }
@@ -166,20 +173,19 @@ Itk_ClassOptionDefineCmd(clientData, interp, objc, objv)
  *  been created.  Returns TCL_ERROR along with an error message.
  * ------------------------------------------------------------------------
  */
-/* ARGSUSED */
 int
-Itk_ClassOptionIllegalCmd(clientData, interp, objc, objv)
-    ClientData clientData;   /* class parser info */
-    Tcl_Interp *interp;      /* current interpreter */
-    int objc;                /* number of arguments */
-    Tcl_Obj *CONST objv[];   /* argument objects */
+Itk_ClassOptionIllegalCmd(
+    TCL_UNUSED(void *),      /* class parser info */
+    Tcl_Interp *interp,      /* current interpreter */
+    TCL_UNUSED(int),         /* number of arguments */
+    Tcl_Obj *const objv[])   /* argument objects */
 {
-    char *op = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+    char *op = Tcl_GetString(objv[0]);
 
     Tcl_AppendResult(interp,
-        "can only ", op, " options for a specific widget\n",
-        "(move this command into the constructor)",
-        (char*)NULL);
+	    "can only ", op, " options for a specific widget\n",
+	    "(move this command into the constructor)",
+	    (char*)NULL);
 
     return TCL_ERROR;
 }
@@ -198,26 +204,81 @@ Itk_ClassOptionIllegalCmd(clientData, interp, objc, objv)
  *  message in the interpreter) if anything goes wrong.
  * ------------------------------------------------------------------------
  */
-/* ARGSUSED */
 int
-Itk_ConfigClassOption(interp, contextObj, cdata, newval)
-    Tcl_Interp *interp;        /* interpreter managing the class */
-    ItclObject *contextObj;    /* object being configured */
-    ClientData cdata;          /* class option */
-    CONST char *newval;        /* new value for this option */
+Itk_ConfigClassOption(
+    Tcl_Interp *interp,        /* interpreter managing the class */
+    ItclObject *contextObj,    /* object being configured */
+    void *cdata,               /* class option */
+    TCL_UNUSED(const char *))  /* new value for this option */
 {
     ItkClassOption *opt = (ItkClassOption*)cdata;
     int result = TCL_OK;
     ItclMemberCode *mcode;
+    Tcl_CallFrame frame;
 
     /*
      *  If the option has any config code, execute it now.
      *  Make sure that the namespace context is set up correctly.
      */
-    mcode = opt->member->code;
-    if (mcode && mcode->procPtr->bodyPtr) {
-        result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
-            opt->member, contextObj, 0, (Tcl_Obj**)NULL);
+    mcode = opt->codePtr;
+    if (mcode && mcode->bodyPtr) {
+
+	Itcl_PushCallFrame(interp, &frame, opt->iclsPtr->nsPtr, 1);
+	Itcl_SetContext(interp, contextObj);
+
+	result = Tcl_EvalObjEx(interp, mcode->bodyPtr, 0);
+
+	Itcl_UnsetContext(interp);
+	Itcl_PopCallFrame(interp);
+
+	/*
+	 * Here we engage in some ugly hackery workaround until
+	 * someone has time to come back and implement this
+	 * properly.
+	 *
+	 * In Itcl/Itk 3, the same machinery was used to implement
+	 * method invocation and configbody invocation, and the
+	 * code here looked like:
+	 *
+
+	result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
+	    opt->member, contextObj, 0, (Tcl_Obj**)NULL);
+
+	 *
+	 * In Itcl 4, Itcl methods have become (a particular variant)
+	 * of TclOO methods.  It's not clear whether config bodies
+	 * should also do that, or what?
+	 *
+	 * Instead the existing solution above has been to just "eval"
+	 * the configbody body script in a suitable context, which
+	 * works very nearly correctly.  The trouble is that unlike
+	 * method invocation, we've not pushed a proper frame, nor
+	 * have we unwound a return level, so when the "eval" returns
+	 * TCL_RETURN we've not been handling that right.  You will
+	 * find some configbody bodies out there that expect to be
+	 * able to use [return] for early exit.  Iwidgets test
+	 * Extbutton-2.8 is an example.
+	 *
+	 * As a cheap workaround, we put in explicit special treatment
+	 * for (result == TCL_RETURN) here.  This is essentially a
+	 * reproduction of the Tcl internal routine TclUpdateReturnInfo()
+	 * but without the benefit of internals access.
+	 */
+
+	if (result == TCL_RETURN) {
+	    Tcl_Obj *opts = Tcl_GetReturnOptions(interp, TCL_RETURN);
+	    Tcl_Obj *levelKey = Tcl_NewStringObj("-level", -1);
+	    Tcl_Obj *levelObj;
+	    int level;
+
+	    Tcl_DictObjGet(NULL, opts, levelKey, &levelObj);
+	    Tcl_GetIntFromObj(NULL, levelObj, &level);
+
+	    Tcl_DictObjPut(NULL, opts, levelKey, Tcl_NewIntObj(--level));
+	    result = Tcl_SetReturnOptions(interp, opts);
+
+	    Tcl_DecrRefCount(levelKey);
+	}
     }
     return result;
 }
@@ -242,15 +303,15 @@ Itk_ConfigClassOption(interp, contextObj, cdata, newval)
  * ------------------------------------------------------------------------
  */
 ItkClassOptTable*
-Itk_CreateClassOptTable(interp, cdefn)
-    Tcl_Interp *interp;        /* interpreter managing the class */
-    ItclClass *cdefn;          /* class definition */
+Itk_CreateClassOptTable(
+    Tcl_Interp *interp,        /* interpreter managing the class */
+    ItclClass *iclsPtr)        /* class definition */
 {
     int newEntry, result;
     Tcl_HashTable *itkClasses;
     Tcl_HashEntry *entry;
     ItkClassOptTable *optTable;
-    Itcl_CallFrame frame;
+    Tcl_CallFrame frame;
 
     /*
      *  Look for the specified class definition in the table.
@@ -263,26 +324,25 @@ Itk_CreateClassOptTable(interp, cdefn)
      */
     itkClasses = ItkGetClassesWithOptInfo(interp);
 
-    entry = Tcl_CreateHashEntry(itkClasses, (char*)cdefn, &newEntry);
+    entry = Tcl_CreateHashEntry(itkClasses, (char*)iclsPtr, &newEntry);
     if (newEntry) {
-        optTable = (ItkClassOptTable*)ckalloc(sizeof(ItkClassOptTable));
-        Tcl_InitHashTable(&optTable->options, TCL_STRING_KEYS);
-        Itk_OptListInit(&optTable->order, &optTable->options);
+	optTable = (ItkClassOptTable*)Tcl_Alloc(sizeof(ItkClassOptTable));
+	Tcl_InitHashTable(&optTable->options, TCL_STRING_KEYS);
+	Itk_OptListInit(&optTable->order, &optTable->options);
 
-        Tcl_SetHashValue(entry, (ClientData)optTable);
+	Tcl_SetHashValue(entry, (void *)optTable);
 
-        result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) &frame,
-             cdefn->namesp, /* isProcCallFrame */ 0);
+	result = Itcl_PushCallFrame(interp, &frame,
+	     iclsPtr->nsPtr, /* isProcCallFrame */ 0);
 
-        if (result == TCL_OK) {
-            Tcl_TraceVar(interp, "_itk_option_data",
-                (TCL_TRACE_UNSETS | TCL_NAMESPACE_ONLY),
-                (Tcl_VarTraceProc*) ItkTraceClassDestroy, (ClientData)cdefn);
-            Tcl_PopCallFrame(interp);
-        }
-    }
-    else {
-        optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
+	if (result == TCL_OK) {
+	    Tcl_TraceVar(interp, "_itk_option_data",
+		    (TCL_TRACE_UNSETS | TCL_NAMESPACE_ONLY),
+		    ItkTraceClassDestroy, (void *)iclsPtr);
+	    Itcl_PopCallFrame(interp);
+	}
+    } else {
+	optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
     }
     return optTable;
 }
@@ -303,8 +363,8 @@ Itk_CreateClassOptTable(interp, cdefn)
  * ------------------------------------------------------------------------
  */
 ItkClassOptTable*
-Itk_FindClassOptTable(cdefn)
-    ItclClass *cdefn;          /* class definition */
+Itk_FindClassOptTable(
+    ItclClass *iclsPtr)          /* class definition */
 {
     Tcl_HashTable *itkClasses;
     Tcl_HashEntry *entry;
@@ -312,10 +372,10 @@ Itk_FindClassOptTable(cdefn)
     /*
      *  Look for the specified class definition in the table.
      */
-    itkClasses = ItkGetClassesWithOptInfo(cdefn->interp);
-    entry = Tcl_FindHashEntry(itkClasses, (char*)cdefn);
+    itkClasses = ItkGetClassesWithOptInfo(iclsPtr->interp);
+    entry = Tcl_FindHashEntry(itkClasses, (char*)iclsPtr);
     if (entry) {
-        return (ItkClassOptTable*)Tcl_GetHashValue(entry);
+	return (ItkClassOptTable*)Tcl_GetHashValue(entry);
     }
     return NULL;
 }
@@ -335,16 +395,15 @@ Itk_FindClassOptTable(cdefn)
  *  error that is encountered.
  * ------------------------------------------------------------------------
  */
-/* ARGSUSED */
 static char*
-ItkTraceClassDestroy(cdata, interp, name1, name2, flags)
-    ClientData cdata;          /* class definition data */
-    Tcl_Interp *interp;        /* interpreter managing the class */
-    CONST char *name1;               /* name of variable involved in trace */
-    CONST char *name2;         /* name of array element within variable */
-    int flags;                 /* flags describing trace */
+ItkTraceClassDestroy(
+    void *cdata,               /* class definition data */
+    Tcl_Interp *interp,        /* interpreter managing the class */
+    TCL_UNUSED(const char *),  /* name of variable involved in trace */
+    TCL_UNUSED(const char *),  /* name of array element within variable */
+    TCL_UNUSED(int))           /* flags describing trace */
 {
-    ItclClass *cdefn = (ItclClass*)cdata;
+    ItclClass *iclsPtr = (ItclClass*)cdata;
 
     Tcl_HashTable *itkClasses;
     Tcl_HashEntry *entry;
@@ -357,21 +416,21 @@ ItkTraceClassDestroy(cdata, interp, name1, name2, flags)
      *  If it is found, delete all the option records and tear
      *  down the table.
      */
-    itkClasses = ItkGetClassesWithOptInfo(cdefn->interp);
-    entry = Tcl_FindHashEntry(itkClasses, (char*)cdefn);
+    itkClasses = ItkGetClassesWithOptInfo(interp);
+    entry = Tcl_FindHashEntry(itkClasses, (char*)iclsPtr);
     if (entry) {
-        optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
-        Tcl_DeleteHashEntry(entry);
+	optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
+	Tcl_DeleteHashEntry(entry);
 
-        entry = Tcl_FirstHashEntry(&optTable->options, &place);
-        while (entry) {
-            opt = (ItkClassOption*)Tcl_GetHashValue(entry);
-            Itk_DelClassOption(opt);
-            entry = Tcl_NextHashEntry(&place);
-        }
-        Tcl_DeleteHashTable(&optTable->options);
-        Itk_OptListFree(&optTable->order);
-        ckfree((char*)optTable);
+	entry = Tcl_FirstHashEntry(&optTable->options, &place);
+	while (entry) {
+	    opt = (ItkClassOption*)Tcl_GetHashValue(entry);
+	    Itk_DelClassOption(opt);
+	    entry = Tcl_NextHashEntry(&place);
+	}
+	Tcl_DeleteHashTable(&optTable->options);
+	Itk_OptListFree(&optTable->order);
+	Tcl_Free(optTable);
     }
     return NULL;
 }
@@ -392,17 +451,15 @@ ItkTraceClassDestroy(cdata, interp, name1, name2, flags)
  * ------------------------------------------------------------------------
  */
 int
-Itk_CreateClassOption(interp, cdefn, switchName, resName, resClass,
-    defVal, config, optPtr)
-
-    Tcl_Interp *interp;            /* interpreter managing the class */
-    ItclClass *cdefn;              /* class containing this option */
-    char *switchName;              /* name of command-line switch */
-    char *resName;                 /* resource name in X11 database */
-    char *resClass;                /* resource class name in X11 database */
-    char *defVal;                  /* last-resort default value */
-    char *config;                  /* configuration code */
-    ItkClassOption **optPtr;       /* returns: option record */
+Itk_CreateClassOption(
+    Tcl_Interp *interp,            /* interpreter managing the class */
+    ItclClass *iclsPtr,            /* class containing this option */
+    const char *switchName,        /* name of command-line switch */
+    const char *resName,           /* resource name in X11 database */
+    const char *resClass,          /* resource class name in X11 database */
+    const char *defVal,            /* last-resort default value */
+    const char *config,            /* configuration code */
+    ItkClassOption **optPtr)       /* returns: option record */
 {
     ItkClassOption *opt;
     ItclMemberCode *mcode;
@@ -412,33 +469,42 @@ Itk_CreateClassOption(interp, cdefn, switchName, resName, resClass,
      *  an implementation for it.
      */
     if (config) {
-        if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, config,
-            &mcode) != TCL_OK) {
+	if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, config,
+	    &mcode) != TCL_OK) {
 
-            return TCL_ERROR;
-        }
-        Itcl_PreserveData((ClientData)mcode);
-        Itcl_EventuallyFree((ClientData)mcode,
-		(Tcl_FreeProc*) Itcl_DeleteMemberCode);
-    }
-    else {
-        mcode = NULL;
+	    return TCL_ERROR;
+	}
+	Itcl_PreserveData((void *)mcode);
+#ifdef NOTDEF
+	Itcl_EventuallyFree((void *)mcode, (Tcl_FreeProc *)Itcl_DeleteMemberCode);
+#endif
+    } else {
+	mcode = NULL;
     }
 
     /*
      *  Create the record to represent this option.
      */
-    opt = (ItkClassOption*)ckalloc(sizeof(ItkClassOption));
-    opt->member = Itcl_CreateMember(interp, cdefn, switchName);
-    opt->member->code = mcode;
+    opt = (ItkClassOption*)Tcl_Alloc(sizeof(ItkClassOption));
+    memset(opt, 0, sizeof(ItkClassOption));
+    opt->iclsPtr      = iclsPtr;
+    opt->flags        = 0;
+    opt->protection   = Itcl_Protection(interp, 0);
+    opt->namePtr      = Tcl_NewStringObj(switchName, -1);
+    Tcl_IncrRefCount(opt->namePtr);
+    opt->fullNamePtr = Tcl_NewStringObj(Tcl_GetString(iclsPtr->fullNamePtr), -1);
+    Tcl_AppendToObj(opt->fullNamePtr, "::", 2);
+    Tcl_AppendToObj(opt->fullNamePtr, switchName, -1);
+    Tcl_IncrRefCount(opt->fullNamePtr);
+    opt->codePtr = mcode;
 
-    opt->resName = (char*)ckalloc((unsigned)(strlen(resName)+1));
+    opt->resName = (char*)Tcl_Alloc((strlen(resName)+1));
     strcpy(opt->resName, resName);
 
-    opt->resClass = (char*)ckalloc((unsigned)(strlen(resClass)+1));
+    opt->resClass = (char*)Tcl_Alloc((strlen(resClass)+1));
     strcpy(opt->resClass, resClass);
 
-    opt->init = (char*)ckalloc((unsigned)(strlen(defVal)+1));
+    opt->init = (char*)Tcl_Alloc((strlen(defVal)+1));
     strcpy(opt->init, defVal);
 
     *optPtr = opt;
@@ -460,9 +526,9 @@ Itk_CreateClassOption(interp, cdefn, switchName, resName, resClass,
  * ------------------------------------------------------------------------
  */
 ItkClassOption*
-Itk_FindClassOption(cdefn, switchName)
-    ItclClass *cdefn;              /* class containing this option */
-    char *switchName;              /* name of command-line switch */
+Itk_FindClassOption(
+    ItclClass *iclsPtr,            /* class containing this option */
+    const char *switchName)        /* name of command-line switch */
 {
     ItkClassOption *opt = NULL;
 
@@ -475,21 +541,21 @@ Itk_FindClassOption(cdefn, switchName)
      */
     Tcl_DStringInit(&buffer);
     if (*switchName != '-') {
-        Tcl_DStringAppend(&buffer, "-", -1);
-        Tcl_DStringAppend(&buffer, switchName, -1);
-        switchName = Tcl_DStringValue(&buffer);
+	Tcl_DStringAppend(&buffer, "-", -1);
+	Tcl_DStringAppend(&buffer, switchName, -1);
+	switchName = Tcl_DStringValue(&buffer);
     }
 
     /*
      *  Look for the option table for the specified class, and check
      *  for the requested switch.
      */
-    optTable = Itk_FindClassOptTable(cdefn);
+    optTable = Itk_FindClassOptTable(iclsPtr);
     if (optTable) {
-        entry = Tcl_FindHashEntry(&optTable->options, switchName);
-        if (entry) {
-            opt = (ItkClassOption*)Tcl_GetHashValue(entry);
-        }
+	entry = Tcl_FindHashEntry(&optTable->options, switchName);
+	if (entry) {
+	    opt = (ItkClassOption*)Tcl_GetHashValue(entry);
+	}
     }
     Tcl_DStringFree(&buffer);
     return opt;
@@ -504,15 +570,17 @@ Itk_FindClassOption(cdefn, switchName)
  * ------------------------------------------------------------------------
  */
 void
-Itk_DelClassOption(opt)
-    ItkClassOption *opt;  /* pointer to option data */
+Itk_DelClassOption(
+    ItkClassOption *opt)  /* pointer to option data */
 {
+#ifdef NOTDEF
     Itcl_DeleteMember(opt->member);
-    ckfree(opt->resName);
-    ckfree(opt->resClass);
-    ckfree(opt->init);
+#endif
+    Tcl_Free(opt->resName);
+    Tcl_Free(opt->resClass);
+    Tcl_Free(opt->init);
 
-    ckfree((char*)opt);
+    Tcl_Free(opt);
 }
 
 
@@ -526,8 +594,8 @@ Itk_DelClassOption(opt)
  * ------------------------------------------------------------------------
  */
 static Tcl_HashTable*
-ItkGetClassesWithOptInfo(interp)
-    Tcl_Interp *interp;  /* interpreter handling this registration */
+ItkGetClassesWithOptInfo(
+    Tcl_Interp *interp)  /* interpreter handling this registration */
 {
     Tcl_HashTable* classesTable;
 
@@ -535,13 +603,13 @@ ItkGetClassesWithOptInfo(interp)
      *  If the registration table does not yet exist, then create it.
      */
     classesTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
-        "itk_classesWithOptInfo", (Tcl_InterpDeleteProc**)NULL);
+	"itk_classesWithOptInfo", (Tcl_InterpDeleteProc**)NULL);
 
     if (!classesTable) {
-        classesTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
-        Tcl_InitHashTable(classesTable, TCL_ONE_WORD_KEYS);
-        Tcl_SetAssocData(interp, "itk_classesWithOptInfo",
-            ItkFreeClassesWithOptInfo, (ClientData)classesTable);
+	classesTable = (Tcl_HashTable*)Tcl_Alloc(sizeof(Tcl_HashTable));
+	Tcl_InitHashTable(classesTable, TCL_ONE_WORD_KEYS);
+	Tcl_SetAssocData(interp, "itk_classesWithOptInfo",
+	    ItkFreeClassesWithOptInfo, (void *)classesTable);
     }
     return classesTable;
 }
@@ -555,33 +623,35 @@ ItkGetClassesWithOptInfo(interp)
  * ------------------------------------------------------------------------
  */
 static void
-ItkFreeClassesWithOptInfo(clientData, interp)
-    ClientData clientData;       /* associated data */
-    Tcl_Interp *interp;          /* interpreter being freed */
+ItkFreeClassesWithOptInfo(
+    void *clientData,         /* associated data */
+    TCL_UNUSED(Tcl_Interp *)) /* interpreter being freed */
 {
     Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
-    Tcl_HashSearch place, place2;
-    Tcl_HashEntry *entry, *entry2;
+    Tcl_HashSearch place;
+    Tcl_HashSearch place2;
+    Tcl_HashEntry *entry;
+    Tcl_HashEntry *entry2;
     ItkClassOptTable *optTable;
     ItkClassOption *opt;
 
     entry = Tcl_FirstHashEntry(tablePtr, &place);
     while (entry) {
-        optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
+	optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
 
-        entry2 = Tcl_FirstHashEntry(&optTable->options, &place2);
-        while (entry2) {
-            opt = (ItkClassOption*)Tcl_GetHashValue(entry2);
-            Itk_DelClassOption(opt);
-            entry2 = Tcl_NextHashEntry(&place2);
-        }
-        Tcl_DeleteHashTable(&optTable->options);
-        Itk_OptListFree(&optTable->order);
-        ckfree((char*)optTable);
+	entry2 = Tcl_FirstHashEntry(&optTable->options, &place2);
+	while (entry2) {
+	    opt = (ItkClassOption*)Tcl_GetHashValue(entry2);
+	    Itk_DelClassOption(opt);
+	    entry2 = Tcl_NextHashEntry(&place2);
+	}
+	Tcl_DeleteHashTable(&optTable->options);
+	Itk_OptListFree(&optTable->order);
+	Tcl_Free(optTable);
 
-        entry = Tcl_NextHashEntry(&place);
+	entry = Tcl_NextHashEntry(&place);
     }
 
     Tcl_DeleteHashTable(tablePtr);
-    ckfree((char*)tablePtr);
+    Tcl_Free(tablePtr);
 }

generic/itkStubInit.c

@@ -1,4 +1,4 @@
-/* 
+/*
  * tkStubInit.c --
  *
  *	This file contains the initializers for the Itk stub vectors.
@@ -7,11 +7,9 @@
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: $Id: itkStubInit.c,v 1.3 2001/06/22 04:38:54 davygrvy Exp $
  */
 
-#include "itk.h"
+#include "itkInt.h"
 
 /*
  * Remove macros that will interfere with the definitions below.
@@ -23,13 +21,17 @@
  * below should be made in the generic/itk.decls script.
  */
 
+MODULE_SCOPE const ItkStubs itkStubs;
+
 /* !BEGIN!: Do not edit below this line. */
 
-ItkStubs itkStubs = {
+static const ItkIntStubs itkIntStubs = {
     TCL_STUB_MAGIC,
-    NULL,
-    Itk_Init, /* 0 */
-    Itk_SafeInit, /* 1 */
+    ITKINT_STUBS_EPOCH,
+    ITKINT_STUBS_REVISION,
+    0,
+    0, /* 0 */
+    0, /* 1 */
     Itk_ConfigBodyCmd, /* 2 */
     Itk_UsualCmd, /* 3 */
     Itk_ClassOptionDefineCmd, /* 4 */
@@ -37,15 +39,40 @@ ItkStubs itkStubs = {
     Itk_ConfigClassOption, /* 6 */
     Itk_CreateClassOptTable, /* 7 */
     Itk_FindClassOptTable, /* 8 */
-    NULL, /* 9 */
+    0, /* 9 */
     Itk_CreateClassOption, /* 10 */
     Itk_FindClassOption, /* 11 */
     Itk_DelClassOption, /* 12 */
-    Itk_ArchetypeInit, /* 13 */
+    0, /* 13 */
     Itk_OptListInit, /* 14 */
     Itk_OptListFree, /* 15 */
     Itk_OptListAdd, /* 16 */
     Itk_OptListRemove, /* 17 */
 };
 
+static const ItkStubHooks itkStubHooks = {
+    &itkIntStubs
+};
+
+const ItkStubs itkStubs = {
+    TCL_STUB_MAGIC,
+    ITK_STUBS_EPOCH,
+    ITK_STUBS_REVISION,
+    &itkStubHooks,
+    Itk_Init, /* 0 */
+    Itk_SafeInit, /* 1 */
+    0, /* 2 */
+    0, /* 3 */
+    0, /* 4 */
+    0, /* 5 */
+    0, /* 6 */
+    0, /* 7 */
+    0, /* 8 */
+    0, /* 9 */
+    0, /* 10 */
+    0, /* 11 */
+    0, /* 12 */
+    Itk_ArchetypeInit, /* 13 */
+};
+
 /* !END!: Do not edit above this line. */

generic/itkStubLib.c

@@ -1,4 +1,4 @@
-/* 
+/*
  * itkStubLib.c --
  *
  *	Stub object that will be statically linked into extensions that wish
@@ -9,8 +9,6 @@
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: $Id: itkStubLib.c,v 1.7 2003/12/24 03:38:03 davygrvy Exp $
  */
 
 /*
@@ -26,14 +24,13 @@
 #undef USE_TCL_STUB_PROCS
 
 #ifndef USE_ITK_STUBS
-#define USE_ITK_STUBS
+#define USE_ITK_STUBS 1
 #endif
 #undef USE_ITK_STUB_PROCS
+#undef BUILD_itk
 
 #include "itk.h"
 
-ItkStubs *itkStubsPtr;
-
 
 /*
  *----------------------------------------------------------------------
@@ -53,21 +50,20 @@ ItkStubs *itkStubsPtr;
  *----------------------------------------------------------------------
  */
 
-CONST char *
-Itk_InitStubs (interp, version, exact)
-    Tcl_Interp *interp;
-    CONST char *version;
-    int exact;
+const char *
+Itk_InitStubs (
+    Tcl_Interp *interp,
+    const char *version,
+    int exact)
 {
-    CONST char *actualVersion;
-    
-    actualVersion = Tcl_PkgRequireEx(interp, "Itk", (CONST84 char *)version, exact,
-        (ClientData *) &itkStubsPtr);
+    const char *actualVersion;
 
+    actualVersion = Tcl_PkgRequireEx(interp, "itk", (const char *)version,
+	    exact, &itkStubsPtr);
     if (actualVersion == NULL) {
 	itkStubsPtr = NULL;
 	return NULL;
     }
-    
+
     return actualVersion;
 }

generic/itkUtil.c

@@ -15,15 +15,13 @@
  *           Bell Labs Innovations for Lucent Technologies
  *           mmclennan@lucent.com
  *           http://www.tcltk.com/itcl
- *
- *     RCS:  $Id: itk_util.c,v 1.1 1998/07/27 18:45:25 stanton Exp $
  * ========================================================================
  *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
  * ------------------------------------------------------------------------
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
-#include "itk.h"
+#include "itkInt.h"
 
 
 /*
@@ -35,15 +33,15 @@
  * ------------------------------------------------------------------------
  */
 void
-Itk_OptListInit(olist, options)
-    ItkOptList *olist;       /* list to be initialized */
-    Tcl_HashTable *options;  /* table containing the real option entries */
+Itk_OptListInit(
+    ItkOptList *olist,       /* list to be initialized */
+    Tcl_HashTable *options)  /* table containing the real option entries */
 {
     olist->options = options;
     olist->len = 0;
     olist->max = 10;
-    olist->list = (Tcl_HashEntry**)ckalloc(
-        (unsigned)(olist->max*sizeof(Tcl_HashEntry*))
+    olist->list = (Tcl_HashEntry**)Tcl_Alloc(
+	((size_t)olist->max*sizeof(Tcl_HashEntry*))
     );
 }
 
@@ -58,10 +56,10 @@ Itk_OptListInit(olist, options)
  * ------------------------------------------------------------------------
  */
 void
-Itk_OptListFree(olist)
-    ItkOptList *olist;     /* list to be freed */
+Itk_OptListFree(
+    ItkOptList *olist)     /* list to be freed */
 {
-    ckfree((char*)olist->list);
+    Tcl_Free(olist->list);
     olist->len = olist->max = 0;
 }
 
@@ -76,26 +74,32 @@ Itk_OptListFree(olist)
  * ------------------------------------------------------------------------
  */
 void
-Itk_OptListAdd(olist, entry)
-    ItkOptList *olist;     /* ordered list */
-    Tcl_HashEntry *entry;  /* entry to be added to the list */
+Itk_OptListAdd(
+    ItkOptList *olist,     /* ordered list */
+    Tcl_HashEntry *entry)  /* entry to be added to the list */
 {
-    int i, first, last, cmp, pos, size;
+    int i;
+    int first;
+    int last;
+    int cmp;
+    int pos;
+    size_t size;
     Tcl_HashEntry** newOrder;
-    char *swname, *optname;
+    const char *swname;
+    const char *optname;
 
     /*
      *  Make sure that the option list is big enough.  Resize
      *  if needed.
      */
     if (olist->len >= olist->max) {
-        size = olist->max*sizeof(Tcl_HashEntry*);
-        newOrder = (Tcl_HashEntry**)ckalloc((unsigned)2*size);
-        memcpy((VOID*)newOrder, (VOID*)olist->list, (size_t)size);
-        ckfree((char*)olist->list);
+	size = (size_t)olist->max*sizeof(Tcl_HashEntry*);
+	newOrder = (Tcl_HashEntry**)Tcl_Alloc(2*size);
+	memcpy((void*)newOrder, (void*)olist->list, size);
+	Tcl_Free(olist->list);
 
-        olist->list = newOrder;
-        olist->max *= 2;
+	olist->list = newOrder;
+	olist->max *= 2;
     }
 
     /*
@@ -103,41 +107,42 @@ Itk_OptListAdd(olist, entry)
      */
     first = 0;
     last  = olist->len-1;
-    swname = Tcl_GetHashKey(olist->options, entry) + 1;
+    swname = ((const char *)Tcl_GetHashKey(olist->options, entry)) + 1;
 
     while (last >= first) {
-        pos = (first+last)/2;
-        optname = Tcl_GetHashKey(olist->options, olist->list[pos]) + 1;
-        if (*swname == *optname) {
-            cmp = strcmp(swname, optname);
-            if (cmp == 0) {
-                break;    /* found it! */
-            }
-        }
-        else if (*swname < *optname) {
-            cmp = -1;
-        }
-        else {
-            cmp = 1;
-        }
+	pos = (first+last)/2;
+	optname = ((const char *)Tcl_GetHashKey(olist->options,
+		olist->list[pos])) + 1;
+	if (*swname == *optname) {
+	    cmp = strcmp(swname, optname);
+	    if (cmp == 0) {
+		break;    /* found it! */
+	    }
+	}
+	else if (*swname < *optname) {
+	    cmp = -1;
+	}
+	else {
+	    cmp = 1;
+	}
 
-        if (cmp > 0)
-            first = pos+1;
-        else
-            last = pos-1;
+	if (cmp > 0)
+	    first = pos+1;
+	else
+	    last = pos-1;
     }
 
     /*
      *  If a matching entry was not found, then insert one.
      */
     if (last < first) {
-        pos = first;
+	pos = first;
 
-        for (i=olist->len; i > pos; i--) {
-            olist->list[i] = olist->list[i-1];
-        }
-        olist->list[pos] = entry;
-        olist->len++;
+	for (i=olist->len; i > pos; i--) {
+	    olist->list[i] = olist->list[i-1];
+	}
+	olist->list[pos] = entry;
+	olist->len++;
     }
 }
 
@@ -154,47 +159,52 @@ Itk_OptListAdd(olist, entry)
  * ------------------------------------------------------------------------
  */
 void
-Itk_OptListRemove(olist, entry)
-    ItkOptList *olist;     /* ordered list */
-    Tcl_HashEntry *entry;  /* entry to be removed from the list */
+Itk_OptListRemove(
+    ItkOptList *olist,     /* ordered list */
+    Tcl_HashEntry *entry)  /* entry to be removed from the list */
 {
     int pos = 0;
-    int i, first, last, cmp;
-    char *swname, *optname;
+    int i;
+    int first;
+    int last;
+    int cmp;
+    const char *swname;
+    const char *optname;
 
     first = 0;
     last  = olist->len-1;
-    swname = Tcl_GetHashKey(olist->options, entry) + 1;
+    swname = ((const char *)Tcl_GetHashKey(olist->options, entry)) + 1;
 
     while (last >= first) {
-        pos = (first+last)/2;
-        optname = Tcl_GetHashKey(olist->options, olist->list[pos]) + 1;
-        if (*swname == *optname) {
-            cmp = strcmp(swname, optname);
-            if (cmp == 0) {
-                break;    /* found it! */
-            }
-        }
-        else if (*swname < *optname) {
-            cmp = -1;
-        }
-        else {
-            cmp = 1;
-        }
+	pos = (first+last)/2;
+	optname = ((const char *)Tcl_GetHashKey(olist->options,
+		olist->list[pos])) + 1;
+	if (*swname == *optname) {
+	    cmp = strcmp(swname, optname);
+	    if (cmp == 0) {
+		break;    /* found it! */
+	    }
+	}
+	else if (*swname < *optname) {
+	    cmp = -1;
+	}
+	else {
+	    cmp = 1;
+	}
 
-        if (cmp > 0)
-            first = pos+1;
-        else
-            last = pos-1;
+	if (cmp > 0)
+	    first = pos+1;
+	else
+	    last = pos-1;
     }
 
     /*
      *  If a matching entry was found, then remove it.
      */
     if (last >= first) {
-        olist->len--;
-        for (i=pos; i < olist->len; i++) {
-            olist->list[i] = olist->list[i+1];
-        }
+	olist->len--;
+	for (i=pos; i < olist->len; i++) {
+	    olist->list[i] = olist->list[i+1];
+	}
     }
 }

generic/itk_cmds.c

@@ -1,416 +0,0 @@
-/*
- * ------------------------------------------------------------------------
- *      PACKAGE:  [incr Tk]
- *  DESCRIPTION:  Building mega-widgets with [incr Tcl]
- *
- *  [incr Tk] provides a framework for building composite "mega-widgets"
- *  using [incr Tcl] classes.  It defines a set of base classes that are
- *  specialized to create all other widgets.
- *
- *  This file defines the initialization and facilities common to all
- *  mega-widgets.
- *
- * ========================================================================
- *  AUTHOR:  Michael J. McLennan
- *           Bell Labs Innovations for Lucent Technologies
- *           mmclennan@lucent.com
- *           http://www.tcltk.com/itcl
- *
- *     RCS:  $Id: itk_cmds.c,v 1.17 2007/05/24 22:12:56 hobbs Exp $
- * ========================================================================
- *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
- * ------------------------------------------------------------------------
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-#include "itk.h"
-
-/*  
- * The following script is used to initialize Itcl in a safe interpreter.
- */
- 
-static char safeInitScript[] =
-"proc ::itcl::local {class name args} {\n\
-    set ptr [uplevel [list $class $name] $args]\n\
-    uplevel [list set itcl-local-$ptr $ptr]\n\
-    set cmd [uplevel namespace which -command $ptr]\n\
-    uplevel [list trace variable itcl-local-$ptr u \"::itcl::delete object $cmd; list\"]\n\
-    return $ptr\n\
-}";  
-
-/*
- *  FORWARD DECLARATIONS
- */
-static int Initialize _ANSI_ARGS_((Tcl_Interp *interp));
-/*
- * The following string is the startup script executed in new
- * interpreters.  It looks on disk in several different directories
- * for a script "init.tcl" that is compatible with this version
- * of Tcl.  The init.tcl script does all of the real work of
- * initialization.
- */
-
-static char initScript[] = "\n\
-namespace eval ::itk {\n\
-    proc _find_init {} {\n\
-        global env tcl_library\n\
-        variable library\n\
-        variable version\n\
-        rename _find_init {}\n\
-        if {[info exists library]} {\n\
-            lappend dirs $library\n\
-        } else {\n\
-            if {[catch {uplevel #0 source -rsrc itk}] == 0} {\n\
-                return\n\
-            }\n\
-            set dirs {}\n\
-            if {[info exists env(ITK_LIBRARY)]} {\n\
-                lappend dirs $env(ITK_LIBRARY)\n\
-            }\n\
-            lappend dirs [file join [file dirname $tcl_library] itk$version]\n\
-            set bindir [file dirname [info nameofexecutable]]\n\
-            lappend dirs [file join $bindir .. lib itk$version]\n\
-            lappend dirs [file join $bindir .. library]\n\
-            lappend dirs [file join $bindir .. .. library]\n\
-            lappend dirs [file join $bindir .. .. itk library]\n\
-            # On MacOSX, check the directories in the tcl_pkgPath\n\
-            if {[string equal $::tcl_platform(platform) \"unix\"] && \
-                    [string equal $::tcl_platform(os) \"Darwin\"]} {\n\
-                foreach d $::tcl_pkgPath {\n\
-                    lappend dirs [file join $d itk$version]\n\
-                }\n\
-            }\n\
-        }\n\
-        foreach i $dirs {\n\
-            set library $i\n\
-            set itkfile [file join $i itk.tcl]\n\
-            if {![catch {uplevel #0 [list source $itkfile]} msg]} {\n\
-                return\n\
-            }\n\
-        }\n\
-        set msg \"Can't find a usable itk.tcl in the following directories:\n\"\n\
-        append msg \"    $dirs\n\"\n\
-        append msg \"This probably means that Itcl/Itk weren't installed properly.\n\"\n\
-        append msg \"If you know where the Itk library directory was installed,\n\"\n\
-        append msg \"you can set the environment variable ITK_LIBRARY to point\n\"\n\
-        append msg \"to the library directory.\n\"\n\
-        error $msg\n\
-    }\n\
-    _find_init\n\
-}";
-
-/*
- * ------------------------------------------------------------------------
- *  Initialize()
- *
- *  Invoked whenever a new interpeter is created to install the
- *  [incr Tk] package.
- *
- *  Creates the "::itk" namespace and installs access commands.
- *
- *  Returns TCL_OK on success, or TCL_ERROR (along with an error
- *  message in the interpreter) if anything goes wrong.
- * ------------------------------------------------------------------------
- */
-static int
-Initialize(interp)
-    Tcl_Interp *interp;  /* interpreter to be updated */
-{
-    Tcl_Namespace *itkNs, *parserNs;
-    ClientData parserInfo;
-
-#ifndef USE_TCL_STUBS
-    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
-      return TCL_ERROR;
-    }
-    if (Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) {
-      return TCL_ERROR;
-    }
-    if (Tcl_PkgRequire(interp, "Itcl", ITCL_VERSION, 0) == NULL) {
-      return TCL_ERROR;
-    }
-#else
-    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
-      return TCL_ERROR;
-    }
-    if (Tk_InitStubs(interp, "8.1", 0) == NULL) {
-	return TCL_ERROR;
-    };
-    if (Itcl_InitStubs(interp, ITCL_VERSION, 1) == NULL) {
-	return TCL_ERROR;
-    }
-#endif
-
-
-    /*
-     *  Add the "itk_option" ensemble to the itcl class definition parser.
-     */
-    parserNs = Tcl_FindNamespace(interp, "::itcl::parser",
-        (Tcl_Namespace*)NULL, /* flags */ 0);
-
-    if (!parserNs) {
-        Tcl_AppendResult(interp,
-            "cannot initialize [incr Tk]: [incr Tcl] has not been installed\n",
-            "Make sure that Itcl_Init() is called before Itk_Init()",
-            (char*)NULL);
-        return TCL_ERROR;
-    }
-    parserInfo = parserNs->clientData;
-
-    if (Itcl_CreateEnsemble(interp, "::itcl::parser::itk_option") != TCL_OK) {
-        return TCL_ERROR;
-    }
-    if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
-            "define", "-switch resourceName resourceClass init ?config?",
-            Itk_ClassOptionDefineCmd,
-            parserInfo, Itcl_ReleaseData) != TCL_OK) {
-
-        return TCL_ERROR;
-    }
-    Itcl_PreserveData(parserInfo);
-
-    if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
-            "add", "name ?name name...?",
-            Itk_ClassOptionIllegalCmd,
-            (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
-
-        Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
-            "remove", "name ?name name...?",
-            Itk_ClassOptionIllegalCmd,
-            (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
-
-        return TCL_ERROR;
-    }
-
-    /*
-     *  Install [incr Tk] facilities if not already installed.
-     */
-    itkNs = Tcl_FindNamespace(interp, "::itk", (Tcl_Namespace*)NULL,
-        /* flags */ 0);
-
-    if (itkNs == NULL) {
-	/*
-	 *  Create the "itk" namespace.  Export all the commands in
-	 *  the namespace so that they can be imported by a command
-	 *  such as "namespace import itk::*"
-	 */
-	itkNs = Tcl_CreateNamespace(interp, "::itk",
-	    (ClientData)NULL, (Tcl_NamespaceDeleteProc*)NULL);
-    }
-
-    if (!itkNs ||
-        Tcl_Export(interp, itkNs, "*", /* resetListFirst */ 1) != TCL_OK) {
-        return TCL_ERROR;
-    }
-
-    /*
-     *  Setup things for itk::Archetype base class.
-     */
-    if (Itk_ArchetypeInit(interp) != TCL_OK) {
-        return TCL_ERROR;
-    }
-
-    /*
-     *  Fix the "itcl::configbody" command to recognize mega-widget
-     *  options.
-     */
-    Tcl_CreateObjCommand(interp, "::itcl::configbody", Itk_ConfigBodyCmd,
-        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
-
-    Tcl_SetVar(interp, "::itk::version", ITK_VERSION, 0);
-    Tcl_SetVar(interp, "::itk::patchLevel", ITK_PATCH_LEVEL, 0);
-
-    /*
-     *  Signal that the package has been loaded and provide the Itk Stubs table
-     *  for dependent modules.  I know this is unlikely, but possible that
-     *  someone could be extending Itk.  Who is to say that Itk is the
-     *  end-of-the-line?
-     */
-
-#if TCL_DOES_STUBS
-    {
-	extern ItkStubs itkStubs;
-	if (Tcl_PkgProvideEx(interp, "Itk", ITK_VERSION,
-		(ClientData) &itkStubs) != TCL_OK) {
-	    return TCL_ERROR;
-	}
-    }
-#else
-    if (Tcl_PkgProvide(interp, "Itk", ITK_VERSION) != TCL_OK) {
-	return TCL_ERROR;
-    }
-#endif
-    return TCL_OK;
-}
-
-/*
- * ------------------------------------------------------------------------
- *  Itk_Init()
- *
- *  Invoked whenever a new interpeter is created to install the
- *  [incr Tcl] package.  Usually invoked within Tcl_AppInit() at
- *  the start of execution.
- *
- *  Creates the "::itk" namespace and installs access commands.
- *
- *  Returns TCL_OK on success, or TCL_ERROR (along with an error
- *  message in the interpreter) if anything goes wrong.
- * ------------------------------------------------------------------------
- */
-int
-Itk_Init(interp)
-    Tcl_Interp *interp;  /* interpreter to be updated */
-{
-    if (Initialize(interp) != TCL_OK) {
-	return TCL_ERROR;
-    }
-    return Tcl_Eval(interp, initScript);
-    return TCL_OK;
-}
-
-
-/*
- * ------------------------------------------------------------------------
- *  Itk_SafeInit()
- *   
- *  Invoked whenever a new SAFE INTERPRETER is created to install
- *  the [incr Tcl] package.
- *      
- *  Creates the "::itk" namespace and installs access commands for
- *  creating classes and querying info.
- *  
- *  Returns TCL_OK on success, or TCL_ERROR (along with an error 
- *  message in the interpreter) if anything goes wrong.
- * ------------------------------------------------------------------------
- */  
-int 
-Itk_SafeInit(interp)
-    Tcl_Interp *interp;  /* interpreter to be updated */ 
-{   
-    if (Initialize(interp) != TCL_OK) {
-        return TCL_ERROR;
-    }
-    return Tcl_Eval(interp, safeInitScript);
-}
-
-
-/*
- * ------------------------------------------------------------------------
- *  Itk_ConfigBodyCmd()
- *
- *  Replacement for the usual "itcl::configbody" command.  Recognizes
- *  mega-widget options included in a class definition.  Options are
- *  identified by their "switch" name, but without the "-" prefix:
- *
- *    itcl::configbody <class>::<itkOption> <body>
- *
- *  Handles bodies for public variables as well:
- *
- *    itcl::configbody <class>::<publicVar> <body>
- *
- *  If an <itkOption> is found, it has priority over public variables.
- *  If <body> has the form "@name" then it is treated as a reference
- *  to a C handling procedure; otherwise, it is taken as a body of
- *  Tcl statements.
- *
- *  Returns TCL_OK/TCL_ERROR to indicate success/failure.
- * ------------------------------------------------------------------------
- */
-/* ARGSUSED */
-int
-Itk_ConfigBodyCmd(dummy, interp, objc, objv)
-    ClientData dummy;        /* unused */
-    Tcl_Interp *interp;      /* current interpreter */
-    int objc;                /* number of arguments */
-    Tcl_Obj *CONST objv[];   /* argument objects */
-{
-    int result = TCL_OK;
-
-    char *token, *head, *tail;
-    ItclClass *cdefn;
-    ItclMemberCode *mcode;
-    ItkClassOptTable *optTable;
-    Tcl_HashEntry *entry;
-    ItkClassOption *opt;
-    Tcl_DString buffer;
-
-    if (objc != 3) {
-        Tcl_WrongNumArgs(interp, 1, objv, "class::option body");
-        return TCL_ERROR;
-    }
-
-    /*
-     *  Parse the member name "namesp::namesp::class::option".
-     *  Make sure that a class name was specified, and that the
-     *  class exists.
-     */
-    token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
-    Itcl_ParseNamespPath(token, &buffer, &head, &tail);
-
-    if (!head || *head == '\0') {
-        Tcl_AppendResult(interp,
-            "missing class specifier for body declaration \"", token, "\"",
-            (char*)NULL);
-        result = TCL_ERROR;
-        goto configBodyCmdDone;
-    }
-
-    cdefn = Itcl_FindClass(interp, head, /* autoload */ 1);
-    if (cdefn == NULL) {
-        result = TCL_ERROR;
-        goto configBodyCmdDone;
-    }
-
-    /*
-     *  Look first for a configuration option with that name.
-     *  If it is not found, assume the reference is for a public
-     *  variable, and use the usual "configbody" implementation
-     *  to handle it.
-     */
-    optTable = Itk_FindClassOptTable(cdefn);
-    opt = NULL;
-
-    if (optTable) {
-        Tcl_DString optName;
-
-        Tcl_DStringInit(&optName);
-        Tcl_DStringAppend(&optName, "-", -1);
-        Tcl_DStringAppend(&optName, tail, -1);
-        entry = Tcl_FindHashEntry(&optTable->options,
-            Tcl_DStringValue(&optName));
-
-        if (entry) {
-            opt = (ItkClassOption*)Tcl_GetHashValue(entry);
-        }
-        Tcl_DStringFree(&optName);
-    }
-
-    if (opt == NULL) {
-        result = Itcl_ConfigBodyCmd(dummy, interp, objc, objv);
-        goto configBodyCmdDone;
-    }
-
-    /*
-     *  Otherwise, change the implementation for this option.
-     */
-    token = Tcl_GetStringFromObj(objv[2], (int*)NULL);
-
-    if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, token,
-        &mcode) != TCL_OK) {
-
-        result = TCL_ERROR;
-        goto configBodyCmdDone;
-    }
-
-    Itcl_PreserveData((ClientData)mcode);
-    Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
-
-    if (opt->member->code) {
-        Itcl_ReleaseData((ClientData)opt->member->code);
-    }
-    opt->member->code = mcode;
-
-configBodyCmdDone:
-    Tcl_DStringFree(&buffer);
-    return result;
-}

itkConfig.sh.in

@@ -1,5 +1,5 @@
 # itkConfig.sh --
-# 
+#
 # This shell script (for sh) is generated automatically by Itk's
 # configure script.  It will create shell variables for most of
 # the configuration options discovered by the configure script.
@@ -15,26 +15,26 @@
 ITCL_VERSION='@ITCL_VERSION@'
 
 # The name of the Itk library (may be either a .a file or a shared library):
-ITK_LIB_FILE=@ITK_LIB_FILE@
+ITK_LIB_FILE=@itk_LIB_FILE@
 
 # String to pass to linker to pick up the Itk library from its
 # build directory.
-ITK_BUILD_LIB_SPEC='@ITK_BUILD_LIB_SPEC@'
+ITK_BUILD_LIB_SPEC='@itk_BUILD_LIB_SPEC@'
 
 # String to pass to linker to pick up the Itk library from its
 # installed directory.
-ITK_LIB_SPEC='@ITK_LIB_SPEC@'
+ITK_LIB_SPEC='@itk_LIB_SPEC@'
 
 # The name of the Itk stub library (a .a file):
-ITK_STUB_LIB_FILE=@ITK_STUB_LIB_FILE@
+ITK_STUB_LIB_FILE=@itk_STUB_LIB_FILE@
 
 # String to pass to linker to pick up the Itk stub library from its
 # build directory.
-ITK_BUILD_STUB_LIB_SPEC='@ITK_BUILD_STUB_LIB_SPEC@'
+ITK_BUILD_STUB_LIB_SPEC='@itk_BUILD_STUB_LIB_SPEC@'
 
 # String to pass to linker to pick up the Itk stub library from its
 # installed directory.
-ITK_STUB_LIB_SPEC='@ITK_STUB_LIB_SPEC@'
+ITK_STUB_LIB_SPEC='@itk_STUB_LIB_SPEC@'
 
 # Location of the top-level source directories from which [incr Tk]
 # was built.  This is the directory that contains a README file as well
@@ -42,4 +42,4 @@ ITK_STUB_LIB_SPEC='@ITK_STUB_LIB_SPEC@'
 # compiled in a different place than the directory containing the source
 # files, this points to the location of the sources, not the location
 # where [incr Tk] was compiled.
-ITK_SRC_DIR='@ITK_SRC_DIR@'
+ITK_SRC_DIR='@itk_SRC_DIR@'

library/Archetype.itk

@@ -45,8 +45,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: Archetype.itk,v 1.1 1998/07/27 18:45:26 stanton Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -56,32 +54,27 @@
 itcl::class itk::Archetype {
 
     constructor {args} {
-        _initOptionInfo
-        eval itk_initialize $args
+	::itcl::builtin::Archetype init
+	eval itk_initialize $args
     }
 
     destructor {
-        _deleteOptionInfo
+	::itcl::builtin::Archetype delete
     }
 
     method cget {option} @Archetype-cget
-    method configure {{option ""} args} \
-        @Archetype-configure
-    method config {{option ""} args} {
-        eval configure $option $args
-    }
 
-    method component {{name ""} args} \
-        @Archetype-component
+    method configure {{option ""} args} @Archetype-configure
 
-    protected method itk_component {option args} \
-        @Archetype-itk_component
+    method config {{option ""} args} @Archetype-configure
 
-    protected method itk_option {option args} \
-        @Archetype-itk_option
+    method component {{name ""} args} @Archetype-component
 
-    protected method itk_initialize {args} \
-        @Archetype-itk_initialize
+    protected method itk_component {option args} @Archetype-itk_component
+
+    protected method itk_option {option args} @Archetype-itk_option
+
+    protected method itk_initialize {args} @Archetype-itk_initialize
 
     protected variable itk_option
     protected variable itk_component

library/Toplevel.itk

@@ -23,8 +23,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: Toplevel.itk,v 1.4 2007/05/24 23:29:30 hobbs Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -35,49 +33,49 @@ itcl::class itk::Toplevel {
     inherit itk::Archetype
 
     constructor {args} {
-        #
-        #  Create a toplevel window with the same name as this object
-        #
-        set itk_hull [namespace tail $this]
-        set itk_interior $itk_hull
+	#
+	#  Create a toplevel window with the same name as this object
+	#
+	set itk_hull [namespace tail $this]
+	set itk_interior $itk_hull
 
-        itk_component add hull {
-            toplevel $itk_hull -class [namespace tail [info class]]
-        } {
-            keep -menu -background -cursor -takefocus
-        }
-        bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
+	itk_component add hull {
+	    toplevel $itk_hull -class [namespace tail [info class]]
+	} {
+	    keep -menu -background -cursor -takefocus
+	}
+	bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
 
-        set tags [bindtags $itk_hull]
-        bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
+	set tags [bindtags $itk_hull]
+	bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
 
-        eval itk_initialize $args
+	eval itk_initialize $args
     }
 
     destructor {
-        if {[winfo exists $itk_hull]} {
-            set tags [bindtags $itk_hull]
-            set i [lsearch $tags itk-delete-$itk_hull]
-            if {$i >= 0} {
-                bindtags $itk_hull [lreplace $tags $i $i]
-            }
-            destroy $itk_hull
-        }
-        itk_component delete hull
+	if {[winfo exists $itk_hull]} {
+	    set tags [bindtags $itk_hull]
+	    set i [lsearch $tags itk-delete-$itk_hull]
+	    if {$i >= 0} {
+		bindtags $itk_hull [lreplace $tags $i $i]
+	    }
+	    destroy $itk_hull
+	}
+	itk_component delete hull
 
-        set components [component]
-        foreach component $components {
-            set path($component) [component $component]
-        }
-        foreach component $components {
-            if {[winfo exists $path($component)]} {
-                destroy $path($component)
-            }
-        }
+	set components [component]
+	foreach component $components {
+	    set path($component) [component $component]
+	}
+	foreach component $components {
+	    if {[winfo exists $path($component)]} {
+		destroy $path($component)
+	    }
+	}
     }
 
     itk_option define -title title Title "" {
-        wm title $itk_hull $itk_option(-title)
+	wm title $itk_hull $itk_option(-title)
     }
 
     private variable itk_hull ""

library/Widget.itk

@@ -21,8 +21,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: Widget.itk,v 1.3 2007/05/24 23:27:05 hobbs Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -36,45 +34,45 @@ itcl::class itk::Widget {
     #  CONSTRUCTOR
     # ------------------------------------------------------------------
     constructor {args} {
-        #
-        #  Create a window with the same name as this object
-        #
-        set itk_hull [namespace tail $this]
-        set itk_interior $itk_hull
+	#
+	#  Create a window with the same name as this object
+	#
+	set itk_hull [namespace tail $this]
+	set itk_interior $itk_hull
 
-        itk_component add hull {
-            frame $itk_hull -class [namespace tail [info class]]
-        } {
-            keep -background -cursor
-        }
-        bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
+	itk_component add hull {
+	    frame $itk_hull -class [namespace tail [info class]]
+	} {
+	    keep -background -cursor
+	}
+	bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]
 
-        set tags [bindtags $itk_hull]
-        bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
+	set tags [bindtags $itk_hull]
+	bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
 
-        eval itk_initialize $args
+	eval itk_initialize $args
     }
 
     destructor {
-        if {[winfo exists $itk_hull]} {
-            set tags [bindtags $itk_hull]
-            set i [lsearch $tags itk-delete-$itk_hull]
-            if {$i >= 0} {
-                bindtags $itk_hull [lreplace $tags $i $i]
-            }
-            destroy $itk_hull
-        }
-        itk_component delete hull
+	if {[winfo exists $itk_hull]} {
+	    set tags [bindtags $itk_hull]
+	    set i [lsearch $tags itk-delete-$itk_hull]
+	    if {$i >= 0} {
+		bindtags $itk_hull [lreplace $tags $i $i]
+	    }
+	    destroy $itk_hull
+	}
+	itk_component delete hull
 
-        set components [component]
-        foreach component $components {
-            set path($component) [component $component]
-        }
-        foreach component $components {
-            if {[winfo exists $path($component)]} {
-                destroy $path($component)
-            }
-        }
+	set components [component]
+	foreach component $components {
+	    set path($component) [component $component]
+	}
+	foreach component $components {
+	    if {[winfo exists $path($component)]} {
+		destroy $path($component)
+	    }
+	}
     }
 
     private variable itk_hull ""

library/itk.tcl

@@ -8,22 +8,17 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: itk.tcl,v 1.3 2002/05/14 22:53:28 davygrvy Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
 # See the file "license.terms" for information on usage and
 # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
+package require -exact Itk 4.2.7
 #
 # Provide transparent access to all [incr Tk] commands
 #
-if {$tcl_platform(os) == "MacOS"} {
-    source -rsrc itk:tclIndex
-} else {
-    lappend auto_path ${itk::library}
-}
+lappend auto_path ${itk::library}
 
 # ----------------------------------------------------------------------
 #  USAGE:  itk::remove_destroy_hook <widget>
@@ -41,7 +36,7 @@ proc ::itk::remove_destroy_hook {widget} {
     set tags [bindtags $widget]
     set i [lsearch $tags "itk-destroy-$widget"]
     if {$i >= 0} {
-        bindtags $widget [lreplace $tags $i $i]
+	bindtags $widget [lreplace $tags $i $i]
     }
     bind itk-destroy-$widget <Destroy> {}
 }

license.terms

@@ -27,7 +27,7 @@ MODIFICATIONS.
 
 GOVERNMENT USE: If you are acquiring this software on behalf of the
 U.S. government, the Government shall have only "Restricted Rights"
-in the software and related documentation as defined in the Federal 
+in the software and related documentation as defined in the Federal
 Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
 are acquiring the software on behalf of the Department of Defense, the
 software shall be classified as "Commercial Computer Software" and the
@@ -35,4 +35,4 @@ Government shall have only "Restricted Rights" as defined in Clause
 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
 authors grant the U.S. Government and others acting in its behalf
 permission to use and distribute the software in accordance with the
-terms specified in this license. 
+terms specified in this license.

pkgIndex.tcl.in

@@ -1,3 +1,16 @@
-# Tcl package index file, version 1.0
+# -*- tcl -*-
+# Tcl package index file, version 1.1
+#
 
-package ifneeded Itk @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] Itk]
+if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
+if {[string length [package provide Itcl]] && ![package vsatisfies [package provide Itcl] 4.1]} return
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded itk @PACKAGE_VERSION@ \
+	    [list load [file join $dir @PKG_LIB_FILE9@] Itk]
+} else {
+    package ifneeded itk @PACKAGE_VERSION@ \
+	    [list load [file join $dir @PKG_LIB_FILE8@] Itk]
+}
+
+package ifneeded Itk @PACKAGE_VERSION@ \
+	[list package require -exact itk @PACKAGE_VERSION@]

tests/all

@@ -1,21 +0,0 @@
-# This file contains a top-level script to run all of the Tcl
-# tests.  Execute it by invoking "source all" when running tclTest
-# in this directory.
-#
-# SCCS: @(#) all 1.7 96/02/16 08:55:38
-# ------------------------------------------------------------------
-# THIS SCRIPT IS NOW DEPRECATED!  It is kept for older Tcl
-# installations that don't have the "tcltest" package.
-# Instead, use the "all.tcl" script to run the test suite.
-# ------------------------------------------------------------------
-
-foreach i [lsort [glob *.test]] {
-    if [string match l.*.test $i] {
-	# This is an SCCS lock file;  ignore it.
-	continue
-    }
-    puts stdout $i
-    if [catch {source $i} msg] {
-	puts $msg
-    }	
-}

tests/all.tcl

@@ -6,12 +6,13 @@
 #
 # Copyright (c) 1998-2000 by Ajuba Solutions
 # All rights reserved.
-# 
-# RCS: @(#) $Id: all.tcl,v 1.4 2004/09/22 09:37:08 davygrvy Exp $
 
-package require tcltest 2.1
+package prefer latest
 
-tcltest::testsDirectory [file dir [info script]]
+package require Tcl 8.6-
+package require tcltest 2.2
+
+tcltest::configure {*}$argv -testdir [file dir [info script]]
 tcltest::runAllTests
 
 return

tests/defs

@@ -1,350 +0,0 @@
-# This file contains support code for the Tcl test suite.  It is
-# normally sourced by the individual files in the test suite before
-# they run their tests.  This improved approach to testing was designed
-# and initially implemented by Mary Ann May-Pumphrey of Sun Microsystems.
-#
-# Copyright (c) 1990-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) defs 1.44 96/10/08 17:26:58
-# ------------------------------------------------------------------
-# THIS SCRIPT IS NOW DEPRECATED!  It is kept for older Tcl
-# installations that don't have the "tcltest" package.
-# Instead, use "package require tcltest" in the test suite.
-# ------------------------------------------------------------------
-
-if ![info exists VERBOSE] {
-    set VERBOSE 0
-}
-if ![info exists TESTS] {
-    set TESTS {}
-}
-
-# If tests are being run as root, issue a warning message and set a
-# variable to prevent some tests from running at all.
-
-set user {}
-if {$tcl_platform(platform) == "unix"} {
-    catch {set user [exec whoami]}
-    if {$user == ""} {
-        catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
-    }
-    if {$user == ""} {set user root}
-    if {$user == "root"} {
-        puts stdout "Warning: you're executing as root.  I'll have to"
-        puts stdout "skip some of the tests, since they'll fail as root."
-    }
-}
-
-# Some of the tests don't work on some system configurations due to
-# differences in word length, file system configuration, etc.  In order
-# to prevent false alarms, these tests are generally only run in the
-# master development directory for Tcl.  The presence of a file
-# "doAllTests" in this directory is used to indicate that the non-portable
-# tests should be run.
-
-set doNonPortableTests [file exists doAllTests]
-
-# If there is no "memory" command (because memory debugging isn't
-# enabled), generate a dummy command that does nothing.
-
-if {[info commands memory] == ""} {
-    proc memory args {}
-}
-
-# Check configuration information that will determine which tests
-# to run.  To do this, create an array testConfig.  Each element
-# has a 0 or 1 value, and the following elements are defined:
-#	unixOnly -	1 means this is a UNIX platform, so it's OK
-#			to run tests that only work under UNIX.
-#	macOnly -	1 means this is a Mac platform, so it's OK
-#			to run tests that only work on Macs.
-#	pcOnly -	1 means this is a PC platform, so it's OK to
-#			run tests that only work on PCs.
-#	unixOrPc -	1 means this is a UNIX or PC platform.
-#	macOrPc -	1 means this is a Mac or PC platform.
-#	macOrUnix -	1 means this is a Mac or UNIX platform.
-#	nonPortable -	1 means this the tests are being running in
-#			the master Tcl/Tk development environment;
-#			Some tests are inherently non-portable because
-#			they depend on things like word length, file system
-#			configuration, window manager, etc.  These tests
-#			are only run in the main Tcl development directory
-#			where the configuration is well known.  The presence
-#			of the file "doAllTests" in this directory indicates
-#			that it is safe to run non-portable tests.
-#	tempNotPc -	The inverse of pcOnly.  This flag is used to
-#			temporarily disable a test.
-#	nonBlockFiles - 1 means this platform supports setting files into
-#			nonblocking mode.
-#	asyncPipeClose- 1 means this platform supports async flush and
-#			async close on a pipe.
-#	unixExecs     - 1 means this machine has commands such as 'cat',
-#			'echo' etc available.
-
-package require Itk
-
-catch {unset testConfig}
-if {$tcl_platform(platform) == "unix"} {
-    set testConfig(unixOnly) 1
-    set testConfig(tempNotPc) 1
-} else {
-    set testConfig(unixOnly) 0
-} 
-if {$tcl_platform(platform) == "macintosh"} {
-    set testConfig(tempNotPc) 1
-    set testConfig(macOnly) 1
-} else {
-    set testConfig(macOnly) 0
-} 
-if {$tcl_platform(platform) == "windows"} {
-    set testConfig(pcOnly) 1
-} else {
-    set testConfig(pcOnly) 0
-}
-set testConfig(unixOrPc) [expr $testConfig(unixOnly) || $testConfig(pcOnly)]
-set testConfig(macOrPc) [expr $testConfig(macOnly) || $testConfig(pcOnly)]
-set testConfig(macOrUnix) [expr $testConfig(macOnly) || $testConfig(unixOnly)]
-set testConfig(nonPortable) [file exists doAllTests]
-
-set f [open defs r]
-if {[expr [catch {fconfigure $f -blocking off}]] == 0} {
-    set testConfig(nonBlockFiles) 1
-} else {
-    set testConfig(nonBlockFiles) 0
-}
-close $f
-
-# Test for SCO Unix - cannot run async flushing tests because a potential
-# problem with select is apparently interfering. (Mark Diekhans).
-
-if {$tcl_platform(platform) == "unix"} {
-    if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
-	set testConfig(asyncPipeClose) 0
-    } else {
-	set testConfig(asyncPipeClose) 1
-    }
-} else {
-    set testConfig(asyncPipeClose) 1
-}
-
-# Test to see if execed commands such as cat, echo, rm and so forth are
-# present on this machine.
-
-set testConfig(unixExecs) 1
-if {$tcl_platform(platform) == "macintosh"} {
-    set testConfig(unixExecs) 0
-}
-if {($testConfig(unixExecs) == 1) && ($tcl_platform(platform) == "windows")} {
-    if {[catch {exec cat defs}] == 1} {
-	set testConfig(unixExecs) 0
-    }
-    if {($testConfig(unixExecs) == 1) && ([catch {exec echo hello}] == 1)} {
-	set testConfig(unixExecs) 0
-    }
-    if {($testConfig(unixExecs) == 1) && \
-		([catch {exec sh -c echo hello}] == 1)} {
-	set testConfig(unixExecs) 0
-    }
-    if {($testConfig(unixExecs) == 1) && ([catch {exec wc defs}] == 1)} {
-	set testConfig(unixExecs) 0
-    }
-    if {$testConfig(unixExecs) == 1} {
-	exec echo hello > removeMe
-        if {[catch {exec rm removeMe}] == 1} {
-	    set testConfig(unixExecs) 0
-	}
-    }
-    if {($testConfig(unixExecs) == 1) && ([catch {exec sleep 1}] == 1)} {
-	set testConfig(unixExecs) 0
-    }
-    if {($testConfig(unixExecs) == 1) && \
-		([catch {exec fgrep unixExecs defs}] == 1)} {
-	set testConfig(unixExecs) 0
-    }
-    if {($testConfig(unixExecs) == 1) && ([catch {exec ps}] == 1)} {
-	set testConfig(unixExecs) 0
-    }
-    if {($testConfig(unixExecs) == 1) && \
-		([catch {exec echo abc > removeMe}] == 0) && \
-		([catch {exec chmod 644 removeMe}] == 1) && \
-		([catch {exec rm removeMe}] == 0)} {
-	set testConfig(unixExecs) 0
-    } else {
-	catch {exec rm -f removeMe}
-    }
-    if {($testConfig(unixExecs) == 1) && \
-		([catch {exec mkdir removeMe}] == 1)} {
-	set testConfig(unixExecs) 0
-    } else {
-	catch {exec rm -r removeMe}
-    }
-    if {$testConfig(unixExecs) == 0} {
-	puts stdout "Warning: Unix-style executables are not available, so"
-	puts stdout "some tests will be skipped."
-    }
-}    
-
-proc print_verbose {name description script code answer} {
-    puts stdout "\n"
-    puts stdout "==== $name $description"
-    puts stdout "==== Contents of test case:"
-    puts stdout "$script"
-    if {$code != 0} {
-	if {$code == 1} {
-	    puts stdout "==== Test generated error:"
-	    puts stdout $answer
-	} elseif {$code == 2} {
-	    puts stdout "==== Test generated return exception;  result was:"
-	    puts stdout $answer
-	} elseif {$code == 3} {
-	    puts stdout "==== Test generated break exception"
-	} elseif {$code == 4} {
-	    puts stdout "==== Test generated continue exception"
-	} else {
-	    puts stdout "==== Test generated exception $code;  message was:"
-	    puts stdout $answer
-	}
-    } else {
-	puts stdout "==== Result was:"
-	puts stdout "$answer"
-    }
-}
-
-# test --
-# This procedure runs a test and prints an error message if the
-# test fails.  If VERBOSE has been set, it also prints a message
-# even if the test succeeds.  The test will be skipped if it
-# doesn't match the TESTS variable, or if one of the elements
-# of "constraints" turns out not to be true.
-#
-# Arguments:
-# name -		Name of test, in the form foo-1.2.
-# description -		Short textual description of the test, to
-#			help humans understand what it does.
-# constraints -		A list of one or more keywords, each of
-#			which must be the name of an element in
-#			the array "testConfig".  If any of these
-#			elements is zero, the test is skipped.
-#			This argument may be omitted.
-# script -		Script to run to carry out the test.  It must
-#			return a result that can be checked for
-#			correctness.
-# answer -		Expected result from script.
-
-proc test {name description script answer args} {
-    global VERBOSE TESTS testConfig
-    if {[string compare $TESTS ""] != 0} then {
-	set ok 0
-	foreach test $TESTS {
-	    if [string match $test $name] then {
-		set ok 1
-		break
-	    }
-        }
-	if !$ok then return
-    }
-    set i [llength $args]
-    if {$i == 0} {
-	# Empty body
-    } elseif {$i == 1} {
-	# "constraints" argument exists;  shuffle arguments down, then
-	# make sure that the constraints are satisfied.
-
-	set constraints $script
-	set script $answer
-	set answer [lindex $args 0]
-	foreach constraint $constraints {
-	    if {![info exists testConfig($constraint)]
-		    || !$testConfig($constraint)} {
-		return
-	    }
-	}
-    } else {
-	error "wrong # args: must be \"test name description ?constraints? script answer\""
-    }
-    memory tag $name
-    set code [catch {uplevel $script} result]
-    if {$code != 0} {
-	print_verbose $name $description $script \
-		$code $result
-    } elseif {[string compare $result $answer] == 0} then { 
-	if $VERBOSE then {
-	    if {$VERBOSE > 0} {
-		print_verbose $name $description $script \
-		    $code $result
-	    }
-	    puts stdout "++++ $name PASSED"
-	}
-    } else { 
-	print_verbose $name $description $script \
-		$code $result
-	puts stdout "---- Result should have been:"
-	puts stdout "$answer"
-	puts stdout "---- $name FAILED" 
-    }
-}
-
-proc dotests {file args} {
-    global TESTS
-    set savedTests $TESTS
-    set TESTS $args
-    source $file
-    set TESTS $savedTests
-}
-
-proc normalizeMsg {msg} {
-    regsub "\n$" [string tolower $msg] "" msg
-    regsub -all "\n\n" $msg "\n" msg
-    regsub -all "\n\}" $msg "\}" msg
-    return $msg
-}
-
-proc makeFile {contents name} {
-    set fd [open $name w]
-    fconfigure $fd -translation lf
-    if {[string index $contents [expr [string length $contents] - 1]] == "\n"} {
-	puts -nonewline $fd $contents
-    } else {
-	puts $fd $contents
-    }
-    close $fd
-}
-
-proc removeFile {name} {
-    file delete $name
-}
-
-proc makeDirectory {name} {
-    file mkdir $name
-}
-
-proc removeDirectory {name} {
-    file delete -force $name
-}
-
-proc viewFile {name} {
-    global tcl_platform testConfig
-    if {($tcl_platform(platform) == "macintosh") || \
-		($testConfig(unixExecs) == 0)} {
-	set f [open $name]
-	set data [read -nonewline $f]
-	close $f
-	return $data
-    } else {
-	exec cat $name
-    }
-}
-
-# Locate tcltest executable
-
-set tcltest [list [info nameofexecutable]]
-if {$tcltest == "{}"} {
-    set tcltest {}
-    puts "Unable to find tcltest executable, multiple process tests will fail."
-}
-
-

tests/interp.test

@@ -5,8 +5,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: interp.test,v 1.3 2004/09/22 09:37:08 davygrvy Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -31,13 +29,14 @@ test interp-1.1 {create a slave interp with [incr Tk]} {
     list [slave eval "namespace children :: ::itk"] [interp delete slave]
 } {::itk {}}
 
-test interp-1.2 {can't load [incr Tk] into a safe interp} {
-    interp create -safe slave
+test interp-1.2 {can load [incr Tk] into a safe interp} {
+    safe::interpCreate slave
+    safe::loadTk slave
     load "" Itcl slave
     set result [list [catch {load "" Itk slave} msg] $msg]
-    interp delete slave
+    safe::interpDelete slave
     set result
-} {1 {can't use package in a safe interpreter: no Itk_SafeInit procedure}}
+} {0 {}}
 
 test interp-1.3 {errors are okay when slave interp is deleted} {
     interp create slave
@@ -45,8 +44,8 @@ test interp-1.3 {errors are okay when slave interp is deleted} {
     load "" Tk slave
     load "" Itk slave
     slave eval {
-        label .l
-        bind .l <Destroy> {error "dying!"}
+	label .l
+	bind .l <Destroy> {error "dying!"}
     }
     interp delete slave
 } {}

tests/option.test

@@ -5,8 +5,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: option.test,v 1.4 2004/09/22 09:37:09 davygrvy Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -24,59 +22,59 @@ namespace import -force ::tcltest::*
 # ----------------------------------------------------------------------
 test option-1.1 {create a widget for the following tests} {
     itcl::class TestOptComp {
-        inherit itk::Widget
-        constructor {args} {
-            itk_component add test1 {
-                label $itk_interior.t1
-            } {
-                keep -background -foreground -cursor
-                keep -text
-            }
-            pack $itk_component(test1) -side left -padx 2
-            eval itk_initialize $args
-        }
-        private variable status ""
-        public method action {info} {
-            lappend status $info
-        }
-        public method do {cmd} {
-            eval $cmd
-        }
-        itk_option define -status status Status {} {
-            lappend status $itk_option(-status)
-        }
+	inherit itk::Widget
+	constructor {args} {
+	    itk_component add test1 {
+		label $itk_interior.t1
+	    } {
+		keep -background -foreground -cursor
+		keep -text
+	    }
+	    pack $itk_component(test1) -side left -padx 2
+	    eval itk_initialize $args
+	}
+	private variable status ""
+	public method action {info} {
+	    lappend status $info
+	}
+	public method do {cmd} {
+	    eval $cmd
+	}
+	itk_option define -status status Status {} {
+	    lappend status $itk_option(-status)
+	}
     }
 
     itcl::class TestOptWidget {
-        inherit itk::Widget
-        constructor {args} {
-            itk_component add test1 {
-                label $itk_interior.t1
-            } {
-                keep -background -foreground -cursor
-                keep -text
-            }
-            pack $itk_component(test1) -side left -padx 2
-            eval itk_initialize $args
-        }
-        public method do {cmd} {
-            eval $cmd
-        }
+	inherit itk::Widget
+	constructor {args} {
+	    itk_component add test1 {
+		label $itk_interior.t1
+	    } {
+		keep -background -foreground -cursor
+		keep -text
+	    }
+	    pack $itk_component(test1) -side left -padx 2
+	    eval itk_initialize $args
+	}
+	public method do {cmd} {
+	    eval $cmd
+	}
     }
     TestOptWidget .#auto
 } {.testOptWidget0}
 
 test option-1.2 {"keep" can be called more than once} {
     .testOptWidget0 do {
-        itk_component add k0 {
-            TestOptComp $itk_interior.k0 -status "create"
-        } {
-            keep -background -foreground -cursor
-            keep -background -foreground -cursor
-            keep -status
-            keep -status
-        }
-        pack $itk_component(k0)
+	itk_component add k0 {
+	    TestOptComp $itk_interior.k0 -status "create"
+	} {
+	    keep -background -foreground -cursor
+	    keep -background -foreground -cursor
+	    keep -status
+	    keep -status
+	}
+	pack $itk_component(k0)
     }
     .testOptWidget0 configure -status "foo"
     .testOptWidget0 component k0 do {set status}
@@ -84,13 +82,13 @@ test option-1.2 {"keep" can be called more than once} {
 
 test option-1.3 {"rename" can be called more than once} {
     .testOptWidget0 do {
-        itk_component add k1 {
-            TestOptComp $itk_interior.k1 -status "create"
-        } {
-            rename -status -test test Test
-            rename -status -test test Test
-        }
-        pack $itk_component(k1)
+	itk_component add k1 {
+	    TestOptComp $itk_interior.k1 -status "create"
+	} {
+	    rename -status -test test Test
+	    rename -status -test test Test
+	}
+	pack $itk_component(k1)
     }
     .testOptWidget0 configure -test "bar"
     .testOptWidget0 component k1 do {set status}
@@ -98,14 +96,14 @@ test option-1.3 {"rename" can be called more than once} {
 
 test option-1.4 {"ignore" overrides keep and rename} {
     .testOptWidget0 do {
-        itk_component add k2 {
-            TestOptComp $itk_interior.k2 -status "create"
-        } {
-            keep -status
-            rename -status -test test Test
-            ignore -status
-        }
-        pack $itk_component(k2)
+	itk_component add k2 {
+	    TestOptComp $itk_interior.k2 -status "create"
+	} {
+	    keep -status
+	    rename -status -test test Test
+	    ignore -status
+	}
+	pack $itk_component(k2)
     }
     .testOptWidget0 configure -status k2 -test k2
     .testOptWidget0 component k2 do {set status}
@@ -132,48 +130,48 @@ test option-2.4 {query back unknown "usual" code} {
 
 test option-2.5 {add a component using "usual" code} {
     .testUsual do {
-        itk_component add u0 {
-            label $itk_interior.u0 -text "Usual Test #0"
-        } {
-            usual TestOptComp-test
-        }
-        pack $itk_component(u0)
+	itk_component add u0 {
+	    label $itk_interior.u0 -text "Usual Test #0"
+	} {
+	    usual TestOptComp-test
+	}
+	pack $itk_component(u0)
     }
     .testUsual configure -foreground green -cursor gumby
 
     list [.testUsual component u0 cget -foreground] \
-         [.testUsual component u0 cget -cursor]
+	 [.testUsual component u0 cget -cursor]
 } {green gumby}
 
 test option-2.6 {override "usual" options} {
     .testUsual do {
-        itk_component add u1 {
-            label $itk_interior.u1 -text "Usual Test #1"
-        } {
-            usual TestOptComp-test
-            ignore -cursor
-            keep -background
-        }
-        pack $itk_component(u1)
+	itk_component add u1 {
+	    label $itk_interior.u1 -text "Usual Test #1"
+	} {
+	    usual TestOptComp-test
+	    ignore -cursor
+	    keep -background
+	}
+	pack $itk_component(u1)
     }
     .testUsual configure -foreground red -background white -cursor dot
 
     list [.testUsual component u1 cget -foreground] \
-         [.testUsual component u1 cget -background] \
-         [.testUsual component u1 cget -cursor]
+	 [.testUsual component u1 cget -background] \
+	 [.testUsual component u1 cget -cursor]
 } {red white gumby}
 
 set unique 0
 foreach widget {button canvas checkbutton entry frame label listbox
-                menu menubutton message radiobutton scale scrollbar
-                text toplevel} {
+		menu menubutton message radiobutton scale scrollbar
+		text toplevel} {
     set name "c[incr unique]"
     test option-2.7.$name {verify "usual" options for all Tk widgets} {
-        .testUsual do [format {
-            itk_component add %s {
-                %s $itk_interior.%s
-            }
-        } $name $widget $name]
+	.testUsual do [format {
+	    itk_component add %s {
+		%s $itk_interior.%s
+	    }
+	} $name $widget $name]
     } $name
 }
 

tests/privacy.test

@@ -5,8 +5,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: privacy.test,v 1.3 2004/09/22 09:37:09 davygrvy Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -24,13 +22,13 @@ namespace import -force ::tcltest::*
 # ----------------------------------------------------------------------
 test privacy-1.1 {define simple mega-widget class} {
     itcl::class TestPrivacy {
-        inherit itk::Widget
-        constructor {args} {
-            eval itk_initialize $args
-        }
-        method do {args} {
-            return [eval $args]
-        }
+	inherit itk::Widget
+	constructor {args} {
+	    eval itk_initialize $args
+	}
+	method do {args} {
+	    return [eval $args]
+	}
     }
     set testobj [TestPrivacy .#auto]
     pack $testobj
@@ -38,58 +36,58 @@ test privacy-1.1 {define simple mega-widget class} {
 
 test privacy-1.2 {"itk_component add" requires certain arguments} {
     list [catch {$testobj do itk_component add foo} msg] $msg \
-         [catch {$testobj do itk_component add foo bar baz qux} msg] $msg
+	 [catch {$testobj do itk_component add foo bar baz qux} msg] $msg
 } {1 {wrong # args: should be "itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds?"} 1 {wrong # args: should be "add ?-protected? ?-private? ?--? name createCmds ?optionCmds?}}
 
 test privacy-1.3 {"itk_component add" rejects invalid options} {
     list [catch {
-             $testobj do itk_component add -foo bar baz qux
-         } msg] $msg \
-         [catch {
-             $testobj do itk_component add -- -foo {label $itk_interior.l}
-         } msg] $msg
+	     $testobj do itk_component add -foo bar baz qux
+	 } msg] $msg \
+	 [catch {
+	     $testobj do itk_component add -- -foo {label $itk_interior.l}
+	 } msg] $msg
 } {1 {bad option "-foo": should be -private, -protected or --} 0 -foo}
 
 test privacy-1.4 {"itk_component add" recognizes privacy options} {
     list [catch {
-             $testobj do itk_component add -protected x {label $itk_interior.x}
-         } msg] $msg \
-         [catch {
-             $testobj do itk_component add -private y {label $itk_interior.y}
-         } msg] $msg
+	     $testobj do itk_component add -protected x {label $itk_interior.x}
+	 } msg] $msg \
+	 [catch {
+	     $testobj do itk_component add -private y {label $itk_interior.y}
+	 } msg] $msg
 } {0 x 0 y}
 
 test privacy-1.5 {protected/private components are hidden} {
     list [lsort [$testobj component]] \
-         [lsort [$testobj do component]]
+	 [lsort [$testobj do component]]
 } {{-foo hull} {-foo hull x y}}
 
 test privacy-1.6 {define a derived class and add protected/private comps} {
     itcl::class TestMorePrivacy {
-        inherit TestPrivacy
-        constructor {args} {
-            eval itk_initialize $args
-        }
-        method do {args} {
-            return [eval $args]
-        }
+	inherit TestPrivacy
+	constructor {args} {
+	    eval itk_initialize $args
+	}
+	method do {args} {
+	    return [eval $args]
+	}
     }
     set testobj2 [TestMorePrivacy .#auto]
     $testobj2 TestPrivacy::do itk_component add -private x {
-        label $itk_interior.x
+	label $itk_interior.x
     }
     $testobj2 TestPrivacy::do itk_component add -protected y {
-        label $itk_interior.y
+	label $itk_interior.y
     }
     $testobj2 TestPrivacy::do itk_component add z {
-        label $itk_interior.z
+	label $itk_interior.z
     }
 } {z}
 
 test privacy-1.7 {components are visible depending on namespace context} {
     list [lsort [$testobj2 component]] \
-         [lsort [$testobj2 do component]] \
-         [lsort [$testobj2 TestPrivacy::do component]]
+	 [lsort [$testobj2 do component]] \
+	 [lsort [$testobj2 TestPrivacy::do component]]
 } {{hull z} {hull y z} {hull x y z}}
 
 # ----------------------------------------------------------------------

tests/public.test

@@ -5,8 +5,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: public.test,v 1.3 2004/09/22 09:37:09 davygrvy Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -24,17 +22,17 @@ namespace import -force ::tcltest::*
 # ----------------------------------------------------------------------
 test public-1.1 {define base class and simple mega-widget class} {
     itcl::class test_public_base {
-        public variable null
-        public variable background "not used"
-        public variable message
+	public variable null
+	public variable background "not used"
+	public variable message
     }
     itcl::configbody test_public_base::message {
-        global ::test_public_status
-        lappend test_public_status "message: $message"
+	global ::test_public_status
+	lappend test_public_status "message: $message"
     }
     itcl::configbody test_public_base::background {
-        global ::test_public_status
-        lappend test_public_status "background: $background"
+	global ::test_public_status
+	lappend test_public_status "background: $background"
     }
     option add *TestPublic.background red
     option add *TestPublic.foreground white
@@ -42,18 +40,18 @@ test public-1.1 {define base class and simple mega-widget class} {
     option add *TestPublic.message "Hello, World!"
 
     itcl::class TestPublic {
-        inherit itk::Widget test_public_base
-        constructor {args} {
-            itk_component add mesg {
-                label $itk_interior.mesg
-            } {
-                keep -background -foreground -cursor
-                rename -text -message message Message
-            }
-            pack $itk_component(mesg) -side left -padx 2
+	inherit itk::Widget test_public_base
+	constructor {args} {
+	    itk_component add mesg {
+		label $itk_interior.mesg
+	    } {
+		keep -background -foreground -cursor
+		rename -text -message message Message
+	    }
+	    pack $itk_component(mesg) -side left -padx 2
 
-            eval itk_initialize $args
-        }
+	    eval itk_initialize $args
+	}
     }
     set testobj [TestPublic .#auto]
     pack $testobj

tests/toplevel.test

@@ -5,8 +5,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: toplevel.test,v 1.5 2007/05/24 23:29:30 hobbs Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -31,25 +29,25 @@ test toplevel-1.1 {define a toplevel mega-widget class} {
     option add *TestToplevel.text ""
 
     itcl::class TestToplevel {
-        inherit itk::Toplevel
-        constructor {args} {
-            itk_component add test1 {
-                label $itk_interior.t1
-            } {
-                keep -background -foreground -cursor
-                keep -text
-            }
-            pack $itk_component(test1) -side left -padx 2
-            eval itk_initialize $args
-        }
-        public method do {cmd} {
-            eval $cmd
-        }
+	inherit itk::Toplevel
+	constructor {args} {
+	    itk_component add test1 {
+		label $itk_interior.t1
+	    } {
+		keep -background -foreground -cursor
+		keep -text
+	    }
+	    pack $itk_component(test1) -side left -padx 2
+	    eval itk_initialize $args
+	}
+	public method do {cmd} {
+	    eval $cmd
+	}
 
-        private variable status ""
-        itk_option define -background background Background {} {
-            lappend status "background: $itk_option(-background)"
-        }
+	private variable status ""
+	itk_option define -background background Background {} {
+	    lappend status "background: $itk_option(-background)"
+	}
     }
     TestToplevel .#auto
 } {.testToplevel0}
@@ -65,8 +63,8 @@ test toplevel-1.3 {check the list components} {
 test toplevel-1.4 {check the propagation of configuration options} {
     .testToplevel0 configure -background red
     list [.testToplevel0 component hull cget -background] \
-         [.testToplevel0 component test1 cget -background] \
-         [.testToplevel0 do {set status}]
+	 [.testToplevel0 component test1 cget -background] \
+	 [.testToplevel0 do {set status}]
 } {red red {{background: linen} {background: red}}}
 
 test toplevel-1.5 {mega-widgets show up on the object list} {
@@ -79,7 +77,7 @@ test toplevel-1.6 {when a mega-widget is destroyed, its object is deleted} {
 } {}
 
 test toplevel-1.7 {when an mega-widget object is deleted, its window and any
-        components are destroyed } {
+	components are destroyed } {
     TestToplevel .delme
     set label [.delme component test1]
     itcl::delete object .delme
@@ -87,25 +85,25 @@ test toplevel-1.7 {when an mega-widget object is deleted, its window and any
 } {0 0}
 
 test toplevel-1.8 {when a mega-widget object is deleted, its window and any
-        components are destroyed (even if in another window) } {
+	components are destroyed (even if in another window) } {
     catch {destroy .t1}
     catch {destroy .t2}
     catch {rename .t2 {}}
     catch {itcl::delete class ButtonTop}
 
     itcl::class ButtonTop {
-        inherit itk::Toplevel
+	inherit itk::Toplevel
 
-        constructor {args} {
-            eval itk_initialize $args
+	constructor {args} {
+	    eval itk_initialize $args
 
-            itk_component add button {
-                button $itk_option(-container).b -text Button
-            } {}
-            pack $itk_component(button)
-        }
+	    itk_component add button {
+		button $itk_option(-container).b -text Button
+	    } {}
+	    pack $itk_component(button)
+	}
 
-        itk_option define -container container Container {}
+	itk_option define -container container Container {}
     }
 
     toplevel .t1
@@ -119,25 +117,25 @@ test toplevel-1.8 {when a mega-widget object is deleted, its window and any
 } {.t1.b 0}
 
 test toplevel-1.9 {when a window that contains a megawidget component
-        is destroyed, the component is removed from the megawidget} {
+	is destroyed, the component is removed from the megawidget} {
     catch {destroy .t1}
     catch {destroy .t2}
     catch {rename .t2 {}}
     catch {itcl::delete class ButtonTop}
 
     itcl::class ButtonTop {
-        inherit itk::Toplevel
+	inherit itk::Toplevel
 
-        constructor {args} {
-            eval itk_initialize $args
+	constructor {args} {
+	    eval itk_initialize $args
 
-            itk_component add button {
-                button $itk_option(-container).b -text Button
-            } {}
-            pack $itk_component(button)
-        }
+	    itk_component add button {
+		button $itk_option(-container).b -text Button
+	    } {}
+	    pack $itk_component(button)
+	}
 
-        itk_option define -container container Container {}
+	itk_option define -container container Container {}
     }
 
     toplevel .t1
@@ -151,36 +149,36 @@ test toplevel-1.9 {when a window that contains a megawidget component
 } {{button hull} hull}
 
 test toplevel-1.10 {when destroying a component that is inside another
-        window protect against that case where one component destroy
-        actually destroys other contained components} {
+	window protect against that case where one component destroy
+	actually destroys other contained components} {
     catch {destroy .t1}
     catch {destroy .t2}
     catch {rename .t2 {}}
     catch {itcl::delete class ButtonTop}
 
     itcl::class ButtonTop {
-        inherit itk::Toplevel
+	inherit itk::Toplevel
 
-        constructor {args} {
-            eval itk_initialize $args
+	constructor {args} {
+	    eval itk_initialize $args
 
-            # Note, the component names matter here since
-            # [.t2 component] returns names in hash order.
-            # We need to delete cframe first since it
-            # is the parent of cbutton.
+	    # Note, the component names matter here since
+	    # [.t2 component] returns names in hash order.
+	    # We need to delete cframe first since it
+	    # is the parent of cbutton.
 
-            itk_component add cframe {
-                button $itk_option(-container).cframe
-            } {}
-            pack $itk_component(cframe)
+	    itk_component add cframe {
+		button $itk_option(-container).cframe
+	    } {}
+	    pack $itk_component(cframe)
 
-            itk_component add cbutton {
-                button $itk_component(cframe).b -text Button
-            } {}
-            pack $itk_component(cbutton)
-        }
+	    itk_component add cbutton {
+		button $itk_component(cframe).b -text Button
+	    } {}
+	    pack $itk_component(cbutton)
+	}
 
-        itk_option define -container container Container {}
+	itk_option define -container container Container {}
     }
 
     toplevel .t1

tests/widget.test

@@ -5,8 +5,6 @@
 #            Bell Labs Innovations for Lucent Technologies
 #            mmclennan@lucent.com
 #            http://www.tcltk.com/itcl
-#
-#      RCS:  $Id: widget.test,v 1.6 2004/09/22 09:37:09 davygrvy Exp $
 # ----------------------------------------------------------------------
 #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
 # ======================================================================
@@ -33,39 +31,39 @@ test widget-1.1 {define a simple mega-widget class} {
     option add *TestWidget.text ""
 
     itcl::class TestWidget {
-        inherit itk::Widget
-        constructor {args} {
-            itk_component add test1 {
-                label $itk_interior.t1
-            } {
-                keep -background -foreground -cursor
-                keep -text
-            }
-            pack $itk_component(test1) -side left -padx 2
+	inherit itk::Widget
+	constructor {args} {
+	    itk_component add test1 {
+		label $itk_interior.t1
+	    } {
+		keep -background -foreground -cursor
+		keep -text
+	    }
+	    pack $itk_component(test1) -side left -padx 2
 
-            itk_component add test2 {
-                button $itk_interior.t2 -text "Push Me"
-            } {
-                keep -foreground -cursor -borderwidth -command
-                rename -background -normal normal Background
-                rename -activebackground -highlight highlight Foreground
-            }
-            pack $itk_component(test2) -side right -fill x -pady 2
+	    itk_component add test2 {
+		button $itk_interior.t2 -text "Push Me"
+	    } {
+		keep -foreground -cursor -borderwidth -command
+		rename -background -normal normal Background
+		rename -activebackground -highlight highlight Foreground
+	    }
+	    pack $itk_component(test2) -side right -fill x -pady 2
 
-            eval itk_initialize $args
-        }
-        private variable status ""
-        public method action {info} {
-            lappend status $info
-        }
+	    eval itk_initialize $args
+	}
+	private variable status ""
+	public method action {info} {
+	    lappend status $info
+	}
 
-        public method do {cmd} {
-            eval $cmd
-        }
+	public method do {cmd} {
+	    eval $cmd
+	}
 
-        itk_option define -status status Status {} {
-            lappend status $itk_option(-status)
-        }
+	itk_option define -status status Status {} {
+	    lappend status $itk_option(-status)
+	}
     }
     TestWidget .#auto
 } {.testWidget0}
@@ -93,7 +91,7 @@ foreach test {
     set result [lindex $test 1]
 
     test widget-1.3.[incr unique] {check individual configuration options} {
-        .testWidget0 configure $opt
+	.testWidget0 configure $opt
     } $result
 }
 
@@ -114,9 +112,9 @@ foreach test {
     set value [lindex $test 1]
 
     test widget-1.4.[incr unique] {set individual configuration options} {
-        list [.testWidget0 configure $opt $value] \
-             [.testWidget0 cget $opt] \
-             [.testWidget0 do "set itk_option($opt)"]
+	list [.testWidget0 configure $opt $value] \
+	     [.testWidget0 cget $opt] \
+	     [.testWidget0 do "set itk_option($opt)"]
     } [list "" $value $value]
 }
 
@@ -134,26 +132,26 @@ foreach test {
     set win  [lindex $test 1]
 
     test widget-1.6 {check the window for each component} {
-        list [.testWidget0 component $name] \
-             [.testWidget0 do "set itk_component($name)"]
+	list [.testWidget0 component $name] \
+	     [.testWidget0 do "set itk_component($name)"]
     } [list $win $win]
 }
 
 test widget-1.7 {check the propagation of configuration options} {
     list [.testWidget0 component hull cget -cursor] \
-         [.testWidget0 component test1 cget -cursor] \
-         [.testWidget0 component test2 cget -cursor]
+	 [.testWidget0 component test1 cget -cursor] \
+	 [.testWidget0 component test2 cget -cursor]
 } {trek trek trek}
 
 test widget-1.8 {check the propagation of configuration options} {
     list [.testWidget0 component hull cget -background] \
-         [.testWidget0 component test1 cget -background] \
-         [.testWidget0 component test2 cget -background]
+	 [.testWidget0 component test1 cget -background] \
+	 [.testWidget0 component test2 cget -background]
 } {red red MistyRose2}
 
 test widget-1.9 {check the propagation of configuration options} {
     list [.testWidget0 component test1 cget -text] \
-         [.testWidget0 component test2 cget -text]
+	 [.testWidget0 component test2 cget -text]
 } {Label: {Push Me}}
 
 test widget-1.10 {check the invocation of "config" code} {
@@ -175,17 +173,17 @@ test widget-1.11b {execute some code created by "code" command} {
 
 test widget-1.12a {components can be added on the fly} {
     .testWidget0 do {
-        itk_component add test3 {
-            label $itk_interior.t3 -text "Temporary"
-        } {
-            keep -background -foreground -cursor
-        }
+	itk_component add test3 {
+	    label $itk_interior.t3 -text "Temporary"
+	} {
+	    keep -background -foreground -cursor
+	}
     }
 } {test3}
 
 test widget-1.12b {components can be added on the fly} {
     .testWidget0 do {
-        pack $itk_component(test3) -fill x
+	pack $itk_component(test3) -fill x
     }
 } {}
 
@@ -195,8 +193,8 @@ test widget-1.13 {new components show up on the component list} {
 
 test widget-1.14 {new components are initialized properly} {
     list [.testWidget0 component test3 cget -background] \
-         [.testWidget0 component test3 cget -foreground] \
-         [.testWidget0 component test3 cget -cursor]
+	 [.testWidget0 component test3 cget -foreground] \
+	 [.testWidget0 component test3 cget -cursor]
 } {red IndianRed trek}
 
 test widget-1.15 {components can be deleted like ordinary widgets} {
@@ -247,42 +245,42 @@ test widget-1.24 {recreate another test widget} {
 
 test widget-1.25 {when an internal component is destroyed, it is removed from the list of components, and any dead options disappear} {
     list [lsort [.testWidget component]] \
-         [.testWidget configure] \
+	 [.testWidget configure] \
       [catch {destroy [.testWidget component test1]}] \
-         [.testWidget component] \
-         [.testWidget do {return [lsort [array names itk_component]]}] \
-         [.testWidget configure]
+	 [.testWidget component] \
+	 [.testWidget do {return [lsort [array names itk_component]]}] \
+	 [.testWidget configure]
 } {{hull test1 test2} {{-background background Background linen linen} {-borderwidth borderWidth BorderWidth 2 2} {-clientdata clientData ClientData {} {}} {-command command Command {} {}} {-cursor cursor Cursor {} {}} {-foreground foreground Foreground navy navy} {-highlight highlight Foreground white white} {-normal normal Background ivory ivory} {-status status Status {} {}} {-text text Text {} {}}} 0 {hull test2} {hull test2} {{-background background Background linen linen} {-borderwidth borderWidth BorderWidth 2 2} {-clientdata clientData ClientData {} {}} {-command command Command {} {}} {-cursor cursor Cursor {} {}} {-foreground foreground Foreground navy navy} {-highlight highlight Foreground white white} {-normal normal Background ivory ivory} {-status status Status {} {}}}}
 
 test widget-1.26 {when an internal component is deleted (but not destroyed) it is disconnected from the option list and its binding tags are updated} {
     set comp [.testWidget component test2]
     list [bindtags $comp] \
-         [bind itk-destroy-$comp <Destroy>] \
+	 [bind itk-destroy-$comp <Destroy>] \
       [catch {.testWidget do {itk_component delete test2}}] \
-         [bindtags $comp] \
-         [bind itk-destroy-$comp <Destroy>] \
-         [.testWidget configure]
-} {{itk-destroy-.testWidget.t2 .testWidget.t2 Button . all} {namespace inscope ::itk::Archetype {::.testWidget itk_component delete test2}} 0 {.testWidget.t2 Button . all} {} {{-background background Background linen linen} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor {} {}} {-status status Status {} {}}}}
+	 [bindtags $comp] \
+	 [bind itk-destroy-$comp <Destroy>] \
+	 [.testWidget configure]
+} {{itk-destroy-.testWidget.t2 .testWidget.t2 Button . all} {namespace inscope ::TestWidget {::.testWidget itk_component delete test2}} 0 {.testWidget.t2 Button . all} {} {{-background background Background linen linen} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor {} {}} {-status status Status {} {}}}}
 
 test widget-1.27 {when a mega-widget object is deleted, its window and any
-        components are destroyed (even if in another window) } {
+	components are destroyed (even if in another window) } {
     catch {destroy .t1}
     catch {rename .t1.bw {}}
     catch {itcl::delete class ButtonWidget}
 
     itcl::class ButtonWidget {
-        inherit itk::Widget
+	inherit itk::Widget
 
-        constructor {args} {
-            eval itk_initialize $args
+	constructor {args} {
+	    eval itk_initialize $args
 
-            itk_component add button {
-                button $itk_option(-container).b -text Button
-            } {}
-            pack $itk_component(button)
-        }
+	    itk_component add button {
+		button $itk_option(-container).b -text Button
+	    } {}
+	    pack $itk_component(button)
+	}
 
-        itk_option define -container container Container {}
+	itk_option define -container container Container {}
     }
 
     toplevel .t1
@@ -301,24 +299,24 @@ test widget-1.27 {when a mega-widget object is deleted, its window and any
 } {.t1.f.b 0}
 
 test widget-1.28 {when a window that contains a megawidget component
-        is destroyed, the component is removed from the megawidget} {
+	is destroyed, the component is removed from the megawidget} {
     catch {destroy .t1}
     catch {rename .t1.bw {}}
     catch {itcl::delete class ButtonWidget}
 
     itcl::class ButtonWidget {
-        inherit itk::Widget
+	inherit itk::Widget
 
-        constructor {args} {
-            eval itk_initialize $args
+	constructor {args} {
+	    eval itk_initialize $args
 
-            itk_component add button {
-                button $itk_option(-container).b -text Button
-            } {}
-            pack $itk_component(button)
-        }
+	    itk_component add button {
+		button $itk_option(-container).b -text Button
+	    } {}
+	    pack $itk_component(button)
+	}
 
-        itk_option define -container container Container {}
+	itk_option define -container container Container {}
     }
 
     toplevel .t1
@@ -338,35 +336,35 @@ test widget-1.28 {when a window that contains a megawidget component
 } {{button hull} hull}
 
 test widget-1.29 {when destroying a component that is inside another
-        window protect against that case where one component destroy
-        actually destroys other contained components} {
+	window protect against that case where one component destroy
+	actually destroys other contained components} {
     catch {destroy .t1}
     catch {rename .t1.bw {}}
     catch {itcl::delete class ButtonWidget}
 
     itcl::class ButtonWidget {
-        inherit itk::Widget
+	inherit itk::Widget
 
-        constructor {args} {
-            eval itk_initialize $args
+	constructor {args} {
+	    eval itk_initialize $args
 
-            # Note, the component names matter here since
-            # [.t2 component] returns names in hash order.
-            # We need to delete cframe first since it
-            # is the parent of cbutton.
+	    # Note, the component names matter here since
+	    # [.t2 component] returns names in hash order.
+	    # We need to delete cframe first since it
+	    # is the parent of cbutton.
 
-            itk_component add cframe {
-                button $itk_option(-container).cframe
-            } {}
-            pack $itk_component(cframe)
+	    itk_component add cframe {
+		button $itk_option(-container).cframe
+	    } {}
+	    pack $itk_component(cframe)
 
-            itk_component add cbutton {
-                button $itk_component(cframe).b -text Button
-            } {}
-            pack $itk_component(cbutton)
-        }
+	    itk_component add cbutton {
+		button $itk_component(cframe).b -text Button
+	    } {}
+	    pack $itk_component(cbutton)
+	}
 
-        itk_option define -container container Container {}
+	itk_option define -container container Container {}
     }
 
     toplevel .t1

win/.cvsignore

@@ -1,4 +0,0 @@
-Debug
-Release
-nmakehlp.obj
-nmakehlp.exe

win/dllEntryPoint.c

@@ -1,4 +1,4 @@
-/* 
+/*
  * dllEntryPoint.c --
  *
  *	This file implements the Dll entry point as needed by Windows.

win/gitmanifest.in

@@ -0,0 +1 @@
+git-

win/itkUuid.h.in

@@ -0,0 +1 @@
+#define ITK_VERSION_UUID \

win/makefile.vc

@@ -1,456 +1,163 @@
-#------------------------------------------------------------------------------
-# Visual C++ 5.0+ makefile for [Incr Tk]
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-# 
-# Copyright (c) 1993-1998 Lucent Technologies, Inc.
-# RCS: $Id: makefile.vc,v 1.29 2006/09/17 01:11:49 davygrvy Exp $
-#------------------------------------------------------------------------------
-#  Do not modify this file!
-#------------------------------------------------------------------------------
-
-!if !exist("makefile.vc")
-MSG = ^
-You must run this makefile only from the directory it is in.^
-Please `cd` to its location first.
-!error $(MSG) 
-!endif
-
-PROJECT	= itk
-!include "..\..\rules.vc"
-
-
-!if $(TCLINSTALL)
-!message *** Warning: [Incr Tk] requires the source distribution of Tcl to build from,
-!message ***    at this time, sorry.  Please set the TCLDIR and TKDIR macros to point
-!message ***    to the sources.
-!endif
-
-ITCLDIR		= ..\..\itcl
-
-
-!if [nmakehlp -g $(ITCLDIR)\generic\itcl.h ITCL_VERSION] == 33
-ITCL_DOTVERSION	= 3.3
-!elseif [nmakehlp -g $(ITCLDIR)\generic\itcl.h ITCL_VERSION] == 34
-ITCL_DOTVERSION	= 3.4
-!elseif [nmakehlp -g $(ITCLDIR)\generic\itcl.h ITCL_VERSION] == 35
-ITCL_DOTVERSION	= 3.5
-!elseif [nmakehlp -g $(ITCLDIR)\generic\itcl.h ITCL_VERSION] == 0
-MSG =^
-Can't get version string from ..\generic\itcl.h
-!error $(MSG)
-!endif
-ITCL_VERSION	= $(ITCL_DOTVERSION:.=)
-
-!if [nmakehlp -g ..\generic\itk.h ITK_VERSION] == 33
-ITK_DOTVERSION	= 3.3
-!elseif [nmakehlp -g ..\generic\itk.h ITK_VERSION] == 34
-ITK_DOTVERSION	= 3.4
-!elseif [nmakehlp -g ..\generic\itk.h ITK_VERSION] == 35
-ITK_DOTVERSION	= 3.5
-!elseif [nmakehlp -g ..\generic\itk.h ITK_VERSION] == 0
-MSG =^
-Can't get version string from ..\generic\itk.h
-!error $(MSG)
-!endif
-ITK_VERSION	= $(ITK_DOTVERSION:.=)
-
-
-BINROOT		= .
-ROOT		= ..
-STUBPREFIX	= $(PROJECT)stub
-
-PKGINDEX	= "$(TMP_DIR)\pkgIndex.tcl"
-
-ITCLLIBNAME	= itcl$(ITCL_VERSION)$(SUFX).$(EXT)
-ITCLLIB		= "$(ITCLDIR)\win\$(OUT_DIR)\$(ITCLLIBNAME)"
-ITKIMPLIB	= "$(OUT_DIR)\$(PROJECT)$(ITK_VERSION)$(SUFX).lib"
-ITKSTUBLIBNAME	= $(STUBPREFIX)$(ITK_VERSION).lib
-ITKSTUBLIB	= "$(OUT_DIR)\$(ITKSTUBLIBNAME)"
-
-!if $(TCL_DOES_STUBS)
-ITKLIBNAME	= $(PROJECT)$(ITK_VERSION)$(SUFX).$(EXT)
-ITCLIMPLIBNAME	= itcl$(ITCL_VERSION)$(SUFX).$(EXT)
-!else
-ITKLIBNAME	= $(PROJECT)$(ITK_VERSION)80$(SUFX).$(EXT)
-ITCLIMPLIBNAME	= itcl$(ITCL_VERSION)80$(SUFX).lib
-!endif
-ITKLIB		= "$(OUT_DIR)\$(ITKLIBNAME)"
-ITCLIMPLIB	= "$(ITCLDIR)\win\Release\$(ITCLIMPLIBNAME)"
-
-
-!if $(TCLINSTALL)
-TKSTUBLIB	= "$(TCLDIR)\lib\tkstub$(TCL_VERSION).lib"
-TKIMPLIB	= "$(TCLDIR)\lib\tk$(TCL_VERSION)$(DBGX).lib"
-WISH		= "$(TCLDIR)\bin\wish$(TCL_VERSION)$(DBGX).exe"
-TCL_LIBRARY	= 
-TK_LIBRARY	= 
-!else
-TKSTUBLIB	= "$(TKDIR)\win\Release\tkstub$(TCL_VERSION).lib"
-TKIMPLIB	= "$(TKDIR)\win\$(OUT_DIR)\tk$(TCL_VERSION)$(DBGX).lib"
-WISH		= "$(TKDIR)\win\$(OUT_DIR)\wish$(TCL_VERSION)$(DBGX).exe"
-TCL_LIBRARY	= "$(TCLDIR)\library"
-TK_LIBRARY	= "$(TKDIR)\library"
-!endif
-ITCL_LIBRARY	= "$(ITCLDIR:\=/)/library"
-ITK_LIBRARY	= "$(ROOT)/library
-
-ITCLSTUBLIBNAME	= itclstub$(ITCL_VERSION).lib
-ITCLSTUBLIB	= "$(ITCLDIR)\win\Release\$(ITCLSTUBLIBNAME)"
-
-### For Tcl 8.0
-!if !$(TCL_DOES_STUBS)
-TCLSTUBLIB	= $(TCLIMPLIB)
-TKSTUBLIB	= $(TKIMPLIB)
-ITCLSTUBLIB	= $(ITCLIMPLIB)
-!endif
-
-
-BIN_INSTALL_DIR		= $(_INSTALLDIR)\bin
-DOC_INSTALL_DIR		= $(_INSTALLDIR)\doc
-LIB_INSTALL_DIR		= $(_INSTALLDIR)\lib
-SCRIPT_INSTALL_DIR	= $(_INSTALLDIR)\lib\itk$(ITK_DOTVERSION)
-INCLUDE_INSTALL_DIR	= $(_INSTALLDIR)\include
-
-ITKOBJS = \
-	$(TMP_DIR)\itk_archetype.obj \
-	$(TMP_DIR)\itk_cmds.obj \
-	$(TMP_DIR)\itk_option.obj \
-	$(TMP_DIR)\itk_util.obj \
-!if !$(STATIC_BUILD)
-	$(TMP_DIR)\dllEntryPoint.obj \
-	$(TMP_DIR)\itk.res \
-!endif
-!if $(TCL_DOES_STUBS)
-	$(TMP_DIR)\itkStubInit.obj
-!endif
-
-ITKSTUBOBJS = \
-!if $(TCL_DOES_STUBS)
-    $(TMP_DIR)\itkStubLib.obj
-!endif
-
-GENERICDIR	= $(ROOT)\generic
-DOCDIR		= $(ROOT)\doc
-WINDIR		= $(ROOT)\win
-RCDIR		= $(ROOT)\win\rc
-TOOLSDIR	= ..\..\tools
-
-#---------------------------------------------------------------------
-# Link flags
-#---------------------------------------------------------------------
-
-!if $(DEBUG)
-ldebug	= -debug:full -debugtype:cv
-!else
-ldebug	= -release -opt:ref -opt:icf,3
-!endif
-
-# declarations common to all linker options
-lflags	= -nologo -machine:$(MACHINE) $(ldebug)
-
-!if $(PROFILE)
-lflags	= $(lflags) -profile
-!endif
-
-!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
-# align sections for PE size savings.
-lflags	= $(lflags) -opt:nowin98
-!else if !$(ALIGN98_HACK) && $(STATIC_BUILD)
-# align sections for speed in loading by choosing the virtual page size.
-lflags	= $(lflags) -align:4096
-!endif
-
-!if $(LOIMPACT)
-lflags	= $(lflags) -ws:aggressive
-!endif
-
-ITK_LFLAGS = $(lflags) -subsystem:windows -dll
-ITK_LLIBS	= $(TCLSTUBLIB) $(TKSTUBLIB) $(ITCLSTUBLIB)
-
-!if exist("$(TCLDIR)\win\coffbase.txt")
-ITK_DLLBASE	= -base:@$(TCLDIR)\win\coffbase.txt,itk
-!else
-ITK_DLLBASE	=
-!endif
-
-#---------------------------------------------------------------------
-# Compile flags
-#---------------------------------------------------------------------
-
-!if $(DEBUG)
-!if "$(MACHINE)" == "IA64"
-cdebug = -Od -Zi
-!else
-cdebug = -Z7 -Od -WX
-!endif
-!else
-# This cranks the optimization level up to max.
-cdebug = -O2
-!endif
-
-# declarations common to all compiler options
-cflags = -nologo -c -W3 -YX -Fp$(TMP_DIR)^\
-
-!if $(PENT_0F_ERRATA)
-cflags = $(cflags) -QI0f
-!endif
-
-!if $(ITAN_B_ERRATA)
-cflags = $(cflags) -QIA64_Bx
-!endif
-
-!if $(MSVCRT)
-crt = -MD$(DBGX)
-!else
-crt = -MT$(DBGX)
-!endif
-
-!if $(TCLINSTALL)
-TCL_INCLUDES	= -I"$(TCLDIR)\include"
-TK_INCLUDES	= 
-!else
-TCL_INCLUDES	= -I"$(TCLDIR)\generic" -I"$(TCLDIR)\win"
-TK_INCLUDES	= -I"$(TKDIR)\generic" -I"$(TKDIR)\xlib"
-!endif
-
-ITK_INCLUDES	= -I$(WINDIR) -I$(GENERICDIR)
-ITCL_INCLUDES	= -I"$(ITCLDIR)\generic"
-ITK_DEFINES	= -DBUILD_itk -DTCL_THREADS=1
-ITK_EXE_CFLAGS	= $(cdebug) $(cflags) $(crt) $(ITCL_INCLUDES) $(ITK_INCLUDES) \
-		$(TCL_INCLUDES) $(TK_INCLUDES) $(ITK_DEFINES)
-
-### By convention, static builds do not use Stubs.  This is just a practice,
-### not a technical limitation.
-!if $(STATIC_BUILD)
-ITK_CFLAGS	= $(ITK_EXE_CFLAGS) -DSTATIC_BUILD $(OPTDEFINES)
-!elseif $(TCL_DOES_STUBS)
-ITK_CFLAGS	= $(ITK_EXE_CFLAGS) -DUSE_TCL_STUBS -DUSE_TK_STUBS -DUSE_ITCL_STUBS $(OPTDEFINES)
-!else
-ITK_CFLAGS	= $(ITK_EXE_CFLAGS) $(OPTDEFINES)
-!endif
-
-#---------------------------------------------------------------------
-# Project specific targets
-#---------------------------------------------------------------------
-
-all :     setup $(ITKLIB) $(ITKSTUBLIB)
-release : setup $(ITKLIB) $(ITKSTUBLIB)
-install	: install-binaries install-docs
-
-!if $(STATIC_BUILD)
-test :
-	@echo test target not supported for a static library.
-!else
-test : setup $(ITKLIB) $(ITKSTUBLIB)
-	set TCL_LIBRARY=$(TCL_LIBRARY)
-	set TK_LIBRARY=$(TK_LIBRARY)
-	set ITCL_LIBRARY=$(ITCL_LIBRARY)
-	set ITK_LIBRARY=$(ITK_LIBRARY)
-	$(TCLSH) ..\tests\all.tcl $(TESTFLAGS) -loadfile <<
-	load [file normalize $(ITCLLIB:\=/)] Itcl
-	load [file normalize $(ITKLIB:\=/)] Itk
-<<
-!endif
-
-setup :
-	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)
-	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
-
-$(ITKLIB): $(ITKOBJS)
-!if $(STATIC_BUILD)
-	$(lib32) -nologo -machine:$(MACHINE) -out:$@ @<<
-!else
-	$(link32) $(ITK_LFLAGS) $(ITK_DLLBASE) -out:$@ $(ITK_LLIBS) @<<
-!endif
-		$(ITKOBJS)
-<<
-
-
-!if $(TCL_DOES_STUBS)
-$(ITKSTUBLIB) : $(ITKSTUBOBJS)
-	$(lib32) -nologo -out:$@ $(ITKSTUBOBJS)
-!endif
-
-install-binaries:
-	if not exist "$(_INSTALLDIR)" mkdir "$(_INSTALLDIR)"
-	if not exist "$(BIN_INSTALL_DIR)" mkdir "$(BIN_INSTALL_DIR)"
-	if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)"
-	if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
-	if not exist "$(INCLUDE_INSTALL_DIR)" mkdir "$(INCLUDE_INSTALL_DIR)"
-	copy $(ITKLIB) "$(SCRIPT_INSTALL_DIR)"
-!if $(ITKSTUBLIB) != ""
-	copy $(ITKSTUBLIB) "$(LIB_INSTALL_DIR)"
-!endif
-	copy $(ROOT)\generic\itk.h "$(INCLUDE_INSTALL_DIR)"
-	copy $(ROOT)\generic\itkDecls.h "$(INCLUDE_INSTALL_DIR)"
-	copy $(ROOT)\library\*.* "$(SCRIPT_INSTALL_DIR)"
-	echo if {[package vsatisfies 8.0 [package provide Tcl]]} {\
-		> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo ^ ^ ^ ^ set add 80>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo } else {>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo ^ ^ ^ ^ set add {}>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo }>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo if {[info exists ::tcl_platform(debug)] ^&^&\
-		$$::tcl_platform(debug)	^&^& \>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo ^ ^ ^ ^ ^ ^ ^ ^ [file exists [file join $$dir\
-		$(PROJECT)$(ITK_VERSION)$${add}g.dll]]}\
-		{>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo ^ ^ ^ ^ package ifneeded Itk $(ITK_DOTVERSION) [list load\
-		[file join $$dir $(PROJECT)$(ITK_VERSION)$${add}g.dll]\
-		Itk]>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo } else {>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo ^ ^ ^ ^ package ifneeded Itk $(ITK_DOTVERSION) [list load\
-		[file join $$dir $(PROJECT)$(ITK_VERSION)$${add}.dll]\
-		Itk]>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo }>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-	echo unset add>> "$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
-
-
-#---------------------------------------------------------------------
-# Regenerate the stubs files.
-#---------------------------------------------------------------------
-
-!if !$(TCLINSTALL)
-# Only from the sources of Tcl does genStubs.tcl exist.
-genstubs:
-    $(TCLSH) $(TOOLSDIR)\genStubs.tcl $(GENERICDIR) \
-        $(GENERICDIR)\itk.decls
-!else
-genstubs:
-    @echo ERROR: Can't rebuild stubs tables without the Tcl source distribution
-!endif
-
-#---------------------------------------------------------------------
-# Special case object file targets
-#---------------------------------------------------------------------
-
-# The following object is part of the stub library and should not
-# be built as DLL objects but none of the symbols should be exported
-
-$(TMP_DIR)\itkStubLib.obj : $(GENERICDIR)\itkStubLib.c
-    $(cc32) -DSTATIC_BUILD $(ITK_EXE_CFLAGS) -Zl -Fo$@ $?
-
-#---------------------------------------------------------------------
-# Inference rules.
-#---------------------------------------------------------------------
-
-{$(WINDIR)}.c{$(TMP_DIR)}.obj ::
-	$(cc32) $(ITK_CFLAGS) -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(GENERICDIR)}.c{$(TMP_DIR)}.obj ::
-	$(cc32) $(ITK_CFLAGS) -Fo$(TMP_DIR)\ @<<
-$<
-<<
-
-{$(RCDIR)}.rc{$(TMP_DIR)}.res :
-	$(rc32) -fo $@ -DDEBUG=$(DEBUG) $(ITK_INCLUDES) $(TCL_INCLUDES) $(ITCL_INCLUDES) $(ITK_DEFINES) $<
-
-#---------------------------------------------------------------------
-# Generate the windows help files.
-#---------------------------------------------------------------------
-
-HLPBASE		= $(PROJECT)$(ITK_VERSION)
-HELPFILE	= $(OUT_DIR)\$(HLPBASE).hlp
-HELPCNT		= $(OUT_DIR)\$(HLPBASE).cnt
-DOCTMP_DIR	= $(OUT_DIR)\$(PROJECT)_docs
-HELPRTF		= $(DOCTMP_DIR)\$(PROJECT).rtf
-MAN2HELP	= $(DOCTMP_DIR)\man2help.tcl
-MAN2HELP2	= $(DOCTMP_DIR)\man2help2.tcl
-INDEX		= $(DOCTMP_DIR)\index.tcl
-BMP		= $(DOCTMP_DIR)\toaster.bmp
-BMP_NOPATH	= toaster.bmp
-MAN2TCL		= $(DOCTMP_DIR)\man2tcl.exe
-
-winhelp: docsetup $(HELPFILE)
-
-docsetup:
-	@if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)
-
-$(MAN2HELP) $(MAN2HELP2) $(INDEX): $(TCLTOOLSDIR)\$$(@F)
-	copy $(TCLTOOLSDIR)\$(@F) $(@D)
-
-$(BMP):
-	copy $(WINDIR)\$(@F) $(@D)
-
-$(HELPFILE): $(HELPRTF) $(BMP)
-	cd $(DOCTMP_DIR)
-	start /wait hcrtf.exe -x <<$(PROJECT).hpj
-[OPTIONS]
-COMPRESS=12 Hall Zeck
-LCID=0x409 0x0 0x0 ; English (United States)
-TITLE=[Incr Tk] Reference Manual
-BMROOT=.
-CNT=$(@B).cnt
-HLP=$(@B).hlp
-
-[FILES]
-$(PROJECT).rtf
-
-[WINDOWS]
-main="[Incr Tk] Reference Manual",,27648,(r15263976),(r65280)
-
-[CONFIG]
-BrowseButtons()
-CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
-CreateButton(2, "SF", ExecFile("http://sf.net/projects/incrtcl"))
-CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
-CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
-<<
-	cd $(MAKEDIR)
-	copy "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
-	copy "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"
-
-$(MAN2TCL): $(TCLTOOLSDIR)\$$(@B).c
-	$(cc32) -nologo -G4 -ML -O2 -Fo$(@D)\ $(TCLTOOLSDIR)\$(@B).c -link -out:$@
-
-$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX)
-	$(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(ITK_VERSION) $(DOCDIR:\=/)
-
-install-docs:
-!if exist($(HELPFILE))
-	@xcopy /i /y "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
-	@xcopy /i /y "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
-	$(TCLSH) <<
-puts "Installing $(PROJECT)'s helpfile contents into Tcl's ..."
-set f [open {$(DOC_INSTALL_DIR:\=/)/tcl$(TCL_VERSION).cnt} r]
-while {![eof $$f]} {
-    if {[regexp {:Include $(PROJECT)([0-9]{2}).cnt} [gets $$f] dummy ver]} {
-	if {$$ver == $(ITK_VERSION)} {
-	    puts "Already installed."
-	    exit
-	} else {
-	    # do something here logical to remove (or replace) it.
-	    puts "$$ver != $(ITK_VERSION), unfinished code path, die, die!"
-	    exit 1
-	}
-    }
-}
-close $$f
-set f [open {$(DOC_INSTALL_DIR:\=/)/tcl$(TCL_VERSION).cnt} a]
-puts $$f {:Include $(HLPBASE).cnt}
-close $$f
-<<
-	start /wait winhlp32 -g $(DOC_INSTALL_DIR)\tcl$(TCL_VERSION).hlp
-!endif
-
-#---------------------------------------------------------------------
-# Clean up
-#---------------------------------------------------------------------
-
-tidy :
-	-del $(TMP_DIR)\*.pch
-	-del $(TMP_DIR)\*.obj
-	-del $(TMP_DIR)\*.res
-
-clean : tidy
-	-del $(OUT_DIR)\*.exp
-	-del $(OUT_DIR)\*.lib
-	-del $(OUT_DIR)\*.dll
-
-hose : clean
-	-rmdir $(OUT_DIR)
-	-rmdir $(TMP_DIR)
+#------------------------------------------------------------- -*- makefile -*-
+#
+# Makefile for [Incr Tk] interface
+#
+# Basic build, test and install
+#   nmake /f makefile.vc INSTALLDIR=c:\path\to\installdir
+#   nmake /f makefile.vc INSTALLDIR=c:\path\to\installdir test
+#   nmake /f makefile.vc INSTALLDIR=c:\path\to\installdir install
+#
+# For other build options (debug, static etc.),
+# See TIP 477 (https://core.tcl-lang.org/tips/doc/main/tip/477.md) for
+# detailed documentation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#------------------------------------------------------------------------------
+
+PROJECT = itk
+# Tcl 8.6 etc. compile with /DUNICODE. ITK pre-nmake reform compiled
+# without -DUNICODE. Keep that behaviour for now.
+USE_WIDECHAR_API  = 0
+NEED_TK = 1
+
+PRJ_DEFINES	= $(PRJ_DEFINES) -Dinline=__inline
+PRJ_DEFINES = $(PRJ_DEFINES)
+PRJ_DEFINES = $(PRJ_DEFINES) -I$(TMP_DIR)
+
+!include "rules-ext.vc"
+
+# nmakehelp -V <file> <tag> will search the file for tag, skips until a
+#	number and returns all character until a character not in [0-9.ab]
+#	is read.
+!if [echo REM = This file is generated from Makefile.vc > versions.vc]
+!endif
+!if [echo TCL_VERSION_REQ = \>> versions.vc] \
+   && [nmakehlp -V ..\configure.ac TCL_VERSION_REQ >> versions.vc]
+!endif
+!include "versions.vc"
+
+PRJ_OBJS = \
+	$(TMP_DIR)\itkArchBase.obj \
+	$(TMP_DIR)\itkArchetype.obj \
+	$(TMP_DIR)\itkBase.obj \
+	$(TMP_DIR)\itkCmd.obj \
+	$(TMP_DIR)\itkHelpers.obj \
+	$(TMP_DIR)\itkOption.obj \
+	$(TMP_DIR)\itkUtil.obj \
+	$(TMP_DIR)\itkStubInit.obj
+
+
+# Uncomment the following line if you want to build and install stubs
+PRJ_STUBOBJS = $(TMP_DIR)\itkStubLib.obj
+
+PRJ_HEADERS = \
+	$(GENERICDIR)\itkInt.h \
+	$(GENERICDIR)\itk.h
+
+# Locate ITCL headers and libraries.
+# In principle, we don't need the ITCL source directory, and an installed
+# ITCL should suffice. But that needs additional machinery not implemented
+# yet.
+!if [echo ITCL_DIR = \> nmakehlp.out] \
+   || [nmakehlp -L generic\itcl.h >> nmakehlp.out]
+!error Could not locate ITCL source directory.
+!endif
+# Locate TK headers and libraries.
+# In principle, we don't need the TK source directory, and an installed
+# TK should suffice. But that needs additional machinery not implemented
+# yet.
+!if [echo TK_DIR = \> nmakehlp.out] \
+   || [nmakehlp -L generic\tk.h >> nmakehlp.out]
+!error Could not locate TK source directory.
+!endif
+!include nmakehlp.out
+
+# Get the ITCL version from its configure.ac
+!if [echo ITCL_DOTVERSION = \> versions.vc] \
+   && [nmakehlp -V "$(ITCL_DIR)\configure.ac" itcl >> versions.vc]
+!error Could not retrieve ITCL version.
+!endif
+# Get the TK version from its configure.ac
+!if [echo TK_DOTVERSION = \> versions.vc] \
+   && [nmakehlp -V "$(TK_DIR)\configure.ac" tk >> versions.vc]
+!error Could not retrieve TK version.
+!endif
+!include versions.vc
+
+ITCL_VERSION     = $(ITCL_DOTVERSION:.=)
+ITCL_GENERIC_DIR = $(ITCL_DIR)\generic
+!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
+ITCLSTUBLIBNAME	 = itclstub$(ITCL_VERSION).lib
+ITCL_LIB_FILE	 = itcl$(ITCL_VERSION).dll
+!else
+ITCLSTUBLIBNAME	 = itclstub.lib
+ITCL_LIB_FILE	 = tcl9itcl$(ITCL_VERSION).dll
+!endif
+ITCLSTUBLIB	 = $(ITCL_DIR)\win\$(BUILDDIRTOP)\$(ITCLSTUBLIBNAME)
+ITCL_BIN_DIR     = $(ITCL_DIR)/win/$(BUILDDIRTOP)
+
+TK_VERSION     = $(TK_DOTVERSION:.=)
+TK_GENERIC_DIR = $(TK_DIR)\generic
+TK_XLIB_DIR = $(TK_DIR)\xlib
+!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
+TKSTUBLIBNAME	 = tkstub$(TK_VERSION).lib
+!else
+TKSTUBLIBNAME	 = tkstub.lib
+!endif
+TKSTUBLIB	 = $(TK_DIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
+TK_BIN_DIR     = $(TK_DIR)/win/$(BUILDDIRTOP)
+
+PRJ_INCLUDES	= -I"$(ITCL_GENERIC_DIR)" -I"$(TK_GENERIC_DIR)" -I"$(TK_XLIB_DIR)"
+
+!if !$(STATIC_BUILD)
+PRJ_LIBS  = $(ITCLSTUBLIB) $(TKSTUBLIB)
+!endif
+
+# Disable standard test target because we have a custom one
+DISABLE_TARGET_test = 1
+!include "$(_RULESDIR)\targets.vc"
+
+# Additional default actions for install
+install: default-install-docs-n
+
+# The TIP 477 generation of pkgIndex.tcl from pkgIndex.tcl.in does not include
+# all replacements below so define our own target.
+pkgindex:   $(OUT_DIR)\pkgIndex.tcl
+$(OUT_DIR)\pkgIndex.tcl: $(ROOT)\pkgIndex.tcl.in
+	@nmakehlp -s << $** > $@
+@PACKAGE_NAME@        $(PROJECT)
+@PACKAGE_VERSION@     $(DOTVERSION)
+@TCL_VERSION_REQ@     $(TCL_VERSION_REQ)
+@PKG_LIB_FILE@        $(PRJLIBNAME)
+@PKG_LIB_FILE8@       $(PRJLIBNAME8)
+@PKG_LIB_FILE9@       $(PRJLIBNAME9)
+<<
+
+$(ROOT)\manifest.uuid:
+   copy $(WIN_DIR)\gitmanifest.in $(ROOT)\manifest.uuid
+   git rev-parse HEAD >>$(ROOT)\manifest.uuid
+
+$(TMP_DIR)\itkUuid.h:	$(ROOT)\manifest.uuid
+	copy $(WIN_DIR)\itkUuid.h.in+$(ROOT)\manifest.uuid $(TMP_DIR)\itkUuid.h
+
+test: setup $(PROJECT)
+	@echo testing itk
+	@set ITK_LIBRARY=$(LIBDIR:\=/)
+	@$(CPY) $(LIBDIR)\*.tcl $(OUT_DIR)
+!if $(TKINSTALL)
+	@set PATH=$(_TKDIR)\bin;$(PATH)
+	$(DEBUGGER) $(WISH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS)
+!else
+	@set PATH=$(_TKDIR)\win\$(BUILDDIRTOP);$(PATH)
+	$(DEBUGGER) $(WISH) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) \
+		-load "package ifneeded itk $(DOTVERSION) \
+			{source {$(LIBDIR:\=/)/itk.tcl};load {$(PRJLIB:\=/)} [string totitle $(PROJECT)]};\
+		package ifneeded itcl $(ITCL_DOTVERSION) \
+			{source {$(ITCL_BIN_DIR:\=/)/itcl.tcl};load {$(ITCL_BIN_DIR:\=/)/$(ITCL_LIB_FILE)} Itcl}"
+!endif
+
+
+# Explicit dependency rules
+$(GENERICDIR)\itkBase.c : $(TMP_DIR)\itkUuid.h

win/nmakehlp.c

@@ -1,31 +1,53 @@
-/* ----------------------------------------------------------------------------
+/*
+ * ----------------------------------------------------------------------------
  * nmakehlp.c --
  *
  *	This is used to fix limitations within nmake and the environment.
  *
- * Copyright (c) 2002 by David Gravereaux.
+ * Copyright (c) 2002 David Gravereaux.
+ * Copyright (c) 2006 Pat Thoyts
  *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * ----------------------------------------------------------------------------
- * RCS: @(#) $Id: nmakehlp.c,v 1.4 2004/04/29 17:40:44 davygrvy Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  * ----------------------------------------------------------------------------
  */
+
+#define _CRT_SECURE_NO_DEPRECATE
 #include <windows.h>
+#ifdef _MSC_VER
 #pragma comment (lib, "user32.lib")
 #pragma comment (lib, "kernel32.lib")
+#endif
 #include <stdio.h>
-#include <math.h>
+
+/*
+ * This library is required for x64 builds with _some_ versions of MSVC
+ */
+#if defined(_M_IA64) || defined(_M_AMD64)
+#if _MSC_VER >= 1400 && _MSC_VER < 1500
+#pragma comment(lib, "bufferoverflowU")
+#endif
+#endif
+
+/* ISO hack for dumb VC++ */
+#if defined(_WIN32) && defined(_MSC_VER) && _MSC_VER < 1900
+#define   snprintf	_snprintf
+#endif
+
 
 /* protos */
-int CheckForCompilerFeature (const char *option);
-int CheckForLinkerFeature (const char *option);
-int IsIn (const char *string, const char *substring);
-int GrepForDefine (const char *file, const char *string);
-DWORD WINAPI ReadFromPipe (LPVOID args);
+
+static int CheckForCompilerFeature(const char *option);
+static int CheckForLinkerFeature(char **options, int count);
+static int IsIn(const char *string, const char *substring);
+static int SubstituteFile(const char *substs, const char *filename);
+static int QualifyPath(const char *path);
+static int LocateDependency(const char *keyfile);
+static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
+static DWORD WINAPI ReadFromPipe(LPVOID args);
 
 /* globals */
+
 #define CHUNK	25
 #define STATICBUFFERSIZE    1000
 typedef struct {
@@ -33,23 +55,33 @@ typedef struct {
     char buffer[STATICBUFFERSIZE];
 } pipeinfo;
 
-pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'};
-pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};
+pipeinfo Out = {INVALID_HANDLE_VALUE, ""};
+pipeinfo Err = {INVALID_HANDLE_VALUE, ""};
+
+/*
+ * exitcodes: 0 == no, 1 == yes, 2 == error
+ */
 
-
-
-/* exitcodes: 0 == no, 1 == yes, 2 == error */
 int
-main (int argc, char *argv[])
+main(
+    int argc,
+    char *argv[])
 {
     char msg[300];
     DWORD dwWritten;
     int chars;
+    const char *s;
+
+    /*
+     * Make sure children (cl.exe and link.exe) are kept quiet.
+     */
 
-    /* make sure children (cl.exe and link.exe) are kept quiet. */
     SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX);
 
-    /* Make sure the compiler and linker aren't effected by the outside world. */
+    /*
+     * Make sure the compiler and linker aren't effected by the outside world.
+     */
+
     SetEnvironmentVariable("CL", "");
     SetEnvironmentVariable("LINK", "");
 
@@ -57,56 +89,111 @@ main (int argc, char *argv[])
 	switch (*(argv[1]+1)) {
 	case 'c':
 	    if (argc != 3) {
-		chars = wsprintf(msg, "usage: %s -c <compiler option>\n"
+		chars = snprintf(msg, sizeof(msg) - 1,
+			"usage: %s -c <compiler option>\n"
 			"Tests for whether cl.exe supports an option\n"
 			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
-		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+			&dwWritten, NULL);
 		return 2;
 	    }
 	    return CheckForCompilerFeature(argv[2]);
 	case 'l':
-	    if (argc != 3) {
-		chars = wsprintf(msg, "usage: %s -l <linker option>\n"
+	    if (argc < 3) {
+		chars = snprintf(msg, sizeof(msg) - 1,
+			"usage: %s -l <linker option> ?<mandatory option> ...?\n"
 			"Tests for whether link.exe supports an option\n"
 			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
-		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+			&dwWritten, NULL);
 		return 2;
 	    }
-	    return CheckForLinkerFeature(argv[2]);
+	    return CheckForLinkerFeature(&argv[2], argc-2);
 	case 'f':
 	    if (argc == 2) {
-		chars = wsprintf(msg, "usage: %s -f <string> <substring>\n"
-		    "Find a substring within another\n"
-		    "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
-		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+		chars = snprintf(msg, sizeof(msg) - 1,
+			"usage: %s -f <string> <substring>\n"
+			"Find a substring within another\n"
+			"exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+			&dwWritten, NULL);
 		return 2;
 	    } else if (argc == 3) {
-		/* if the string is blank, there is no match */
+		/*
+		 * If the string is blank, there is no match.
+		 */
+
 		return 0;
 	    } else {
 		return IsIn(argv[2], argv[3]);
 	    }
-	case 'g':
+	case 's':
 	    if (argc == 2) {
-		chars = wsprintf(msg, "usage: %s -g <file> <string>\n"
-		    "grep for a #define\n"
-		    "exitcodes: integer of the found string (no decimals)\n", argv[0]);
-		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
+		chars = snprintf(msg, sizeof(msg) - 1,
+			"usage: %s -s <substitutions file> <file>\n"
+			"Perform a set of string map type substutitions on a file\n"
+			"exitcodes: 0\n",
+			argv[0]);
+		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+			&dwWritten, NULL);
 		return 2;
 	    }
-	    return GrepForDefine(argv[2], argv[3]);
+	    return SubstituteFile(argv[2], argv[3]);
+	case 'V':
+	    if (argc != 4) {
+		chars = snprintf(msg, sizeof(msg) - 1,
+		    "usage: %s -V filename matchstring\n"
+		    "Extract a version from a file:\n"
+		    "eg: pkgIndex.tcl \"package ifneeded http\"",
+		    argv[0]);
+		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+		    &dwWritten, NULL);
+		return 0;
+	    }
+	    s = GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0');
+	    if (s && *s) {
+		printf("%s\n", s);
+		return 0;
+	    } else
+		return 1; /* Version not found. Return non-0 exit code */
+
+	case 'Q':
+	    if (argc != 3) {
+		chars = snprintf(msg, sizeof(msg) - 1,
+		    "usage: %s -Q path\n"
+		    "Emit the fully qualified path\n"
+		    "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]);
+		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+		    &dwWritten, NULL);
+		return 2;
+	    }
+	    return QualifyPath(argv[2]);
+
+	case 'L':
+	    if (argc != 3) {
+		chars = snprintf(msg, sizeof(msg) - 1,
+		    "usage: %s -L keypath\n"
+		    "Emit the fully qualified path of directory containing keypath\n"
+		    "exitcodes: 0 == success, 1 == not found, 2 == error\n", argv[0]);
+		WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars,
+		    &dwWritten, NULL);
+		return 2;
+	    }
+	    return LocateDependency(argv[2]);
 	}
     }
-    chars = wsprintf(msg, "usage: %s -c|-l|-f ...\n"
+    chars = snprintf(msg, sizeof(msg) - 1,
+	    "usage: %s -c|-f|-l|-Q|-s|-V ...\n"
 	    "This is a little helper app to equalize shell differences between WinNT and\n"
 	    "Win9x and get nmake.exe to accomplish its job.\n",
 	    argv[0]);
     WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL);
     return 2;
 }
-
-int
-CheckForCompilerFeature (const char *option)
+
+static int
+CheckForCompilerFeature(
+    const char *option)
 {
     STARTUPINFO si;
     PROCESS_INFORMATION pi;
@@ -119,35 +206,55 @@ CheckForCompilerFeature (const char *option)
 
     hProcess = GetCurrentProcess();
 
-    ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
-    ZeroMemory(&si, sizeof(STARTUPINFO));
+    memset(&pi, 0, sizeof(PROCESS_INFORMATION));
+    memset(&si, 0, sizeof(STARTUPINFO));
     si.cb = sizeof(STARTUPINFO);
     si.dwFlags   = STARTF_USESTDHANDLES;
     si.hStdInput = INVALID_HANDLE_VALUE;
 
-    ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
+    memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
     sa.nLength = sizeof(SECURITY_ATTRIBUTES);
     sa.lpSecurityDescriptor = NULL;
     sa.bInheritHandle = FALSE;
 
-    /* create a non-inheritible pipe. */
+    /*
+     * Create a non-inheritable pipe.
+     */
+
     CreatePipe(&Out.pipe, &h, &sa, 0);
 
-    /* dupe the write side, make it inheritible, and close the original. */
-    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 
-	    0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+    /*
+     * Dupe the write side, make it inheritable, and close the original.
+     */
+
+    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
+	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+
+    /*
+     * Same as above, but for the error side.
+     */
 
-    /* Same as above, but for the error side. */
     CreatePipe(&Err.pipe, &h, &sa, 0);
-    DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 
-	    0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+    DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
+	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
 
-    /* base command line */
-    strcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X ");
-    /* append our option for testing */
-    strcat(cmdline, option);
-    /* filename to compile, which exists, but is nothing and empty. */
-    strcat(cmdline, " .\\nul");
+    /*
+     * Base command line.
+     */
+
+    lstrcpy(cmdline, "cl.exe -nologo -c -TC -Zs -X -Fp.\\_junk.pch ");
+
+    /*
+     * Append our option for testing
+     */
+
+    lstrcat(cmdline, option);
+
+    /*
+     * Filename to compile, which exists, but is nothing and empty.
+     */
+
+    lstrcat(cmdline, " .\\nul");
 
     ok = CreateProcess(
 	    NULL,	    /* Module name. */
@@ -163,41 +270,65 @@ CheckForCompilerFeature (const char *option)
 
     if (!ok) {
 	DWORD err = GetLastError();
-	int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
+	int chars = snprintf(msg, sizeof(msg) - 1,
+		"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
 
-	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS |
-		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars],
+	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
+		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
 		(300-chars), 0);
-	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL);
+	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
 	return 2;
     }
 
-    /* close our references to the write handles that have now been inherited. */
+    /*
+     * Close our references to the write handles that have now been inherited.
+     */
+
     CloseHandle(si.hStdOutput);
     CloseHandle(si.hStdError);
 
     WaitForInputIdle(pi.hProcess, 5000);
     CloseHandle(pi.hThread);
 
-    /* start the pipe reader threads. */
+    /*
+     * Start the pipe reader threads.
+     */
+
     pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
     pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
 
-    /* block waiting for the process to end. */
+    /*
+     * Block waiting for the process to end.
+     */
+
     WaitForSingleObject(pi.hProcess, INFINITE);
     CloseHandle(pi.hProcess);
 
-    /* wait for our pipe to get done reading, should it be a little slow. */
+    /*
+     * Wait for our pipe to get done reading, should it be a little slow.
+     */
+
     WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
     CloseHandle(pipeThreads[0]);
     CloseHandle(pipeThreads[1]);
 
-    /* look for the commandline warning code in both streams. */
-    return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL);
-}
+    /*
+     * Look for the commandline warning code in both streams.
+     *  - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
+     */
 
-int
-CheckForLinkerFeature (const char *option)
+    return !(strstr(Out.buffer, "D4002") != NULL
+	    || strstr(Err.buffer, "D4002") != NULL
+	    || strstr(Out.buffer, "D9002") != NULL
+	    || strstr(Err.buffer, "D9002") != NULL
+	    || strstr(Out.buffer, "D2021") != NULL
+	    || strstr(Err.buffer, "D2021") != NULL);
+}
+
+static int
+CheckForLinkerFeature(
+    char **options,
+    int count)
 {
     STARTUPINFO si;
     PROCESS_INFORMATION pi;
@@ -206,37 +337,58 @@ CheckForLinkerFeature (const char *option)
     char msg[300];
     BOOL ok;
     HANDLE hProcess, h, pipeThreads[2];
-    char cmdline[100];
+    int i;
+    char cmdline[255];
 
     hProcess = GetCurrentProcess();
 
-    ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
-    ZeroMemory(&si, sizeof(STARTUPINFO));
+    memset(&pi, 0, sizeof(PROCESS_INFORMATION));
+    memset(&si, 0, sizeof(STARTUPINFO));
     si.cb = sizeof(STARTUPINFO);
     si.dwFlags   = STARTF_USESTDHANDLES;
     si.hStdInput = INVALID_HANDLE_VALUE;
 
-    ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
+    memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
     sa.nLength = sizeof(SECURITY_ATTRIBUTES);
     sa.lpSecurityDescriptor = NULL;
     sa.bInheritHandle = TRUE;
 
-    /* create a non-inheritible pipe. */
+    /*
+     * Create a non-inheritible pipe.
+     */
+
     CreatePipe(&Out.pipe, &h, &sa, 0);
 
-    /* dupe the write side, make it inheritible, and close the original. */
-    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 
-	    0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+    /*
+     * Dupe the write side, make it inheritable, and close the original.
+     */
+
+    DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, 0, TRUE,
+	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+
+    /*
+     * Same as above, but for the error side.
+     */
 
-    /* Same as above, but for the error side. */
     CreatePipe(&Err.pipe, &h, &sa, 0);
-    DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 
-	    0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
+    DuplicateHandle(hProcess, h, hProcess, &si.hStdError, 0, TRUE,
+	    DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE);
 
-    /* base command line */
-    strcpy(cmdline, "link.exe -nologo ");
-    /* append our option for testing */
-    strcat(cmdline, option);
+    /*
+     * Base command line.
+     */
+
+    lstrcpy(cmdline, "link.exe -nologo ");
+
+    /*
+     * Append our option for testing.
+     */
+
+    for (i = 0; i < count; i++) {
+	lstrcat(cmdline, " \"");
+	lstrcat(cmdline, options[i]);
+	lstrcat(cmdline, "\"");
+    }
 
     ok = CreateProcess(
 	    NULL,	    /* Module name. */
@@ -252,51 +404,73 @@ CheckForLinkerFeature (const char *option)
 
     if (!ok) {
 	DWORD err = GetLastError();
-	int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
+	int chars = snprintf(msg, sizeof(msg) - 1,
+		"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
 
-	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS |
-		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars],
+	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
+		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
 		(300-chars), 0);
-	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL);
+	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
 	return 2;
     }
 
-    /* close our references to the write handles that have now been inherited. */
+    /*
+     * Close our references to the write handles that have now been inherited.
+     */
+
     CloseHandle(si.hStdOutput);
     CloseHandle(si.hStdError);
 
     WaitForInputIdle(pi.hProcess, 5000);
     CloseHandle(pi.hThread);
 
-    /* start the pipe reader threads. */
+    /*
+     * Start the pipe reader threads.
+     */
+
     pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID);
     pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID);
 
-    /* block waiting for the process to end. */
+    /*
+     * Block waiting for the process to end.
+     */
+
     WaitForSingleObject(pi.hProcess, INFINITE);
     CloseHandle(pi.hProcess);
 
-    /* wait for our pipe to get done reading, should it be a little slow. */
+    /*
+     * Wait for our pipe to get done reading, should it be a little slow.
+     */
+
     WaitForMultipleObjects(2, pipeThreads, TRUE, 500);
     CloseHandle(pipeThreads[0]);
     CloseHandle(pipeThreads[1]);
 
-    /* look for the commandline warning code in the stderr stream. */
-    return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL);
-}
+    /*
+     * Look for the commandline warning code in the stderr stream.
+     */
 
-DWORD WINAPI
-ReadFromPipe (LPVOID args)
+    return !(strstr(Out.buffer, "LNK1117") != NULL ||
+	    strstr(Err.buffer, "LNK1117") != NULL ||
+	    strstr(Out.buffer, "LNK4044") != NULL ||
+	    strstr(Err.buffer, "LNK4044") != NULL ||
+	    strstr(Out.buffer, "LNK4224") != NULL ||
+	    strstr(Err.buffer, "LNK4224") != NULL);
+}
+
+static DWORD WINAPI
+ReadFromPipe(
+    LPVOID args)
 {
     pipeinfo *pi = (pipeinfo *) args;
     char *lastBuf = pi->buffer;
     DWORD dwRead;
     BOOL ok;
 
-again:
+  again:
     if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) {
 	CloseHandle(pi->pipe);
-	return -1;
+	return (DWORD)-1;
     }
     ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L);
     if (!ok || dwRead == 0) {
@@ -308,52 +482,339 @@ again:
 
     return 0;  /* makes the compiler happy */
 }
-
-int
-IsIn (const char *string, const char *substring)
+
+static int
+IsIn(
+    const char *string,
+    const char *substring)
 {
     return (strstr(string, substring) != NULL);
 }
-
+
 /*
- *  Find a specified #define by name.
- *
- *  If the line is '#define TCL_VERSION "8.5"', it returns
- *  85 as the result.
+ * GetVersionFromFile --
+ *	Looks for a match string in a file and then returns the version
+ *	following the match where a version is anything acceptable to
+ *	package provide or package ifneeded.
  */
 
-int
-GrepForDefine (const char *file, const char *string)
+static const char *
+GetVersionFromFile(
+    const char *filename,
+    const char *match,
+    int numdots)
 {
-    FILE *f;
-    char s1[51], s2[51], s3[51];
-    int r = 0;
-    double d1;
+    static char szBuffer[100];
+    char *szResult = NULL;
+    FILE *fp = fopen(filename, "rt");
 
-    f = fopen(file, "rt");
-    if (f == NULL) {
-	return 0;
-    }
+    if (fp != NULL) {
+	/*
+	 * Read data until we see our match string.
+	 */
 
-    do {
-	r = fscanf(f, "%50s", s1);
-	if (r == 1 && !strcmp(s1, "#define")) {
-	    /* get next two words */
-	    r = fscanf(f, "%50s %50s", s2, s3);
-	    if (r != 2) continue;
-	    /* is the first word what we're looking for? */
-	    if (!strcmp(s2, string)) {
-		fclose(f);
-		/* add 1 past first double quote char. "8.5" */
-		d1 = atof(s3 + 1);		  /*    8.5  */
-		while (floor(d1) != d1) {
-		    d1 *= 10.0;
+	while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
+	    LPSTR p, q;
+
+	    p = strstr(szBuffer, match);
+	    if (p != NULL) {
+		/*
+		 * Skip to first digit after the match.
+		 */
+
+		p += strlen(match);
+		while (*p && !isdigit((unsigned char)*p)) {
+		    ++p;
 		}
-		return ((int) d1);		  /*    85   */
+
+		/*
+		 * Find ending whitespace.
+		 */
+
+		q = p;
+		while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q)
+			    && !strchr("ab", q[-1])) || --numdots))) {
+		    ++q;
+		}
+
+		*q = 0;
+		szResult = p;
+		break;
 	    }
 	}
-    } while (!feof(f));
+	fclose(fp);
+    }
+    return szResult;
+}
+
+/*
+ * List helpers for the SubstituteFile function
+ */
 
-    fclose(f);
+typedef struct list_item_t {
+    struct list_item_t *nextPtr;
+    char * key;
+    char * value;
+} list_item_t;
+
+/* insert a list item into the list (list may be null) */
+static list_item_t *
+list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
+{
+    list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t));
+    if (itemPtr) {
+	itemPtr->key = strdup(key);
+	itemPtr->value = strdup(value);
+	itemPtr->nextPtr = NULL;
+
+	while(*listPtrPtr) {
+	    listPtrPtr = &(*listPtrPtr)->nextPtr;
+	}
+	*listPtrPtr = itemPtr;
+    }
+    return itemPtr;
+}
+
+static void
+list_free(list_item_t **listPtrPtr)
+{
+    list_item_t *tmpPtr, *listPtr = *listPtrPtr;
+    while (listPtr) {
+	tmpPtr = listPtr;
+	listPtr = listPtr->nextPtr;
+	free(tmpPtr->key);
+	free(tmpPtr->value);
+	free(tmpPtr);
+    }
+}
+
+/*
+ * SubstituteFile --
+ *	As windows doesn't provide anything useful like sed and it's unreliable
+ *	to use the tclsh you are building against (consider x-platform builds -
+ *	e.g. compiling AMD64 target from IX86) we provide a simple substitution
+ *	option here to handle autoconf style substitutions.
+ *	The substitution file is whitespace and line delimited. The file should
+ *	consist of lines matching the regular expression:
+ *	  \s*\S+\s+\S*$
+ *
+ *	Usage is something like:
+ *	  nmakehlp -S << $** > $@
+ *	    @PACKAGE_NAME@ $(PACKAGE_NAME)
+ *	    @PACKAGE_VERSION@ $(PACKAGE_VERSION)
+ *	    <<
+ */
+
+static int
+SubstituteFile(
+    const char *substitutions,
+    const char *filename)
+{
+    static char szBuffer[1024], szCopy[1024];
+    list_item_t *substPtr = NULL;
+    FILE *fp, *sp;
+
+    fp = fopen(filename, "rt");
+    if (fp != NULL) {
+
+	/*
+	 * Build a list of substitutions from the first filename
+	 */
+
+	sp = fopen(substitutions, "rt");
+	if (sp != NULL) {
+	    while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) {
+		unsigned char *ks, *ke, *vs, *ve;
+		ks = (unsigned char*)szBuffer;
+		while (ks && *ks && isspace(*ks)) ++ks;
+		ke = ks;
+		while (ke && *ke && !isspace(*ke)) ++ke;
+		vs = ke;
+		while (vs && *vs && isspace(*vs)) ++vs;
+		ve = vs;
+		while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve;
+		*ke = 0, *ve = 0;
+		list_insert(&substPtr, (char*)ks, (char*)vs);
+	    }
+	    fclose(sp);
+	}
+
+	/* debug: dump the list */
+#ifndef NDEBUG
+	{
+	    int n = 0;
+	    list_item_t *p = NULL;
+	    for (p = substPtr; p != NULL; p = p->nextPtr, ++n) {
+		fprintf(stderr, "% 3d '%s' => '%s'\n", n, p->key, p->value);
+	    }
+	}
+#endif
+
+	/*
+	 * Run the substitutions over each line of the input
+	 */
+
+	while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
+	    list_item_t *p = NULL;
+	    for (p = substPtr; p != NULL; p = p->nextPtr) {
+		char *m = strstr(szBuffer, p->key);
+		if (m) {
+		    char *cp, *op, *sp;
+		    cp = szCopy;
+		    op = szBuffer;
+		    while (op != m) *cp++ = *op++;
+		    sp = p->value;
+		    while (sp && *sp) *cp++ = *sp++;
+		    op += strlen(p->key);
+		    while (*op) *cp++ = *op++;
+		    *cp = 0;
+		    memcpy(szBuffer, szCopy, sizeof(szCopy));
+		}
+	    }
+	    printf("%s", szBuffer);
+	}
+
+	list_free(&substPtr);
+    }
+    fclose(fp);
     return 0;
 }
+
+BOOL FileExists(LPCTSTR szPath)
+{
+#ifndef INVALID_FILE_ATTRIBUTES
+    #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
+#endif
+    DWORD pathAttr = GetFileAttributes(szPath);
+    return (pathAttr != INVALID_FILE_ATTRIBUTES &&
+	    !(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
+}
+
+
+/*
+ * QualifyPath --
+ *
+ *	This composes the current working directory with a provided path
+ *	and returns the fully qualified and normalized path.
+ *	Mostly needed to setup paths for testing.
+ */
+
+static int
+QualifyPath(
+    const char *szPath)
+{
+    char szCwd[MAX_PATH + 1];
+
+    GetFullPathName(szPath, sizeof(szCwd)-1, szCwd, NULL);
+    printf("%s\n", szCwd);
+    return 0;
+}
+
+/*
+ * Implements LocateDependency for a single directory. See that command
+ * for an explanation.
+ * Returns 0 if found after printing the directory.
+ * Returns 1 if not found but no errors.
+ * Returns 2 on any kind of error
+ * Basically, these are used as exit codes for the process.
+ */
+static int LocateDependencyHelper(const char *dir, const char *keypath)
+{
+    HANDLE hSearch;
+    char path[MAX_PATH+1];
+    size_t dirlen;
+    int keylen, ret;
+    WIN32_FIND_DATA finfo;
+
+    if (dir == NULL || keypath == NULL) {
+	return 2; /* Have no real error reporting mechanism into nmake */
+    }
+    dirlen = strlen(dir);
+    if (dirlen > sizeof(path) - 3) {
+	return 2;
+    }
+    strncpy(path, dir, dirlen);
+    strncpy(path+dirlen, "\\*", 3);	/* Including terminating \0 */
+    keylen = strlen(keypath);
+
+#if 0 /* This function is not available in Visual C++ 6 */
+    /*
+     * Use numerics 0 -> FindExInfoStandard,
+     * 1 -> FindExSearchLimitToDirectories,
+     * as these are not defined in Visual C++ 6
+     */
+    hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
+#else
+    hSearch = FindFirstFile(path, &finfo);
+#endif
+    if (hSearch == INVALID_HANDLE_VALUE) {
+	return 1; /* Not found */
+    }
+
+    /* Loop through all subdirs checking if the keypath is under there */
+    ret = 1; /* Assume not found */
+    do {
+	int sublen;
+	/*
+	 * We need to check it is a directory despite the
+	 * FindExSearchLimitToDirectories in the above call. See SDK docs
+	 */
+	if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0) {
+	    continue;
+	}
+	sublen = strlen(finfo.cFileName);
+	if ((dirlen+1+sublen+1+keylen+1) > sizeof(path)) {
+	    continue;		/* Path does not fit, assume not matched */
+	}
+	strncpy(path+dirlen+1, finfo.cFileName, sublen);
+	path[dirlen+1+sublen] = '\\';
+	strncpy(path+dirlen+1+sublen+1, keypath, keylen+1);
+	if (FileExists(path)) {
+	    /* Found a match, print to stdout */
+	    path[dirlen+1+sublen] = '\0';
+	    QualifyPath(path);
+	    ret = 0;
+	    break;
+	}
+    } while (FindNextFile(hSearch, &finfo));
+    FindClose(hSearch);
+    return ret;
+}
+
+/*
+ * LocateDependency --
+ *
+ *	Locates a dependency for a package.
+ *	    keypath - a relative path within the package directory
+ *	      that is used to confirm it is the correct directory.
+ *	The search path for the package directory is currently only
+ *	    the parent and grandparent of the current working directory.
+ *	    If found, the command prints
+ *	      name_DIRPATH=<full path of located directory>
+ *	    and returns 0. If not found, does not print anything and returns 1.
+ */
+static int LocateDependency(const char *keypath)
+{
+    size_t i;
+    int ret;
+    static const char *paths[] = {"..", "..\\..", "..\\..\\.."};
+
+    for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
+	ret = LocateDependencyHelper(paths[i], keypath);
+	if (ret == 0) {
+	    return ret;
+	}
+    }
+    return ret;
+}
+
+
+/*
+ * Local variables:
+ *   mode: c
+ *   c-basic-offset: 4
+ *   fill-column: 78
+ *   indent-tabs-mode: t
+ *   tab-width: 8
+ * End:
+ */

win/rc/itk.rc

@@ -1,4 +1,3 @@
-// RCS: @(#) $Id: itk.rc,v 1.10 2003/12/23 10:01:35 davygrvy Exp $
 //
 // Version resource script.
 //

win/rules-ext.vc

@@ -0,0 +1,141 @@
+# This file should only be included in makefiles for Tcl extensions,
+# NOT in the makefile for Tcl itself.
+
+!ifndef _RULES_EXT_VC
+
+# We need to run from the directory the parent makefile is located in.
+# nmake does not tell us what makefile was used to invoke it so parent
+# makefile has to set the MAKEFILEVC macro or we just make a guess and
+# warn if we think that is not the case.
+!if "$(MAKEFILEVC)" == ""
+
+!if exist("$(PROJECT).vc")
+MAKEFILEVC = $(PROJECT).vc
+!elseif exist("makefile.vc")
+MAKEFILEVC = makefile.vc
+!endif
+!endif # "$(MAKEFILEVC)" == ""
+
+!if !exist("$(MAKEFILEVC)")
+MSG = ^
+You must run nmake from the directory containing the project makefile.^
+If you are doing that and getting this message, set the MAKEFILEVC^
+macro to the name of the project makefile.
+!message WARNING: $(MSG)
+!endif
+
+!if "$(PROJECT)" == "tcl"
+!error The rules-ext.vc file is not intended for Tcl itself.
+!endif
+
+# We extract version numbers using the nmakehlp program. For now use
+# the local copy of nmakehlp. Once we locate Tcl, we will use that
+# one if it is newer.
+!if [$(CC) -nologo -DNDEBUG "nmakehlp.c" -link -subsystem:console > nul]
+!endif
+
+# We need a nmakehlp that will run on the host machine as part of the build.
+# if TCLSH_NATIVE is set for cross compilation, we'll try to find an associated
+# nmakehlp.exe that runs on the build architecture.
+!ifdef TCLSH_NATIVE
+!ifndef NMAKEHLP_NATIVE
+!if [$(TCLSH_NATIVE) $(TCLDIR)\win\find_nmakehlp.tcl $(TCLSH_NATIVE) > find_nmakehlp.out]
+!error TCLSH_NATIVE is set, but unable to find associated nmakehlp.exe nearby.
+!else
+!include find_nmakehlp.out
+!endif
+!endif
+!endif
+
+!ifndef NMAKEHLP_NATIVE
+NMAKEHLP_NATIVE=nmakehlp
+!endif
+
+# First locate the Tcl directory that we are working with.
+!if "$(TCLDIR)" != ""
+
+_RULESDIR = $(TCLDIR:/=\)
+
+!else
+
+# If an installation path is specified, that is also the Tcl directory.
+# Also Tk never builds against an installed Tcl, it needs Tcl sources
+!if defined(INSTALLDIR) && "$(PROJECT)" != "tk"
+_RULESDIR=$(INSTALLDIR:/=\)
+!else
+# Locate Tcl sources
+!if [echo _RULESDIR = \> nmakehlp.out] \
+   || [$(NMAKEHLP_NATIVE) -L generic\tcl.h >> nmakehlp.out]
+_RULESDIR = ..\..\tcl
+!else
+!include nmakehlp.out
+!endif
+
+!endif # defined(INSTALLDIR)....
+
+!endif # ifndef TCLDIR
+
+# Now look for the targets.vc file under the Tcl root. Note we check this
+# file and not rules.vc because the latter also exists on older systems.
+!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl
+_RULESDIR = $(_RULESDIR)\lib\nmake
+!elseif exist("$(_RULESDIR)\win\targets.vc")   # Building against Tcl sources
+_RULESDIR = $(_RULESDIR)\win
+!else
+# If we have not located Tcl's targets file, most likely we are compiling
+# against an older version of Tcl and so must use our own support files.
+_RULESDIR = .
+!endif
+
+!if "$(_RULESDIR)" != "."
+# Potentially using Tcl's support files. If this extension has its own
+# nmake support files, need to compare the versions and pick newer.
+
+!if exist("rules.vc") # The extension has its own copy
+
+!if [echo TCL_RULES_MAJOR = \> versions.vc] \
+   && [$(NMAKEHLP_NATIVE) -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc]
+!endif
+!if [echo TCL_RULES_MINOR = \>> versions.vc] \
+   && [$(NMAKEHLP_NATIVE) -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc]
+!endif
+
+!if [echo OUR_RULES_MAJOR = \>> versions.vc] \
+   && [$(NMAKEHLP_NATIVE) -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc]
+!endif
+!if [echo OUR_RULES_MINOR = \>> versions.vc] \
+   && [$(NMAKEHLP_NATIVE) -V "rules.vc" RULES_VERSION_MINOR >> versions.vc]
+!endif
+!include versions.vc
+# We have a newer version of the support files, use them
+!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR))
+_RULESDIR = .
+!endif
+
+!endif # if exist("rules.vc")
+
+!endif # if $(_RULESDIR) != "."
+
+# Let rules.vc know what copy of nmakehlp.c to use.
+NMAKEHLPC = $(_RULESDIR)\nmakehlp.c
+
+# Get rid of our internal defines before calling rules.vc
+!undef TCL_RULES_MAJOR
+!undef TCL_RULES_MINOR
+!undef OUR_RULES_MAJOR
+!undef OUR_RULES_MINOR
+
+!if exist("$(_RULESDIR)\rules.vc")
+!include "$(_RULESDIR)\rules.vc"
+!ifndef VERBOSE
+# Backward compatibility
+VERBOSE=1
+!endif
+!if $(VERBOSE)
+!message *** Using $(_RULESDIR)\rules.vc
+!endif
+!else
+!error *** Could not locate rules.vc in $(_RULESDIR)
+!endif
+
+!endif # _RULES_EXT_VC

win/svnmanifest.in

@@ -0,0 +1 @@
+svn-r