Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,10 @@ +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 * generic/itkArchetype.c: Fix for SF bug #253. 2013-02-03 Arnulf P. Wiedemann * bumped version to 4.0.0 for release Index: configure ================================================================== --- configure +++ configure @@ -1,8 +1,8 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for itk 4.0.1. +# Generated by GNU Autoconf 2.69 for itk 4.1.0. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # @@ -575,12 +575,12 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='itk' PACKAGE_TARNAME='itk' -PACKAGE_VERSION='4.0.1' -PACKAGE_STRING='itk 4.0.1' +PACKAGE_VERSION='4.1.0' +PACKAGE_STRING='itk 4.1.0' PACKAGE_BUGREPORT='' PACKAGE_URL='' # Factoring default headers for most tests. ac_includes_default="\ @@ -646,10 +646,11 @@ CELIB_DIR AR SHARED_BUILD XMKMF TK_INCLUDES +TCL_TOP_DIR_NATIVE TCL_INCLUDES PKG_OBJECTS PKG_SOURCES MATH_LIBS EGREP @@ -1320,11 +1321,11 @@ # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures itk 4.0.1 to adapt to many kinds of systems. +\`configure' configures itk 4.1.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. @@ -1385,11 +1386,11 @@ _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of itk 4.0.1:";; + short | recursive ) echo "Configuration of itk 4.1.0:";; esac cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options @@ -1489,11 +1490,11 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -itk configure 4.0.1 +itk configure 4.1.0 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. @@ -1854,11 +1855,11 @@ } # ac_fn_c_check_header_mongrel cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by itk $as_me 4.0.1, which was +It was created by itk $as_me 4.1.0, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ _ACEOF @@ -2218,11 +2219,11 @@ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for correct TEA configuration" >&5 $as_echo_n "checking for correct TEA configuration... " >&6; } if test x"${PACKAGE_NAME}" = x ; then as_fn_error $? " -The PACKAGE_NAME variable must be defined by your TEA configure.in" "$LINENO" 5 +The PACKAGE_NAME variable must be defined by your TEA configure.ac" "$LINENO" 5 fi if test x"3.9" = x ; then as_fn_error $? " TEA version not specified." "$LINENO" 5 elif test "3.9" != "${TEA_VERSION}" ; then @@ -2256,11 +2257,11 @@ do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CYGPATH="cygpath -w" + ac_cv_prog_CYGPATH="cygpath -m" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done @@ -2281,13 +2282,12 @@ EXEEXT=".exe" TEA_PLATFORM="windows" ;; *CYGWIN_*) - CYGPATH=echo EXEEXT=".exe" - # TEA_PLATFORM is determined later in LOAD_TCLCONFIG + # CYGPATH and TEA_PLATFORM are determined later in LOAD_TCLCONFIG ;; *) CYGPATH=echo # Maybe we are cross-compiling.... case ${host_alias} in @@ -3411,13 +3411,55 @@ ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : - TEA_PLATFORM="unix" + + TEA_PLATFORM="unix" + CYGPATH=echo + else - TEA_PLATFORM="windows" + + TEA_PLATFORM="windows" + # Extract the first word of "cygpath", so it can be a program name with args. +set dummy cygpath; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CYGPATH+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CYGPATH"; then + ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CYGPATH="cygpath -m" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo" +fi +fi +CYGPATH=$ac_cv_prog_CYGPATH +if test -n "$CYGPATH"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5 +$as_echo "$CYGPATH" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext CC=$hold_cc { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TEA_PLATFORM" >&5 @@ -5982,10 +6024,11 @@ # 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 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tcl public headers" >&5 $as_echo_n "checking for Tcl public headers... " >&6; } @@ -6066,11 +6109,68 @@ TCL_INCLUDES=-I\"${INCLUDE_DIR_NATIVE}\" -#TEA_PRIVATE_TCL_HEADERS + + # Allow for --with-tclinclude to take effect and define ${ac_cv_c_tclh} + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tcl private include files" >&5 +$as_echo_n "checking for Tcl private include files... " >&6; } + + TCL_SRC_DIR_NATIVE=`${CYGPATH} ${TCL_SRC_DIR}` + TCL_TOP_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}\" + + # Check to see if tclPort.h isn't already with the public headers + # Don't look for tclInt.h because that resides with tcl.h in the core + # sources, but the Port headers are in a different directory + if test "${TEA_PLATFORM}" = "windows" -a \ + -f "${ac_cv_c_tclh}/tclWinPort.h"; then + result="private headers found with public headers" + elif test "${TEA_PLATFORM}" = "unix" -a \ + -f "${ac_cv_c_tclh}/tclUnixPort.h"; then + result="private headers found with public headers" + else + TCL_GENERIC_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/generic\" + if test "${TEA_PLATFORM}" = "windows"; then + TCL_PLATFORM_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/win\" + else + TCL_PLATFORM_DIR_NATIVE=\"${TCL_SRC_DIR_NATIVE}/unix\" + fi + # Overwrite the previous TCL_INCLUDES as this should capture both + # public and private headers in the same set. + # We want to ensure these are substituted so as not to require + # any *_NATIVE vars be defined in the Makefile + TCL_INCLUDES="-I${TCL_GENERIC_DIR_NATIVE} -I${TCL_PLATFORM_DIR_NATIVE}" + if test "`uname -s`" = "Darwin"; then + # If Tcl was built as a framework, attempt to use + # the framework's Headers and PrivateHeaders directories + case ${TCL_DEFS} in + *TCL_FRAMEWORK*) + if test -d "${TCL_BIN_DIR}/Headers" -a \ + -d "${TCL_BIN_DIR}/PrivateHeaders"; then + TCL_INCLUDES="-I\"${TCL_BIN_DIR}/Headers\" -I\"${TCL_BIN_DIR}/PrivateHeaders\" ${TCL_INCLUDES}" + else + TCL_INCLUDES="${TCL_INCLUDES} ${TCL_INCLUDE_SPEC} `echo "${TCL_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" + fi + ;; + esac + result="Using ${TCL_INCLUDES}" + else + if test ! -f "${TCL_SRC_DIR}/generic/tclInt.h" ; then + as_fn_error $? "Cannot find private header tclInt.h in ${TCL_SRC_DIR}" "$LINENO" 5 + fi + result="Using srcdir found in tclConfig.sh: ${TCL_SRC_DIR}" + fi + fi + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${result}" >&5 +$as_echo "${result}" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Tk public headers" >&5 $as_echo_n "checking for Tk public headers... " >&6; } @@ -7091,17 +7191,35 @@ if test "${SHARED_BUILD}" = "0" ; then runtime=-MT else runtime=-MD fi + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + + vars="ucrt.lib" + for i in $vars; do + if test "${TEA_PLATFORM}" = "windows" -a "$GCC" = "yes" ; then + # Convert foo.lib to -lfoo for GCC. No-op if not *.lib + i=`echo "$i" | sed -e 's/^\([^-].*\)\.lib$/-l\1/i'` + fi + PKG_LIBS="$PKG_LIBS $i" + done + + + ;; + *) + ;; + esac if test "$do64bit" != "no" ; then # All this magic is necessary for the Win64 SDK RC1 - hobbs CC="\"${PATH64}/cl.exe\"" CFLAGS="${CFLAGS} -I\"${MSSDK}/Include\" -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" RC="\"${MSSDK}/bin/rc.exe\"" - lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" + lflags="${lflags} -nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" LINKBIN="\"${PATH64}/link.exe\"" CFLAGS_DEBUG="-nologo -Zi -Od -W3 ${runtime}d" CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" # Avoid 'unresolved external symbol __security_cookie' # errors, c.f. http://support.microsoft.com/?id=894573 @@ -7149,16 +7267,16 @@ _ACEOF CFLAGS_DEBUG="-nologo -Zi -Od" CFLAGS_OPTIMIZE="-nologo -Ox" lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'` - lflags="-MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" + lflags="${lflags} -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo" LINKBIN="\"${CEBINROOT}/link.exe\"" else RC="rc" - lflags="-nologo" + lflags="${lflags} -nologo" LINKBIN="link" CFLAGS_DEBUG="-nologo -Z7 -Od -W3 -WX ${runtime}d" CFLAGS_OPTIMIZE="-nologo -O2 -W2 ${runtime}" fi fi @@ -9185,19 +9303,19 @@ fi SHLIB_LD_LIBS="${SHLIB_LD_LIBS} \"`${CYGPATH} ${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}`\"" if test "$GCC" = "yes"; then SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -static-libgcc" fi - eval eval "PKG_LIB_FILE=${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" else - eval eval "PKG_LIB_FILE=${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" if test "$GCC" = "yes"; then PKG_LIB_FILE=lib${PKG_LIB_FILE} fi fi # Some packages build their own stubs libraries - eval eval "PKG_STUB_LIB_FILE=${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" if test "$GCC" = "yes"; then PKG_STUB_LIB_FILE=lib${PKG_STUB_LIB_FILE} fi # These aren't needed on Windows (either MSVC or gcc) RANLIB=: @@ -9207,17 +9325,17 @@ if test "${SHARED_BUILD}" = "1" ; then SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TCL_STUB_LIB_SPEC}" if test x"${TK_BIN_DIR}" != x ; then SHLIB_LD_LIBS="${SHLIB_LD_LIBS} ${TK_STUB_LIB_SPEC}" fi - eval eval "PKG_LIB_FILE=lib${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${SHARED_LIB_SUFFIX}" RANLIB=: else - eval eval "PKG_LIB_FILE=lib${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" + eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" fi # Some packages build their own stubs libraries - eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" + eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" fi # These are escaped so that only CFLAGS is picked up at configure time. # The other values will be substituted at make time. CFLAGS="${CFLAGS} \${CFLAGS_DEFAULT} \${CFLAGS_WARNING}" @@ -9865,11 +9983,11 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by itk $as_me 4.0.1, which was +This file was extended by itk $as_me 4.1.0, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS @@ -9918,11 +10036,11 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -itk config.status 4.0.1 +itk config.status 4.1.0 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation Index: configure.in ================================================================== --- configure.in +++ configure.in @@ -8,11 +8,11 @@ # 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. #----------------------------------------------------------------------- -AC_INIT([itk], [4.0.1]) +AC_INIT([itk], [4.1.0]) #-------------------------------------------------------------------- # Call TEA_INIT as the first TEA_ macro to set up initial vars. # This will define a ${TEA_PLATFORM} variable == "unix" or "windows" # as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE. @@ -128,12 +128,12 @@ # 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_TCL_HEADERS +TEA_PRIVATE_TCL_HEADERS TEA_PUBLIC_TK_HEADERS #TEA_PRIVATE_TK_HEADERS #-------------------------------------------------------------------- Index: generic/itk.h ================================================================== --- generic/itk.h +++ generic/itk.h @@ -64,16 +64,16 @@ # define TCL_FINAL_RELEASE 2 #endif #define ITK_MAJOR_VERSION 4 -#define ITK_MINOR_VERSION 0 -#define ITK_RELEASE_LEVEL TCL_RELEASE -#define ITK_RELEASE_SERIAL 1 +#define ITK_MINOR_VERSION 1 +#define ITK_RELEASE_LEVEL TCL_FINAL_RELEASE +#define ITK_RELEASE_SERIAL 0 -#define ITK_VERSION "4.0" -#define ITK_PATCH_LEVEL "4.0.1" +#define ITK_VERSION "4.1" +#define ITK_PATCH_LEVEL "4.1.0" /* * A special definition used to allow this header file to be included * in resource files so that they can get obtain version information from Index: generic/itkArchBase.c ================================================================== --- generic/itkArchBase.c +++ generic/itkArchBase.c @@ -178,31 +178,26 @@ Tcl_Obj *tmpNamePtr = NULL; Tcl_Obj *winNamePtr = NULL; Tcl_Obj *hullNamePtr = NULL; int pLevel = ITCL_PUBLIC; - ItclShowArgs(1, "Itk_ArchCompAddCmd", objc, objv); int newEntry; int result; CONST char *cmd; CONST char *token; CONST char *resultStr; - Tcl_CallFrame frame; char *name; Tcl_Namespace *parserNs; ItclClass *contextClass; ItclClass *ownerClass; ItclObject *contextObj; ArchInfo *info; Tcl_Command accessCmd; Tcl_Obj *objPtr; Tcl_DString buffer; - Tcl_CallFrame *uplevelFramePtr; - Tcl_CallFrame *oldFramePtr = NULL; - ItclObjectInfo *infoPtr; - ItclCallContext *callContextPtr; + ItclShowArgs(1, "Itk_ArchCompAddCmd", objc, objv); /* * Get the Archetype info associated with this widget. */ contextClass = NULL; if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK || @@ -303,14 +298,10 @@ /* * Execute the to create the component widget. * Do this one level up, in the scope of the calling routine. */ - Itcl_SetCallFrameResolver(interp, contextClass->resolvePtr); - infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL); - uplevelFramePtr = Itcl_GetUplevelCallFrame(interp, 1); - oldFramePtr = Itcl_ActivateCallFrame(interp, uplevelFramePtr); result = Tcl_EvalObjEx(interp, objv[2], 0); if (result != TCL_OK) { goto compFail; } @@ -337,12 +328,10 @@ path, "\" for component \"", name, "\"", (char*)NULL); goto compFail; } - (void) Itcl_ActivateCallFrame(interp, oldFramePtr); - oldFramePtr = NULL; winNamePtr = Tcl_NewStringObj((char*)NULL, 0); Tcl_GetCommandFullName(interp, accessCmd, winNamePtr); Tcl_IncrRefCount(winNamePtr); @@ -349,25 +338,10 @@ /* * Create the component record. Set the protection level * according to the "-protected" or "-private" option. */ ownerClass = contextClass; - Tcl_Namespace *ownerNsPtr; - callContextPtr = Itcl_PeekStack(&infoPtr->contextStack); - ownerNsPtr = callContextPtr->nsPtr; - if (ownerNsPtr != NULL) { - Tcl_HashEntry *hPtr; - int idx = 2; - if (Itcl_GetStackSize(&infoPtr->contextStack) == 1) { - idx = 1; - } - callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack, - Itcl_GetStackSize(&infoPtr->contextStack)-idx); - hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, - (char *)callContextPtr->nsPtr); - ownerClass = (ItclClass*)Tcl_GetHashValue(hPtr); - } archComp = Itk_CreateArchComponent(interp, info, name, ownerClass, accessCmd); if (!archComp) { @@ -415,34 +389,40 @@ * from its parent's component list. Avoid doing these things * for the "hull" component, since it is a special case and * these things are not really necessary. */ Tcl_DStringSetLength(&buffer, 0); - Tcl_DStringAppend(&buffer, "bindtags ", -1); + Tcl_DStringAppend(&buffer, "::bindtags ", -1); Tcl_DStringAppend(&buffer, path, -1); if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) { goto compFail; } + /* + * NOTE: We need the [::itcl::code] because the itk_component + * method is protected. + */ + Tcl_DStringSetLength(&buffer, 0); - Tcl_DStringAppend(&buffer, "bind itk-destroy-", -1); + Tcl_DStringAppend(&buffer, "::bind itk-destroy-", -1); Tcl_DStringAppend(&buffer, path, -1); - Tcl_DStringAppend(&buffer, " [itcl::code ", -1); + Tcl_DStringAppend(&buffer, " [::itcl::code ", -1); Tcl_DStringAppend(&buffer, Tcl_GetStringFromObj(objNamePtr,(int*)NULL), -1); Tcl_DStringAppend(&buffer, " itk_component delete ", -1); Tcl_DStringAppend(&buffer, name, -1); Tcl_DStringAppend(&buffer, "]\n", -1); - Tcl_DStringAppend(&buffer, "bindtags ", -1); + Tcl_DStringAppend(&buffer, "::bindtags ", -1); Tcl_DStringAppend(&buffer, path, -1); Tcl_DStringAppend(&buffer, " {itk-destroy-", -1); Tcl_DStringAppend(&buffer, path, -1); Tcl_DStringAppend(&buffer, " ", -1); Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1); Tcl_DStringAppend(&buffer, "}", -1); + if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) { goto compFail; } } @@ -502,19 +482,15 @@ Tcl_IncrRefCount(objPtr); } else { objPtr = objv[3]; } - result = Itcl_PushCallFrame(interp, &frame, parserNs, - /* isProcCallFrame */ 0); - - if (result == TCL_OK) { - result = Tcl_EvalObj(interp, objPtr); - Itcl_PopCallFrame(interp); - } - - if (objPtr != objv[3]) { + Tcl_Eval(interp, "::namespace path [::lreplace [::namespace path] end+1 end ::itk::option-parser]"); + result = Tcl_EvalObj(interp, objPtr); + Tcl_Eval(interp, "::namespace path [::lrange [::namespace path] 0 end-1]"); + + if (objc != 4) { Tcl_DecrRefCount(objPtr); } if (result != TCL_OK) { goto compFail; } @@ -545,13 +521,10 @@ /* * If any errors were encountered, clean up and return. */ compFail: - if (oldFramePtr) { - (void) Itcl_ActivateCallFrame(interp, oldFramePtr); - } if (archComp) { Itk_DelArchComponent(archComp); } if (entry) { Tcl_DeleteHashEntry(entry); @@ -675,11 +648,11 @@ * Clean up the binding tag that causes the widget to * call this method automatically when destroyed. * Ignore errors if anything goes wrong. */ Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, "itk::remove_destroy_hook ", -1); + Tcl_DStringAppend(&buffer, "::itk::remove_destroy_hook ", -1); Tcl_DStringAppend(&buffer, archComp->pathName, -1); (void) Tcl_Eval(interp, Tcl_DStringValue(&buffer)); Tcl_ResetResult(interp); Tcl_DStringFree(&buffer); @@ -1608,12 +1581,11 @@ ClientData cdata, /* command prefix to use for configuration */ CONST char *newval) /* new value for this option */ { ItclVariable *ivPtr = (ItclVariable*)cdata; - Tcl_CallFrame frame; - int result; + int result = TCL_OK; CONST char *val; ItclMemberCode *mcode; /* * Update the public variable with the new option value. @@ -1620,25 +1592,28 @@ * There should already be a call frame installed for handling * instance variables, but make sure that the namespace context * is the most-specific class, so that the public variable can * be found. */ - result = Itcl_PushCallFrame(interp, &frame, contextObj->iclsPtr->nsPtr, - /*isProcCallFrame*/0); if (result == TCL_OK) { /* * Casting away CONST of newval only to satisfy Tcl 8.3 and * earlier headers. */ + +#if 1 + val = ItclSetInstanceVar(interp, Tcl_GetString(ivPtr->fullNamePtr), + NULL, newval, contextObj, ivPtr->iclsPtr); +#else val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), (char *) NULL, (char *) newval, TCL_LEAVE_ERR_MSG); +#endif if (!val) { result = TCL_ERROR; } - Itcl_PopCallFrame(interp); } if (result != TCL_OK) { char msg[256]; sprintf(msg, "\n (error in configuration of public variable \"%.100s\")", Tcl_GetString(ivPtr->fullNamePtr)); @@ -1652,16 +1627,19 @@ * NOTE: Invoke the "config" code in the class scope * containing the data member. */ mcode = ivPtr->codePtr; if (mcode && mcode->bodyPtr) { + Tcl_CallFrame frame; - Itcl_SetCallFrameResolver(interp, ivPtr->iclsPtr->resolvePtr); - Tcl_Namespace *saveNsPtr = Tcl_GetCurrentNamespace(interp); - Itcl_SetCallFrameNamespace(interp, ivPtr->iclsPtr->nsPtr); + Itcl_PushCallFrame(interp, &frame, ivPtr->iclsPtr->nsPtr, 1); + Itcl_SetContext(interp, contextObj); + result = Tcl_EvalObjEx(interp, mcode->bodyPtr, 0); - Itcl_SetCallFrameNamespace(interp, saveNsPtr); + + Itcl_UnsetContext(interp); + Itcl_PopCallFrame(interp); if (result == TCL_OK) { Tcl_ResetResult(interp); } else { char msg[256]; @@ -1757,10 +1735,12 @@ Tcl_HashEntry *entry; ArchOption *archOpt; Itcl_ListElem *part; ArchOptionPart *optPart; Itcl_InterpState istate; + ItclClass *iclsPtr; + ItclObject *ioPtr; /* * Query the "itk_option" array to get the current setting. */ entry = Tcl_FindHashEntry(&info->options, name); @@ -1775,11 +1755,19 @@ (char*)NULL); return TCL_ERROR; } archOpt = (ArchOption*)Tcl_GetHashValue(entry); +#if 0 v = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0); +#else + Itcl_GetContext(interp, &iclsPtr, &ioPtr); + + v = ItclGetInstanceVar(interp, "itk_option", archOpt->switchName, + ioPtr, iclsPtr); +#endif + if (v) { lastval = (char*)ckalloc((unsigned)(strlen(v)+1)); strcpy(lastval, v); } else { lastval = NULL; @@ -1786,11 +1774,16 @@ } /* * Update the "itk_option" array with the new setting. */ +#if 0 if (!Tcl_SetVar2(interp, "itk_option", archOpt->switchName, value, 0)) { +#else + if (!ItclSetInstanceVar(interp, "itk_option", archOpt->switchName, value, + ioPtr, iclsPtr)) { +#endif Itk_ArchOptAccessError(interp, info, archOpt); result = TCL_ERROR; goto configDone; } @@ -1818,11 +1811,16 @@ * the option parts and sync them up with the old value. */ if (result == TCL_ERROR) { istate = Itcl_SaveInterpState(interp, result); +#if 0 Tcl_SetVar2(interp, "itk_option", archOpt->switchName, lastval, 0); +#else + ItclSetInstanceVar(interp, "itk_option", archOpt->switchName, lastval, + ioPtr, iclsPtr); +#endif part = Itcl_FirstListElem(&archOpt->parts); while (part) { optPart = (ArchOptionPart*)Itcl_GetListValue(part); (*optPart->configProc)(interp, info->itclObj, @@ -2124,13 +2122,10 @@ ArchOption *archOpt, /* option to initialize */ CONST char *defVal, /* last-resort default value */ char *currVal) /* current option value */ { CONST char *init = NULL; - - Tcl_CallFrame frame; - int result; CONST char *ival; char c; /* * If the option is already initialized, then abort. @@ -2167,26 +2162,12 @@ ival = currVal; } else { ival = init; } - /* - * Set the initial value in the itk_option array. - * Since this might be called from the itk::option-parser - * namespace, reinstall the object context. - */ - result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0); - - if (result == TCL_OK) { - /* - * Casting away CONST of ival only to satisfy Tcl 8.3 and - * earlier headers. - */ - Tcl_SetVar2(interp, "itk_option", archOpt->switchName, + Tcl_SetVar2(interp, "itk_option", archOpt->switchName, (char *)((ival) ? ival : ""), 0); - Itcl_PopCallFrame(interp); - } if (ival) { archOpt->init = (char*)ckalloc((unsigned)(strlen(ival)+1)); strcpy(archOpt->init, ival); } @@ -2302,14 +2283,13 @@ char *currVal, /* current value (or NULL) */ ArchOptionPart *optPart, /* part to be added in */ ArchOption **raOpt) /* returns: option containing new part */ { CONST char *init = NULL; - - Tcl_CallFrame frame; int result; ArchOption *archOpt; + Itcl_ListElem *elemPtr; *raOpt = NULL; archOpt = NULL; /* @@ -2326,32 +2306,31 @@ * Add the option part to the composite option. If the * composite option has already been configured, then * simply update this part to the current value. Otherwise, * leave the configuration to Itk_ArchInitCmd(). */ - Itcl_AppendList(&archOpt->parts, (ClientData)optPart); + elemPtr = Itcl_AppendList(&archOpt->parts, (ClientData)optPart); if ((archOpt->flags & ITK_ARCHOPT_INIT) != 0) { - result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0); - if (result == TCL_OK) { init = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0); - Itcl_PopCallFrame(interp); } if (!init) { Itk_ArchOptAccessError(interp, info, archOpt); + Itcl_DeleteListElem(elemPtr); return TCL_ERROR; } if (!currVal || (strcmp(init,currVal) != 0)) { result = (*optPart->configProc)(interp, info->itclObj, optPart->clientData, init); if (result != TCL_OK) { Itk_ArchOptConfigError(interp, info, archOpt); + Itcl_DeleteListElem(elemPtr); return TCL_ERROR; } } } Index: generic/itkArchetype.c ================================================================== --- generic/itkArchetype.c +++ generic/itkArchetype.c @@ -30,10 +30,11 @@ * ------------------------------------------------------------------------ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include +#include #include "itkInt.h" int _itcl_debug_level = 0; #ifdef ITCL_DEBUG @@ -63,18 +64,12 @@ /* * List of commands that are used to implement the [info object] subcommands. */ static const struct NameProcMap archetypeCmds[] = { - { "::itcl::builtin::Archetype::cget", Itk_ArchCgetCmd }, - { "::itcl::builtin::Archetype::component", Itk_ArchCompAccessCmd }, - { "::itcl::builtin::Archetype::configure", Itk_ArchConfigureCmd }, { "::itcl::builtin::Archetype::delete", Itk_ArchDeleteOptsCmd }, { "::itcl::builtin::Archetype::init", Itk_ArchInitOptsCmd }, - { "::itcl::builtin::Archetype::itk_component", Itk_ArchComponentCmd }, - { "::itcl::builtin::Archetype::itk_initialize", Itk_ArchInitCmd }, - { "::itcl::builtin::Archetype::itk_option", Itk_ArchOptionCmd }, { NULL, NULL } }; /* @@ -263,10 +258,11 @@ ArchInfo *info; ItclClass *contextClass; ItclObject *contextObj; Tcl_HashTable *objsWithArchInfo; Tcl_HashEntry *entry; + Tcl_CmdInfo cmdInfo; ItclShowArgs(2, "Itk_ArchInitOptsCmd", objc, objv); if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; @@ -308,11 +304,10 @@ * resides in the global namespace. If need be, move * the command. */ result = TCL_OK; - Tcl_CmdInfo cmdInfo; Tcl_GetCommandInfoFromToken(contextObj->accessCmd, &cmdInfo); if (cmdInfo.namespacePtr != Tcl_GetGlobalNamespace(interp)) { Tcl_Obj *oldNamePtr, *newNamePtr; oldNamePtr = Tcl_NewStringObj((char*)NULL, 0); @@ -413,27 +408,27 @@ { char *cmd; char *token; char c; int length; + Tcl_DString buffer; + const char *head; + const char *tail; ItclShowArgs(2, "Itk_ArchComponentCmd", objc, objv); /* * Check arguments and handle the various options... */ - Tcl_DString buffer; - const char *head; - const char *tail; cmd = Tcl_GetString(objv[0]); Itcl_ParseNamespPath(cmd, &buffer, &head, &tail); - Tcl_DStringFree(&buffer); if (objc < 2) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "wrong # args: should be one of...\n", " ", tail, " add ?-protected? ?-private? ?--? name createCmds ?optionCmds?\n", " ", tail, " delete name ?name name...?", (char*)NULL); + Tcl_DStringFree(&buffer); return TCL_ERROR; } token = Tcl_GetString(objv[1]); c = *token; @@ -448,12 +443,14 @@ "wrong # args: should be \"", tail, " add ?-protected? ?-private? ?--?", " name createCmds ?optionCmds?\"", (char*)NULL); + Tcl_DStringFree(&buffer); return TCL_ERROR; } + Tcl_DStringFree(&buffer); return Itk_ArchCompAddCmd(dummy, interp, objc-1, objv+1); } else { /* * Handle: itk_component delete... @@ -463,15 +460,18 @@ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "wrong # args: should be \"", tail, " delete name ?name name...?\"", (char*)NULL); + Tcl_DStringFree(&buffer); return TCL_ERROR; } + Tcl_DStringFree(&buffer); return Itk_ArchCompDeleteCmd(dummy, interp, objc-1, objv+1); } } + Tcl_DStringFree(&buffer); /* * Flag any errors. */ cmd = Tcl_GetStringFromObj(objv[0], (int*)NULL); @@ -526,13 +526,10 @@ ArchOptionPart *optPart; ItclHierIter hier; ItclVariable *ivPtr; Tcl_HashSearch place; Tcl_HashEntry *entry; - ItclObjectInfo *infoPtr; - ItclCallContext *callContextPtr; - Tcl_HashEntry *hPtr; ItclShowArgs(2, "Itk_ArchInitCmd", objc, objv); contextClass = NULL; if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK || !contextObj) { @@ -544,42 +541,43 @@ token, " ?-option value -option value...?\"", (char*)NULL); return TCL_ERROR; } - infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp, - ITCL_INTERP_DATA, NULL); if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) { return TCL_ERROR; } /* * See what class is being initialized by getting the namespace * for the calling context. */ - infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL); - callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack, - Itcl_GetStackSize(&infoPtr->contextStack)-2); - hPtr = Tcl_FindHashEntry( - &callContextPtr->ioPtr->iclsPtr->infoPtr->namespaceClasses, - (char *)callContextPtr->nsPtr); - if (hPtr != NULL) { - contextClass = (ItclClass *)Tcl_GetHashValue(hPtr); - } - /* * Integrate all public variables for the current class * context into the composite option list. */ Itcl_InitHierIter(&hier, contextClass); while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) { - entry = Tcl_FirstHashEntry(&iclsPtr->variables, &place); - while (entry) { + + for (entry = Tcl_FirstHashEntry(&iclsPtr->variables, &place); + entry; entry = Tcl_NextHashEntry(&place)) { + Var *arrayPtr, *varPtr = NULL; + ivPtr = (ItclVariable*)Tcl_GetHashValue(entry); - if (ivPtr->protection == ITCL_PUBLIC) { + if (ivPtr->protection != ITCL_PUBLIC) { + continue; + } + + varPtr = TclObjLookupVar(interp, ivPtr->fullNamePtr, NULL, 0, + NULL, 0, 0, &arrayPtr); + + if (varPtr && TclIsVarArray(varPtr)) { + continue; + } + optPart = Itk_FindArchOptionPart(info, Tcl_GetString(ivPtr->namePtr), (ClientData)ivPtr); if (!optPart) { optPart = Itk_CreateOptionPart(interp, (ClientData)ivPtr, @@ -598,12 +596,10 @@ if (result != TCL_OK) { Itk_DelOptionPart(optPart); return TCL_ERROR; } } - } - entry = Tcl_NextHashEntry(&place); } } Itcl_DeleteHierIter(&hier); /* @@ -872,26 +868,12 @@ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) { return TCL_ERROR; } - ItclObjectInfo *infoPtr; - infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp, - ITCL_INTERP_DATA, NULL); - if (Itcl_GetStackSize(&infoPtr->contextStack) == 1) { - callingNs = Tcl_GetGlobalNamespace(interp); - } else { - ItclCallContext *callContextPtr; - callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack, - Itcl_GetStackSize(&infoPtr->contextStack)-2); -#ifdef NOTDEF - callingNs = (Tcl_Namespace *)Itcl_GetStackValue( - &infoPtr->namespaceStack, - Itcl_GetStackSize(&infoPtr->namespaceStack)-2); -#endif - callingNs = callContextPtr->nsPtr; - } + callingNs = Tcl_GetCurrentNamespace(interp); + /* * With no arguments, return a list of components that can be * accessed from the calling scope. */ if (objc == 2) { @@ -947,27 +929,30 @@ /* * If only the component name is specified, then return the * window name for this component. */ if (objc == 2) { - Tcl_Obj *objPtr; - objPtr = Tcl_NewObj(); - Tcl_GetCommandFullName(interp, archComp->accessCmd, objPtr); - Tcl_IncrRefCount(objPtr); - Tcl_DString buffer; - Tcl_DStringInit(&buffer); - Tcl_DStringAppend(&buffer, ITCL_VARIABLES_NAMESPACE, -1); - Tcl_DStringAppend(&buffer, Tcl_GetString(objPtr), -1); - Tcl_DecrRefCount(objPtr); - Tcl_DStringAppend(&buffer, archComp->iclsPtr->nsPtr->fullName, -1); - Tcl_Namespace *nsPtr; - Tcl_CallFrame frame; - nsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buffer), NULL, 0); - Itcl_PushCallFrame(interp, &frame, nsPtr, /*isProcCallFrame*/0); + + /* + * This is moderately ugly. We want to resolve the instance + * variable "itk_component". We have the contextObj context, + * but the only way to make that context control variable + * resolution is to force the context namespace to be the class + * namespace of the contextObj, while at the same time, not + * pushing any frame, so that the same contextObj context is + * still in force, when that custom resolver attached to that + * namespace finally gets the chance to resolve. + * + * Instance variable resolution, even (especially?) in C code, + * shouldn't need quite so many contortions. + */ + + Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp); + + Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr); val = Tcl_GetVar2(interp, "itk_component", token, 0); - Tcl_DStringFree(&buffer); - Itcl_PopCallFrame(interp); + Itcl_SetCallFrameNamespace(interp, save); if (!val) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "internal error: cannot access itk_component(", token, ")", (char*)NULL); @@ -1081,11 +1066,13 @@ if (objc == 1) { Tcl_DStringInit(&buffer); for (i=0; i < info->order.len; i++) { archOpt = (ArchOption*)Tcl_GetHashValue(info->order.list[i]); - val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0); + + val = ItclGetInstanceVar(interp, "itk_option", archOpt->switchName, + contextObj, contextClass); if (!val) { Itk_ArchOptAccessError(interp, info, archOpt); Tcl_DStringFree(&buffer); return TCL_ERROR; } @@ -1120,11 +1107,13 @@ (char*)NULL); return TCL_ERROR; } archOpt = (ArchOption*)Tcl_GetHashValue(entry); - val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0); + + val = ItclGetInstanceVar(interp, "itk_option", archOpt->switchName, + contextObj, contextClass); if (!val) { Itk_ArchOptAccessError(interp, info, archOpt); return TCL_ERROR; } @@ -1144,20 +1133,25 @@ * Otherwise, it must be a series of "-option value" assignments. * Look up each option and assign the new value. */ for (objc--,objv++; objc > 0; objc-=2, objv+=2) { char *value; + int code; +// Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp); token = Tcl_GetString(objv[0]); if (objc < 2) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "value for \"", token, "\" missing", (char*)NULL); return TCL_ERROR; } value = Tcl_GetString(objv[1]); - if (Itk_ArchConfigOption(interp, info, token, value) != TCL_OK) { +// Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr); + code = Itk_ArchConfigOption(interp, info, token, value); +// Itcl_SetCallFrameNamespace(interp, save); + if (code != TCL_OK) { return TCL_ERROR; } } Tcl_ResetResult(interp); @@ -1189,10 +1183,11 @@ ItclClass *contextClass; ItclObject *contextObj; ArchInfo *info; Tcl_HashEntry *entry; ArchOption *archOpt; + Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp); ItclShowArgs(2, "Itk_ArchCgetCmd", objc, objv); contextClass = NULL; if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK || !contextObj) { @@ -1225,11 +1220,13 @@ (char*)NULL); return TCL_ERROR; } archOpt = (ArchOption*)Tcl_GetHashValue(entry); + Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr); val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0); + Itcl_SetCallFrameNamespace(interp, save); if (!val) { Itk_ArchOptAccessError(interp, info, archOpt); return TCL_ERROR; } Index: generic/itkBase.c ================================================================== --- generic/itkBase.c +++ generic/itkBase.c @@ -212,10 +212,11 @@ * 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? */ + Tcl_PkgProvideEx(interp, "Itk", ITK_PATCH_LEVEL, (ClientData) &itkStubs); return Tcl_PkgProvideEx(interp, "itk", ITK_PATCH_LEVEL, (ClientData) &itkStubs); } /* Index: generic/itkOption.c ================================================================== --- generic/itkOption.c +++ generic/itkOption.c @@ -215,28 +215,75 @@ 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) { -//fprintf(stderr, "EXE!%s!\n", Tcl_GetString(mcode->bodyPtr)); - Itcl_SetCallFrameResolver(interp, opt->iclsPtr->resolvePtr); - Tcl_Namespace *saveNsPtr = Tcl_GetCurrentNamespace(interp); -//fprintf(stderr, "MCNS!%s!\n", saveNsPtr->fullName); - Itcl_SetCallFrameNamespace(interp, opt->iclsPtr->nsPtr); + + Itcl_PushCallFrame(interp, &frame, opt->iclsPtr->nsPtr, 1); + Itcl_SetContext(interp, contextObj); + result = Tcl_EvalObjEx(interp, mcode->bodyPtr, 0); - Itcl_SetCallFrameNamespace(interp, saveNsPtr); -#ifdef NOTDEF + + 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); -#endif + + * + * In Itcl 4, Itcl methods have become (a particular variant) + * of TclOO methods. It's not clear whether config bodies + * should also do that, or what? + * + * Instead the existing solution above has been to just "eval" + * the configbody body script in a suitable context, which + * works very nearly correctly. The trouble is that unlike + * method invocation, we've not pushed a proper frame, nor + * have we unwound a return level, so when the "eval" returns + * TCL_RETURN we've not been handling that right. You will + * find some configbody bodies out there that expect to be + * able to use [return] for early exit. Iwidgets test + * Extbutton-2.8 is an example. + * + * As a cheap workaround, we put in explicit special treatment + * for (result == TCL_RETURN) here. This is essentially a + * reproduction of the Tcl internal routine TclUpdateReturnInfo() + * but without the benefit of internals access. + */ + + if (result == TCL_RETURN) { + Tcl_Obj *opts = Tcl_GetReturnOptions(interp, TCL_RETURN); + Tcl_Obj *levelKey = Tcl_NewStringObj("-level", -1); + Tcl_Obj *levelObj; + int level; + + Tcl_DictObjGet(NULL, opts, levelKey, &levelObj); + Tcl_GetIntFromObj(NULL, levelObj, &level); + + Tcl_DictObjPut(NULL, opts, levelKey, Tcl_NewIntObj(--level)); + result = Tcl_SetReturnOptions(interp, opts); + + Tcl_DecrRefCount(levelKey); + } } return result; } Index: library/Archetype.itk ================================================================== --- library/Archetype.itk +++ library/Archetype.itk @@ -60,37 +60,23 @@ destructor { ::itcl::builtin::Archetype delete } - method cget {option} { - ::itcl::builtin::Archetype cget $option - } - - method configure {{option ""} args} { - ::itcl::builtin::Archetype configure $option {*}$args - } - - method config {{option ""} args} { - eval configure $option $args - } - - method component {{name ""} args} { - ::itcl::builtin::Archetype component $name {*}$args - } - - protected method itk_component {option args} { - ::itcl::builtin::Archetype itk_component $option {*}$args - } - - protected method itk_option {option args} { - ::itcl::builtin::Archetype itk_option $option {*}$args - } - - protected method itk_initialize {args} { - ::itcl::builtin::Archetype itk_initialize {*}$args - } + method cget {option} @Archetype-cget + + method configure {{option ""} args} @Archetype-configure + + method config {{option ""} args} @Archetype-configure + + method component {{name ""} args} @Archetype-component + + protected method itk_component {option args} @Archetype-itk_component + + protected method itk_option {option args} @Archetype-itk_option + + protected method itk_initialize {args} @Archetype-itk_initialize protected variable itk_option protected variable itk_component protected variable itk_interior "" Index: library/itk.tcl ================================================================== --- library/itk.tcl +++ library/itk.tcl @@ -12,10 +12,11 @@ # Copyright (c) 1993-1998 Lucent Technologies, Inc. # ====================================================================== # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +package require -exact Itk 4.1.0 # # Provide transparent access to all [incr Tk] commands # if {$tcl_platform(os) == "MacOS"} { source -rsrc itk:tclIndex Index: pkgIndex.tcl.in ================================================================== --- pkgIndex.tcl.in +++ pkgIndex.tcl.in @@ -1,3 +1,6 @@ # Tcl package index file, version 1.0 -package ifneeded itk @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] itk] +if {![package vsatisfies [package provide Tcl] 8.6]} return +if {[string length [package provide Itcl]] && ![package vsatisfies [package provide Itcl] 4.1]} return +package ifneeded itk @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] Itk] +package ifneeded Itk @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] Itk] Index: tests/widget.test ================================================================== --- tests/widget.test +++ tests/widget.test @@ -258,11 +258,11 @@ [bind itk-destroy-$comp ] \ [catch {.testWidget do {itk_component delete test2}}] \ [bindtags $comp] \ [bind itk-destroy-$comp ] \ [.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 {} {}}}} +} {{itk-destroy-.testWidget.t2 .testWidget.t2 Button . all} {namespace inscope ::TestWidget {::.testWidget itk_component delete test2}} 0 {.testWidget.t2 Button . all} {} {{-background background Background linen linen} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor {} {}} {-status status Status {} {}}}} test widget-1.27 {when a mega-widget object is deleted, its window and any components are destroyed (even if in another window) } { catch {destroy .t1} catch {rename .t1.bw {}} Index: win/makefile.vc ================================================================== --- win/makefile.vc +++ win/makefile.vc @@ -1,62 +1,60 @@ #------------------------------------------------------------------------------ -# Visual C++ 5.0+ makefile for [Incr Tk] +# Visual C++ 6.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! -#------------------------------------------------------------------------------ +# To build (after setting up Visual C++ command line environment), +# nmake -f makefile.vc TCLDIR=path_to_tcl_sources TKDIR=path_to_tk_sources +# To install +# nmake -f makefile.vc TCLDIR=path_to_tcl_sources TKDIR=path_to_tk_sources INSTALLDIR=path_to_install_dir install !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" - +PROJECT_REQUIRES_TK = 1 +ITCLDIR = ..\..\itcl +!include "$(ITCLDIR)\win\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:.=) - +!if [echo REM = This file is generated from makefile.vc > versions.vc] +!endif +!if [echo ITCL_MAJOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V $(ITCLDIR)\generic\itcl.h ITCL_MAJOR_VERSION >> versions.vc] +!endif +!if [echo ITCL_MINOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V $(ITCLDIR)\generic\itcl.h ITCL_MINOR_VERSION >> versions.vc] +!endif +!if [echo ITCL_PATCH_LEVEL = \>> versions.vc] \ + && [nmakehlp -V $(ITCLDIR)\generic\itcl.h ITCL_PATCH_LEVEL >> versions.vc] +!endif +!if [echo ITK_MAJOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V ..\generic\itk.h ITK_MAJOR_VERSION >> versions.vc] +!endif +!if [echo ITK_MINOR_VERSION = \>> versions.vc] \ + && [nmakehlp -V ..\generic\itk.h ITK_MINOR_VERSION >> versions.vc] +!endif +!if [echo ITK_PATCH_LEVEL = \>> versions.vc] \ + && [nmakehlp -V ..\generic\itk.h ITK_PATCH_LEVEL >> versions.vc] +!endif +!include "versions.vc" +ITCL_VERSION = $(ITCL_MAJOR_VERSION)$(ITCL_MINOR_VERSION) +ITK_VERSION = $(ITK_MAJOR_VERSION)$(ITK_MINOR_VERSION) +DOTVERSION = $(ITK_PATCH_LEVEL) BINROOT = . ROOT = .. STUBPREFIX = $(PROJECT)stub @@ -66,71 +64,49 @@ ITCLLIB = "$(ITCLDIR)\win\$(OUT_DIR)\$(ITCLLIBNAME)" ITKIMPLIB = "$(OUT_DIR)\$(PROJECT)$(ITK_VERSION)$(SUFX).lib" ITKSTUBLIBNAME = $(STUBPREFIX)$(ITK_VERSION).lib ITKSTUBLIB = "$(OUT_DIR)\$(ITKSTUBLIBNAME)" -!if $(TCL_DOES_STUBS) ITKLIBNAME = $(PROJECT)$(ITK_VERSION)$(SUFX).$(EXT) ITCLIMPLIBNAME = itcl$(ITCL_VERSION)$(SUFX).$(EXT) -!else -ITKLIBNAME = $(PROJECT)$(ITK_VERSION)80$(SUFX).$(EXT) -ITCLIMPLIBNAME = itcl$(ITCL_VERSION)80$(SUFX).lib -!endif ITKLIB = "$(OUT_DIR)\$(ITKLIBNAME)" -ITCLIMPLIB = "$(ITCLDIR)\win\Release\$(ITCLIMPLIBNAME)" - - -!if $(TCLINSTALL) -TKSTUBLIB = "$(TCLDIR)\lib\tkstub$(TCL_VERSION).lib" -TKIMPLIB = "$(TCLDIR)\lib\tk$(TCL_VERSION)$(DBGX).lib" -WISH = "$(TCLDIR)\bin\wish$(TCL_VERSION)$(DBGX).exe" -TCL_LIBRARY = -TK_LIBRARY = -!else -TKSTUBLIB = "$(TKDIR)\win\Release\tkstub$(TCL_VERSION).lib" -TKIMPLIB = "$(TKDIR)\win\$(OUT_DIR)\tk$(TCL_VERSION)$(DBGX).lib" -WISH = "$(TKDIR)\win\$(OUT_DIR)\wish$(TCL_VERSION)$(DBGX).exe" -TCL_LIBRARY = "$(TCLDIR)\library" -TK_LIBRARY = "$(TKDIR)\library" -!endif -ITCL_LIBRARY = "$(ITCLDIR:\=/)/library" -ITK_LIBRARY = "$(ROOT)/library +ITCLIMPLIB = "$(ITCLDIR)\win\$(BUILDDIRTOP)\$(ITCLIMPLIBNAME)" + + +TKSTUBLIB = $(TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib +TKIMPLIB = $(TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(DBGX).lib +WISH = $(TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(DBGX).exe +TCL_LIBRARY = $(TCLDIR)\library +TK_LIBRARY = $(TKDIR)\library +ITCL_LIBRARY = $(ITCLDIR:\=/)/library +ITK_LIBRARY = $(ROOT)/library ITCLSTUBLIBNAME = itclstub$(ITCL_VERSION).lib -ITCLSTUBLIB = "$(ITCLDIR)\win\Release\$(ITCLSTUBLIBNAME)" - -### For Tcl 8.0 -!if !$(TCL_DOES_STUBS) -TCLSTUBLIB = $(TCLIMPLIB) -TKSTUBLIB = $(TKIMPLIB) -ITCLSTUBLIB = $(ITCLIMPLIB) -!endif - - -BIN_INSTALL_DIR = $(_INSTALLDIR)\bin -DOC_INSTALL_DIR = $(_INSTALLDIR)\doc -LIB_INSTALL_DIR = $(_INSTALLDIR)\lib -SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\lib\itk$(ITK_DOTVERSION) -INCLUDE_INSTALL_DIR = $(_INSTALLDIR)\include +ITCLSTUBLIB = $(ITCLDIR)\win\$(BUILDDIRTOP)\$(ITCLSTUBLIBNAME) + +BIN_INSTALL_DIR = $(_INSTALLDIR)\..\bin +DOC_INSTALL_DIR = $(_INSTALLDIR)\..\doc +LIB_INSTALL_DIR = $(_INSTALLDIR) +SCRIPT_INSTALL_DIR = $(_INSTALLDIR)\$(PROJECT)$(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 \ + $(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 \ !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 @@ -171,41 +147,57 @@ !if exist("$(TCLDIR)\win\coffbase.txt") ITK_DLLBASE = -base:@$(TCLDIR)\win\coffbase.txt,itk !else ITK_DLLBASE = !endif + +baselibs = +# Avoid 'unresolved external symbol __security_cookie' errors. +# c.f. http://support.microsoft.com/?id=894573 +!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" +!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500 +baselibs = $(baselibs) bufferoverflowU.lib +!endif +!endif #--------------------------------------------------------------------- # Compile flags #--------------------------------------------------------------------- -!if $(DEBUG) -!if "$(MACHINE)" == "IA64" -cdebug = -Od -Zi -!else -cdebug = -Z7 -Od -WX -!endif -!else -# This cranks the optimization level up to max. -cdebug = -O2 -!endif - -# declarations common to all compiler options -cflags = -nologo -c -W3 -YX -Fp$(TMP_DIR)^\ - -!if $(PENT_0F_ERRATA) -cflags = $(cflags) -QI0f -!endif - -!if $(ITAN_B_ERRATA) -cflags = $(cflags) -QIA64_Bx -!endif +!if !$(DEBUG) +!if $(OPTIMIZING) +### This cranks the optimization level to maximize speed +cdebug = -O2 $(OPTIMIZATIONS) +!else +cdebug = +!endif +!if $(SYMBOLS) +cdebug = $(cdebug) -Zi +!endif +!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" +### Warnings are too many, can't support warnings into errors. +cdebug = -Zi -Od $(DEBUGFLAGS) +!else +cdebug = -Zi -WX $(DEBUGFLAGS) +!endif + +### Declarations common to all compiler options +cwarn = $(WARNINGS) -D _CRT_SECURE_NO_DEPRECATE -D _CRT_NONSTDC_NO_DEPRECATE +cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\ !if $(MSVCRT) -crt = -MD$(DBGX) +!if $(DEBUG) && !$(UNCHECKED) +crt = -MDd +!else +crt = -MD +!endif +!else +!if $(DEBUG) && !$(UNCHECKED) +crt = -MTd !else -crt = -MT$(DBGX) +crt = -MT +!endif !endif !if $(TCLINSTALL) TCL_INCLUDES = -I"$(TCLDIR)\include" TK_INCLUDES = @@ -222,14 +214,12 @@ ### 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) +ITK_CFLAGS = $(ITK_EXE_CFLAGS) -DUSE_TCL_STUBS -DUSE_TK_STUBS -DUSE_ITCL_STUBS $(OPTDEFINES) !endif #--------------------------------------------------------------------- # Project specific targets #--------------------------------------------------------------------- @@ -259,20 +249,18 @@ $(ITKLIB): $(ITKOBJS) !if $(STATIC_BUILD) $(lib32) -nologo -machine:$(MACHINE) -out:$@ @<< !else - $(link32) $(ITK_LFLAGS) $(ITK_DLLBASE) -out:$@ $(ITK_LLIBS) @<< + $(link32) $(ITK_LFLAGS) $(ITK_DLLBASE) -out:$@ $(ITK_LLIBS) $(baselibs) @<< !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)" @@ -287,22 +275,22 @@ 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 ^ ^ ^ ^ set add {$(SUFX:g=)}>> "$(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\ + echo ^ ^ ^ ^ package ifneeded 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\ + echo ^ ^ ^ ^ package ifneeded 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" @@ -402,15 +390,15 @@ 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:$@ + $(cc32) -nologo -G4 -ML -O2 -Fo$(@D)\ $(TCLTOOLSDIR)\$(@B).c $(baselibs) -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) << Index: win/nmakehlp.c ================================================================== --- win/nmakehlp.c +++ win/nmakehlp.c @@ -1,111 +1,187 @@ -/* ---------------------------------------------------------------------------- +/* + * ---------------------------------------------------------------------------- * nmakehlp.c -- * * This is used to fix limitations within nmake and the environment. * * Copyright (c) 2002 by David Gravereaux. + * Copyright (c) 2006 by Pat Thoyts * - * 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 +#define NO_SHLWAPI_GDI +#define NO_SHLWAPI_STREAM +#define NO_SHLWAPI_REG +#include #pragma comment (lib, "user32.lib") #pragma comment (lib, "kernel32.lib") +#pragma comment (lib, "shlwapi.lib") #include #include + +/* + * 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++ */ +#ifdef _MSC_VER +#define snprintf _snprintf +#endif + + /* protos */ -int CheckForCompilerFeature (const char *option); -int CheckForLinkerFeature (const char *option); -int IsIn (const char *string, const char *substring); -int GrepForDefine (const char *file, const char *string); -DWORD WINAPI ReadFromPipe (LPVOID args); + +static int CheckForCompilerFeature(const char *option); +static int CheckForLinkerFeature(const char *option); +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 const char *GetVersionFromFile(const char *filename, const char *match, int numdots); +static DWORD WINAPI ReadFromPipe(LPVOID args); /* globals */ + #define CHUNK 25 #define STATICBUFFERSIZE 1000 typedef struct { HANDLE pipe; char buffer[STATICBUFFERSIZE]; } pipeinfo; pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'}; pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'}; + +/* + * exitcodes: 0 == no, 1 == yes, 2 == error + */ - - -/* exitcodes: 0 == no, 1 == yes, 2 == error */ int -main (int argc, char *argv[]) +main( + int argc, + char *argv[]) { char msg[300]; DWORD dwWritten; int chars; - /* 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", ""); if (argc > 1 && *argv[1] == '-') { switch (*(argv[1]+1)) { case 'c': if (argc != 3) { - chars = wsprintf(msg, "usage: %s -c \n" + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -c \n" "Tests for whether cl.exe supports an option\n" "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); return 2; } return CheckForCompilerFeature(argv[2]); case 'l': if (argc != 3) { - chars = wsprintf(msg, "usage: %s -l \n" + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -l \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]); case 'f': if (argc == 2) { - chars = wsprintf(msg, "usage: %s -f \n" - "Find a substring within another\n" - "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -f \n" + "Find a substring within another\n" + "exitcodes: 0 == no, 1 == yes, 2 == error\n", argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); return 2; } else if (argc == 3) { - /* if the string is blank, there is no match */ + /* + * If the string is blank, there is no match. + */ + return 0; } else { return IsIn(argv[2], argv[3]); } - case 'g': + case 's': if (argc == 2) { - chars = wsprintf(msg, "usage: %s -g \n" - "grep for a #define\n" - "exitcodes: integer of the found string (no decimals)\n", argv[0]); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -s \n" + "Perform a set of string map type substutitions on a file\n" + "exitcodes: 0\n", + argv[0]); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, + &dwWritten, NULL); + return 2; + } + return 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; + } + printf("%s\n", GetVersionFromFile(argv[2], argv[3], *(argv[1]+2) - '0')); + return 0; + 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 GrepForDefine(argv[2], argv[3]); + return QualifyPath(argv[2]); } } - chars = wsprintf(msg, "usage: %s -c|-l|-f ...\n" + chars = snprintf(msg, sizeof(msg) - 1, + "usage: %s -c|-f|-l|-Q|-s|-V ...\n" "This is a little helper app to equalize shell differences between WinNT and\n" "Win9x and get nmake.exe to accomplish its job.\n", argv[0]); WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, chars, &dwWritten, NULL); return 2; } - -int -CheckForCompilerFeature (const char *option) + +static int +CheckForCompilerFeature( + const char *option) { STARTUPINFO si; PROCESS_INFORMATION pi; SECURITY_ATTRIBUTES sa; DWORD threadID; @@ -125,28 +201,48 @@ ZeroMemory(&sa, sizeof(SECURITY_ATTRIBUTES)); sa.nLength = sizeof(SECURITY_ATTRIBUTES); sa.lpSecurityDescriptor = NULL; sa.bInheritHandle = FALSE; - /* create a non-inheritible pipe. */ + /* + * Create a non-inheritible pipe. + */ + CreatePipe(&Out.pipe, &h, &sa, 0); - /* dupe the write side, make it inheritible, and close the original. */ - DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, - 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + /* + * Dupe the write side, make it inheritible, and close the original. + */ - /* Same as above, but for the error side. */ + 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); - - /* 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"); + 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"); ok = CreateProcess( NULL, /* Module name. */ cmdline, /* Command line. */ NULL, /* Process handle not inheritable. */ @@ -158,45 +254,68 @@ &si, /* Pointer to STARTUPINFO structure. */ &pi); /* Pointer to PROCESS_INFORMATION structure. */ if (!ok) { DWORD err = GetLastError(); - int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + int chars = snprintf(msg, sizeof(msg) - 1, + "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); - FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | - FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } - /* close our references to the write handles that have now been inherited. */ + /* + * Close our references to the write handles that have now been inherited. + */ + CloseHandle(si.hStdOutput); CloseHandle(si.hStdError); WaitForInputIdle(pi.hProcess, 5000); CloseHandle(pi.hThread); - /* start the pipe reader threads. */ + /* + * Start the pipe reader threads. + */ + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); - /* block waiting for the process to end. */ + /* + * Block waiting for the process to end. + */ + WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); - /* wait for our pipe to get done reading, should it be a little slow. */ + /* + * Wait for our pipe to get done reading, should it be a little slow. + */ + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); CloseHandle(pipeThreads[0]); CloseHandle(pipeThreads[1]); - /* look for the commandline warning code in both streams. */ - return !(strstr(Out.buffer, "D4002") != NULL || strstr(Err.buffer, "D4002") != NULL); + /* + * Look for the commandline warning code in both streams. + * - in MSVC 6 & 7 we get D4002, in MSVC 8 we get D9002. + */ + + 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); } - -int -CheckForLinkerFeature (const char *option) + +static int +CheckForLinkerFeature( + const char *option) { STARTUPINFO si; PROCESS_INFORMATION pi; SECURITY_ATTRIBUTES sa; DWORD threadID; @@ -216,26 +335,42 @@ 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 inheritible, and close the original. */ - DuplicateHandle(hProcess, h, hProcess, &si.hStdOutput, - 0, TRUE, DUPLICATE_SAME_ACCESS | DUPLICATE_CLOSE_SOURCE); + /* + * Dupe the write side, make it 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. */ + /* + * 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. + */ - /* base command line */ - strcpy(cmdline, "link.exe -nologo "); - /* append our option for testing */ - strcat(cmdline, option); + lstrcat(cmdline, option); ok = CreateProcess( NULL, /* Module name. */ cmdline, /* Command line. */ NULL, /* Process handle not inheritable. */ @@ -247,55 +382,75 @@ &si, /* Pointer to STARTUPINFO structure. */ &pi); /* Pointer to PROCESS_INFORMATION structure. */ if (!ok) { DWORD err = GetLastError(); - int chars = wsprintf(msg, "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); + int chars = snprintf(msg, sizeof(msg) - 1, + "Tried to launch: \"%s\", but got error [%u]: ", cmdline, err); - FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS | - FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID) &msg[chars], + FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS| + FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars], (300-chars), 0); - WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, strlen(msg), &err, NULL); + WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL); return 2; } - /* close our references to the write handles that have now been inherited. */ + /* + * Close our references to the write handles that have now been inherited. + */ + CloseHandle(si.hStdOutput); CloseHandle(si.hStdError); WaitForInputIdle(pi.hProcess, 5000); CloseHandle(pi.hThread); - /* start the pipe reader threads. */ + /* + * Start the pipe reader threads. + */ + pipeThreads[0] = CreateThread(NULL, 0, ReadFromPipe, &Out, 0, &threadID); pipeThreads[1] = CreateThread(NULL, 0, ReadFromPipe, &Err, 0, &threadID); - /* block waiting for the process to end. */ + /* + * Block waiting for the process to end. + */ + WaitForSingleObject(pi.hProcess, INFINITE); CloseHandle(pi.hProcess); - /* wait for our pipe to get done reading, should it be a little slow. */ + /* + * Wait for our pipe to get done reading, should it be a little slow. + */ + WaitForMultipleObjects(2, pipeThreads, TRUE, 500); CloseHandle(pipeThreads[0]); CloseHandle(pipeThreads[1]); - /* look for the commandline warning code in the stderr stream. */ - return !(strstr(Out.buffer, "LNK1117") != NULL || strstr(Err.buffer, "LNK1117") != NULL); + /* + * Look for the commandline warning code in the stderr stream. + */ + + return !(strstr(Out.buffer, "LNK1117") != NULL || + strstr(Err.buffer, "LNK1117") != NULL || + strstr(Out.buffer, "LNK4044") != NULL || + strstr(Err.buffer, "LNK4044") != NULL); } - -DWORD WINAPI -ReadFromPipe (LPVOID args) + +static DWORD WINAPI +ReadFromPipe( + LPVOID args) { pipeinfo *pi = (pipeinfo *) args; char *lastBuf = pi->buffer; DWORD dwRead; BOOL ok; -again: + again: if (lastBuf - pi->buffer + CHUNK > STATICBUFFERSIZE) { CloseHandle(pi->pipe); - return -1; + return (DWORD)-1; } ok = ReadFile(pi->pipe, lastBuf, CHUNK, &dwRead, 0L); if (!ok || dwRead == 0) { CloseHandle(pi->pipe); return 0; @@ -303,54 +458,240 @@ lastBuf += dwRead; goto again; return 0; /* makes the compiler happy */ } - -int -IsIn (const char *string, const char *substring) + +static int +IsIn( + const char *string, + const char *substring) { return (strstr(string, substring) != NULL); } - -/* - * Find a specified #define by name. - * - * If the line is '#define TCL_VERSION "8.5"', it returns - * 85 as the result. - */ - -int -GrepForDefine (const char *file, const char *string) -{ - FILE *f; - char s1[51], s2[51], s3[51]; - int r = 0; - double d1; - - f = fopen(file, "rt"); - if (f == NULL) { - return 0; - } - - do { - r = fscanf(f, "%50s", s1); - if (r == 1 && !strcmp(s1, "#define")) { - /* get next two words */ - r = fscanf(f, "%50s %50s", s2, s3); - if (r != 2) continue; - /* is the first word what we're looking for? */ - if (!strcmp(s2, string)) { - fclose(f); - /* add 1 past first double quote char. "8.5" */ - d1 = atof(s3 + 1); /* 8.5 */ - while (floor(d1) != d1) { - d1 *= 10.0; - } - return ((int) d1); /* 85 */ - } - } - } while (!feof(f)); - - fclose(f); - return 0; -} + +/* + * 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) +{ + size_t cbBuffer = 100; + 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, cbBuffer, 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(*p)) { + ++p; + } + + /* + * Find ending whitespace. + */ + + q = p; + while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q) + && (!strchr("ab", q[-1])) || --numdots))) { + ++q; + } + + memcpy(szBuffer, p, q - p); + szBuffer[q-p] = 0; + szResult = szBuffer; + 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 = 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 - + * eg compiling AMD64 target from IX86) we provide a simple substitution + * option here to handle autoconf style substitutions. + * The substitution file is whitespace and line delimited. The file should + * consist of lines matching the regular expression: + * \s*\S+\s+\S*$ + * + * Usage is something like: + * nmakehlp -S << $** > $@ + * @PACKAGE_NAME@ $(PACKAGE_NAME) + * @PACKAGE_VERSION@ $(PACKAGE_VERSION) + * << + */ + +static int +SubstituteFile( + const char *substitutions, + const char *filename) +{ + size_t cbBuffer = 1024; + static char szBuffer[1024], szCopy[1024]; + char *szResult = NULL; + list_item_t *substPtr = NULL; + FILE *fp, *sp; + + fp = fopen(filename, "rt"); + if (fp != NULL) { + + /* + * Build a list of substutitions from the first filename + */ + + sp = fopen(substitutions, "rt"); + if (sp != NULL) { + while (fgets(szBuffer, cbBuffer, sp) != NULL) { + char *ks, *ke, *vs, *ve; + ks = 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, ks, vs); + } + fclose(sp); + } + + /* debug: dump the list */ +#ifdef _DEBUG + { + 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, cbBuffer, 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(szBuffer); + } + + list_free(&substPtr); + } + fclose(fp); + return 0; +} + +/* + * 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]; + char szTmp[MAX_PATH + 1]; + char *p; + GetCurrentDirectory(MAX_PATH, szCwd); + while ((p = strchr(szPath, '/')) && *p) + *p = '\\'; + PathCombine(szTmp, szCwd, szPath); + PathCanonicalize(szCwd, szTmp); + printf("%s\n", szCwd); + return 0; +} + +/* + * Local variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * indent-tabs-mode: t + * tab-width: 8 + * End: + */