Compare commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
0d1dc9780c | ||
|
|
339acd56d0 | ||
|
|
91f69d62ce | ||
|
|
74d572d124 | ||
|
|
ab2b92a888 | ||
|
|
d3b395675c | ||
|
|
314ab41be8 | ||
|
|
eb4468f65e | ||
|
|
ba0d4a9bf3 | ||
|
|
0dfec72677 | ||
|
|
7bba62b94a | ||
|
|
f8f8061fa1 | ||
|
|
c08668adfb | ||
|
|
6ac755e0ee | ||
|
|
5aeb446da4 | ||
|
|
ad0245d1e4 | ||
|
|
548bc49665 | ||
|
|
2aa842bb62 |
@@ -1,12 +0,0 @@
|
||||
*.a
|
||||
*.bmp
|
||||
*.dll
|
||||
*.exe
|
||||
*.gif
|
||||
*.gz
|
||||
*.jpg
|
||||
*.lib
|
||||
*.pdf
|
||||
*.png
|
||||
*.xlsx
|
||||
*.zip
|
||||
@@ -1,18 +0,0 @@
|
||||
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
|
||||
@@ -1,7 +0,0 @@
|
||||
tools/tcl.wse.in
|
||||
win/buildall.vc.bat
|
||||
win/coffbase.txt
|
||||
win/makefile.vc
|
||||
win/rules.vc
|
||||
win/tcl.dsp
|
||||
win/tcl.dsw
|
||||
@@ -1,29 +0,0 @@
|
||||
*.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
|
||||
@@ -1 +0,0 @@
|
||||
u
|
||||
@@ -1,40 +0,0 @@
|
||||
# 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
|
||||
-33
@@ -1,33 +0,0 @@
|
||||
*.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
|
||||
@@ -1,27 +0,0 @@
|
||||
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
|
||||
|
||||
+132
-183
@@ -7,24 +7,11 @@
|
||||
# replaced in the actual Makefile.
|
||||
#
|
||||
# Copyright (c) 1999 Scriptics Corporation.
|
||||
# Copyright (c) 2002-2005 ActiveState Corporation.
|
||||
# Copyright (c) 2002-2004 ActiveState Corporation.
|
||||
#
|
||||
# See the file "license.terms" for information on usage and redistribution
|
||||
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
|
||||
#========================================================================
|
||||
# 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.
|
||||
# The object files are used for linking into the final library.
|
||||
@@ -55,16 +42,40 @@ PKG_TCL_SOURCES = @PKG_TCL_SOURCES@
|
||||
PKG_HEADERS = @PKG_HEADERS@
|
||||
|
||||
#========================================================================
|
||||
# "PKG_LIB_FILE" refers to the library (dynamic or static as per
|
||||
# configuration options) composed of the named objects.
|
||||
# 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 = @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) $(PKG_STUB_LIB_FILE)
|
||||
lib_BINARIES = $(PKG_LIB_FILE)
|
||||
BINARIES = $(lib_BINARIES)
|
||||
|
||||
SHELL = @SHELL@
|
||||
@@ -75,11 +86,9 @@ exec_prefix = @exec_prefix@
|
||||
|
||||
bindir = @bindir@
|
||||
libdir = @libdir@
|
||||
includedir = @includedir@
|
||||
datarootdir = @datarootdir@
|
||||
runstatedir = @runstatedir@
|
||||
datadir = @datadir@
|
||||
mandir = @mandir@
|
||||
includedir = @includedir@
|
||||
|
||||
DESTDIR =
|
||||
|
||||
@@ -88,21 +97,19 @@ pkgdatadir = $(datadir)/$(PKG_DIR)
|
||||
pkglibdir = $(libdir)/$(PKG_DIR)
|
||||
pkgincludedir = $(includedir)/$(PKG_DIR)
|
||||
|
||||
top_builddir = @abs_top_builddir@
|
||||
top_builddir = .
|
||||
|
||||
INSTALL_OPTIONS =
|
||||
INSTALL = @INSTALL@ $(INSTALL_OPTIONS)
|
||||
INSTALL_DATA_DIR = @INSTALL_DATA_DIR@
|
||||
INSTALL_DATA = @INSTALL_DATA@
|
||||
INSTALL = @INSTALL@
|
||||
INSTALL_PROGRAM = @INSTALL_PROGRAM@
|
||||
INSTALL_DATA = @INSTALL_DATA@
|
||||
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@
|
||||
@@ -116,15 +123,14 @@ SHLIB_CFLAGS = @SHLIB_CFLAGS@
|
||||
SHLIB_LD = @SHLIB_LD@
|
||||
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@
|
||||
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
|
||||
@@ -133,40 +139,27 @@ ITCL_TOOLS_DIR = @itcl_SRC_DIR@/tools
|
||||
# require for testing here (like TCLX_LIBRARY).
|
||||
#========================================================================
|
||||
|
||||
#EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR)
|
||||
EXTRA_PATH = $(top_builddir):$(TCL_BIN_DIR):$(TK_BIN_DIR)
|
||||
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)" \
|
||||
TCLSH_ENV = TCL_LIBRARY=`@CYGPATH@ $(TCL_SRC_DIR)/library` \
|
||||
TK_LIBRARY=`@CYGPATH@ $(TK_SRC_DIR)/library` \
|
||||
ITCL_LIBRARY=`@CYGPATH@ @itcl_SRC_DIR@/library` \
|
||||
ITK_LIBRARY=`@CYGPATH@ $(srcdir)/library` \
|
||||
TCLLIBPATH="$(TCLLIBPATH)"
|
||||
|
||||
@LD_LIBRARY_PATH_VAR@="$(EXTRA_PATH):$(@LD_LIBRARY_PATH_VAR@)" \
|
||||
PATH="$(EXTRA_PATH):$(PATH)" \
|
||||
TCLLIBPATH="$(top_builddir) @itcl_BIN_DIR@"
|
||||
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)
|
||||
TCLSH = $(TCLSH_ENV) $(TCLSH_PROG)
|
||||
WISH = $(TCLSH_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@
|
||||
|
||||
# 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)\"
|
||||
DEFS = @DEFS@ $(PKG_CFLAGS) \
|
||||
-DITK_LIBRARY=\"$(pkglibdir)\" -DUSE_NON_CONST
|
||||
|
||||
CONFIG_CLEAN_FILES = @CONFIG_CLEAN_FILES@ Makefile itkConfig.sh pkgIndex.tcl
|
||||
CLEANFILES = @CLEANFILES@
|
||||
|
||||
CPPFLAGS = @CPPFLAGS@
|
||||
LIBS = @PKG_LIBS@ @LIBS@
|
||||
@@ -174,20 +167,13 @@ 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 includes executable programs and
|
||||
# independent files, and the "binaries:" target inclues 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.
|
||||
@@ -206,12 +192,6 @@ 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
|
||||
@@ -220,15 +200,14 @@ 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
|
||||
@$(INSTALL_DATA_DIR) "$(DESTDIR)$(includedir)"
|
||||
@mkdir -p $(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;
|
||||
|
||||
#========================================================================
|
||||
@@ -237,45 +216,27 @@ install-libraries: libraries
|
||||
#========================================================================
|
||||
|
||||
install-doc: doc
|
||||
@$(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; \
|
||||
@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; \
|
||||
done
|
||||
|
||||
test: binaries libraries
|
||||
$(WISH) `@CYGPATH@ $(srcdir)/tests/all.tcl` $(TESTFLAGS) -load "package require -exact itk $(PACKAGE_VERSION)"
|
||||
$(WISH) `@CYGPATH@ $(srcdir)/tests/all.tcl` -load "package require Itk $(PACKAGE_VERSION)" $(TESTFLAGS) | cat
|
||||
|
||||
shell: binaries libraries
|
||||
@$(WISH) $(SCRIPT)
|
||||
|
||||
gdb:
|
||||
$(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)
|
||||
$(TCLSH_ENV) gdb $(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
|
||||
@@ -303,79 +264,63 @@ $(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:
|
||||
#
|
||||
# sample.$(OBJEXT): $(srcdir)/generic/sample.c
|
||||
# $(COMPILE) -c `@CYGPATH@ $(srcdir)/generic/sample.c` -o $@
|
||||
# exampleA.$(OBJEXT): $(srcdir)/src/win/exampleA.c
|
||||
# $(COMPILE) -c `@CYGPATH@ $(srcdir)/src/win/exampleA.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):$(srcdir)/generic:$(srcdir)/unix:$(srcdir)/win:$(srcdir)/macosx
|
||||
VPATH = $(srcdir)/unix:$(srcdir)/generic:$(srcdir)/win
|
||||
|
||||
.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 "" >>$@
|
||||
.c.$(OBJEXT):
|
||||
$(COMPILE) -c `@CYGPATH@ $<` -o $@
|
||||
|
||||
#========================================================================
|
||||
# Distribution creation
|
||||
# You may need to tweak this target to make it work correctly.
|
||||
#========================================================================
|
||||
|
||||
#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
|
||||
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)
|
||||
|
||||
dist-clean:
|
||||
rm -rf $(DIST_DIR) $(DIST_ROOT)/$(PKG_DIR).tar.*
|
||||
|
||||
dist: dist-clean $(srcdir)/manifest.uuid
|
||||
$(INSTALL_DATA_DIR) $(DIST_DIR)
|
||||
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
|
||||
|
||||
# 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)/
|
||||
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
|
||||
|
||||
list='demos doc examples generic library tests win win/rc'; \
|
||||
for p in $$list; do \
|
||||
$(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; \
|
||||
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; \
|
||||
done
|
||||
|
||||
(cd $(DIST_ROOT); $(COMPRESS);)
|
||||
@@ -386,12 +331,13 @@ dist: dist-clean $(srcdir)/manifest.uuid
|
||||
|
||||
#========================================================================
|
||||
# Don't modify the file to clean here. Instead, set the "CLEANFILES"
|
||||
# variable in configure.ac
|
||||
# variable in configure.in
|
||||
#========================================================================
|
||||
|
||||
clean:
|
||||
clean:
|
||||
-test -z "$(BINARIES)" || rm -f $(BINARIES)
|
||||
-rm -f *.$(OBJEXT) core *.core
|
||||
-rm -f *.o core *.core
|
||||
-rm -f *.$(OBJEXT)
|
||||
-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
|
||||
|
||||
distclean: clean
|
||||
@@ -403,25 +349,34 @@ 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.
|
||||
# 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)
|
||||
# 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)
|
||||
#
|
||||
# You should not have to modify this target.
|
||||
#========================================================================
|
||||
|
||||
install-lib-binaries: binaries
|
||||
@$(INSTALL_DATA_DIR) "$(DESTDIR)$(pkglibdir)"
|
||||
install-lib-binaries:
|
||||
@mkdir -p $(DESTDIR)$(pkglibdir)
|
||||
@list='$(lib_BINARIES)'; for p in $$list; do \
|
||||
if test -f $$p; then \
|
||||
echo " $(INSTALL_LIBRARY) $$p $(DESTDIR)$(pkglibdir)/$$p"; \
|
||||
$(INSTALL_LIBRARY) $$p "$(DESTDIR)$(pkglibdir)/$$p"; \
|
||||
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; \
|
||||
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; \
|
||||
@@ -430,52 +385,46 @@ install-lib-binaries: 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
|
||||
@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_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir)
|
||||
: $(INSTALL_DATA) itkConfig.sh $(DESTDIR)$(libdir)
|
||||
|
||||
#========================================================================
|
||||
# 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.
|
||||
# Install binary executables (e.g. .exe files)
|
||||
#
|
||||
# You should not have to modify this target, except to define bin_BINARIES
|
||||
# above if necessary.
|
||||
# You should not have to modify this target.
|
||||
#========================================================================
|
||||
|
||||
install-bin-binaries: binaries
|
||||
@$(INSTALL_DATA_DIR) "$(DESTDIR)$(bindir)"
|
||||
install-bin-binaries:
|
||||
@mkdir -p $(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
|
||||
|
||||
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
|
||||
cd $(top_builddir) \
|
||||
&& CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status
|
||||
.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.
|
||||
|
||||
Vendored
-8
@@ -1,9 +1 @@
|
||||
#
|
||||
# Include the TEA standard macro set
|
||||
#
|
||||
|
||||
builtin(include,tclconfig/tcl.m4)
|
||||
|
||||
#
|
||||
# Add here whatever m4 macros you want to define for your package
|
||||
#
|
||||
|
||||
+59
-105
@@ -1,25 +1,16 @@
|
||||
#!/bin/bash -norc
|
||||
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
|
||||
#--------------------------------------------------------------------
|
||||
# Sample configure.in 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],[4.2.7])
|
||||
AC_INIT([itk], [3.4])
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
|
||||
@@ -27,29 +18,18 @@ AC_INIT([itk],[4.2.7])
|
||||
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
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.
|
||||
#--------------------------------------------------------------------
|
||||
TEA_INIT([3.9])
|
||||
|
||||
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)
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
@@ -60,34 +40,30 @@ TEA_PATH_TCLCONFIG
|
||||
TEA_LOAD_TCLCONFIG
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Load the tkConfig.sh file if necessary (Tk extension)
|
||||
# Load the tkConfig.sh file
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
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 TEA_SETUP_COMPILER.
|
||||
#-----------------------------------------------------------------------
|
||||
# Must be called after TEA_LOAD_TCLCONFIG and before $prefix is used.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
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 and a few others to create the basic setup
|
||||
# necessary to compile executables.
|
||||
#-----------------------------------------------------------------------
|
||||
# This also calls AC_PROG_CC, AC_PROG_INSTALL and a few others to create
|
||||
# the basic setup necessary to compile executables.
|
||||
#------------------------------------------------------------------------
|
||||
|
||||
TEA_SETUP_COMPILER
|
||||
|
||||
@@ -101,21 +77,16 @@ TEA_SETUP_COMPILER
|
||||
# and PKG_TCL_SOURCES.
|
||||
#-----------------------------------------------------------------------
|
||||
|
||||
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_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_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
|
||||
@@ -124,29 +95,17 @@ TEA_ADD_TCL_SOURCES([library/Archetype.itk
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# __CHANGE__
|
||||
# A few miscellaneous platform-specific items:
|
||||
#
|
||||
# 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 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.
|
||||
#
|
||||
# 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
|
||||
# Ensure no empty if clauses
|
||||
:
|
||||
#TEA_ADD_SOURCES([win/winFile.c])
|
||||
#TEA_ADD_INCLUDES([-I\"$(${CYGPATH} ${srcdir}/win)\"])
|
||||
TEA_ADD_SOURCES([dllEntryPoint.c])
|
||||
else
|
||||
# Ensure no empty else clauses
|
||||
:
|
||||
#TEA_ADD_SOURCES([unix/unixFile.c])
|
||||
#TEA_ADD_LIBS([-lsuperfly])
|
||||
fi
|
||||
#CLEANFILES="$CLEANFILES *.ext"
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# __CHANGE__
|
||||
@@ -154,14 +113,21 @@ fi
|
||||
# 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 called after TEA_LOAD_TCLCONFIG / TEA_LOAD_TKCONFIG
|
||||
# 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
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
#TEA_PUBLIC_TCL_HEADERS
|
||||
TEA_PRIVATE_TCL_HEADERS
|
||||
|
||||
TEA_PUBLIC_TK_HEADERS
|
||||
#TEA_PRIVATE_TK_HEADERS
|
||||
#TEA_PUBLIC_TK_HEADERS
|
||||
TEA_PRIVATE_TK_HEADERS
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# For Unix/Tk builds, make sure that the X libraries/headers are found.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
TEA_PATH_X
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
@@ -172,7 +138,6 @@ TEA_PATH_X
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
AC_DEFINE(TCL_THREADS)
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Check whether --enable-threads or --disable-threads was given.
|
||||
# This auto-enables if Tcl was compiled threaded.
|
||||
@@ -196,16 +161,22 @@ 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
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Itcl stubs
|
||||
# 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.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
if test "${SHARED_BUILD}" = "1" ; then
|
||||
AC_DEFINE(USE_TCL_STUBS)
|
||||
AC_DEFINE(USE_TK_STUBS)
|
||||
AC_DEFINE(USE_ITCL_STUBS)
|
||||
fi
|
||||
|
||||
@@ -218,45 +189,28 @@ fi
|
||||
TEA_MAKE_LIB
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# 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.
|
||||
# __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.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
TEA_PROG_TCLSH
|
||||
TEA_PROG_WISH
|
||||
|
||||
#--------------------------------------------------------------------
|
||||
# Setup a *Config.sh.in configuration file.
|
||||
# Finally, substitute all of the various values into the Makefile.
|
||||
#--------------------------------------------------------------------
|
||||
|
||||
# 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
|
||||
AC_OUTPUT([Makefile pkgIndex.tcl itkConfig.sh])
|
||||
+45
-45
@@ -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
|
||||
"
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -48,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, so that all options are properly
|
||||
within its constructor\fR, so that all options are properly
|
||||
integrated and initialized in the composite list.
|
||||
|
||||
|
||||
|
||||
+2
-2
@@ -28,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.\fR\fIxxx\fR".
|
||||
in turn, looks for other script files with the name "\fCinit.\fIxxx\fR".
|
||||
Mega-widget libraries will be automatically initialized if they
|
||||
install a script named "\fCinit.\fR\fIxxx\fR" in this directory,
|
||||
install a script named "\fCinit.\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.
|
||||
|
||||
+88
-119
@@ -1,86 +1,80 @@
|
||||
.\" 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.
|
||||
'\" 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.
|
||||
.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
|
||||
.\}
|
||||
.ta \\n()Au \\n()Bu
|
||||
.ie !"\\$3"" \{\
|
||||
\&\\$1 \\fI\\$2\\fP (\\$3)
|
||||
.ta \\n()Au \\n()Bu
|
||||
\&\\$1 \\fI\\$2\\fP (\\$3)
|
||||
.\".b
|
||||
.\}
|
||||
.el \{\
|
||||
@@ -93,7 +87,7 @@
|
||||
.\}
|
||||
.\}
|
||||
..
|
||||
.\" # define tabbing values for .AP
|
||||
'\" # define tabbing values for .AP
|
||||
.de AS
|
||||
.nr )A 10n
|
||||
.if !"\\$1"" .nr )A \\w'\\$1'u+3n
|
||||
@@ -103,9 +97,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
|
||||
@@ -115,7 +109,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
|
||||
@@ -135,16 +129,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 \{\
|
||||
@@ -159,9 +153,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
|
||||
@@ -188,36 +182,34 @@
|
||||
.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 5.5c 11c
|
||||
.ta 4c 8c 12c
|
||||
.ft B
|
||||
..
|
||||
.\" # SE - end of list of standard options
|
||||
'\" # SE - end of list of standard options
|
||||
.de SE
|
||||
.fi
|
||||
.ft R
|
||||
.LP
|
||||
See the \\*(So manual entry for details on the standard options.
|
||||
See the \\fBoptions\\fR 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
|
||||
@@ -228,40 +220,17 @@ 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 ""
|
||||
..
|
||||
|
||||
+27
-27
@@ -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
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+13
-13
@@ -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
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+54
-54
@@ -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
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+11
-11
@@ -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
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+6
-6
@@ -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"
|
||||
}
|
||||
}
|
||||
|
||||
+68
-82
@@ -1,20 +1,14 @@
|
||||
# -*- 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.
|
||||
|
||||
# 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
|
||||
@@ -25,11 +19,64 @@ scspec ITKAPI
|
||||
# Exported functions:
|
||||
#
|
||||
|
||||
declare 0 {
|
||||
int Itk_Init(Tcl_Interp *interp)
|
||||
declare 0 generic {
|
||||
int Itk_Init (Tcl_Interp *interp)
|
||||
}
|
||||
declare 1 {
|
||||
int Itk_SafeInit(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)
|
||||
}
|
||||
|
||||
|
||||
@@ -37,85 +84,24 @@ declare 1 {
|
||||
# Functions needed for the Archetype base class:
|
||||
#
|
||||
|
||||
declare 13 {
|
||||
int Itk_ArchetypeInit(Tcl_Interp *interp)
|
||||
declare 13 generic {
|
||||
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 {
|
||||
void Itk_OptListInit(ItkOptList *olist, Tcl_HashTable *options)
|
||||
declare 14 generic {
|
||||
void Itk_OptListInit (ItkOptList* olist, Tcl_HashTable *options)
|
||||
}
|
||||
declare 15 {
|
||||
void Itk_OptListFree(ItkOptList *olist)
|
||||
declare 15 generic {
|
||||
void Itk_OptListFree (ItkOptList* olist)
|
||||
}
|
||||
declare 16 {
|
||||
void Itk_OptListAdd(ItkOptList *olist, Tcl_HashEntry *entry)
|
||||
declare 16 generic {
|
||||
void Itk_OptListAdd (ItkOptList* olist, Tcl_HashEntry *entry)
|
||||
}
|
||||
declare 17 {
|
||||
void Itk_OptListRemove(ItkOptList *olist, Tcl_HashEntry *entry)
|
||||
declare 17 generic {
|
||||
void Itk_OptListRemove (ItkOptList* olist, Tcl_HashEntry *entry)
|
||||
}
|
||||
|
||||
|
||||
|
||||
+50
-18
@@ -46,21 +46,24 @@
|
||||
#ifndef ITK_H
|
||||
#define ITK_H
|
||||
|
||||
#if defined(BUILD_itk)
|
||||
# define ITKAPI DLLEXPORT
|
||||
# undef USE_ITK_STUBS
|
||||
# undef USE_ITCL_STUBS
|
||||
#else
|
||||
# define ITKAPI DLLIMPORT
|
||||
#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
|
||||
#endif
|
||||
|
||||
#define ITK_MAJOR_VERSION 4
|
||||
#define ITK_MINOR_VERSION 2
|
||||
#define ITK_RELEASE_LEVEL TCL_FINAL_RELEASE
|
||||
#define ITK_RELEASE_SERIAL 7
|
||||
|
||||
#define ITK_VERSION "4.2"
|
||||
#define ITK_PATCH_LEVEL "4.2.7"
|
||||
#define ITK_MAJOR_VERSION 3
|
||||
#define ITK_MINOR_VERSION 4
|
||||
#define ITK_RELEASE_LEVEL TCL_FINAL_RELEASE
|
||||
#define ITK_RELEASE_SERIAL 2
|
||||
|
||||
#define ITK_VERSION "3.4"
|
||||
#define ITK_PATCH_LEVEL "3.4.2"
|
||||
|
||||
|
||||
/*
|
||||
@@ -72,7 +75,8 @@
|
||||
|
||||
#ifndef RC_INVOKED
|
||||
|
||||
#include <tk.h>
|
||||
#include "tk.h"
|
||||
#include "itclInt.h"
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#ifdef BUILD_itk
|
||||
@@ -85,21 +89,49 @@
|
||||
# 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
|
||||
EXTERN const char *
|
||||
Itk_InitStubs(Tcl_Interp *interp,
|
||||
const char *version, int exact);
|
||||
TCL_EXTERNC CONST char *
|
||||
Itk_InitStubs _ANSI_ARGS_((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.
|
||||
*/
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -1,329 +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
|
||||
* ========================================================================
|
||||
* 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);
|
||||
}
|
||||
@@ -1,148 +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
|
||||
* ========================================================================
|
||||
* 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;
|
||||
}
|
||||
+214
-58
@@ -1,91 +1,247 @@
|
||||
/*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
#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 */
|
||||
ITKAPI int Itk_Init(Tcl_Interp *interp);
|
||||
TCL_EXTERN(int) Itk_Init _ANSI_ARGS_((Tcl_Interp * interp));
|
||||
#endif
|
||||
#ifndef Itk_SafeInit_TCL_DECLARED
|
||||
#define Itk_SafeInit_TCL_DECLARED
|
||||
/* 1 */
|
||||
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 */
|
||||
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
|
||||
/* Slot 9 is reserved */
|
||||
/* Slot 10 is reserved */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 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
|
||||
/* 13 */
|
||||
ITKAPI int Itk_ArchetypeInit(Tcl_Interp *interp);
|
||||
|
||||
typedef struct {
|
||||
const struct ItkIntStubs *itkIntStubs;
|
||||
} ItkStubHooks;
|
||||
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
|
||||
|
||||
typedef struct ItkStubs {
|
||||
int magic;
|
||||
int epoch;
|
||||
int revision;
|
||||
const ItkStubHooks *hooks;
|
||||
struct ItkStubHooks *hooks;
|
||||
|
||||
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 */
|
||||
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 */
|
||||
} ItkStubs;
|
||||
|
||||
extern const ItkStubs *itkStubsPtr;
|
||||
TCL_EXTERNC ItkStubs *itkStubsPtr;
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#if defined(USE_ITK_STUBS)
|
||||
#if defined(USE_ITK_STUBS) && !defined(USE_ITK_STUB_PROCS)
|
||||
|
||||
/*
|
||||
* Inline function declarations:
|
||||
*/
|
||||
|
||||
#ifndef Itk_Init
|
||||
#define Itk_Init \
|
||||
(itkStubsPtr->itk_Init) /* 0 */
|
||||
#endif
|
||||
#ifndef Itk_SafeInit
|
||||
#define Itk_SafeInit \
|
||||
(itkStubsPtr->itk_SafeInit) /* 1 */
|
||||
/* 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 */
|
||||
#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 9 is reserved */
|
||||
/* Slot 10 is reserved */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 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
|
||||
#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) */
|
||||
#endif /* defined(USE_ITK_STUBS) && !defined(USE_ITK_STUB_PROCS) */
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
|
||||
#endif /* _ITKDECLS */
|
||||
|
||||
|
||||
@@ -1,195 +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 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);
|
||||
}
|
||||
|
||||
@@ -1,233 +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.
|
||||
*
|
||||
*
|
||||
* ========================================================================
|
||||
* 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"
|
||||
@@ -1,144 +0,0 @@
|
||||
|
||||
/* !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;
|
||||
};
|
||||
|
||||
+8
-37
@@ -1,4 +1,4 @@
|
||||
/*
|
||||
/*
|
||||
* tkStubInit.c --
|
||||
*
|
||||
* This file contains the initializers for the Itk stub vectors.
|
||||
@@ -9,7 +9,7 @@
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "itkInt.h"
|
||||
#include "itk.h"
|
||||
|
||||
/*
|
||||
* Remove macros that will interfere with the definitions below.
|
||||
@@ -21,17 +21,13 @@
|
||||
* below should be made in the generic/itk.decls script.
|
||||
*/
|
||||
|
||||
MODULE_SCOPE const ItkStubs itkStubs;
|
||||
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
static const ItkIntStubs itkIntStubs = {
|
||||
ItkStubs itkStubs = {
|
||||
TCL_STUB_MAGIC,
|
||||
ITKINT_STUBS_EPOCH,
|
||||
ITKINT_STUBS_REVISION,
|
||||
0,
|
||||
0, /* 0 */
|
||||
0, /* 1 */
|
||||
NULL,
|
||||
Itk_Init, /* 0 */
|
||||
Itk_SafeInit, /* 1 */
|
||||
Itk_ConfigBodyCmd, /* 2 */
|
||||
Itk_UsualCmd, /* 3 */
|
||||
Itk_ClassOptionDefineCmd, /* 4 */
|
||||
@@ -39,40 +35,15 @@ static const ItkIntStubs itkIntStubs = {
|
||||
Itk_ConfigClassOption, /* 6 */
|
||||
Itk_CreateClassOptTable, /* 7 */
|
||||
Itk_FindClassOptTable, /* 8 */
|
||||
0, /* 9 */
|
||||
NULL, /* 9 */
|
||||
Itk_CreateClassOption, /* 10 */
|
||||
Itk_FindClassOption, /* 11 */
|
||||
Itk_DelClassOption, /* 12 */
|
||||
0, /* 13 */
|
||||
Itk_ArchetypeInit, /* 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. */
|
||||
|
||||
+14
-12
@@ -1,4 +1,4 @@
|
||||
/*
|
||||
/*
|
||||
* itkStubLib.c --
|
||||
*
|
||||
* Stub object that will be statically linked into extensions that wish
|
||||
@@ -24,13 +24,14 @@
|
||||
#undef USE_TCL_STUB_PROCS
|
||||
|
||||
#ifndef USE_ITK_STUBS
|
||||
#define USE_ITK_STUBS 1
|
||||
#define USE_ITK_STUBS
|
||||
#endif
|
||||
#undef USE_ITK_STUB_PROCS
|
||||
#undef BUILD_itk
|
||||
|
||||
#include "itk.h"
|
||||
|
||||
ItkStubs *itkStubsPtr;
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -50,20 +51,21 @@
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
const char *
|
||||
Itk_InitStubs (
|
||||
Tcl_Interp *interp,
|
||||
const char *version,
|
||||
int exact)
|
||||
CONST char *
|
||||
Itk_InitStubs (interp, version, exact)
|
||||
Tcl_Interp *interp;
|
||||
CONST char *version;
|
||||
int exact;
|
||||
{
|
||||
const char *actualVersion;
|
||||
CONST char *actualVersion;
|
||||
|
||||
actualVersion = Tcl_PkgRequireEx(interp, "Itk", (CONST84 char *)version, exact,
|
||||
(ClientData *) &itkStubsPtr);
|
||||
|
||||
actualVersion = Tcl_PkgRequireEx(interp, "itk", (const char *)version,
|
||||
exact, &itkStubsPtr);
|
||||
if (actualVersion == NULL) {
|
||||
itkStubsPtr = NULL;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
return actualVersion;
|
||||
}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,414 @@
|
||||
/*
|
||||
* ------------------------------------------------------------------------
|
||||
* 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 "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;
|
||||
}
|
||||
@@ -21,17 +21,17 @@
|
||||
* 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 "itk.h"
|
||||
|
||||
/*
|
||||
* FORWARD DECLARATIONS
|
||||
*/
|
||||
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);
|
||||
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));
|
||||
|
||||
|
||||
/*
|
||||
@@ -53,74 +53,65 @@ static void ItkFreeClassesWithOptInfo (void *cdata,
|
||||
* Returns TCL_OK/TCL_ERROR to indicate success/failure.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Itk_ClassOptionDefineCmd(
|
||||
void *clientData, /* class parser info */
|
||||
Tcl_Interp *interp, /* current interpreter */
|
||||
int objc, /* number of arguments */
|
||||
Tcl_Obj *const objv[]) /* argument objects */
|
||||
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 */
|
||||
{
|
||||
ItclObjectInfo *info = (ItclObjectInfo*)clientData;
|
||||
ItclClass *iclsPtr = (ItclClass*)Itcl_PeekStack(&info->clsStack);
|
||||
ItclClass *cdefn = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
|
||||
|
||||
int newEntry;
|
||||
const char *switchName;
|
||||
const char *resName;
|
||||
const char *resClass;
|
||||
const char *init;
|
||||
const char *config;
|
||||
char *switchName, *resName, *resClass, *init, *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_GetString(objv[1]);
|
||||
switchName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
|
||||
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_GetString(objv[2]);
|
||||
resName = Tcl_GetStringFromObj(objv[2], (int*)NULL);
|
||||
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_GetString(objv[3]);
|
||||
resClass = Tcl_GetStringFromObj(objv[3], (int*)NULL);
|
||||
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
|
||||
@@ -129,35 +120,35 @@ Itk_ClassOptionDefineCmd(
|
||||
* which option is being referenced if the configuration code
|
||||
* is redefined by a subsequent "body" command.
|
||||
*/
|
||||
optTable = Itk_CreateClassOptTable(interp, iclsPtr);
|
||||
optTable = Itk_CreateClassOptTable(interp, cdefn);
|
||||
entry = Tcl_CreateHashEntry(&optTable->options, switchName, &newEntry);
|
||||
|
||||
if (!newEntry) {
|
||||
Tcl_AppendResult(interp,
|
||||
"option \"", switchName, "\" already defined in class \"",
|
||||
Tcl_GetString(iclsPtr->fullNamePtr), "\"",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
Tcl_AppendResult(interp,
|
||||
"option \"", switchName, "\" already defined in class \"",
|
||||
cdefn->fullname, "\"",
|
||||
(char*)NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Create a new option record and add it to the table for this
|
||||
* class.
|
||||
*/
|
||||
init = Tcl_GetString(objv[4]);
|
||||
init = Tcl_GetStringFromObj(objv[4], (int*)NULL);
|
||||
|
||||
if (objc == 6) {
|
||||
config = Tcl_GetString(objv[5]);
|
||||
config = Tcl_GetStringFromObj(objv[5], (int*)NULL);
|
||||
} else {
|
||||
config = NULL;
|
||||
config = NULL;
|
||||
}
|
||||
|
||||
if (Itk_CreateClassOption(interp, iclsPtr, switchName, resName, resClass,
|
||||
init, config, &opt) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
if (Itk_CreateClassOption(interp, cdefn, switchName, resName, resClass,
|
||||
init, config, &opt) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_SetHashValue(entry, (void *)opt);
|
||||
Tcl_SetHashValue(entry, (ClientData)opt);
|
||||
Itk_OptListAdd(&optTable->order, entry);
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -173,19 +164,20 @@ Itk_ClassOptionDefineCmd(
|
||||
* been created. Returns TCL_ERROR along with an error message.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
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 */
|
||||
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 */
|
||||
{
|
||||
char *op = Tcl_GetString(objv[0]);
|
||||
char *op = Tcl_GetStringFromObj(objv[0], (int*)NULL);
|
||||
|
||||
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;
|
||||
}
|
||||
@@ -204,81 +196,26 @@ Itk_ClassOptionIllegalCmd(
|
||||
* message in the interpreter) if anything goes wrong.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
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 */
|
||||
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 */
|
||||
{
|
||||
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->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);
|
||||
}
|
||||
mcode = opt->member->code;
|
||||
if (mcode && mcode->procPtr->bodyPtr) {
|
||||
result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
|
||||
opt->member, contextObj, 0, (Tcl_Obj**)NULL);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
@@ -303,15 +240,15 @@ Itk_ConfigClassOption(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
ItkClassOptTable*
|
||||
Itk_CreateClassOptTable(
|
||||
Tcl_Interp *interp, /* interpreter managing the class */
|
||||
ItclClass *iclsPtr) /* class definition */
|
||||
Itk_CreateClassOptTable(interp, cdefn)
|
||||
Tcl_Interp *interp; /* interpreter managing the class */
|
||||
ItclClass *cdefn; /* class definition */
|
||||
{
|
||||
int newEntry, result;
|
||||
Tcl_HashTable *itkClasses;
|
||||
Tcl_HashEntry *entry;
|
||||
ItkClassOptTable *optTable;
|
||||
Tcl_CallFrame frame;
|
||||
Itcl_CallFrame frame;
|
||||
|
||||
/*
|
||||
* Look for the specified class definition in the table.
|
||||
@@ -324,25 +261,26 @@ Itk_CreateClassOptTable(
|
||||
*/
|
||||
itkClasses = ItkGetClassesWithOptInfo(interp);
|
||||
|
||||
entry = Tcl_CreateHashEntry(itkClasses, (char*)iclsPtr, &newEntry);
|
||||
entry = Tcl_CreateHashEntry(itkClasses, (char*)cdefn, &newEntry);
|
||||
if (newEntry) {
|
||||
optTable = (ItkClassOptTable*)Tcl_Alloc(sizeof(ItkClassOptTable));
|
||||
Tcl_InitHashTable(&optTable->options, TCL_STRING_KEYS);
|
||||
Itk_OptListInit(&optTable->order, &optTable->options);
|
||||
optTable = (ItkClassOptTable*)ckalloc(sizeof(ItkClassOptTable));
|
||||
Tcl_InitHashTable(&optTable->options, TCL_STRING_KEYS);
|
||||
Itk_OptListInit(&optTable->order, &optTable->options);
|
||||
|
||||
Tcl_SetHashValue(entry, (void *)optTable);
|
||||
Tcl_SetHashValue(entry, (ClientData)optTable);
|
||||
|
||||
result = Itcl_PushCallFrame(interp, &frame,
|
||||
iclsPtr->nsPtr, /* isProcCallFrame */ 0);
|
||||
result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) &frame,
|
||||
cdefn->namesp, /* isProcCallFrame */ 0);
|
||||
|
||||
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);
|
||||
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);
|
||||
}
|
||||
return optTable;
|
||||
}
|
||||
@@ -363,8 +301,8 @@ Itk_CreateClassOptTable(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
ItkClassOptTable*
|
||||
Itk_FindClassOptTable(
|
||||
ItclClass *iclsPtr) /* class definition */
|
||||
Itk_FindClassOptTable(cdefn)
|
||||
ItclClass *cdefn; /* class definition */
|
||||
{
|
||||
Tcl_HashTable *itkClasses;
|
||||
Tcl_HashEntry *entry;
|
||||
@@ -372,10 +310,10 @@ Itk_FindClassOptTable(
|
||||
/*
|
||||
* Look for the specified class definition in the table.
|
||||
*/
|
||||
itkClasses = ItkGetClassesWithOptInfo(iclsPtr->interp);
|
||||
entry = Tcl_FindHashEntry(itkClasses, (char*)iclsPtr);
|
||||
itkClasses = ItkGetClassesWithOptInfo(cdefn->interp);
|
||||
entry = Tcl_FindHashEntry(itkClasses, (char*)cdefn);
|
||||
if (entry) {
|
||||
return (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
return (ItkClassOptTable*)Tcl_GetHashValue(entry);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
@@ -395,15 +333,16 @@ Itk_FindClassOptTable(
|
||||
* error that is encountered.
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
static char*
|
||||
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 */
|
||||
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 */
|
||||
{
|
||||
ItclClass *iclsPtr = (ItclClass*)cdata;
|
||||
ItclClass *cdefn = (ItclClass*)cdata;
|
||||
|
||||
Tcl_HashTable *itkClasses;
|
||||
Tcl_HashEntry *entry;
|
||||
@@ -416,21 +355,21 @@ ItkTraceClassDestroy(
|
||||
* If it is found, delete all the option records and tear
|
||||
* down the table.
|
||||
*/
|
||||
itkClasses = ItkGetClassesWithOptInfo(interp);
|
||||
entry = Tcl_FindHashEntry(itkClasses, (char*)iclsPtr);
|
||||
itkClasses = ItkGetClassesWithOptInfo(cdefn->interp);
|
||||
entry = Tcl_FindHashEntry(itkClasses, (char*)cdefn);
|
||||
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);
|
||||
Tcl_Free(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);
|
||||
ckfree((char*)optTable);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
@@ -451,15 +390,17 @@ ItkTraceClassDestroy(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
int
|
||||
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 */
|
||||
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 */
|
||||
{
|
||||
ItkClassOption *opt;
|
||||
ItclMemberCode *mcode;
|
||||
@@ -469,42 +410,33 @@ Itk_CreateClassOption(
|
||||
* an implementation for it.
|
||||
*/
|
||||
if (config) {
|
||||
if (Itcl_CreateMemberCode(interp, iclsPtr, (char*)NULL, config,
|
||||
&mcode) != TCL_OK) {
|
||||
if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, config,
|
||||
&mcode) != TCL_OK) {
|
||||
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Itcl_PreserveData((void *)mcode);
|
||||
#ifdef NOTDEF
|
||||
Itcl_EventuallyFree((void *)mcode, (Tcl_FreeProc *)Itcl_DeleteMemberCode);
|
||||
#endif
|
||||
} else {
|
||||
mcode = NULL;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Itcl_PreserveData((ClientData)mcode);
|
||||
Itcl_EventuallyFree((ClientData)mcode,
|
||||
(Tcl_FreeProc*) Itcl_DeleteMemberCode);
|
||||
}
|
||||
else {
|
||||
mcode = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the record to represent this option.
|
||||
*/
|
||||
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 = (ItkClassOption*)ckalloc(sizeof(ItkClassOption));
|
||||
opt->member = Itcl_CreateMember(interp, cdefn, switchName);
|
||||
opt->member->code = mcode;
|
||||
|
||||
opt->resName = (char*)Tcl_Alloc((strlen(resName)+1));
|
||||
opt->resName = (char*)ckalloc((unsigned)(strlen(resName)+1));
|
||||
strcpy(opt->resName, resName);
|
||||
|
||||
opt->resClass = (char*)Tcl_Alloc((strlen(resClass)+1));
|
||||
opt->resClass = (char*)ckalloc((unsigned)(strlen(resClass)+1));
|
||||
strcpy(opt->resClass, resClass);
|
||||
|
||||
opt->init = (char*)Tcl_Alloc((strlen(defVal)+1));
|
||||
opt->init = (char*)ckalloc((unsigned)(strlen(defVal)+1));
|
||||
strcpy(opt->init, defVal);
|
||||
|
||||
*optPtr = opt;
|
||||
@@ -526,9 +458,9 @@ Itk_CreateClassOption(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
ItkClassOption*
|
||||
Itk_FindClassOption(
|
||||
ItclClass *iclsPtr, /* class containing this option */
|
||||
const char *switchName) /* name of command-line switch */
|
||||
Itk_FindClassOption(cdefn, switchName)
|
||||
ItclClass *cdefn; /* class containing this option */
|
||||
char *switchName; /* name of command-line switch */
|
||||
{
|
||||
ItkClassOption *opt = NULL;
|
||||
|
||||
@@ -541,21 +473,21 @@ Itk_FindClassOption(
|
||||
*/
|
||||
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(iclsPtr);
|
||||
optTable = Itk_FindClassOptTable(cdefn);
|
||||
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;
|
||||
@@ -570,17 +502,15 @@ Itk_FindClassOption(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
void
|
||||
Itk_DelClassOption(
|
||||
ItkClassOption *opt) /* pointer to option data */
|
||||
Itk_DelClassOption(opt)
|
||||
ItkClassOption *opt; /* pointer to option data */
|
||||
{
|
||||
#ifdef NOTDEF
|
||||
Itcl_DeleteMember(opt->member);
|
||||
#endif
|
||||
Tcl_Free(opt->resName);
|
||||
Tcl_Free(opt->resClass);
|
||||
Tcl_Free(opt->init);
|
||||
ckfree(opt->resName);
|
||||
ckfree(opt->resClass);
|
||||
ckfree(opt->init);
|
||||
|
||||
Tcl_Free(opt);
|
||||
ckfree((char*)opt);
|
||||
}
|
||||
|
||||
|
||||
@@ -594,8 +524,8 @@ Itk_DelClassOption(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
static Tcl_HashTable*
|
||||
ItkGetClassesWithOptInfo(
|
||||
Tcl_Interp *interp) /* interpreter handling this registration */
|
||||
ItkGetClassesWithOptInfo(interp)
|
||||
Tcl_Interp *interp; /* interpreter handling this registration */
|
||||
{
|
||||
Tcl_HashTable* classesTable;
|
||||
|
||||
@@ -603,13 +533,13 @@ ItkGetClassesWithOptInfo(
|
||||
* 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*)Tcl_Alloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(classesTable, TCL_ONE_WORD_KEYS);
|
||||
Tcl_SetAssocData(interp, "itk_classesWithOptInfo",
|
||||
ItkFreeClassesWithOptInfo, (void *)classesTable);
|
||||
classesTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
|
||||
Tcl_InitHashTable(classesTable, TCL_ONE_WORD_KEYS);
|
||||
Tcl_SetAssocData(interp, "itk_classesWithOptInfo",
|
||||
ItkFreeClassesWithOptInfo, (ClientData)classesTable);
|
||||
}
|
||||
return classesTable;
|
||||
}
|
||||
@@ -623,35 +553,33 @@ ItkGetClassesWithOptInfo(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
static void
|
||||
ItkFreeClassesWithOptInfo(
|
||||
void *clientData, /* associated data */
|
||||
TCL_UNUSED(Tcl_Interp *)) /* interpreter being freed */
|
||||
ItkFreeClassesWithOptInfo(clientData, interp)
|
||||
ClientData clientData; /* associated data */
|
||||
Tcl_Interp *interp; /* interpreter being freed */
|
||||
{
|
||||
Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
|
||||
Tcl_HashSearch place;
|
||||
Tcl_HashSearch place2;
|
||||
Tcl_HashEntry *entry;
|
||||
Tcl_HashEntry *entry2;
|
||||
Tcl_HashSearch place, place2;
|
||||
Tcl_HashEntry *entry, *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);
|
||||
Tcl_Free(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);
|
||||
ckfree((char*)optTable);
|
||||
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
entry = Tcl_NextHashEntry(&place);
|
||||
}
|
||||
|
||||
Tcl_DeleteHashTable(tablePtr);
|
||||
Tcl_Free(tablePtr);
|
||||
ckfree((char*)tablePtr);
|
||||
}
|
||||
@@ -21,7 +21,7 @@
|
||||
* 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 "itk.h"
|
||||
|
||||
|
||||
/*
|
||||
@@ -33,15 +33,15 @@
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
void
|
||||
Itk_OptListInit(
|
||||
ItkOptList *olist, /* list to be initialized */
|
||||
Tcl_HashTable *options) /* table containing the real option entries */
|
||||
Itk_OptListInit(olist, options)
|
||||
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**)Tcl_Alloc(
|
||||
((size_t)olist->max*sizeof(Tcl_HashEntry*))
|
||||
olist->list = (Tcl_HashEntry**)ckalloc(
|
||||
(unsigned)(olist->max*sizeof(Tcl_HashEntry*))
|
||||
);
|
||||
}
|
||||
|
||||
@@ -56,10 +56,10 @@ Itk_OptListInit(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
void
|
||||
Itk_OptListFree(
|
||||
ItkOptList *olist) /* list to be freed */
|
||||
Itk_OptListFree(olist)
|
||||
ItkOptList *olist; /* list to be freed */
|
||||
{
|
||||
Tcl_Free(olist->list);
|
||||
ckfree((char*)olist->list);
|
||||
olist->len = olist->max = 0;
|
||||
}
|
||||
|
||||
@@ -74,32 +74,26 @@ Itk_OptListFree(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
void
|
||||
Itk_OptListAdd(
|
||||
ItkOptList *olist, /* ordered list */
|
||||
Tcl_HashEntry *entry) /* entry to be added to the list */
|
||||
Itk_OptListAdd(olist, entry)
|
||||
ItkOptList *olist; /* ordered list */
|
||||
Tcl_HashEntry *entry; /* entry to be added to the list */
|
||||
{
|
||||
int i;
|
||||
int first;
|
||||
int last;
|
||||
int cmp;
|
||||
int pos;
|
||||
size_t size;
|
||||
int i, first, last, cmp, pos, size;
|
||||
Tcl_HashEntry** newOrder;
|
||||
const char *swname;
|
||||
const char *optname;
|
||||
char *swname, *optname;
|
||||
|
||||
/*
|
||||
* Make sure that the option list is big enough. Resize
|
||||
* if needed.
|
||||
*/
|
||||
if (olist->len >= olist->max) {
|
||||
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);
|
||||
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);
|
||||
|
||||
olist->list = newOrder;
|
||||
olist->max *= 2;
|
||||
olist->list = newOrder;
|
||||
olist->max *= 2;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -107,42 +101,42 @@ Itk_OptListAdd(
|
||||
*/
|
||||
first = 0;
|
||||
last = olist->len-1;
|
||||
swname = ((const char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
swname = ((char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
|
||||
while (last >= first) {
|
||||
pos = (first+last)/2;
|
||||
optname = ((const char *)Tcl_GetHashKey(olist->options,
|
||||
pos = (first+last)/2;
|
||||
optname = ((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 (*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++;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -159,52 +153,48 @@ Itk_OptListAdd(
|
||||
* ------------------------------------------------------------------------
|
||||
*/
|
||||
void
|
||||
Itk_OptListRemove(
|
||||
ItkOptList *olist, /* ordered list */
|
||||
Tcl_HashEntry *entry) /* entry to be removed from the list */
|
||||
Itk_OptListRemove(olist, entry)
|
||||
ItkOptList *olist; /* ordered list */
|
||||
Tcl_HashEntry *entry; /* entry to be removed from the list */
|
||||
{
|
||||
int pos = 0;
|
||||
int i;
|
||||
int first;
|
||||
int last;
|
||||
int cmp;
|
||||
const char *swname;
|
||||
const char *optname;
|
||||
int i, first, last, cmp;
|
||||
char *swname, *optname;
|
||||
|
||||
first = 0;
|
||||
last = olist->len-1;
|
||||
swname = ((const char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
swname = ((char *)Tcl_GetHashKey(olist->options, entry)) + 1;
|
||||
|
||||
while (last >= first) {
|
||||
pos = (first+last)/2;
|
||||
optname = ((const char *)Tcl_GetHashKey(olist->options,
|
||||
pos = (first+last)/2;
|
||||
optname = ((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 (*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];
|
||||
}
|
||||
}
|
||||
}
|
||||
+8
-8
@@ -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@'
|
||||
|
||||
+16
-11
@@ -54,27 +54,32 @@
|
||||
itcl::class itk::Archetype {
|
||||
|
||||
constructor {args} {
|
||||
::itcl::builtin::Archetype init
|
||||
eval itk_initialize $args
|
||||
_initOptionInfo
|
||||
eval itk_initialize $args
|
||||
}
|
||||
|
||||
destructor {
|
||||
::itcl::builtin::Archetype delete
|
||||
_deleteOptionInfo
|
||||
}
|
||||
|
||||
method cget {option} @Archetype-cget
|
||||
method configure {{option ""} args} \
|
||||
@Archetype-configure
|
||||
method config {{option ""} args} {
|
||||
eval configure $option $args
|
||||
}
|
||||
|
||||
method configure {{option ""} args} @Archetype-configure
|
||||
method component {{name ""} args} \
|
||||
@Archetype-component
|
||||
|
||||
method config {{option ""} args} @Archetype-configure
|
||||
protected method itk_component {option args} \
|
||||
@Archetype-itk_component
|
||||
|
||||
method component {{name ""} args} @Archetype-component
|
||||
protected method itk_option {option args} \
|
||||
@Archetype-itk_option
|
||||
|
||||
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 method itk_initialize {args} \
|
||||
@Archetype-itk_initialize
|
||||
|
||||
protected variable itk_option
|
||||
protected variable itk_component
|
||||
|
||||
+33
-33
@@ -33,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 ""
|
||||
|
||||
+32
-32
@@ -34,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 ""
|
||||
|
||||
+6
-3
@@ -14,11 +14,14 @@
|
||||
# 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
|
||||
#
|
||||
lappend auto_path ${itk::library}
|
||||
if {$tcl_platform(os) == "MacOS"} {
|
||||
source -rsrc itk:tclIndex
|
||||
} else {
|
||||
lappend auto_path ${itk::library}
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# USAGE: itk::remove_destroy_hook <widget>
|
||||
@@ -36,7 +39,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> {}
|
||||
}
|
||||
|
||||
+2
-2
@@ -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.
|
||||
|
||||
+2
-15
@@ -1,16 +1,3 @@
|
||||
# -*- tcl -*-
|
||||
# Tcl package index file, version 1.1
|
||||
#
|
||||
# Tcl package index file, version 1.0
|
||||
|
||||
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@]
|
||||
package ifneeded Itk @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] Itk]
|
||||
|
||||
@@ -0,0 +1,19 @@
|
||||
# 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.
|
||||
# ------------------------------------------------------------------
|
||||
# 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
|
||||
}
|
||||
}
|
||||
+2
-5
@@ -7,12 +7,9 @@
|
||||
# Copyright (c) 1998-2000 by Ajuba Solutions
|
||||
# All rights reserved.
|
||||
|
||||
package prefer latest
|
||||
package require tcltest 2.1
|
||||
|
||||
package require Tcl 8.6-
|
||||
package require tcltest 2.2
|
||||
|
||||
tcltest::configure {*}$argv -testdir [file dir [info script]]
|
||||
tcltest::testsDirectory [file dir [info script]]
|
||||
tcltest::runAllTests
|
||||
|
||||
return
|
||||
|
||||
+348
@@ -0,0 +1,348 @@
|
||||
# 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.
|
||||
# ------------------------------------------------------------------
|
||||
# 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."
|
||||
}
|
||||
|
||||
|
||||
+2
-2
@@ -44,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
|
||||
} {}
|
||||
|
||||
+83
-83
@@ -22,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}
|
||||
@@ -82,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}
|
||||
@@ -96,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}
|
||||
@@ -130,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
|
||||
}
|
||||
|
||||
|
||||
+31
-31
@@ -22,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
|
||||
@@ -36,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}}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
|
||||
+18
-18
@@ -22,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
|
||||
@@ -40,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
|
||||
|
||||
+60
-60
@@ -29,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}
|
||||
@@ -63,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} {
|
||||
@@ -77,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
|
||||
@@ -85,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
|
||||
@@ -117,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
|
||||
@@ -149,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
|
||||
|
||||
+96
-96
@@ -31,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}
|
||||
@@ -91,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
|
||||
}
|
||||
|
||||
@@ -112,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]
|
||||
}
|
||||
|
||||
@@ -132,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} {
|
||||
@@ -173,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
|
||||
}
|
||||
} {}
|
||||
|
||||
@@ -193,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} {
|
||||
@@ -245,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 ::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 {} {}}}}
|
||||
[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 {} {}}}}
|
||||
|
||||
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
|
||||
@@ -299,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
|
||||
@@ -336,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
|
||||
|
||||
+1
-1
@@ -1,4 +1,4 @@
|
||||
/*
|
||||
/*
|
||||
* dllEntryPoint.c --
|
||||
*
|
||||
* This file implements the Dll entry point as needed by Windows.
|
||||
|
||||
@@ -1 +0,0 @@
|
||||
git-
|
||||
@@ -1 +0,0 @@
|
||||
#define ITK_VERSION_UUID \
|
||||
+486
-163
@@ -1,163 +1,486 @@
|
||||
#------------------------------------------------------------- -*- 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
|
||||
#------------------------------------------------------------------------------
|
||||
# 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.
|
||||
#------------------------------------------------------------------------------
|
||||
# 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\$(BUILDDIRTOP)\$(ITCLIMPLIBNAME)"
|
||||
|
||||
|
||||
!if $(TCLINSTALL)
|
||||
TKSTUBLIB = "$(TCLDIR)\lib\tkstub$(TCL_VERSION).lib"
|
||||
TKIMPLIB = "$(TCLDIR)\lib\tk$(TCL_VERSION)$(DBGX).lib"
|
||||
TKLIB = "$(TCLDIR)\bin\tk$(TCL_VERSION)$(DBGX).dll"
|
||||
WISH = "$(TCLDIR)\bin\wish$(TCL_VERSION)$(DBGX).exe"
|
||||
TCL_LIBRARY =
|
||||
TK_LIBRARY =
|
||||
!else
|
||||
TKSTUBLIB = "$(TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
|
||||
TKIMPLIB = "$(TKDIR)\win\$(OUT_DIR)\tk$(TCL_VERSION)$(DBGX).lib"
|
||||
TKLIB = "$(TKDIR)\win\$(OUT_DIR)\tk$(TCL_VERSION)$(DBGX).dll"
|
||||
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\$(BUILDDIRTOP)\$(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 -D_USE_32BIT_TIME_T -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)
|
||||
$(TCLSH) ..\tests\all.tcl $(TESTFLAGS) -loadfile <<
|
||||
set env(TK_LIBRARY) $(TK_LIBRARY:\=/)
|
||||
set env(ITCL_LIBRARY) [file normalize $(ITCL_LIBRARY:\=/)]
|
||||
set env(ITK_LIBRARY) [file normalize $(ITK_LIBRARY:\=/)]
|
||||
load [file normalize $(ITCLLIB:\=/)] Itcl
|
||||
load [file normalize $(TKLIB:\=/)] Tk
|
||||
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
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Generate the source dependencies.
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
depend:
|
||||
!if !exist($(TCLSH))
|
||||
@echo Build tclsh first!
|
||||
!else
|
||||
$(TCLSH) $(TCLTOOLSDIR)\mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
|
||||
-passthru:"-DBUILD_itcl $(ITCL_INCLUDES) $(TCL_INCLUDES) $(ITK_INCLUDES) $(TK_INCLUDES)" \
|
||||
$(GENERICDIR),$$(GENERICDIR) $(WINDIR),$$(WINDIR) @<<
|
||||
$(ITKOBJS)
|
||||
<<
|
||||
!endif
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# Dependency rules
|
||||
#---------------------------------------------------------------------
|
||||
|
||||
!if exist("$(OUT_DIR)\depend.mk")
|
||||
!include "$(OUT_DIR)\depend.mk"
|
||||
!message *** Dependency rules in use.
|
||||
!else
|
||||
!message *** Dependency rules are not being used.
|
||||
!endif
|
||||
|
||||
### add a spacer in the output
|
||||
!message
|
||||
|
||||
#---------------------------------------------------------------------
|
||||
# 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)
|
||||
|
||||
+133
-597
@@ -1,53 +1,28 @@
|
||||
/*
|
||||
* ----------------------------------------------------------------------------
|
||||
/* ----------------------------------------------------------------------------
|
||||
* nmakehlp.c --
|
||||
*
|
||||
* This is used to fix limitations within nmake and the environment.
|
||||
*
|
||||
* Copyright (c) 2002 David Gravereaux.
|
||||
* Copyright (c) 2006 Pat Thoyts
|
||||
* Copyright (c) 2002 by David Gravereaux.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
* 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>
|
||||
|
||||
/*
|
||||
* 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
|
||||
|
||||
#include <math.h>
|
||||
|
||||
/* protos */
|
||||
|
||||
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);
|
||||
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);
|
||||
|
||||
/* globals */
|
||||
|
||||
#define CHUNK 25
|
||||
#define STATICBUFFERSIZE 1000
|
||||
typedef struct {
|
||||
@@ -55,33 +30,23 @@ typedef struct {
|
||||
char buffer[STATICBUFFERSIZE];
|
||||
} pipeinfo;
|
||||
|
||||
pipeinfo Out = {INVALID_HANDLE_VALUE, ""};
|
||||
pipeinfo Err = {INVALID_HANDLE_VALUE, ""};
|
||||
|
||||
/*
|
||||
* exitcodes: 0 == no, 1 == yes, 2 == error
|
||||
*/
|
||||
pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'};
|
||||
pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};
|
||||
|
||||
|
||||
|
||||
/* 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", "");
|
||||
|
||||
@@ -89,111 +54,56 @@ main(
|
||||
switch (*(argv[1]+1)) {
|
||||
case 'c':
|
||||
if (argc != 3) {
|
||||
chars = snprintf(msg, sizeof(msg) - 1,
|
||||
"usage: %s -c <compiler option>\n"
|
||||
chars = wsprintf(msg, "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 = snprintf(msg, sizeof(msg) - 1,
|
||||
"usage: %s -l <linker option> ?<mandatory option> ...?\n"
|
||||
if (argc != 3) {
|
||||
chars = wsprintf(msg, "usage: %s -l <linker 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], argc-2);
|
||||
return CheckForLinkerFeature(argv[2]);
|
||||
case 'f':
|
||||
if (argc == 2) {
|
||||
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);
|
||||
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);
|
||||
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 's':
|
||||
case 'g':
|
||||
if (argc == 2) {
|
||||
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);
|
||||
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);
|
||||
return 2;
|
||||
}
|
||||
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]);
|
||||
return GrepForDefine(argv[2], argv[3]);
|
||||
}
|
||||
}
|
||||
chars = snprintf(msg, sizeof(msg) - 1,
|
||||
"usage: %s -c|-f|-l|-Q|-s|-V ...\n"
|
||||
chars = wsprintf(msg, "usage: %s -c|-l|-f ...\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;
|
||||
}
|
||||
|
||||
static int
|
||||
CheckForCompilerFeature(
|
||||
const char *option)
|
||||
|
||||
int
|
||||
CheckForCompilerFeature (const char *option)
|
||||
{
|
||||
STARTUPINFO si;
|
||||
PROCESS_INFORMATION pi;
|
||||
@@ -206,55 +116,35 @@ CheckForCompilerFeature(
|
||||
|
||||
hProcess = GetCurrentProcess();
|
||||
|
||||
memset(&pi, 0, sizeof(PROCESS_INFORMATION));
|
||||
memset(&si, 0, sizeof(STARTUPINFO));
|
||||
ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
|
||||
ZeroMemory(&si, sizeof(STARTUPINFO));
|
||||
si.cb = sizeof(STARTUPINFO);
|
||||
si.dwFlags = STARTF_USESTDHANDLES;
|
||||
si.hStdInput = INVALID_HANDLE_VALUE;
|
||||
|
||||
memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
|
||||
ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES));
|
||||
sa.nLength = sizeof(SECURITY_ATTRIBUTES);
|
||||
sa.lpSecurityDescriptor = NULL;
|
||||
sa.bInheritHandle = FALSE;
|
||||
|
||||
/*
|
||||
* Create a non-inheritable pipe.
|
||||
*/
|
||||
|
||||
/* create a non-inheritible pipe. */
|
||||
CreatePipe(&Out.pipe, &h, &sa, 0);
|
||||
|
||||
/*
|
||||
* 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.
|
||||
*/
|
||||
/* 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);
|
||||
|
||||
/* 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.
|
||||
*/
|
||||
|
||||
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");
|
||||
/* 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");
|
||||
|
||||
ok = CreateProcess(
|
||||
NULL, /* Module name. */
|
||||
@@ -270,65 +160,41 @@ CheckForCompilerFeature(
|
||||
|
||||
if (!ok) {
|
||||
DWORD err = GetLastError();
|
||||
int chars = snprintf(msg, sizeof(msg) - 1,
|
||||
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
|
||||
int chars = wsprintf(msg, "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, (LPSTR)&msg[chars],
|
||||
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS |
|
||||
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars],
|
||||
(300-chars), 0);
|
||||
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
|
||||
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(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.
|
||||
* - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002.
|
||||
*/
|
||||
|
||||
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);
|
||||
/* look for the commandline warning code in both streams. */
|
||||
return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL);
|
||||
}
|
||||
|
||||
static int
|
||||
CheckForLinkerFeature(
|
||||
char **options,
|
||||
int count)
|
||||
|
||||
int
|
||||
CheckForLinkerFeature (const char *option)
|
||||
{
|
||||
STARTUPINFO si;
|
||||
PROCESS_INFORMATION pi;
|
||||
@@ -337,58 +203,37 @@ CheckForLinkerFeature(
|
||||
char msg[300];
|
||||
BOOL ok;
|
||||
HANDLE hProcess, h, pipeThreads[2];
|
||||
int i;
|
||||
char cmdline[255];
|
||||
char cmdline[100];
|
||||
|
||||
hProcess = GetCurrentProcess();
|
||||
|
||||
memset(&pi, 0, sizeof(PROCESS_INFORMATION));
|
||||
memset(&si, 0, sizeof(STARTUPINFO));
|
||||
ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
|
||||
ZeroMemory(&si, sizeof(STARTUPINFO));
|
||||
si.cb = sizeof(STARTUPINFO);
|
||||
si.dwFlags = STARTF_USESTDHANDLES;
|
||||
si.hStdInput = INVALID_HANDLE_VALUE;
|
||||
|
||||
memset(&sa, 0, sizeof(SECURITY_ATTRIBUTES));
|
||||
ZeroMemory(&sa, 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 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.
|
||||
*/
|
||||
/* 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);
|
||||
|
||||
/* 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.
|
||||
*/
|
||||
|
||||
lstrcpy(cmdline, "link.exe -nologo ");
|
||||
|
||||
/*
|
||||
* Append our option for testing.
|
||||
*/
|
||||
|
||||
for (i = 0; i < count; i++) {
|
||||
lstrcat(cmdline, " \"");
|
||||
lstrcat(cmdline, options[i]);
|
||||
lstrcat(cmdline, "\"");
|
||||
}
|
||||
/* base command line */
|
||||
strcpy(cmdline, "link.exe -nologo ");
|
||||
/* append our option for testing */
|
||||
strcat(cmdline, option);
|
||||
|
||||
ok = CreateProcess(
|
||||
NULL, /* Module name. */
|
||||
@@ -404,73 +249,51 @@ CheckForLinkerFeature(
|
||||
|
||||
if (!ok) {
|
||||
DWORD err = GetLastError();
|
||||
int chars = snprintf(msg, sizeof(msg) - 1,
|
||||
"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);
|
||||
int chars = wsprintf(msg, "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, (LPSTR)&msg[chars],
|
||||
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS |
|
||||
FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars],
|
||||
(300-chars), 0);
|
||||
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
|
||||
WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(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 ||
|
||||
strstr(Out.buffer, "LNK4044") != NULL ||
|
||||
strstr(Err.buffer, "LNK4044") != NULL ||
|
||||
strstr(Out.buffer, "LNK4224") != NULL ||
|
||||
strstr(Err.buffer, "LNK4224") != NULL);
|
||||
/* look for the commandline warning code in the stderr stream. */
|
||||
return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL);
|
||||
}
|
||||
|
||||
static DWORD WINAPI
|
||||
ReadFromPipe(
|
||||
LPVOID args)
|
||||
|
||||
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 (DWORD)-1;
|
||||
return -1;
|
||||
}
|
||||
ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L);
|
||||
if (!ok || dwRead == 0) {
|
||||
@@ -482,339 +305,52 @@ ReadFromPipe(
|
||||
|
||||
return 0; /* makes the compiler happy */
|
||||
}
|
||||
|
||||
static int
|
||||
IsIn(
|
||||
const char *string,
|
||||
const char *substring)
|
||||
|
||||
int
|
||||
IsIn (const char *string, const char *substring)
|
||||
{
|
||||
return (strstr(string, substring) != NULL);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
static const char *
|
||||
GetVersionFromFile(
|
||||
const char *filename,
|
||||
const char *match,
|
||||
int numdots)
|
||||
{
|
||||
static char szBuffer[100];
|
||||
char *szResult = NULL;
|
||||
FILE *fp = fopen(filename, "rt");
|
||||
|
||||
if (fp != NULL) {
|
||||
/*
|
||||
* Read data until we see our match string.
|
||||
*/
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
/*
|
||||
* 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;
|
||||
}
|
||||
}
|
||||
fclose(fp);
|
||||
}
|
||||
return szResult;
|
||||
}
|
||||
|
||||
/*
|
||||
* List helpers for the SubstituteFile function
|
||||
*/
|
||||
|
||||
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*$
|
||||
* Find a specified #define by name.
|
||||
*
|
||||
* Usage is something like:
|
||||
* nmakehlp -S << $** > $@
|
||||
* @PACKAGE_NAME@ $(PACKAGE_NAME)
|
||||
* @PACKAGE_VERSION@ $(PACKAGE_VERSION)
|
||||
* <<
|
||||
* If the line is '#define TCL_VERSION "8.5"', it returns
|
||||
* 85 as the result.
|
||||
*/
|
||||
|
||||
static int
|
||||
SubstituteFile(
|
||||
const char *substitutions,
|
||||
const char *filename)
|
||||
int
|
||||
GrepForDefine (const char *file, const char *string)
|
||||
{
|
||||
static char szBuffer[1024], szCopy[1024];
|
||||
list_item_t *substPtr = NULL;
|
||||
FILE *fp, *sp;
|
||||
FILE *f;
|
||||
char s1[51], s2[51], s3[51];
|
||||
int r = 0;
|
||||
double d1;
|
||||
|
||||
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 */
|
||||
f = fopen(file, "rt");
|
||||
if (f == NULL) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* 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;
|
||||
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;
|
||||
}
|
||||
return ((int) d1); /* 85 */
|
||||
}
|
||||
}
|
||||
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;
|
||||
} while (!feof(f));
|
||||
|
||||
fclose(f);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* 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:
|
||||
*/
|
||||
|
||||
@@ -1,141 +0,0 @@
|
||||
# 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
|
||||
+490
-1960
File diff suppressed because it is too large
Load Diff
@@ -1 +0,0 @@
|
||||
svn-r
|
||||
Binary file not shown.
Reference in New Issue
Block a user