diff --git a/ChangeLog b/ChangeLog index 8ac1c2eb..19dd6d7f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -178,22 +178,22 @@ https://core.tcl-lang.org/itcl/timeline 2012-07-12 Arnulf P.Wiedemann * generic/itclBase.c: make the info command call in clazzUnknownBody a - list to avoid problems with class names - containing spaces. i + list to avoid problems with class names + containing spaces. i Fix for [incr Tcl] bug ID: 3536018 2012-05-17 Arnulf P.Wiedemann * generic/itclResolve.c: fixed problem with access to protected class - variables when not from top level context - reported from Rene Zaumseil for his itk + variables when not from top level context + reported from Rene Zaumseil for his itk emulation 2012-03-25 Arnulf P.Wiedemann * generic/itclInfo.c: fixed problem with info exists command. - fossil ticket id: d4ee728817f951d0b2aa8e8f9b030ea854e92c9f + fossil ticket id: d4ee728817f951d0b2aa8e8f9b030ea854e92c9f 2012-02-25 Arnulf P.Wiedemann * generic/itclObject.c: special case: we found the class for the class command, for a relative or absolute class path name but we have no method in that class that fits. - Problem of Rene Zaumseil when having the object + Problem of Rene Zaumseil when having the object for a class in a child namespace of the class fossil ticket id: 36577626c340ad59615f0a0238d67872c009a8c9 * generic/itclCmd.c: typo fix @@ -294,7 +294,7 @@ https://core.tcl-lang.org/itcl/timeline argument. 2010-08-22 Arnulf P.Wiedemann - * itclInt.h, itclObject.c, itclInfo.c: fix for BiInfoHeritageCmd + * itclInt.h, itclObject.c, itclInfo.c: fix for BiInfoHeritageCmd and BiInfoInheritCmd function, if we have no object context 2010-08-17 Jeff Hobbs @@ -308,17 +308,17 @@ https://core.tcl-lang.org/itcl/timeline Remove unnecessary itcl_INCLUDE_DIR (dup of itcl_INCLUDE_SPEC) 2010-05-17 Arnulf P.Wiedemann - * itclClass.c: undo change from 2010-05-16 + * itclClass.c: undo change from 2010-05-16 2010-05-16 Arnulf P.Wiedemann - * itclClass.c: allow variable namespace to exist + * itclClass.c: allow variable namespace to exist 2010-05-02 Arnulf P.Wiedemann - * itclClass.c: fix for SF bug #2993540 + * itclClass.c: fix for SF bug #2993540 * itcl2Tcloo.c: fix for SF bug #2993648 * itcl2Tcloo.h: fix for SF bug #2993648 * itclBuiltin.c: added an empty line for beautifying * itclCmd.c: in Itcl_IsObjectCmd if in constructor use the correct ioPtr * itclObject.c: in Itcl_ObjectIsa check for contextIoPtr == NULL - to avoid segmentation violation + to avoid segmentation violation 2010-04-21 Arnulf P.Wiedemann * itclCmd.c: Add missing Tcl_DStringFree for [itcl Bug 2983809] * itclEnsemble.c: @@ -327,7 +327,7 @@ https://core.tcl-lang.org/itcl/timeline * itclResolve.c: * itclParse.c: better error message when using: public mthod ... - instead of public method ... + instead of public method ... 2010-04-08 Don Porter * itclInt.h: Add #ifdef guards to attempt inclusion of a unistd.h header file only where one exists. @@ -345,11 +345,11 @@ https://core.tcl-lang.org/itcl/timeline * itcl2TclOO.c: 2010-03-19 Arnulf P. Wiedemann * configure.in: add missing include files for install,thanks to Reinhard Max for - the patch + the patch * itclInfo.c: removed "uplevel 1" in Itcl_BiInfoUnknownCmd.c, which made problems - with "info complete", reported by Reinhard Max + with "info complete", reported by Reinhard Max * itclMethod.c: fixed bug, which caused core dump in CallItclObjectCmd, thanks to - Reinhard Max for the patch + Reinhard Max for the patch 2010-03-06 Arnulf P. Wiedemann * itcl.decls: changed CONST in declarations to const * itclDecls.h: @@ -365,7 +365,7 @@ https://core.tcl-lang.org/itcl/timeline 2009-10-24 Arnulf P. Wiedemann * itclMethod.c: if during call of constructor, when building - an object there were multiple recursive calls + an object there were multiple recursive calls on CallItclObjectCmd and errors have not been propagated. Now hadConstructorError field in ItclObject struct is used for that @@ -374,31 +374,31 @@ https://core.tcl-lang.org/itcl/timeline * itclObject.c: * itclObject.c: allow %:var_name substitution in delegate - method using part for extendedclass + method using part for extendedclass * itclObject.c: allow call of delegated methods in constructor - of ::itcl::extendedclass + of ::itcl::extendedclass * itclBuiltin.c: * itclMethod.c: 2009-10-23 Arnulf P. Wiedemann - * generic/itcl.h: bumped version to 4.0b4 + * generic/itcl.h: bumped version to 4.0b4 * configure.in: * configure: * itclClass.c: fixed bug which prevented correct error - reporting when there was a problem when + reporting when there was a problem when creating an object, also fixed to use correct NRE calling 2009-10-23 Arnulf P. Wiedemann * itclMigrate2TclCore.c: added Itcl_GetUplevelCallFrame and - Itcl_ActivateCallFrame functions - same as in Itcl3.4. They are needed to call + Itcl_ActivateCallFrame functions + same as in Itcl3.4. They are needed to call the itk_component command with the suitable call frame as this is needed for access to the - proc local vars. This was the fix for SF + proc local vars. This was the fix for SF bug #2840994 * itclStubInit.c: * itcl.decls: @@ -406,7 +406,7 @@ https://core.tcl-lang.org/itcl/timeline * itclIntDecls.h: * itclResolve.c: added special_resolve_vars. Also needed - for SF bug #2840994 + for SF bug #2840994 2009-10-22 Arnulf P. Wiedemann @@ -419,7 +419,7 @@ https://core.tcl-lang.org/itcl/timeline * itclObject.c: added an empty line (beautifying) * itclInfo.c: no extra method for info exists, use the - ItclBiInfoUnknownCmd instead + ItclBiInfoUnknownCmd instead fix for bug # 2738459 * itclObject.c: fix for bug # 2789473 * itclResolve.c: fix for bug # 2495261 @@ -442,7 +442,7 @@ https://core.tcl-lang.org/itcl/timeline * generic/itclInfo.c: fix for bug #2830946. * pkgIndex.tcl.in: fix for bug #2856166. * itclInt.h: for linux we need inclusion of unistd.h otherwise - intprt_t type is not defined + intprt_t type is not defined * itclResolve2.c: changed CONST in declarations to const * itclTclIntStubsFcn.c: @@ -477,15 +477,15 @@ https://core.tcl-lang.org/itcl/timeline * generic/itclBase.c: reduce size of initScript to satisfy MSVC6. 2008-02-21 Arnulf P. Wiedemann - * fix for SF bug 2595708 itclParse.c and itclBuiltin.c + * fix for SF bug 2595708 itclParse.c and itclBuiltin.c * fix for problem with scope command path reported by * Harald Krummeck on c.l.t ItclCmd.c 2008-02-02 Arnulf P. Wiedemann - * generic/itcl.h configure.in: - bumped version to 4.0b3 + * generic/itcl.h configure.in: + bumped version to 4.0b3 2008-02-01 Arnulf P. Wiedemann - * tests/widgetadaptor.test and tests/widgetclass.test: - removed package require Tk to avoid running the tests + * tests/widgetadaptor.test and tests/widgetclass.test: + removed package require Tk to avoid running the tests always 2008-01-24 Arnulf P. Wiedemann * generic/itclBase.c: added *Dict*Info functions to allow fully diff --git a/Makefile.in b/Makefile.in index ef5c837a..b4109c23 100644 --- a/Makefile.in +++ b/Makefile.in @@ -429,7 +429,7 @@ install-lib-binaries: binaries 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; \ diff --git a/README b/README index dc5afa91..4c3341d4 100644 --- a/README +++ b/README @@ -1,6 +1,6 @@ README: Itcl -This is the 4.2.5 source distribution of Itcl, an object oriented +This is the 4.2.6 source distribution of Itcl, an object oriented extension for Tcl. Itcl releases are available from Sourceforge at: https://sourceforge.net/projects/incrtcl/files/%5Bincr%20Tcl_Tk%5D-4-source/ diff --git a/configure b/configure index 63ddedcb..f1c67661 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.72 for itcl 4.2.5. +# Generated by GNU Autoconf 2.72 for itcl 4.2.6. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, @@ -601,8 +601,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='itcl' PACKAGE_TARNAME='itcl' -PACKAGE_VERSION='4.2.5' -PACKAGE_STRING='itcl 4.2.5' +PACKAGE_VERSION='4.2.6' +PACKAGE_STRING='itcl 4.2.6' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1336,7 +1336,7 @@ 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 itcl 4.2.5 to adapt to many kinds of systems. +'configure' configures itcl 4.2.6 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1398,7 +1398,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of itcl 4.2.5:";; + short | recursive ) echo "Configuration of itcl 4.2.6:";; esac cat <<\_ACEOF @@ -1500,7 +1500,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -itcl configure 4.2.5 +itcl configure 4.2.6 generated by GNU Autoconf 2.72 Copyright (C) 2023 Free Software Foundation, Inc. @@ -1866,7 +1866,7 @@ 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 itcl $as_me 4.2.5, which was +It was created by itcl $as_me 4.2.6, which was generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw @@ -3957,11 +3957,11 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu printf %s "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... " >&6; } if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 printf "%s\n" "loading" >&6; } . "${TCL_BIN_DIR}/tclConfig.sh" else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 printf "%s\n" "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; } fi @@ -3972,9 +3972,9 @@ printf "%s\n" "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; } # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then - TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" - TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" - TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" + TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" + TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" + TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works @@ -5561,26 +5561,26 @@ printf "%s\n" "$ac_cv_c_bigendian" >&6; } vars=" - itcl2TclOO.c - itclBase.c - itclBuiltin.c - itclClass.c - itclCmd.c - itclEnsemble.c - itclHelpers.c - itclInfo.c - itclLinkage.c - itclMethod.c - itclObject.c - itclParse.c - itclStubs.c - itclStubInit.c - itclResolve.c - itclTclIntStubsFcn.c - itclUtil.c - itclMigrate2TclCore.c + itcl2TclOO.c + itclBase.c + itclBuiltin.c + itclClass.c + itclCmd.c + itclEnsemble.c + itclHelpers.c + itclInfo.c + itclLinkage.c + itclMethod.c + itclObject.c + itclParse.c + itclStubs.c + itclStubInit.c + itclResolve.c + itclTclIntStubsFcn.c + itclUtil.c + itclMigrate2TclCore.c itclTestRegisterC.c - " + " for i in $vars; do case $i in \$*) @@ -5616,12 +5616,12 @@ printf "%s\n" "$ac_cv_c_bigendian" >&6; } vars="generic/itcl.h - generic/itclDecls.h + generic/itclDecls.h generic/itclInt.h - generic/itclMigrate2TclCore.h - generic/itclTclIntStubsFcn.h - generic/itcl2TclOO.h - generic/itclIntDecls.h + generic/itclMigrate2TclCore.h + generic/itclTclIntStubsFcn.h + generic/itcl2TclOO.h + generic/itclIntDecls.h " for i in $vars; do # check for existence, be strict because it is installed @@ -5878,9 +5878,9 @@ printf %s "checking for Tcl private include files... " >&6; } # 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 + # 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 @@ -5888,7 +5888,7 @@ printf %s "checking for Tcl private include files... " >&6; } else TCL_INCLUDES="${TCL_INCLUDES} ${TCL_INCLUDE_SPEC} `echo "${TCL_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" fi - ;; + ;; esac result="Using ${TCL_INCLUDES}" else @@ -6319,7 +6319,7 @@ fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5 printf "%s\n" "shared" >&6; } SHARED_BUILD=1 - STUBS_BUILD=1 + STUBS_BUILD=1 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5 printf "%s\n" "static" >&6; } @@ -6327,11 +6327,11 @@ printf "%s\n" "static" >&6; } printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h - if test "$stubs_ok" = "yes" ; then - STUBS_BUILD=1 - else - STUBS_BUILD=0 - fi + if test "$stubs_ok" = "yes" ; then + STUBS_BUILD=1 + else + STUBS_BUILD=0 + fi fi if test "${STUBS_BUILD}" = "1" ; then @@ -6770,14 +6770,14 @@ fi fi if test "$GCC" != "yes" ; then - if test "${SHARED_BUILD}" = "0" ; then + if test "${SHARED_BUILD}" = "0" ; then runtime=-MT - else + else runtime=-MD - fi - case "x`echo \${VisualStudioVersion}`" in - x1[4-9]*) - lflags="${lflags} -nodefaultlib:libucrt.lib" + fi + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" vars="ucrt.lib" for i in $vars; do @@ -6789,12 +6789,12 @@ fi done - ;; - *) - ;; - esac + ;; + *) + ;; + esac - if test "$do64bit" != "no" ; then + if test "$do64bit" != "no" ; then CC="cl.exe" RC="rc.exe" lflags="${lflags} -nologo -MACHINE:${MACHINE} " @@ -7511,19 +7511,19 @@ fi if test "$do64bit" = yes then : - if test "$GCC" = yes + if test "$GCC" = yes then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else case e in #( e) - do64bit_ok=yes - SHLIB_LD="ld -64 -shared -rdata_shared" - CFLAGS="$CFLAGS -64" - LDFLAGS_ARCH="-64" - ;; + do64bit_ok=yes + SHLIB_LD="ld -64 -shared -rdata_shared" + CFLAGS="$CFLAGS -64" + LDFLAGS_ARCH="-64" + ;; esac fi @@ -7551,7 +7551,7 @@ then : LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi ;; - esac + esac if test $doRpath = yes then : @@ -8015,11 +8015,11 @@ printf "%s\n" "#define _OE_SOCKETS 1" >>confdefs.h if test "$SHARED_BUILD" = 1 then : - SHLIB_LD='ld -shared -expect_unresolved "*"' + SHLIB_LD='ld -shared -expect_unresolved "*"' else case e in #( e) - SHLIB_LD='ld -non_shared -expect_unresolved "*"' + SHLIB_LD='ld -non_shared -expect_unresolved "*"' ;; esac fi @@ -8308,7 +8308,7 @@ esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$hold_ldflags ;; + LDFLAGS=$hold_ldflags ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 @@ -8751,15 +8751,15 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { switch (0) { - case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; - } + case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; + } ; return 0; } @@ -8917,7 +8917,7 @@ int main (void) { struct dirent64 *p; DIR64 d = opendir64("."); - p = readdir64(d); rewinddir64(d); closedir64(d); + p = readdir64(d); rewinddir64(d); closedir64(d); ; return 0; } @@ -9021,8 +9021,8 @@ esac fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ - test "x${ac_cv_func_lseek64}" = "xyes" && \ - test "x${ac_cv_func_open64}" = "xyes" ; then + test "x${ac_cv_func_lseek64}" = "xyes" && \ + test "x${ac_cv_func_open64}" = "xyes" ; then printf "%s\n" "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h @@ -9338,7 +9338,7 @@ rm -rf conftest* PACKAGE_LIB_PREFIX8="${PACKAGE_LIB_PREFIX}" PACKAGE_LIB_PREFIX9="${PACKAGE_LIB_PREFIX}tcl9" - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX9}" else PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX8}" @@ -9369,7 +9369,7 @@ printf "%s\n" "#define TCL_MAJOR_VERSION 8" >>confdefs.h eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" fi # Some packages build their own stubs libraries - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a" else eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" @@ -9397,7 +9397,7 @@ printf "%s\n" "#define TCL_MAJOR_VERSION 8" >>confdefs.h eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" fi # Some packages build their own stubs libraries - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a" else eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" @@ -9434,37 +9434,37 @@ printf "%s\n" "#define TCL_MAJOR_VERSION 8" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 printf %s "checking for tclsh... " >&6; } if test -f "${TCL_BIN_DIR}/Makefile" ; then - # tclConfig.sh is in Tcl build directory - if test "${TEA_PLATFORM}" = "windows"; then - if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" - fi - else - TCLSH_PROG="${TCL_BIN_DIR}/tclsh" - fi + # tclConfig.sh is in Tcl build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" + fi + else + TCLSH_PROG="${TCL_BIN_DIR}/tclsh" + fi else - # tclConfig.sh is in install location - if test "${TEA_PLATFORM}" = "windows"; then - TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" - else - TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}" - fi - list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ - `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ - `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" - for i in $list ; do - if test -f "$i/${TCLSH_PROG}" ; then - REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" - break - fi - done - TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" + # tclConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" + else + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}" + fi + list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${TCLSH_PROG}" ; then + REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ${TCLSH_PROG}" >&5 printf "%s\n" "${TCLSH_PROG}" >&6; } @@ -9490,7 +9490,7 @@ printf "%s\n" "${TCLSH_PROG}" >&6; } eval itcl_LIB_FLAG="-litcl`echo ${PACKAGE_VERSION} | tr -d .`" eval itcl_STUB_LIB_FLAG="-litclstub`echo ${PACKAGE_VERSION} | tr -d .`" fi - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval itcl_STUB_LIB_FLAG="-litclstub" fi @@ -10066,7 +10066,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by itcl $as_me 4.2.5, which was +This file was extended by itcl $as_me 4.2.6, which was generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -10121,7 +10121,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -itcl config.status 4.2.5 +itcl config.status 4.2.6 configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" diff --git a/configure.ac b/configure.ac index 4b114ee1..aa5a6f87 100644 --- a/configure.ac +++ b/configure.ac @@ -19,7 +19,7 @@ dnl to configure the system for the local environment. # so that we create the export library with the dll. #----------------------------------------------------------------------- -AC_INIT([itcl],[4.2.5]) +AC_INIT([itcl],[4.2.6]) #-------------------------------------------------------------------- # Call TEA_INIT as the first TEA_ macro to set up initial vars. @@ -109,33 +109,33 @@ TEA_SETUP_COMPILER TEA_ADD_SOURCES([ - itcl2TclOO.c - itclBase.c - itclBuiltin.c - itclClass.c - itclCmd.c - itclEnsemble.c - itclHelpers.c - itclInfo.c - itclLinkage.c - itclMethod.c - itclObject.c - itclParse.c - itclStubs.c - itclStubInit.c - itclResolve.c - itclTclIntStubsFcn.c - itclUtil.c - itclMigrate2TclCore.c + itcl2TclOO.c + itclBase.c + itclBuiltin.c + itclClass.c + itclCmd.c + itclEnsemble.c + itclHelpers.c + itclInfo.c + itclLinkage.c + itclMethod.c + itclObject.c + itclParse.c + itclStubs.c + itclStubInit.c + itclResolve.c + itclTclIntStubsFcn.c + itclUtil.c + itclMigrate2TclCore.c itclTestRegisterC.c - ]) + ]) TEA_ADD_HEADERS([generic/itcl.h - generic/itclDecls.h + generic/itclDecls.h generic/itclInt.h - generic/itclMigrate2TclCore.h - generic/itclTclIntStubsFcn.h - generic/itcl2TclOO.h - generic/itclIntDecls.h + generic/itclMigrate2TclCore.h + generic/itclTclIntStubsFcn.h + generic/itcl2TclOO.h + generic/itclIntDecls.h ]) TEA_ADD_INCLUDES([-I. -I\"`${CYGPATH} ${srcdir}/generic`\" -I\"`${CYGPATH} ${srcdir}`\"]) TEA_ADD_LIBS([]) diff --git a/generic/itcl.decls b/generic/itcl.decls index 2a91b569..03883da8 100644 --- a/generic/itcl.decls +++ b/generic/itcl.decls @@ -13,13 +13,13 @@ scspec ITCLAPI declare 2 { int Itcl_RegisterC(Tcl_Interp *interp, const char *name, - Tcl_CmdProc *proc, void *clientData, - Tcl_CmdDeleteProc *deleteProc) + Tcl_CmdProc *proc, void *clientData, + Tcl_CmdDeleteProc *deleteProc) } declare 3 { int Itcl_RegisterObjC(Tcl_Interp *interp, const char *name, - Tcl_ObjCmdProc *proc, void *clientData, - Tcl_CmdDeleteProc *deleteProc) + Tcl_ObjCmdProc *proc, void *clientData, + Tcl_CmdDeleteProc *deleteProc) } declare 4 { int Itcl_FindC(Tcl_Interp *interp, const char *name, @@ -136,22 +136,22 @@ declare 9 { } declare 11 { void Itcl_ParseNamespPath(const char *name, Tcl_DString *buffer, - const char **head, const char **tail) + const char **head, const char **tail) } declare 12 { int Itcl_DecodeScopedCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace **rNsPtr, char **rCmdPtr) + Tcl_Namespace **rNsPtr, char **rCmdPtr) } declare 13 { int Itcl_EvalArgs(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]) } declare 14 { Tcl_Obj *Itcl_CreateArgs(Tcl_Interp *interp, const char *string, - Tcl_Size objc, Tcl_Obj *const objv[]) + Tcl_Size objc, Tcl_Obj *const objv[]) } declare 17 { int Itcl_GetContext(Tcl_Interp *interp, ItclClass **iclsPtrPtr, - ItclObject **ioPtrPtr) + ItclObject **ioPtrPtr) } declare 18 { void Itcl_InitHierIter(ItclHierIter *iter, ItclClass *iclsPtr) @@ -164,35 +164,35 @@ declare 20 { } declare 21 { int Itcl_FindClassesCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 22 { int Itcl_FindObjectsCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 24 { int Itcl_DelClassCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 25 { int Itcl_DelObjectCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 26 { int Itcl_ScopeCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 27 { int Itcl_CodeCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 28 { int Itcl_StubCreateCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 29 { int Itcl_StubExistsCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 30 { int Itcl_IsStub(Tcl_Command cmd) @@ -205,7 +205,7 @@ declare 30 { declare 31 { int Itcl_CreateClass(Tcl_Interp *interp, const char *path, - ItclObjectInfo *info, ItclClass **rPtr) + ItclObjectInfo *info, ItclClass **rPtr) } declare 32 { int Itcl_DeleteClass(Tcl_Interp *interp, ItclClass *iclsPtr) @@ -215,21 +215,21 @@ declare 33 { } declare 34 { int Itcl_HandleClass(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 38 { void Itcl_BuildVirtualTables(ItclClass *iclsPtr) } declare 39 { int Itcl_CreateVariable(Tcl_Interp *interp, ItclClass *iclsPtr, - Tcl_Obj *name, char *init, char *config, ItclVariable **ivPtr) + Tcl_Obj *name, char *init, char *config, ItclVariable **ivPtr) } declare 40 { void Itcl_DeleteVariable(char *cdata) } declare 41 { const char *Itcl_GetCommonVar(Tcl_Interp *interp, const char *name, - ItclClass *contextClass) + ItclClass *contextClass) } @@ -239,18 +239,18 @@ declare 41 { declare 44 { int Itcl_CreateObject(Tcl_Interp *interp, const char* name, ItclClass *iclsPtr, - Tcl_Size objc, Tcl_Obj *const objv[], ItclObject **rioPtr) + Tcl_Size objc, Tcl_Obj *const objv[], ItclObject **rioPtr) } declare 45 { int Itcl_DeleteObject(Tcl_Interp *interp, ItclObject *contextObj) } declare 46 { int Itcl_DestructObject(Tcl_Interp *interp, ItclObject *contextObj, - int flags) + int flags) } declare 48 { const char *Itcl_GetInstanceVar(Tcl_Interp *interp, const char *name, - ItclObject *contextIoPtr, ItclClass *contextIclsPtr) + ItclObject *contextIoPtr, ItclClass *contextIclsPtr) } # @@ -259,11 +259,11 @@ declare 48 { declare 50 { int Itcl_BodyCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 51 { int Itcl_ConfigBodyCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 52 { int Itcl_CreateMethod(Tcl_Interp *interp, ItclClass *iclsPtr, @@ -275,19 +275,19 @@ declare 53 { } declare 54 { int Itcl_CreateMemberFunc(Tcl_Interp *interp, ItclClass *iclsPtr, - Tcl_Obj *name, const char *arglist, const char *body, + Tcl_Obj *name, const char *arglist, const char *body, ItclMemberFunc **mfuncPtr) } declare 55 { int Itcl_ChangeMemberFunc(Tcl_Interp *interp, ItclMemberFunc *mfunc, - const char *arglist, const char *body) + const char *arglist, const char *body) } declare 56 { void Itcl_DeleteMemberFunc(void *cdata) } declare 57 { int Itcl_CreateMemberCode(Tcl_Interp *interp, ItclClass *iclsPtr, \ - const char *arglist, const char *body, ItclMemberCode **mcodePtr) + const char *arglist, const char *body, ItclMemberCode **mcodePtr) } declare 58 { void Itcl_DeleteMemberCode(void *cdata) @@ -297,32 +297,32 @@ declare 59 { } declare 61 { int Itcl_EvalMemberCode(Tcl_Interp *interp, ItclMemberFunc *mfunc, - ItclObject *contextObj, Tcl_Size objc, Tcl_Obj *const objv[]) + ItclObject *contextObj, Tcl_Size objc, Tcl_Obj *const objv[]) } declare 67 { void Itcl_GetMemberFuncUsage(ItclMemberFunc *mfunc, - ItclObject *contextObj, Tcl_Obj *objPtr) + ItclObject *contextObj, Tcl_Obj *objPtr) } declare 68 { int Itcl_ExecMethod(void *clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 69 { int Itcl_ExecProc(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 71 { int Itcl_ConstructBase(Tcl_Interp *interp, ItclObject *contextObj, - ItclClass *contextClass) + ItclClass *contextClass) } declare 72 { int Itcl_InvokeMethodIfExists(Tcl_Interp *interp, const char *name, - ItclClass *contextClass, ItclObject *contextObj, Tcl_Size objc, - Tcl_Obj *const objv[]) + ItclClass *contextClass, ItclObject *contextObj, Tcl_Size objc, + Tcl_Obj *const objv[]) } declare 74 { int Itcl_ReportFuncErrors(Tcl_Interp *interp, ItclMemberFunc *mfunc, - ItclObject *contextObj, int result) + ItclObject *contextObj, int result) } @@ -335,43 +335,43 @@ declare 75 { } declare 76 { int Itcl_ClassCmd(void *clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 77 { int Itcl_ClassInheritCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 78 { int Itcl_ClassProtectionCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 79 { int Itcl_ClassConstructorCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 80 { int Itcl_ClassDestructorCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 81 { int Itcl_ClassMethodCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 82 { int Itcl_ClassProcCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 83 { int Itcl_ClassVariableCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 84 { int Itcl_ClassCommonCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 85 { int Itcl_ParseVarResolver(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNs, int flags, Tcl_Var *rPtr) + Tcl_Namespace *contextNs, int flags, Tcl_Var *rPtr) } # @@ -386,47 +386,47 @@ declare 87 { } declare 88 { int Itcl_BiIsaCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 89 { int Itcl_BiConfigureCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 90 { int Itcl_BiCgetCmd(void *clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 91 { int Itcl_BiChainCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 92 { int Itcl_BiInfoClassCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 93 { int Itcl_BiInfoInheritCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 94 { int Itcl_BiInfoHeritageCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 95 { int Itcl_BiInfoFunctionCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 96 { int Itcl_BiInfoVariableCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 97 { int Itcl_BiInfoBodyCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 98 { int Itcl_BiInfoArgsCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } #declare 99 { # int Itcl_DefaultInfoCmd(void *dummy, Tcl_Interp *interp, int objc, @@ -446,35 +446,35 @@ declare 101 { } declare 102 { int Itcl_AddEnsemblePart(Tcl_Interp *interp, const char *ensName, - const char *partName, const char *usageInfo, Tcl_ObjCmdProc *objProc, - void *clientData, Tcl_CmdDeleteProc *deleteProc) + const char *partName, const char *usageInfo, Tcl_ObjCmdProc *objProc, + void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 103 { int Itcl_GetEnsemblePart(Tcl_Interp *interp, const char *ensName, - const char *partName, Tcl_CmdInfo *infoPtr) + const char *partName, Tcl_CmdInfo *infoPtr) } declare 104 { int Itcl_IsEnsemble(Tcl_CmdInfo *infoPtr) } declare 105 { int Itcl_GetEnsembleUsage(Tcl_Interp *interp, const char *ensName, - Tcl_Obj *objPtr) + Tcl_Obj *objPtr) } declare 106 { int Itcl_GetEnsembleUsageForObj(Tcl_Interp *interp, Tcl_Obj *ensObjPtr, - Tcl_Obj *objPtr) + Tcl_Obj *objPtr) } declare 107 { int Itcl_EnsembleCmd(void *clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 108 { int Itcl_EnsPartCmd(void *clientData, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 109 { int Itcl_EnsembleErrorCmd(void *clientData, Tcl_Interp *interp, - Tcl_Size objc, Tcl_Obj *const objv[]) + Tcl_Size objc, Tcl_Obj *const objv[]) } declare 115 { void Itcl_Assert(const char *testExpr, const char *fileName, int lineNum) @@ -494,27 +494,27 @@ declare 117 { declare 140 { int Itcl_FilterAddCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 141 { int Itcl_FilterDeleteCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 142 { int Itcl_ForwardAddCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 143 { int Itcl_ForwardDeleteCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 144 { int Itcl_MixinAddCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 145 { int Itcl_MixinDeleteCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } # @@ -527,24 +527,24 @@ declare 145 { #} declare 151 { int Itcl_BiInfoUnknownCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 152 { int Itcl_BiInfoVarsCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 153 { int Itcl_CanAccess2(ItclClass *iclsPtr, int protection, - Tcl_Namespace *fromNsPtr) + Tcl_Namespace *fromNsPtr) } declare 160 { int Itcl_SetCallFrameResolver(Tcl_Interp *interp, - Tcl_Resolve *resolvePtr) + Tcl_Resolve *resolvePtr) } declare 161 { int ItclEnsembleSubCmd(void *clientData, Tcl_Interp *interp, - const char *ensembleName, int objc, Tcl_Obj *const *objv, - const char *functionName) + const char *ensembleName, int objc, Tcl_Obj *const *objv, + const char *functionName) } declare 162 { Tcl_Namespace *Itcl_GetUplevelNamespace(Tcl_Interp *interp, int level) @@ -563,23 +563,23 @@ declare 167 { } declare 168 { int Itcl_NWidgetCmd(void *infoPtr, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 169 { int Itcl_AddOptionCmd(void *infoPtr, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 170 { int Itcl_AddComponentCmd(void *infoPtr, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 171 { int Itcl_BiInfoOptionCmd(void *dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]) + Tcl_Obj *const objv[]) } declare 172 { int Itcl_BiInfoComponentCmd(void *dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[]) + int objc, Tcl_Obj *const objv[]) } declare 173 { int Itcl_RenameCommand(Tcl_Interp *interp, const char *oldName, @@ -594,27 +594,27 @@ declare 175 { } declare 176 { Tcl_CallFrame *Itcl_GetUplevelCallFrame(Tcl_Interp *interp, - int level) + int level) } declare 177 { Tcl_CallFrame *Itcl_ActivateCallFrame(Tcl_Interp *interp, - Tcl_CallFrame *framePtr) + Tcl_CallFrame *framePtr) } declare 178 { const char* ItclSetInstanceVar(Tcl_Interp *interp, - const char *name, const char *name2, const char *value, - ItclObject *contextIoPtr, ItclClass *contextIclsPtr) + const char *name, const char *name2, const char *value, + ItclObject *contextIoPtr, ItclClass *contextIclsPtr) } declare 179 { Tcl_Obj * ItclCapitalize(const char *str) } declare 180 { int ItclClassBaseCmd(void *clientData, Tcl_Interp *interp, - int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr) + int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr) } declare 181 { int ItclCreateComponent(Tcl_Interp *interp, ItclClass *iclsPtr, - Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr) + Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr) } declare 182 { void Itcl_SetContext(Tcl_Interp *interp, ItclObject *ioPtr) diff --git a/generic/itcl.h b/generic/itcl.h index 5bb142f5..a0627379 100644 --- a/generic/itcl.h +++ b/generic/itcl.h @@ -85,7 +85,7 @@ extern "C" { #define ITCL_RELEASE_SERIAL 4 #define ITCL_VERSION "4.2" -#define ITCL_PATCH_LEVEL "4.2.5" +#define ITCL_PATCH_LEVEL "4.2.6" /* diff --git a/generic/itcl2TclOO.c b/generic/itcl2TclOO.c index 14862bc6..4237c1dd 100644 --- a/generic/itcl2TclOO.c +++ b/generic/itcl2TclOO.c @@ -156,13 +156,13 @@ Itcl_InvokeProcedureMethod( mPtr = (Method *)clientData; if (mPtr->declaringClassPtr == NULL) { /* that is the case for typemethods */ - nsPtr = mPtr->declaringObjectPtr->namespacePtr; + nsPtr = mPtr->declaringObjectPtr->namespacePtr; } else { - nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr; + nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr; } return Tcl_InvokeClassProcedureMethod(interp, mPtr->namePtr, nsPtr, - (ProcedureMethod *)mPtr->clientData, objc, objv); + (ProcedureMethod *)mPtr->clientData, objc, objv); } static int @@ -188,9 +188,9 @@ EnsembleErrorProc( overflow = (nameLen > (Tcl_Size)limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (itcl ensemble part \"%.*s%s\" line %d)", - (overflow ? limit : (int)nameLen), procName, - (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); + "\n (itcl ensemble part \"%.*s%s\" line %d)", + (overflow ? limit : (int)nameLen), procName, + (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } int @@ -212,7 +212,7 @@ Itcl_InvokeEnsembleMethod( Tcl_NRAddCallback(interp, FreeProcedureMethod, pmPtr, NULL, NULL, NULL); return Tcl_InvokeClassProcedureMethod(interp, namePtr, nsPtr, - pmPtr, objc, objv); + pmPtr, objc, objv); } @@ -241,7 +241,7 @@ Itcl_PublicObjectCmd( if (oPtr) { result = TclOOInvokeObject(interp, oPtr, clsPtr, PUBLIC_METHOD, - objc, objv); + objc, objv); } else { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot access object-specific info without an object context", @@ -283,8 +283,8 @@ Itcl_NewProcClassMethod( Tcl_Method result; result = TclOONewProcMethodEx(interp, clsPtr, preCallPtr, postCallPtr, - errProc, clientData, nameObj, argsObj, bodyObj, - PUBLIC_METHOD | USE_DECLARER_NS, clientData2); + errProc, clientData, nameObj, argsObj, bodyObj, + PUBLIC_METHOD | USE_DECLARER_NS, clientData2); return result; } @@ -315,8 +315,8 @@ Itcl_NewProcMethod( void **clientData2) { return TclOONewProcInstanceMethodEx(interp, oPtr, preCallPtr, postCallPtr, - errProc, clientData, nameObj, argsObj, bodyObj, - PUBLIC_METHOD | USE_DECLARER_NS, clientData2); + errProc, clientData, nameObj, argsObj, bodyObj, + PUBLIC_METHOD | USE_DECLARER_NS, clientData2); } /* @@ -338,7 +338,7 @@ Itcl_NewForwardClassMethod( Tcl_Obj *prefixObj) { return (Tcl_Method)TclOONewForwardMethod(interp, (Class *)clsPtr, - flags, nameObj, prefixObj); + flags, nameObj, prefixObj); } @@ -350,7 +350,7 @@ Itcl_TclOOObjectName( Tcl_Obj *namePtr; if (oPtr->cachedNameObj) { - return oPtr->cachedNameObj; + return oPtr->cachedNameObj; } namePtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, oPtr->command, namePtr); @@ -371,16 +371,16 @@ Itcl_SelfCmd( CallContext *contextPtr; if (!Itcl_IsMethodCallFrame(interp)) { - Tcl_AppendResult(interp, TclGetString(objv[0]), - " may only be called from inside a method", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, TclGetString(objv[0]), + " may only be called from inside a method", NULL); + return TCL_ERROR; } contextPtr = (CallContext *)framePtr->clientData; if (objc == 1) { - Tcl_SetObjResult(interp, Itcl_TclOOObjectName(interp, contextPtr->oPtr)); - return TCL_OK; + Tcl_SetObjResult(interp, Itcl_TclOOObjectName(interp, contextPtr->oPtr)); + return TCL_OK; } return TCL_ERROR; } @@ -392,7 +392,7 @@ Itcl_IsMethodCallFrame( Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { - return 0; + return 0; } return 1; } diff --git a/generic/itcl2TclOO.h b/generic/itcl2TclOO.h index 7437624a..77e3db16 100644 --- a/generic/itcl2TclOO.h +++ b/generic/itcl2TclOO.h @@ -13,19 +13,19 @@ typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp, MODULE_SCOPE int Itcl_NRRunCallbacks(Tcl_Interp *interp, void *rootPtr); MODULE_SCOPE void * Itcl_GetCurrentCallbackPtr(Tcl_Interp *interp); MODULE_SCOPE Tcl_Method Itcl_NewProcClassMethod(Tcl_Interp *interp, Tcl_Class clsPtr, - TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, + TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, + ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, void **clientData2); MODULE_SCOPE Tcl_Method Itcl_NewProcMethod(Tcl_Interp *interp, Tcl_Object oPtr, - TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, - ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, + TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, + ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, void **clientData2); MODULE_SCOPE int Itcl_PublicObjectCmd(void *clientData, Tcl_Interp *interp, - Tcl_Class clsPtr, Tcl_Size objc, Tcl_Obj *const *objv); + Tcl_Class clsPtr, Tcl_Size objc, Tcl_Obj *const *objv); MODULE_SCOPE Tcl_Method Itcl_NewForwardClassMethod(Tcl_Interp *interp, - Tcl_Class clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); + Tcl_Class clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); MODULE_SCOPE int Itcl_SelfCmd(void *clientData, Tcl_Interp *interp, - int objc, Tcl_Obj *const *objv); + int objc, Tcl_Obj *const *objv); MODULE_SCOPE int Itcl_IsMethodCallFrame(Tcl_Interp *interp); MODULE_SCOPE int Itcl_InvokeEnsembleMethod(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *namePtr, Tcl_Proc *procPtr, Tcl_Size objc, Tcl_Obj *const *objv); diff --git a/generic/itclBase.c b/generic/itclBase.c index 5f167ebd..13b5b3ce 100644 --- a/generic/itclBase.c +++ b/generic/itclBase.c @@ -184,12 +184,12 @@ Initialize ( Tcl_CmdInfo info; if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { - return TCL_ERROR; + return TCL_ERROR; } ret = TclOOInitializeStubs(interp, "1.0"); if (ret == NULL) { - return TCL_ERROR; + return TCL_ERROR; } objPtr = Tcl_NewStringObj("::oo::class", TCL_INDEX_NONE); @@ -197,7 +197,7 @@ Initialize ( clazzObjectPtr = Tcl_GetObjectFromObj(interp, objPtr); if (!clazzObjectPtr || !(tclCls = Tcl_GetObjectAsClass(clazzObjectPtr))) { Tcl_DecrRefCount(objPtr); - return TCL_ERROR; + return TCL_ERROR; } Tcl_DecrRefCount(objPtr); @@ -206,15 +206,15 @@ Initialize ( nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE, infoPtr, FreeItclObjectInfo); if (nsPtr == NULL) { Itcl_Free(infoPtr); - Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", ITCL_NAMESPACE); + Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", ITCL_NAMESPACE); } nsPtr = Tcl_CreateNamespace(interp, ITCL_INTDICTS_NAMESPACE, - NULL, NULL); + NULL, NULL); if (nsPtr == NULL) { Itcl_Free(infoPtr); - Tcl_Panic("Itcl: cannot create namespace: \"%s::internal::dicts\" \n", - ITCL_NAMESPACE); + Tcl_Panic("Itcl: cannot create namespace: \"%s::internal::dicts\" \n", + ITCL_NAMESPACE); } /* @@ -224,7 +224,7 @@ Initialize ( */ infoPtr->interp = interp; infoPtr->class_meta_type = (Tcl_ObjectMetadataType *)ckalloc( - sizeof(Tcl_ObjectMetadataType)); + sizeof(Tcl_ObjectMetadataType)); infoPtr->class_meta_type->version = TCL_OO_METADATA_VERSION_CURRENT; infoPtr->class_meta_type->name = "ItclClass"; infoPtr->class_meta_type->deleteProc = ItclDeleteClassMetadata; @@ -258,30 +258,30 @@ Initialize ( Tcl_SetVar2(interp, ITCL_NAMESPACE"::internal::dicts::objects", NULL, "", 0); Tcl_SetVar2(interp, ITCL_NAMESPACE"::internal::dicts::classOptions", NULL, "", 0); Tcl_SetVar2(interp, - ITCL_NAMESPACE"::internal::dicts::classDelegatedOptions", NULL, "", 0); + ITCL_NAMESPACE"::internal::dicts::classDelegatedOptions", NULL, "", 0); Tcl_SetVar2(interp, - ITCL_NAMESPACE"::internal::dicts::classComponents", NULL, "", 0); + ITCL_NAMESPACE"::internal::dicts::classComponents", NULL, "", 0); Tcl_SetVar2(interp, - ITCL_NAMESPACE"::internal::dicts::classVariables", NULL, "", 0); + ITCL_NAMESPACE"::internal::dicts::classVariables", NULL, "", 0); Tcl_SetVar2(interp, - ITCL_NAMESPACE"::internal::dicts::classFunctions", NULL, "", 0); + ITCL_NAMESPACE"::internal::dicts::classFunctions", NULL, "", 0); Tcl_SetVar2(interp, - ITCL_NAMESPACE"::internal::dicts::classDelegatedFunctions", NULL, "", 0); + ITCL_NAMESPACE"::internal::dicts::classDelegatedFunctions", NULL, "", 0); hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes, - (char *)Tcl_NewStringObj("class", TCL_INDEX_NONE), &isNew); + (char *)Tcl_NewStringObj("class", TCL_INDEX_NONE), &isNew); Tcl_SetHashValue(hPtr, ITCL_CLASS); hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes, - (char *)Tcl_NewStringObj("type", TCL_INDEX_NONE), &isNew); + (char *)Tcl_NewStringObj("type", TCL_INDEX_NONE), &isNew); Tcl_SetHashValue(hPtr, ITCL_TYPE); hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes, - (char *)Tcl_NewStringObj("widget", TCL_INDEX_NONE), &isNew); + (char *)Tcl_NewStringObj("widget", TCL_INDEX_NONE), &isNew); Tcl_SetHashValue(hPtr, ITCL_WIDGET); hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes, - (char *)Tcl_NewStringObj("widgetadaptor", TCL_INDEX_NONE), &isNew); + (char *)Tcl_NewStringObj("widgetadaptor", TCL_INDEX_NONE), &isNew); Tcl_SetHashValue(hPtr, ITCL_WIDGETADAPTOR); hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes, - (char *)Tcl_NewStringObj("extendedclass", TCL_INDEX_NONE), &isNew); + (char *)Tcl_NewStringObj("extendedclass", TCL_INDEX_NONE), &isNew); Tcl_SetHashValue(hPtr, ITCL_ECLASS); res_option = getenv("ITCL_USE_OLD_RESOLVERS"); @@ -312,7 +312,7 @@ Initialize ( /* first create the Itcl base class as root of itcl classes */ if (Tcl_EvalEx(interp, clazzClassScript, TCL_INDEX_NONE, 0) != TCL_OK) { - Tcl_Panic("cannot create Itcl root class ::itcl::clazz"); + Tcl_Panic("cannot create Itcl root class ::itcl::clazz"); } resPtr = Tcl_GetObjResult(interp); /* @@ -324,10 +324,10 @@ Initialize ( Tcl_DecrRefCount(resPtr); if (clazzObjectPtr == NULL) { - Tcl_AppendResult(interp, - "ITCL: cannot get Object for ::itcl::clazz for class \"", - "::itcl::clazz", "\"", NULL); - return TCL_ERROR; + Tcl_AppendResult(interp, + "ITCL: cannot get Object for ::itcl::clazz for class \"", + "::itcl::clazz", "\"", NULL); + return TCL_ERROR; } Tcl_ObjectSetMetadata(clazzObjectPtr, &canary, infoPtr); @@ -341,7 +341,7 @@ Initialize ( */ if (Itcl_EnsembleInit(interp) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } Itcl_ParseInit(interp, infoPtr); @@ -351,7 +351,7 @@ Initialize ( * are automatically built into class definitions. */ if (Itcl_BiInit(interp, infoPtr) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } /* @@ -359,7 +359,7 @@ Initialize ( * can be imported with something like "namespace import itcl::*" */ itclNs = Tcl_FindNamespace(interp, "::itcl", NULL, - TCL_LEAVE_ERR_MSG); + TCL_LEAVE_ERR_MSG); /* * This was changed from a glob export (itcl::*) to explicit @@ -368,28 +368,28 @@ Initialize ( * imported might be confusing ("is"). */ if (!itclNs || - (Tcl_Export(interp, itclNs, "body", /* reset */ 1) != TCL_OK) || - (Tcl_Export(interp, itclNs, "class", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "code", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "configbody", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "delete", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "delete_helper", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "ensemble", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "filter", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "find", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "forward", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "local", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "mixin", 0) != TCL_OK) || - (Tcl_Export(interp, itclNs, "scope", 0) != TCL_OK)) { - return TCL_ERROR; + (Tcl_Export(interp, itclNs, "body", /* reset */ 1) != TCL_OK) || + (Tcl_Export(interp, itclNs, "class", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "code", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "configbody", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "delete", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "delete_helper", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "ensemble", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "filter", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "find", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "forward", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "local", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "mixin", 0) != TCL_OK) || + (Tcl_Export(interp, itclNs, "scope", 0) != TCL_OK)) { + return TCL_ERROR; } Tcl_CreateObjCommand(interp, - ITCL_NAMESPACE"::internal::commands::sethullwindowname", - ItclSetHullWindowName, infoPtr, NULL); + ITCL_NAMESPACE"::internal::commands::sethullwindowname", + ItclSetHullWindowName, infoPtr, NULL); Tcl_CreateObjCommand(interp, - ITCL_NAMESPACE"::internal::commands::checksetitclhull", - ItclCheckSetItclHull, infoPtr, NULL); + ITCL_NAMESPACE"::internal::commands::checksetitclhull", + ItclCheckSetItclHull, infoPtr, NULL); /* * Set up the variables containing version info. @@ -397,7 +397,7 @@ Initialize ( Tcl_SetVar2(interp, "::itcl::version", NULL, ITCL_VERSION, TCL_NAMESPACE_ONLY); Tcl_SetVar2(interp, "::itcl::patchLevel", NULL, ITCL_PATCH_LEVEL, - TCL_NAMESPACE_ONLY); + TCL_NAMESPACE_ONLY); #ifdef ITCL_DEBUG_C_INTERFACE @@ -487,7 +487,7 @@ Itcl_Init ( Tcl_Interp *interp) { if (Initialize(interp) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } return Tcl_EvalEx(interp, initScript, TCL_INDEX_NONE, 0); @@ -513,7 +513,7 @@ Itcl_SafeInit ( Tcl_Interp *interp) { if (Initialize(interp) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } return Tcl_EvalEx(interp, safeInitScript, TCL_INDEX_NONE, 0); } @@ -564,8 +564,8 @@ ItclCheckSetItclHull( const char *valueStr; if (objc < 3) { - Tcl_AppendResult(interp, "ItclCheckSetItclHull wrong # args should be ", - " ", NULL); + Tcl_AppendResult(interp, "ItclCheckSetItclHull wrong # args should be ", + " ", NULL); return TCL_ERROR; } @@ -577,31 +577,31 @@ ItclCheckSetItclHull( assert( strlen(Tcl_GetString(objv[1])) == 0); infoPtr = (ItclObjectInfo *)clientData; { - ioPtr = infoPtr->currIoPtr; + ioPtr = infoPtr->currIoPtr; if (ioPtr == NULL) { - Tcl_AppendResult(interp, "ItclCheckSetItclHull cannot find object", - NULL); + Tcl_AppendResult(interp, "ItclCheckSetItclHull cannot find object", + NULL); return TCL_ERROR; - } + } } objPtr = Tcl_NewStringObj("itcl_hull", TCL_INDEX_NONE); hPtr = Tcl_FindHashEntry(&ioPtr->iclsPtr->variables, (char *)objPtr); Tcl_DecrRefCount(objPtr); if (hPtr == NULL) { - Tcl_AppendResult(interp, "ItclCheckSetItclHull cannot find itcl_hull", - " variable for object \"", Tcl_GetString(objv[1]), "\"", NULL); + Tcl_AppendResult(interp, "ItclCheckSetItclHull cannot find itcl_hull", + " variable for object \"", Tcl_GetString(objv[1]), "\"", NULL); return TCL_ERROR; } ivPtr = (ItclVariable *)Tcl_GetHashValue(hPtr); valueStr = Tcl_GetString(objv[2]); if (strcmp(valueStr, "2") == 0) { - ivPtr->initted = 2; + ivPtr->initted = 2; } else { - if (strcmp(valueStr, "0") == 0) { - ivPtr->initted = 0; + if (strcmp(valueStr, "0") == 0) { + ivPtr->initted = 0; } else { - Tcl_AppendResult(interp, "ItclCheckSetItclHull bad value \"", - valueStr, "\"", NULL); + Tcl_AppendResult(interp, "ItclCheckSetItclHull bad value \"", + valueStr, "\"", NULL); return TCL_ERROR; } } diff --git a/generic/itclTestRegisterC.c b/generic/itclTestRegisterC.c index fa18b60b..3ebb4aa6 100644 --- a/generic/itclTestRegisterC.c +++ b/generic/itclTestRegisterC.c @@ -62,7 +62,7 @@ cArgFunc( Tcl_IncrRefCount(objv[3]); infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL); FOREACH_HASH_VALUE(classPtr,&infoPtr->nameClasses) { - if (strcmp(Tcl_GetString(objv[1]), Tcl_GetString(classPtr->fullNamePtr)) == 0 || + if (strcmp(Tcl_GetString(objv[1]), Tcl_GetString(classPtr->fullNamePtr)) == 0 || strcmp(Tcl_GetString(objv[2]), Tcl_GetString(classPtr->fullNamePtr)) == 0) { iclsPtr = classPtr; break; diff --git a/generic/itclUtil.c b/generic/itclUtil.c index 9a295128..4b0df8d9 100644 --- a/generic/itclUtil.c +++ b/generic/itclUtil.c @@ -112,7 +112,7 @@ Itcl_DeleteStack( * built-in buffer) then free it. */ if (stack->values != stack->space) { - ckfree((char*)stack->values); + ckfree((char*)stack->values); } stack->values = NULL; stack->len = stack->max = 0; @@ -134,18 +134,18 @@ Itcl_PushStack( void **newStack; if (stack->len+1 >= stack->max) { - stack->max = 2*stack->max; - newStack = (void **) - ckalloc(stack->max*sizeof(void *)); - - if (stack->values) { - memcpy(newStack, stack->values, - stack->len*sizeof(void *)); - - if (stack->values != stack->space) - ckfree((char*)stack->values); - } - stack->values = newStack; + stack->max = 2*stack->max; + newStack = (void **) + ckalloc(stack->max*sizeof(void *)); + + if (stack->values) { + memcpy(newStack, stack->values, + stack->len*sizeof(void *)); + + if (stack->values != stack->space) + ckfree((char*)stack->values); + } + stack->values = newStack; } stack->values[stack->len++] = cdata; } @@ -162,8 +162,8 @@ Itcl_PopStack( Itcl_Stack *stack) /* stack to be manipulated */ { if (stack->values && (stack->len > 0)) { - stack->len--; - return stack->values[stack->len]; + stack->len--; + return stack->values[stack->len]; } return NULL; } @@ -180,7 +180,7 @@ Itcl_PeekStack( Itcl_Stack *stack) /* stack to be examined */ { if (stack->values && (stack->len > 0)) { - return stack->values[stack->len-1]; + return stack->values[stack->len-1]; } return NULL; } @@ -199,7 +199,7 @@ Itcl_GetStackValue( Tcl_Size pos) /* get value at this index */ { if (stack->values && (pos >= 0) && (pos < stack->len)) { - return stack->values[pos]; + return stack->values[pos]; } return NULL; } @@ -242,7 +242,7 @@ Itcl_DeleteList( elemPtr = listPtr->head; while (elemPtr) { - elemPtr = Itcl_DeleteListElem(elemPtr); + elemPtr = Itcl_DeleteListElem(elemPtr); } listPtr->validate = 0; } @@ -264,11 +264,11 @@ Itcl_CreateListElem( Itcl_ListElem *elemPtr; if (listPoolLen > 0) { - elemPtr = listPool; - listPool = elemPtr->next; - --listPoolLen; + elemPtr = listPool; + listPool = elemPtr->next; + --listPoolLen; } else { - elemPtr = (Itcl_ListElem*)ckalloc((unsigned)sizeof(Itcl_ListElem)); + elemPtr = (Itcl_ListElem*)ckalloc((unsigned)sizeof(Itcl_ListElem)); } elemPtr->owner = listPtr; elemPtr->value = NULL; @@ -297,27 +297,27 @@ Itcl_DeleteListElem( nextPtr = elemPtr->next; if (elemPtr->prev) { - elemPtr->prev->next = elemPtr->next; + elemPtr->prev->next = elemPtr->next; } if (elemPtr->next) { - elemPtr->next->prev = elemPtr->prev; + elemPtr->next->prev = elemPtr->prev; } listPtr = elemPtr->owner; if (elemPtr == listPtr->head) { - listPtr->head = elemPtr->next; + listPtr->head = elemPtr->next; } if (elemPtr == listPtr->tail) { - listPtr->tail = elemPtr->prev; + listPtr->tail = elemPtr->prev; } --listPtr->num; if (listPoolLen < ITCL_LIST_POOL_SIZE) { - elemPtr->next = listPool; - listPool = elemPtr; - ++listPoolLen; + elemPtr->next = listPool; + listPool = elemPtr; + ++listPoolLen; } else { - ckfree((char*)elemPtr); + ckfree((char*)elemPtr); } return nextPtr; } @@ -345,11 +345,11 @@ Itcl_InsertList( elemPtr->next = listPtr->head; elemPtr->prev = NULL; if (listPtr->head) { - listPtr->head->prev = elemPtr; + listPtr->head->prev = elemPtr; } listPtr->head = elemPtr; if (listPtr->tail == NULL) { - listPtr->tail = elemPtr; + listPtr->tail = elemPtr; } ++listPtr->num; @@ -382,16 +382,16 @@ Itcl_InsertListElem( elemPtr->prev = pos->prev; if (elemPtr->prev) { - elemPtr->prev->next = elemPtr; + elemPtr->prev->next = elemPtr; } elemPtr->next = pos; pos->prev = elemPtr; if (listPtr->head == pos) { - listPtr->head = elemPtr; + listPtr->head = elemPtr; } if (listPtr->tail == NULL) { - listPtr->tail = elemPtr; + listPtr->tail = elemPtr; } ++listPtr->num; @@ -421,11 +421,11 @@ Itcl_AppendList( elemPtr->prev = listPtr->tail; elemPtr->next = NULL; if (listPtr->tail) { - listPtr->tail->next = elemPtr; + listPtr->tail->next = elemPtr; } listPtr->tail = elemPtr; if (listPtr->head == NULL) { - listPtr->head = elemPtr; + listPtr->head = elemPtr; } ++listPtr->num; @@ -458,16 +458,16 @@ Itcl_AppendListElem( elemPtr->next = pos->next; if (elemPtr->next) { - elemPtr->next->prev = elemPtr; + elemPtr->next->prev = elemPtr; } elemPtr->prev = pos; pos->next = elemPtr; if (listPtr->tail == pos) { - listPtr->tail = elemPtr; + listPtr->tail = elemPtr; } if (listPtr->head == NULL) { - listPtr->head = elemPtr; + listPtr->head = elemPtr; } ++listPtr->num; @@ -507,10 +507,10 @@ Itcl_FinishList() listPtr = listPool; while (listPtr != NULL) { - elemPtr = listPtr; + elemPtr = listPtr; listPtr = elemPtr->next; ckfree((char *)elemPtr); - elemPtr = NULL; + elemPtr = NULL; } listPool = NULL; listPoolLen = 0; @@ -551,7 +551,7 @@ Itcl_EventuallyFree( PresMemoryPrefix *blk; if (cdata == NULL) { - return; + return; } /* Itcl memory block to ckalloc block */ @@ -580,7 +580,7 @@ Itcl_PreserveData( PresMemoryPrefix *blk; if (cdata == NULL) { - return; + return; } /* Itcl memory block to ckalloc block */ @@ -608,7 +608,7 @@ Itcl_ReleaseData( Tcl_FreeProc *freeProc; if (cdata == NULL) { - return; + return; } /* Itcl memory block to ckalloc block */ @@ -784,17 +784,17 @@ Itcl_Protection( * In any case, return the protection level as it stands right now. */ infoPtr = (ItclObjectInfo*) Tcl_GetAssocData(interp, ITCL_INTERP_DATA, - NULL); + NULL); assert(infoPtr != NULL); oldVal = infoPtr->protection; if (newLevel != 0) { - assert(newLevel == ITCL_PUBLIC || - newLevel == ITCL_PROTECTED || - newLevel == ITCL_PRIVATE || - newLevel == ITCL_DEFAULT_PROTECT); - infoPtr->protection = newLevel; + assert(newLevel == ITCL_PUBLIC || + newLevel == ITCL_PROTECTED || + newLevel == ITCL_PRIVATE || + newLevel == ITCL_DEFAULT_PROTECT); + infoPtr->protection = newLevel; } return oldVal; } @@ -838,12 +838,12 @@ Itcl_ParseNamespPath( newname = Tcl_DStringValue(buffer); for (sep=newname; *sep != '\0'; sep++) - ; + ; while (--sep > newname) { - if (*sep == ':' && *(sep-1) == ':') { - break; - } + if (*sep == ':' && *(sep-1) == ':') { + break; + } } /* @@ -852,19 +852,19 @@ Itcl_ParseNamespPath( * behavior, which allows names like "foo:::bar". */ if (sep > newname) { - *tail = sep+1; - while (sep > newname && *(sep-1) == ':') { - sep--; - } - *sep = '\0'; - *head = newname; + *tail = sep+1; + while (sep > newname && *(sep-1) == ':') { + sep--; + } + *sep = '\0'; + *head = newname; } else { - /* - * No :: separators--the whole name is treated as a tail. - */ - *tail = newname; - *head = NULL; + /* + * No :: separators--the whole name is treated as a tail. + */ + *tail = newname; + *head = NULL; } } @@ -896,16 +896,16 @@ Itcl_CanAccess2( * answer is known immediately. */ if (protection == ITCL_PUBLIC) { - return 1; + return 1; } else { - if (protection == ITCL_PRIVATE) { + if (protection == ITCL_PRIVATE) { entry = Tcl_FindHashEntry(&iclsPtr->infoPtr->namespaceClasses, fromNsPtr); if (entry == NULL) { return 0; } return (iclsPtr == Tcl_GetHashValue(entry)); - } + } } /* @@ -923,12 +923,12 @@ Itcl_CanAccess2( } fromIclsPtr = (ItclClass *)Tcl_GetHashValue(entry); - entry = Tcl_FindHashEntry(&fromIclsPtr->heritage, - (char*)iclsPtr); + entry = Tcl_FindHashEntry(&fromIclsPtr->heritage, + (char*)iclsPtr); - if (entry) { - return 1; - } + if (entry) { + return 1; + } } return 0; } @@ -984,7 +984,7 @@ Itcl_CanAccessFunc( * Apply the usual rules first. */ if (Itcl_CanAccess(imPtr, fromNsPtr)) { - return 1; + return 1; } /* @@ -995,31 +995,31 @@ Itcl_CanAccessFunc( * has access. */ if ((imPtr->flags & ITCL_COMMON) == 0 && - Itcl_IsClassNamespace(fromNsPtr)) { - Tcl_HashEntry *hPtr; + Itcl_IsClassNamespace(fromNsPtr)) { + Tcl_HashEntry *hPtr; - iclsPtr = imPtr->iclsPtr; + iclsPtr = imPtr->iclsPtr; hPtr = Tcl_FindHashEntry(&iclsPtr->infoPtr->namespaceClasses, - (char *)fromNsPtr); + (char *)fromNsPtr); if (hPtr == NULL) { return 0; } - fromIclsPtr = (ItclClass *)Tcl_GetHashValue(hPtr); + fromIclsPtr = (ItclClass *)Tcl_GetHashValue(hPtr); - if (Tcl_FindHashEntry(&iclsPtr->heritage, (char*)fromIclsPtr)) { - entry = Tcl_FindHashEntry(&fromIclsPtr->resolveCmds, - (char *)imPtr->namePtr); + if (Tcl_FindHashEntry(&iclsPtr->heritage, (char*)fromIclsPtr)) { + entry = Tcl_FindHashEntry(&fromIclsPtr->resolveCmds, + (char *)imPtr->namePtr); - if (entry) { + if (entry) { ItclCmdLookup *clookup; clookup = (ItclCmdLookup *)Tcl_GetHashValue(entry); ovlfunc = clookup->imPtr; - if ((ovlfunc->flags & ITCL_COMMON) == 0 && - ovlfunc->protection < ITCL_PRIVATE) { - return 1; - } - } - } + if ((ovlfunc->flags & ITCL_COMMON) == 0 && + ovlfunc->protection < ITCL_PRIVATE) { + return 1; + } + } + } } return 0; } @@ -1067,39 +1067,39 @@ Itcl_DecodeScopedCommand( /* empty body: skip over spaces */ } if ((*pos == 'i') && ((pos + 7) <= (name + len)) - && (strncmp(pos, "inscope", 7) == 0)) { + && (strncmp(pos, "inscope", 7) == 0)) { - result = Tcl_SplitList(interp, (const char *)name, &listc, + result = Tcl_SplitList(interp, (const char *)name, &listc, &listv); - if (result == TCL_OK) { - if (listc != 4) { - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "malformed command \"", name, "\": should be \"", - "namespace inscope namesp command\"", - NULL); - result = TCL_ERROR; - } else { - nsPtr = Tcl_FindNamespace(interp, listv[2], - NULL, TCL_LEAVE_ERR_MSG); - - if (nsPtr == NULL) { - result = TCL_ERROR; - } else { - ckfree(cmdName); - cmdName = (char *)ckalloc(strlen(listv[3])+1); - strcpy(cmdName, listv[3]); - } - } - } - ckfree((char*)listv); - - if (result != TCL_OK) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (while decoding scoped command \"%s\")", - name)); + if (result == TCL_OK) { + if (listc != 4) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "malformed command \"", name, "\": should be \"", + "namespace inscope namesp command\"", + NULL); + result = TCL_ERROR; + } else { + nsPtr = Tcl_FindNamespace(interp, listv[2], + NULL, TCL_LEAVE_ERR_MSG); + + if (nsPtr == NULL) { + result = TCL_ERROR; + } else { + ckfree(cmdName); + cmdName = (char *)ckalloc(strlen(listv[3])+1); + strcpy(cmdName, listv[3]); + } + } + } + ckfree((char*)listv); + + if (result != TCL_OK) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (while decoding scoped command \"%s\")", + name)); ckfree(cmdName); - return TCL_ERROR; - } + return TCL_ERROR; + } } } diff --git a/itclWidget/configure b/itclWidget/configure index 322e4034..f941ae12 100755 --- a/itclWidget/configure +++ b/itclWidget/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.72 for itclwidget 4.2.5. +# Generated by GNU Autoconf 2.72 for itclwidget 4.2.6. # # # Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, @@ -601,8 +601,8 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='itclwidget' PACKAGE_TARNAME='itclwidget' -PACKAGE_VERSION='4.2.5' -PACKAGE_STRING='itclwidget 4.2.5' +PACKAGE_VERSION='4.2.6' +PACKAGE_STRING='itclwidget 4.2.6' PACKAGE_BUGREPORT='' PACKAGE_URL='' @@ -1351,7 +1351,7 @@ 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 itclwidget 4.2.5 to adapt to many kinds of systems. +'configure' configures itclwidget 4.2.6 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1413,7 +1413,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of itclwidget 4.2.5:";; + short | recursive ) echo "Configuration of itclwidget 4.2.6:";; esac cat <<\_ACEOF @@ -1519,7 +1519,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -itclwidget configure 4.2.5 +itclwidget configure 4.2.6 generated by GNU Autoconf 2.72 Copyright (C) 2023 Free Software Foundation, Inc. @@ -1826,7 +1826,7 @@ 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 itclwidget $as_me 4.2.5, which was +It was created by itclwidget $as_me 4.2.6, which was generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw @@ -3906,11 +3906,11 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu printf %s "checking for existence of ${TCL_BIN_DIR}/tclConfig.sh... " >&6; } if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 printf "%s\n" "loading" >&6; } . "${TCL_BIN_DIR}/tclConfig.sh" else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: could not find ${TCL_BIN_DIR}/tclConfig.sh" >&5 printf "%s\n" "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; } fi @@ -3921,9 +3921,9 @@ printf "%s\n" "could not find ${TCL_BIN_DIR}/tclConfig.sh" >&6; } # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then - TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" - TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" - TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" + TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" + TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" + TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works @@ -4149,12 +4149,18 @@ printf "%s\n" "$as_me: WARNING: --with-tk argument should refer to directory con `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib/tk9.0 2>/dev/null` \ + `ls -d /usr/lib/tk8.7 2>/dev/null` \ `ls -d /usr/lib/tk8.6 2>/dev/null` \ `ls -d /usr/lib/tk8.5 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/local/lib/tk9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.7 2>/dev/null` \ `ls -d /usr/local/lib/tk8.6 2>/dev/null` \ `ls -d /usr/local/lib/tk8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \ `ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \ `ls -d /usr/local/lib/tcl/tk8.5 2>/dev/null` \ ; do @@ -4217,11 +4223,11 @@ printf "%s\n" "found ${TK_BIN_DIR}/tkConfig.sh" >&6; } printf %s "checking for existence of ${TK_BIN_DIR}/tkConfig.sh... " >&6; } if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 printf "%s\n" "loading" >&6; } . "${TK_BIN_DIR}/tkConfig.sh" else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: could not find ${TK_BIN_DIR}/tkConfig.sh" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: could not find ${TK_BIN_DIR}/tkConfig.sh" >&5 printf "%s\n" "could not find ${TK_BIN_DIR}/tkConfig.sh" >&6; } fi @@ -4232,9 +4238,9 @@ printf "%s\n" "could not find ${TK_BIN_DIR}/tkConfig.sh" >&6; } # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TK_BIN_DIR}/Makefile" ; then - TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" - TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" - TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" + TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" + TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" + TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tk was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works @@ -4409,11 +4415,11 @@ printf "%s\n" "found $itcl_BIN_DIR/itclConfig.sh" >&6; } printf %s "checking for existence of ${itcl_BIN_DIR}/itclConfig.sh... " >&6; } if test -f "${itcl_BIN_DIR}/itclConfig.sh" ; then - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: loading" >&5 printf "%s\n" "loading" >&6; } . "${itcl_BIN_DIR}/itclConfig.sh" else - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: file not found" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: file not found" >&5 printf "%s\n" "file not found" >&6; } fi @@ -4429,11 +4435,11 @@ printf "%s\n" "file not found" >&6; } if test -f "${itcl_BIN_DIR}/Makefile" ; then { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: Found Makefile - using build library specs for itcl" >&5 printf "%s\n" "$as_me: WARNING: Found Makefile - using build library specs for itcl" >&2;} - itcl_LIB_SPEC=${itcl_BUILD_LIB_SPEC} - itcl_STUB_LIB_SPEC=${itcl_BUILD_STUB_LIB_SPEC} - itcl_STUB_LIB_PATH=${itcl_BUILD_STUB_LIB_PATH} - itcl_INCLUDE_SPEC=${itcl_BUILD_INCLUDE_SPEC} - itcl_LIBRARY_PATH=${itcl_LIBRARY_PATH} + itcl_LIB_SPEC=${itcl_BUILD_LIB_SPEC} + itcl_STUB_LIB_SPEC=${itcl_BUILD_STUB_LIB_SPEC} + itcl_STUB_LIB_PATH=${itcl_BUILD_STUB_LIB_PATH} + itcl_INCLUDE_SPEC=${itcl_BUILD_INCLUDE_SPEC} + itcl_LIBRARY_PATH=${itcl_LIBRARY_PATH} fi @@ -6264,9 +6270,9 @@ printf %s "checking for Tcl private include files... " >&6; } # 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 + # 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 @@ -6274,7 +6280,7 @@ printf %s "checking for Tcl private include files... " >&6; } else TCL_INCLUDES="${TCL_INCLUDES} ${TCL_INCLUDE_SPEC} `echo "${TCL_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" fi - ;; + ;; esac result="Using ${TCL_INCLUDES}" else @@ -6952,7 +6958,7 @@ fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: shared" >&5 printf "%s\n" "shared" >&6; } SHARED_BUILD=1 - STUBS_BUILD=1 + STUBS_BUILD=1 else { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: static" >&5 printf "%s\n" "static" >&6; } @@ -6960,11 +6966,11 @@ printf "%s\n" "static" >&6; } printf "%s\n" "#define STATIC_BUILD 1" >>confdefs.h - if test "$stubs_ok" = "yes" ; then - STUBS_BUILD=1 - else - STUBS_BUILD=0 - fi + if test "$stubs_ok" = "yes" ; then + STUBS_BUILD=1 + else + STUBS_BUILD=0 + fi fi if test "${STUBS_BUILD}" = "1" ; then @@ -7403,14 +7409,14 @@ fi fi if test "$GCC" != "yes" ; then - if test "${SHARED_BUILD}" = "0" ; then + if test "${SHARED_BUILD}" = "0" ; then runtime=-MT - else + else runtime=-MD - fi - case "x`echo \${VisualStudioVersion}`" in - x1[4-9]*) - lflags="${lflags} -nodefaultlib:libucrt.lib" + fi + case "x`echo \${VisualStudioVersion}`" in + x1[4-9]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" vars="ucrt.lib" for i in $vars; do @@ -7422,12 +7428,12 @@ fi done - ;; - *) - ;; - esac + ;; + *) + ;; + esac - if test "$do64bit" != "no" ; then + if test "$do64bit" != "no" ; then CC="cl.exe" RC="rc.exe" lflags="${lflags} -nologo -MACHINE:${MACHINE} " @@ -8144,19 +8150,19 @@ fi if test "$do64bit" = yes then : - if test "$GCC" = yes + if test "$GCC" = yes then : - { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 + { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5 printf "%s\n" "$as_me: WARNING: 64bit mode not supported by gcc" >&2;} else case e in #( e) - do64bit_ok=yes - SHLIB_LD="ld -64 -shared -rdata_shared" - CFLAGS="$CFLAGS -64" - LDFLAGS_ARCH="-64" - ;; + do64bit_ok=yes + SHLIB_LD="ld -64 -shared -rdata_shared" + CFLAGS="$CFLAGS -64" + LDFLAGS_ARCH="-64" + ;; esac fi @@ -8184,7 +8190,7 @@ then : LDFLAGS="$LDFLAGS $PTHREAD_LIBS" fi ;; - esac + esac if test $doRpath = yes then : @@ -8648,11 +8654,11 @@ printf "%s\n" "#define _OE_SOCKETS 1" >>confdefs.h if test "$SHARED_BUILD" = 1 then : - SHLIB_LD='ld -shared -expect_unresolved "*"' + SHLIB_LD='ld -shared -expect_unresolved "*"' else case e in #( e) - SHLIB_LD='ld -non_shared -expect_unresolved "*"' + SHLIB_LD='ld -non_shared -expect_unresolved "*"' ;; esac fi @@ -8941,7 +8947,7 @@ esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \ conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$hold_ldflags ;; + LDFLAGS=$hold_ldflags ;; esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5 @@ -9384,15 +9390,15 @@ rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main (void) { switch (0) { - case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; - } + case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; + } ; return 0; } @@ -9550,7 +9556,7 @@ int main (void) { struct dirent64 *p; DIR64 d = opendir64("."); - p = readdir64(d); rewinddir64(d); closedir64(d); + p = readdir64(d); rewinddir64(d); closedir64(d); ; return 0; } @@ -9654,8 +9660,8 @@ esac fi if test "x${tcl_cv_type_off64_t}" = "xyes" && \ - test "x${ac_cv_func_lseek64}" = "xyes" && \ - test "x${ac_cv_func_open64}" = "xyes" ; then + test "x${ac_cv_func_lseek64}" = "xyes" && \ + test "x${ac_cv_func_open64}" = "xyes" ; then printf "%s\n" "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h @@ -9925,7 +9931,7 @@ rm -rf conftest* PACKAGE_LIB_PREFIX8="${PACKAGE_LIB_PREFIX}" PACKAGE_LIB_PREFIX9="${PACKAGE_LIB_PREFIX}tcl9" - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX9}" else PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX8}" @@ -9956,7 +9962,7 @@ printf "%s\n" "#define TCL_MAJOR_VERSION 8" >>confdefs.h eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" fi # Some packages build their own stubs libraries - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a" else eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" @@ -9984,7 +9990,7 @@ printf "%s\n" "#define TCL_MAJOR_VERSION 8" >>confdefs.h eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" fi # Some packages build their own stubs libraries - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a" else eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" @@ -10021,37 +10027,37 @@ printf "%s\n" "#define TCL_MAJOR_VERSION 8" >>confdefs.h { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5 printf %s "checking for tclsh... " >&6; } if test -f "${TCL_BIN_DIR}/Makefile" ; then - # tclConfig.sh is in Tcl build directory - if test "${TEA_PLATFORM}" = "windows"; then - if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" - fi - else - TCLSH_PROG="${TCL_BIN_DIR}/tclsh" - fi + # tclConfig.sh is in Tcl build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" + fi + else + TCLSH_PROG="${TCL_BIN_DIR}/tclsh" + fi else - # tclConfig.sh is in install location - if test "${TEA_PLATFORM}" = "windows"; then - TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" - else - TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}" - fi - list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ - `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ - `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" - for i in $list ; do - if test -f "$i/${TCLSH_PROG}" ; then - REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" - break - fi - done - TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" + # tclConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" + else + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}" + fi + list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${TCLSH_PROG}" ; then + REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: ${TCLSH_PROG}" >&5 printf "%s\n" "${TCLSH_PROG}" >&6; } @@ -10601,7 +10607,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by itclwidget $as_me 4.2.5, which was +This file was extended by itclwidget $as_me 4.2.6, which was generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -10656,7 +10662,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\ -itclwidget config.status 4.2.5 +itclwidget config.status 4.2.6 configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\" diff --git a/itclWidget/configure.ac b/itclWidget/configure.ac index 54a31708..d3cdf46e 100644 --- a/itclWidget/configure.ac +++ b/itclWidget/configure.ac @@ -10,7 +10,7 @@ # so you can encode the package version directly into the source files. #----------------------------------------------------------------------- -AC_INIT([itclwidget],[4.2.5]) +AC_INIT([itclwidget],[4.2.6]) #-------------------------------------------------------------------- # Call TEA_INIT as the first TEA_ macro to set up initial vars. diff --git a/itclWidget/tclconfig/tcl.m4 b/itclWidget/tclconfig/tcl.m4 index 75e25a88..5f0f3c47 100644 --- a/itclWidget/tclconfig/tcl.m4 +++ b/itclWidget/tclconfig/tcl.m4 @@ -292,12 +292,18 @@ AC_DEFUN([TEA_PATH_TKCONFIG], [ `ls -d /usr/local/lib 2>/dev/null` \ `ls -d /usr/contrib/lib 2>/dev/null` \ `ls -d /usr/pkg/lib 2>/dev/null` \ + `ls -d /usr/lib/tk9.0 2>/dev/null` \ + `ls -d /usr/lib/tk8.7 2>/dev/null` \ `ls -d /usr/lib/tk8.6 2>/dev/null` \ `ls -d /usr/lib/tk8.5 2>/dev/null` \ `ls -d /usr/lib 2>/dev/null` \ `ls -d /usr/lib64 2>/dev/null` \ + `ls -d /usr/local/lib/tk9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tk8.7 2>/dev/null` \ `ls -d /usr/local/lib/tk8.6 2>/dev/null` \ `ls -d /usr/local/lib/tk8.5 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk9.0 2>/dev/null` \ + `ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \ `ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \ `ls -d /usr/local/lib/tcl/tk8.5 2>/dev/null` \ ; do @@ -376,10 +382,10 @@ AC_DEFUN([TEA_LOAD_TCLCONFIG], [ AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh]) if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then - AC_MSG_RESULT([loading]) + AC_MSG_RESULT([loading]) . "${TCL_BIN_DIR}/tclConfig.sh" else - AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) + AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh]) fi # If the TCL_BIN_DIR is the build directory (not the install directory), @@ -389,9 +395,9 @@ AC_DEFUN([TEA_LOAD_TCLCONFIG], [ # instead of TCL_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TCL_BIN_DIR}/Makefile" ; then - TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" - TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" - TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" + TCL_LIB_SPEC="${TCL_BUILD_LIB_SPEC}" + TCL_STUB_LIB_SPEC="${TCL_BUILD_STUB_LIB_SPEC}" + TCL_STUB_LIB_PATH="${TCL_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tcl was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works @@ -484,10 +490,10 @@ AC_DEFUN([TEA_LOAD_TKCONFIG], [ AC_MSG_CHECKING([for existence of ${TK_BIN_DIR}/tkConfig.sh]) if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then - AC_MSG_RESULT([loading]) + AC_MSG_RESULT([loading]) . "${TK_BIN_DIR}/tkConfig.sh" else - AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) + AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh]) fi # If the TK_BIN_DIR is the build directory (not the install directory), @@ -497,9 +503,9 @@ AC_DEFUN([TEA_LOAD_TKCONFIG], [ # instead of TK_BUILD_LIB_SPEC since it will work with both an # installed and uninstalled version of Tcl. if test -f "${TK_BIN_DIR}/Makefile" ; then - TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" - TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" - TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" + TK_LIB_SPEC="${TK_BUILD_LIB_SPEC}" + TK_STUB_LIB_SPEC="${TK_BUILD_STUB_LIB_SPEC}" + TK_STUB_LIB_PATH="${TK_BUILD_STUB_LIB_PATH}" elif test "`uname -s`" = "Darwin"; then # If Tk was built as a framework, attempt to use the libraries # from the framework at the given location so that linking works @@ -577,37 +583,37 @@ AC_DEFUN([TEA_LOAD_TKCONFIG], [ AC_DEFUN([TEA_PROG_TCLSH], [ AC_MSG_CHECKING([for tclsh]) if test -f "${TCL_BIN_DIR}/Makefile" ; then - # tclConfig.sh is in Tcl build directory - if test "${TEA_PLATFORM}" = "windows"; then - if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" - elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" ; then - TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" - fi - else - TCLSH_PROG="${TCL_BIN_DIR}/tclsh" - fi + # tclConfig.sh is in Tcl build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}s${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}t${EXEEXT}" + elif test -f "${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" ; then + TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}st${EXEEXT}" + fi + else + TCLSH_PROG="${TCL_BIN_DIR}/tclsh" + fi else - # tclConfig.sh is in install location - if test "${TEA_PLATFORM}" = "windows"; then - TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" - else - TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}" - fi - list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ - `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ - `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" - for i in $list ; do - if test -f "$i/${TCLSH_PROG}" ; then - REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" - break - fi - done - TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" + # tclConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}" + else + TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}" + fi + list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TCL_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TCL_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${TCLSH_PROG}" ; then + REAL_TCL_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + TCLSH_PROG="${REAL_TCL_BIN_DIR}${TCLSH_PROG}" fi AC_MSG_RESULT([${TCLSH_PROG}]) AC_SUBST(TCLSH_PROG) @@ -635,37 +641,37 @@ AC_DEFUN([TEA_PROG_TCLSH], [ AC_DEFUN([TEA_PROG_WISH], [ AC_MSG_CHECKING([for wish]) if test -f "${TK_BIN_DIR}/Makefile" ; then - # tkConfig.sh is in Tk build directory - if test "${TEA_PLATFORM}" = "windows"; then - if test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${EXEEXT}" ; then - WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${EXEEXT}" - elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}s${EXEEXT}" ; then - WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}$s{EXEEXT}" - elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}t${EXEEXT}" ; then - WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}t${EXEEXT}" - elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}st${EXEEXT}" ; then - WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}st${EXEEXT}" - fi - else - WISH_PROG="${TK_BIN_DIR}/wish" - fi + # tkConfig.sh is in Tk build directory + if test "${TEA_PLATFORM}" = "windows"; then + if test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}s${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}$s{EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}t${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}t${EXEEXT}" + elif test -f "${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}st${EXEEXT}" ; then + WISH_PROG="${TK_BIN_DIR}/wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}st${EXEEXT}" + fi + else + WISH_PROG="${TK_BIN_DIR}/wish" + fi else - # tkConfig.sh is in install location - if test "${TEA_PLATFORM}" = "windows"; then - WISH_PROG="wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${EXEEXT}" - else - WISH_PROG="wish${TK_MAJOR_VERSION}.${TK_MINOR_VERSION}" - fi - list="`ls -d ${TK_BIN_DIR}/../bin 2>/dev/null` \ - `ls -d ${TK_BIN_DIR}/.. 2>/dev/null` \ - `ls -d ${TK_PREFIX}/bin 2>/dev/null`" - for i in $list ; do - if test -f "$i/${WISH_PROG}" ; then - REAL_TK_BIN_DIR="`cd "$i"; pwd`/" - break - fi - done - WISH_PROG="${REAL_TK_BIN_DIR}${WISH_PROG}" + # tkConfig.sh is in install location + if test "${TEA_PLATFORM}" = "windows"; then + WISH_PROG="wish${TK_MAJOR_VERSION}${TK_MINOR_VERSION}${EXEEXT}" + else + WISH_PROG="wish${TK_MAJOR_VERSION}.${TK_MINOR_VERSION}" + fi + list="`ls -d ${TK_BIN_DIR}/../bin 2>/dev/null` \ + `ls -d ${TK_BIN_DIR}/.. 2>/dev/null` \ + `ls -d ${TK_PREFIX}/bin 2>/dev/null`" + for i in $list ; do + if test -f "$i/${WISH_PROG}" ; then + REAL_TK_BIN_DIR="`cd "$i"; pwd`/" + break + fi + done + WISH_PROG="${REAL_TK_BIN_DIR}${WISH_PROG}" fi AC_MSG_RESULT([${WISH_PROG}]) AC_SUBST(WISH_PROG) @@ -727,22 +733,22 @@ AC_DEFUN([TEA_ENABLE_SHARED], [ if test "$shared_ok" = "yes" ; then AC_MSG_RESULT([shared]) SHARED_BUILD=1 - STUBS_BUILD=1 + STUBS_BUILD=1 else AC_MSG_RESULT([static]) SHARED_BUILD=0 AC_DEFINE(STATIC_BUILD, 1, [This a static build]) - if test "$stubs_ok" = "yes" ; then - STUBS_BUILD=1 - else - STUBS_BUILD=0 - fi + if test "$stubs_ok" = "yes" ; then + STUBS_BUILD=1 + else + STUBS_BUILD=0 + fi fi if test "${STUBS_BUILD}" = "1" ; then AC_DEFINE(USE_TCL_STUBS, 1, [Use Tcl stubs]) AC_DEFINE(USE_TCLOO_STUBS, 1, [Use TclOO stubs]) if test "${TEA_WINDOWINGSYSTEM}" != ""; then - AC_DEFINE(USE_TK_STUBS, 1, [Use Tk stubs]) + AC_DEFINE(USE_TK_STUBS, 1, [Use Tk stubs]) fi fi @@ -1187,21 +1193,21 @@ AC_DEFUN([TEA_CONFIG_CFLAGS], [ fi if test "$GCC" != "yes" ; then - if test "${SHARED_BUILD}" = "0" ; then + if test "${SHARED_BUILD}" = "0" ; then runtime=-MT - else + else runtime=-MD - fi - case "x`echo \${VisualStudioVersion}`" in - x1[[4-9]]*) - lflags="${lflags} -nodefaultlib:libucrt.lib" - TEA_ADD_LIBS([ucrt.lib]) - ;; - *) - ;; - esac - - if test "$do64bit" != "no" ; then + fi + case "x`echo \${VisualStudioVersion}`" in + x1[[4-9]]*) + lflags="${lflags} -nodefaultlib:libucrt.lib" + TEA_ADD_LIBS([ucrt.lib]) + ;; + *) + ;; + esac + + if test "$do64bit" != "no" ; then CC="cl.exe" RC="rc.exe" lflags="${lflags} -nologo -MACHINE:${MACHINE} " @@ -1500,14 +1506,14 @@ AC_DEFUN([TEA_CONFIG_CFLAGS], [ # Check to enable 64-bit flags for compiler/linker AS_IF([test "$do64bit" = yes], [ - AS_IF([test "$GCC" = yes], [ - AC_MSG_WARN([64bit mode not supported by gcc]) - ], [ - do64bit_ok=yes - SHLIB_LD="ld -64 -shared -rdata_shared" - CFLAGS="$CFLAGS -64" - LDFLAGS_ARCH="-64" - ]) + AS_IF([test "$GCC" = yes], [ + AC_MSG_WARN([64bit mode not supported by gcc]) + ], [ + do64bit_ok=yes + SHLIB_LD="ld -64 -shared -rdata_shared" + CFLAGS="$CFLAGS -64" + LDFLAGS_ARCH="-64" + ]) ]) ;; Linux*|GNU*|NetBSD-Debian|DragonFly-*|FreeBSD-*) @@ -1529,7 +1535,7 @@ AC_DEFUN([TEA_CONFIG_CFLAGS], [ CFLAGS="$CFLAGS $PTHREAD_CFLAGS" LDFLAGS="$LDFLAGS $PTHREAD_LIBS"]) ;; - esac + esac AS_IF([test $doRpath = yes], [ CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"']) @@ -1734,9 +1740,9 @@ AC_DEFUN([TEA_CONFIG_CFLAGS], [ # Digital OSF/1 SHLIB_CFLAGS="" AS_IF([test "$SHARED_BUILD" = 1], [ - SHLIB_LD='ld -shared -expect_unresolved "*"' + SHLIB_LD='ld -shared -expect_unresolved "*"' ], [ - SHLIB_LD='ld -non_shared -expect_unresolved "*"' + SHLIB_LD='ld -non_shared -expect_unresolved "*"' ]) SHLIB_SUFFIX=".so" AS_IF([test $doRpath = yes], [ @@ -1906,7 +1912,7 @@ AC_DEFUN([TEA_CONFIG_CFLAGS], [ LDFLAGS="$LDFLAGS -Wl,-Bexport" AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])], [tcl_cv_ld_Bexport=yes],[tcl_cv_ld_Bexport=no]) - LDFLAGS=$hold_ldflags]) + LDFLAGS=$hold_ldflags]) AS_IF([test $tcl_cv_ld_Bexport = yes], [ LDFLAGS="$LDFLAGS -Wl,-Bexport" ]) @@ -2025,8 +2031,8 @@ dnl # preprocessing tests use only CPPFLAGS. SHORT s; LONG l; ]])], - [tcl_cv_winnt_ignore_void=yes], - [tcl_cv_winnt_ignore_void=no]) + [tcl_cv_winnt_ignore_void=yes], + [tcl_cv_winnt_ignore_void=no]) ) if test "$tcl_cv_winnt_ignore_void" = "yes" ; then AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1, @@ -2602,9 +2608,9 @@ AC_DEFUN([TEA_TCL_64BIT_FLAGS], [ # See if we could use long anyway Note that we substitute in the # type that is our current guess for a 64-bit type inside this check # program, so it should be modified only carefully... - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) { - case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; - }]])],[tcl_cv_type_64bit=${tcl_type_64bit}],[])]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) { + case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ; + }]])],[tcl_cv_type_64bit=${tcl_type_64bit}],[])]) if test "${tcl_cv_type_64bit}" = none ; then AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?]) AC_MSG_RESULT([yes]) @@ -2649,7 +2655,7 @@ AC_DEFUN([TEA_TCL_64BIT_FLAGS], [ AC_CACHE_CHECK([for DIR64], tcl_cv_DIR64,[ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[struct dirent64 *p; DIR64 d = opendir64("."); - p = readdir64(d); rewinddir64(d); closedir64(d);]])], + p = readdir64(d); rewinddir64(d); closedir64(d);]])], [tcl_cv_DIR64=yes], [tcl_cv_DIR64=no])]) if test "x${tcl_cv_DIR64}" = "xyes" ; then AC_DEFINE(HAVE_DIR64, 1, [Is 'DIR64' in ?]) @@ -2672,8 +2678,8 @@ AC_DEFUN([TEA_TCL_64BIT_FLAGS], [ dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the dnl functions lseek64 and open64 are defined. if test "x${tcl_cv_type_off64_t}" = "xyes" && \ - test "x${ac_cv_func_lseek64}" = "xyes" && \ - test "x${ac_cv_func_open64}" = "xyes" ; then + test "x${ac_cv_func_lseek64}" = "xyes" && \ + test "x${ac_cv_func_open64}" = "xyes" ; then AC_DEFINE(HAVE_TYPE_OFF64_T, 1, [Is off64_t in ?]) AC_MSG_RESULT([yes]) else @@ -3205,7 +3211,7 @@ print("manifest needed") PACKAGE_LIB_PREFIX8="${PACKAGE_LIB_PREFIX}" PACKAGE_LIB_PREFIX9="${PACKAGE_LIB_PREFIX}tcl9" - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX9}" else PACKAGE_LIB_PREFIX="${PACKAGE_LIB_PREFIX8}" @@ -3234,7 +3240,7 @@ print("manifest needed") eval eval "PKG_LIB_FILE=${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" fi # Some packages build their own stubs libraries - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a" else eval eval "PKG_STUB_LIB_FILE=${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" @@ -3262,7 +3268,7 @@ print("manifest needed") eval eval "PKG_LIB_FILE=lib${PACKAGE_LIB_PREFIX}${PACKAGE_NAME}${UNSHARED_LIB_SUFFIX}" fi # Some packages build their own stubs libraries - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub.a" else eval eval "PKG_STUB_LIB_FILE=lib${PACKAGE_LIB_PREFIX8}${PACKAGE_NAME}stub${UNSHARED_LIB_SUFFIX}" @@ -3408,9 +3414,9 @@ AC_DEFUN([TEA_PRIVATE_TCL_HEADERS], [ # 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 + # 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 @@ -3418,7 +3424,7 @@ AC_DEFUN([TEA_PRIVATE_TCL_HEADERS], [ else TCL_INCLUDES="${TCL_INCLUDES} ${TCL_INCLUDE_SPEC} `echo "${TCL_INCLUDE_SPEC}" | sed -e 's/Headers/PrivateHeaders/'`" fi - ;; + ;; esac result="Using ${TCL_INCLUDES}" else @@ -4029,10 +4035,10 @@ AC_DEFUN([TEA_LOAD_CONFIG], [ AC_MSG_CHECKING([for existence of ${$1_BIN_DIR}/$1Config.sh]) if test -f "${$1_BIN_DIR}/$1Config.sh" ; then - AC_MSG_RESULT([loading]) + AC_MSG_RESULT([loading]) . "${$1_BIN_DIR}/$1Config.sh" else - AC_MSG_RESULT([file not found]) + AC_MSG_RESULT([file not found]) fi # @@ -4046,11 +4052,11 @@ AC_DEFUN([TEA_LOAD_CONFIG], [ if test -f "${$1_BIN_DIR}/Makefile" ; then AC_MSG_WARN([Found Makefile - using build library specs for $1]) - $1_LIB_SPEC=${$1_BUILD_LIB_SPEC} - $1_STUB_LIB_SPEC=${$1_BUILD_STUB_LIB_SPEC} - $1_STUB_LIB_PATH=${$1_BUILD_STUB_LIB_PATH} - $1_INCLUDE_SPEC=${$1_BUILD_INCLUDE_SPEC} - $1_LIBRARY_PATH=${$1_LIBRARY_PATH} + $1_LIB_SPEC=${$1_BUILD_LIB_SPEC} + $1_STUB_LIB_SPEC=${$1_BUILD_STUB_LIB_SPEC} + $1_STUB_LIB_PATH=${$1_BUILD_STUB_LIB_PATH} + $1_INCLUDE_SPEC=${$1_BUILD_INCLUDE_SPEC} + $1_LIBRARY_PATH=${$1_LIBRARY_PATH} fi AC_SUBST($1_VERSION) @@ -4131,7 +4137,7 @@ AC_DEFUN([TEA_EXPORT_CONFIG], [ eval $1_LIB_FLAG="-l$1`echo ${PACKAGE_VERSION} | tr -d .`" eval $1_STUB_LIB_FLAG="-l$1stub`echo ${PACKAGE_VERSION} | tr -d .`" fi - if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" == x; then + if test "${TCL_MAJOR_VERSION}" -gt 8 -a x"${with_tcl8}" = x; then eval $1_STUB_LIB_FLAG="-l$1stub" fi @@ -4224,52 +4230,52 @@ AC_DEFUN([TEA_ZIPFS_SUPPORT], [ AC_CACHE_VAL(ac_cv_path_macher, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do - for j in `ls -r $dir/macher 2> /dev/null` \ - `ls -r $dir/macher 2> /dev/null` ; do - if test x"$ac_cv_path_macher" = x ; then - if test -f "$j" ; then - ac_cv_path_macher=$j - break - fi - fi - done + for j in `ls -r $dir/macher 2> /dev/null` \ + `ls -r $dir/macher 2> /dev/null` ; do + if test x"$ac_cv_path_macher" = x ; then + if test -f "$j" ; then + ac_cv_path_macher=$j + break + fi + fi + done done ]) if test -f "$ac_cv_path_macher" ; then - MACHER_PROG="$ac_cv_path_macher" - AC_MSG_RESULT([$MACHER_PROG]) - AC_MSG_RESULT([Found macher in environment]) + MACHER_PROG="$ac_cv_path_macher" + AC_MSG_RESULT([$MACHER_PROG]) + AC_MSG_RESULT([Found macher in environment]) fi AC_MSG_CHECKING([for zip]) AC_CACHE_VAL(ac_cv_path_zip, [ search_path=`echo ${PATH} | sed -e 's/:/ /g'` for dir in $search_path ; do - for j in `ls -r $dir/zip 2> /dev/null` \ - `ls -r $dir/zip 2> /dev/null` ; do - if test x"$ac_cv_path_zip" = x ; then - if test -f "$j" ; then - ac_cv_path_zip=$j - break - fi - fi - done + for j in `ls -r $dir/zip 2> /dev/null` \ + `ls -r $dir/zip 2> /dev/null` ; do + if test x"$ac_cv_path_zip" = x ; then + if test -f "$j" ; then + ac_cv_path_zip=$j + break + fi + fi + done done ]) if test -f "$ac_cv_path_zip" ; then - ZIP_PROG="$ac_cv_path_zip" - AC_MSG_RESULT([$ZIP_PROG]) - ZIP_PROG_OPTIONS="-rq" - ZIP_PROG_VFSSEARCH="*" - AC_MSG_RESULT([Found INFO Zip in environment]) - # Use standard arguments for zip + ZIP_PROG="$ac_cv_path_zip" + AC_MSG_RESULT([$ZIP_PROG]) + ZIP_PROG_OPTIONS="-rq" + ZIP_PROG_VFSSEARCH="*" + AC_MSG_RESULT([Found INFO Zip in environment]) + # Use standard arguments for zip else - # It is not an error if an installed version of Zip can't be located. - # We can use the locally distributed minizip instead - ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" - ZIP_PROG_OPTIONS="-o -r" - ZIP_PROG_VFSSEARCH="*" - ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" - AC_MSG_RESULT([No zip found on PATH. Building minizip]) + # It is not an error if an installed version of Zip can't be located. + # We can use the locally distributed minizip instead + ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}" + ZIP_PROG_OPTIONS="-o -r" + ZIP_PROG_VFSSEARCH="*" + ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}" + AC_MSG_RESULT([No zip found on PATH. Building minizip]) fi AC_SUBST(MACHER_PROG) AC_SUBST(ZIP_PROG) diff --git a/library/itcl.tcl b/library/itcl.tcl index 7a1bdeea..276abae7 100644 --- a/library/itcl.tcl +++ b/library/itcl.tcl @@ -33,7 +33,7 @@ proc ::itcl::local {class name args} { uplevel [list set itcl-local-$ptr $ptr] set cmd [uplevel namespace which -command $ptr] uplevel [list trace add variable itcl-local-$ptr unset \ - "::itcl::delete_helper $cmd"] + "::itcl::delete_helper $cmd"] return $ptr } @@ -112,8 +112,8 @@ foreach __cmd {itcl::ensemble ensemble} { # foreach __cmd {public protected private} { auto_mkindex_parser::command $__cmd {args} { - variable parser - $parser eval $args + variable parser + $parser eval $args } } @@ -142,10 +142,10 @@ proc auto_import {pattern} { auto_load_index foreach pattern $patternList { - foreach name [array names auto_index $pattern] { - if {"" == [info commands $name]} { - ::itcl::import::stub create $name - } - } + foreach name [array names auto_index $pattern] { + if {"" == [info commands $name]} { + ::itcl::import::stub create $name + } + } } } diff --git a/library/itclHullCmds.tcl b/library/itclHullCmds.tcl index 5cd07f60..5ef32645 100644 --- a/library/itclHullCmds.tcl +++ b/library/itclHullCmds.tcl @@ -74,49 +74,49 @@ proc createhull {widget_type path args} { rename ::$my_this ${tmp}_ set options [list] foreach {option_name value} $args { - switch -glob -- $option_name { + switch -glob -- $option_name { -class { lappend options $option_name [namespace tail $value] } - -* { - lappend options $option_name $value - } - default { + -* { + lappend options $option_name $value + } + default { return -code error "bad option name\"$option_name\" options must start with a \"-\"" - } - } + } + } } set my_win [namespace tail $path] set cmd [list $widget_type $my_win] #puts stderr "my_win!$my_win!cmd!$cmd!$path!" if {[llength $options] > 0} { - lappend cmd {*}$options + lappend cmd {*}$options } set widget [uplevel 1 $cmd] #puts stderr "widget!$widget!" trace add command $widget delete ::itcl::internal::commands::widgetDeleted set opts [uplevel 1 info delegated options] foreach entry $opts { - foreach {optName compName} $entry break + foreach {optName compName} $entry break if {$compName eq "itcl_hull"} { set optInfos [uplevel 1 info delegated option $optName] set realOptName [lindex $optInfos 4] # strip off the "-" at the beginning set myOptName [string range $realOptName 1 end] - set my_opt_val [option get $my_win $myOptName *] - if {$my_opt_val ne ""} { - $my_win configure -$myOptName $my_opt_val - } + set my_opt_val [option get $my_win $myOptName *] + if {$my_opt_val ne ""} { + $my_win configure -$myOptName $my_opt_val + } } } set idx 1 while {1} { - set widgetName ::itcl::internal::widgets::hull${idx}$my_win + set widgetName ::itcl::internal::widgets::hull${idx}$my_win #puts stderr "widgetName!$widgetName!" if {[string length [::info command $widgetName]] == 0} { break } - incr idx + incr idx } #puts stderr "rename2!rename $widget $widgetName!" set dorename 0 @@ -126,7 +126,7 @@ proc createhull {widget_type path args} { set exists [uplevel 1 ::info exists itcl_hull] if {!$exists} { # that does not yet work, beacause of problems with resolving - ::itcl::addcomponent $my_this itcl_hull + ::itcl::addcomponent $my_this itcl_hull } upvar itcl_hull itcl_hull ::itcl::setcomponent $my_this itcl_hull $widgetName @@ -134,7 +134,7 @@ proc createhull {widget_type path args} { set exists [uplevel 1 ::info exists itcl_interior] if {!$exists} { # that does not yet work, beacause of problems with resolving - ::itcl::addcomponent $this itcl_interior + ::itcl::addcomponent $this itcl_interior } upvar itcl_interior itcl_interior set itcl_interior $my_win @@ -151,49 +151,49 @@ proc addToItclOptions {my_class my_win myOptions argsDict} { set opt_lst [list configure] foreach opt [lsort $myOptions] { #puts stderr "IOPT!$opt!$my_class!$my_win![::itcl::is class $my_class]!" - set isClass [::itcl::is class $my_class] + set isClass [::itcl::is class $my_class] set found 0 if {$isClass} { - if {[catch { - set resource [namespace eval $my_class info option $opt -resource] - set class [namespace eval $my_class info option $opt -class] - set default_val [uplevel 2 info option $opt -default] - set found 1 - } msg]} { + if {[catch { + set resource [namespace eval $my_class info option $opt -resource] + set class [namespace eval $my_class info option $opt -class] + set default_val [uplevel 2 info option $opt -default] + set found 1 + } msg]} { # puts stderr "MSG!$opt!$my_class!$msg!" - } - } else { - set tmp_win [uplevel #0 $my_class .___xx] - - set my_info [$tmp_win configure $opt] - set resource [lindex $my_info 1] - set class [lindex $my_info 2] - set default_val [lindex $my_info 3] + } + } else { + set tmp_win [uplevel #0 $my_class .___xx] + + set my_info [$tmp_win configure $opt] + set resource [lindex $my_info 1] + set class [lindex $my_info 2] + set default_val [lindex $my_info 3] uplevel #0 destroy $tmp_win - set found 1 - } + set found 1 + } if {$found} { - if {[catch { - set val [uplevel #0 ::option get $win $resource $class] - } msg]} { - set val "" - } - if {[::dict exists $argsDict $opt]} { - # we have an explicitly set option - set val [::dict get $argsDict $opt] - } else { + if {[catch { + set val [uplevel #0 ::option get $win $resource $class] + } msg]} { + set val "" + } + if {[::dict exists $argsDict $opt]} { + # we have an explicitly set option + set val [::dict get $argsDict $opt] + } else { if {[string length $val] == 0} { - set val $default_val + set val $default_val } - } - set ::itcl::internal::variables::${my_win}::itcl_options($opt) $val - set ::itcl::internal::variables::${my_win}::__itcl_option_infos($opt) [list $resource $class $default_val] + } + set ::itcl::internal::variables::${my_win}::itcl_options($opt) $val + set ::itcl::internal::variables::${my_win}::__itcl_option_infos($opt) [list $resource $class $default_val] #puts stderr "OPT1!$opt!$val!" # uplevel 1 [list set itcl_options($opt) [list $val]] - if {[catch {uplevel 1 $win configure $opt [list $val]} msg]} { + if {[catch {uplevel 1 $win configure $opt [list $val]} msg]} { #puts stderr "addToItclOptions ERR!$msg!$my_class!$win!configure!$opt!$val!" } - } + } } } @@ -211,29 +211,29 @@ proc setupcomponent {comp using widget_type path args} { #puts stderr "ns3![uplevel 3 namespace current]!" set my_comp_object [lindex [uplevel 1 info context] 1] if {[::info exists ::itcl::internal::component_objects($my_comp_object)]} { - set my_comp_object [set ::itcl::internal::component_objects($my_comp_object)] + set my_comp_object [set ::itcl::internal::component_objects($my_comp_object)] } else { - set ::itcl::internal::component_objects($path) $my_comp_object + set ::itcl::internal::component_objects($path) $my_comp_object } set options [list] foreach {option_name value} $args { - switch -glob -- $option_name { - -* { - lappend options $option_name $value - } - default { + switch -glob -- $option_name { + -* { + lappend options $option_name $value + } + default { return -code error "bad option name\"$option_name\" options must start with a \"-\"" - } - } + } + } } if {[llength $args]} { - set argsDict [dict create {*}$args] + set argsDict [dict create {*}$args] } else { - set argsDict [dict create] + set argsDict [dict create] } set cmd [list $widget_type $path] if {[llength $options] > 0} { - lappend cmd {*}$options + lappend cmd {*}$options } #puts stderr "cmd0![::info command $widget_type]!$path![::info command $path]!" #puts stderr "cmd1!$cmd!" @@ -243,28 +243,28 @@ proc setupcomponent {comp using widget_type path args} { ::itcl::setcomponent $this $comp $my_comp set opts [uplevel 1 info delegated options] foreach entry $opts { - foreach {optName compName} $entry break + foreach {optName compName} $entry break if {$compName eq $my_comp} { set optInfos [uplevel 1 info delegated option $optName] set realOptName [lindex $optInfos 4] # strip off the "-" at the beginning set myOptName [string range $realOptName 1 end] - set my_opt_val [option get $my_win $myOptName *] - if {$my_opt_val ne ""} { - $my_comp configure -$myOptName $my_opt_val - } + set my_opt_val [option get $my_win $myOptName *] + if {$my_opt_val ne ""} { + $my_comp configure -$myOptName $my_opt_val + } } } set my_class $widget_type set my_parent_class [uplevel 1 namespace current] if {[catch { - set myOptions [namespace eval $my_class {info classoptions}] + set myOptions [namespace eval $my_class {info classoptions}] } msg]} { - set myOptions [list] + set myOptions [list] } foreach entry [$path configure] { - foreach {opt dummy1 dummy2 dummy3} $entry break - lappend myOptions $opt + foreach {opt dummy1 dummy2 dummy3} $entry break + lappend myOptions $opt } #puts stderr "OPTS!$myOptions!" addToItclOptions $widget_type $my_comp_object $myOptions $argsDict @@ -284,108 +284,108 @@ proc initoptions {args} { #puts stderr "INITOPT!!$win!" if {[llength $args]} { - set argsDict [dict create {*}$args] + set argsDict [dict create {*}$args] } else { - set argsDict [dict create] + set argsDict [dict create] } set my_class [uplevel 1 namespace current] set myOptions [namespace eval $my_class {info classoptions}] if {[dict exists $::itcl::internal::dicts::classComponents $my_class]} { - set class_info_dict [dict get $::itcl::internal::dicts::classComponents $my_class] + set class_info_dict [dict get $::itcl::internal::dicts::classComponents $my_class] # set myOptions [lsort -unique [namespace eval $my_class {info options}]] - foreach comp [uplevel 1 info components] { - if {[dict exists $class_info_dict $comp -keptoptions]} { - foreach my_opt [dict get $class_info_dict $comp -keptoptions] { - if {[lsearch $myOptions $my_opt] < 0} { + foreach comp [uplevel 1 info components] { + if {[dict exists $class_info_dict $comp -keptoptions]} { + foreach my_opt [dict get $class_info_dict $comp -keptoptions] { + if {[lsearch $myOptions $my_opt] < 0} { #puts stderr "KEOPT!$my_opt!" - lappend myOptions $my_opt - } - } - } - } + lappend myOptions $my_opt + } + } + } + } } else { - set class_info_dict [list] + set class_info_dict [list] } #puts stderr "OPTS!$win!$my_class![join [lsort $myOptions]] \n]!" set opt_lst [list configure] set my_win $win foreach opt [lsort $myOptions] { set found 0 - if {[catch { - set resource [uplevel 1 info option $opt -resource] - set class [uplevel 1 info option $opt -class] - set default_val [uplevel 1 info option $opt -default] + if {[catch { + set resource [uplevel 1 info option $opt -resource] + set class [uplevel 1 info option $opt -class] + set default_val [uplevel 1 info option $opt -default] set found 1 - } msg]} { + } msg]} { # puts stderr "MSG!$opt!$msg!" - } + } #puts stderr "OPT!$opt!$found!" if {$found} { - if {[catch { - set val [uplevel #0 ::option get $my_win $resource $class] - } msg]} { - set val "" - } - if {[::dict exists $argsDict $opt]} { - # we have an explicitly set option - set val [::dict get $argsDict $opt] - } else { + if {[catch { + set val [uplevel #0 ::option get $my_win $resource $class] + } msg]} { + set val "" + } + if {[::dict exists $argsDict $opt]} { + # we have an explicitly set option + set val [::dict get $argsDict $opt] + } else { if {[string length $val] == 0} { - set val $default_val + set val $default_val } - } - set ::itcl::internal::variables::${win}::itcl_options($opt) $val - set ::itcl::internal::variables::${win}::__itcl_option_infos($opt) [list $resource $class $default_val] + } + set ::itcl::internal::variables::${win}::itcl_options($opt) $val + set ::itcl::internal::variables::${win}::__itcl_option_infos($opt) [list $resource $class $default_val] #puts stderr "OPT1!$opt!$val!" # uplevel 1 [list set itcl_options($opt) [list $val]] - if {[catch {uplevel 1 $my_win configure $opt [list $val]} msg]} { + if {[catch {uplevel 1 $my_win configure $opt [list $val]} msg]} { puts stderr "initoptions ERR!$msg!$my_class!$my_win!configure!$opt!$val!" } - } - foreach comp [dict keys $class_info_dict] { + } + foreach comp [dict keys $class_info_dict] { #puts stderr "OPT1!$opt!$comp![dict get $class_info_dict $comp]!" - if {[dict exists $class_info_dict $comp -keptoptions]} { - if {[lsearch [dict get $class_info_dict $comp -keptoptions] $opt] >= 0} { - if {$found == 0} { - # we use the option value of the first component for setting - # the option, as the components are traversed in the dict - # depending on the ordering of the component creation!! - set my_info [uplevel 1 \[set $comp\] configure $opt] - set resource [lindex $my_info 1] - set class [lindex $my_info 2] - set default_val [lindex $my_info 3] - set found 2 - set val [uplevel #0 ::option get $my_win $resource $class] - if {[::dict exists $argsDict $opt]} { - # we have an explicitly set option - set val [::dict get $argsDict $opt] - } else { - if {[string length $val] == 0} { - set val $default_val - } - } + if {[dict exists $class_info_dict $comp -keptoptions]} { + if {[lsearch [dict get $class_info_dict $comp -keptoptions] $opt] >= 0} { + if {$found == 0} { + # we use the option value of the first component for setting + # the option, as the components are traversed in the dict + # depending on the ordering of the component creation!! + set my_info [uplevel 1 \[set $comp\] configure $opt] + set resource [lindex $my_info 1] + set class [lindex $my_info 2] + set default_val [lindex $my_info 3] + set found 2 + set val [uplevel #0 ::option get $my_win $resource $class] + if {[::dict exists $argsDict $opt]} { + # we have an explicitly set option + set val [::dict get $argsDict $opt] + } else { + if {[string length $val] == 0} { + set val $default_val + } + } #puts stderr "OPT2!$opt!$val!" - set ::itcl::internal::variables::${win}::itcl_options($opt) $val - set ::itcl::internal::variables::${win}::__itcl_option_infos($opt) [list $resource $class $default_val] + set ::itcl::internal::variables::${win}::itcl_options($opt) $val + set ::itcl::internal::variables::${win}::__itcl_option_infos($opt) [list $resource $class $default_val] # uplevel 1 [list set itcl_options($opt) [list $val]] - } - if {[catch {uplevel 1 \[set $comp\] configure $opt [list $val]} msg]} { + } + if {[catch {uplevel 1 \[set $comp\] configure $opt [list $val]} msg]} { puts stderr "initoptions ERR2!$msg!$my_class!$comp!configure!$opt!$val!" - } + } if {![uplevel 1 info exists itcl_option_components($opt)]} { - set itcl_option_components($opt) [list] + set itcl_option_components($opt) [list] } if {[lsearch [set itcl_option_components($opt)] $comp] < 0} { - if {![catch { - set optval [uplevel 1 [list set itcl_options($opt)]] - } msg3]} { - uplevel 1 \[set $comp\] configure $opt $optval - } - lappend itcl_option_components($opt) $comp + if {![catch { + set optval [uplevel 1 [list set itcl_options($opt)]] + } msg3]} { + uplevel 1 \[set $comp\] configure $opt $optval + } + lappend itcl_option_components($opt) $comp } - } - } - } + } + } + } } # uplevel 1 $opt_lst } @@ -396,9 +396,9 @@ proc setoptions {args} { #puts stderr "setOPT!!$args!" if {[llength $args]} { - set argsDict [dict create {*}$args] + set argsDict [dict create {*}$args] } else { - set argsDict [dict create] + set argsDict [dict create] } set my_class [uplevel 1 namespace current] set myOptions [namespace eval $my_class {info options}] @@ -406,35 +406,35 @@ proc setoptions {args} { set opt_lst [list configure] foreach opt [lsort $myOptions] { set found 0 - if {[catch { - set resource [uplevel 1 info option $opt -resource] - set class [uplevel 1 info option $opt -class] - set default_val [uplevel 1 info option $opt -default] + if {[catch { + set resource [uplevel 1 info option $opt -resource] + set class [uplevel 1 info option $opt -class] + set default_val [uplevel 1 info option $opt -default] set found 1 - } msg]} { + } msg]} { # puts stderr "MSG!$opt!$msg!" - } + } #puts stderr "OPT!$opt!$found!" if {$found} { - set val "" - if {[::dict exists $argsDict $opt]} { - # we have an explicitly set option - set val [::dict get $argsDict $opt] - } else { + set val "" + if {[::dict exists $argsDict $opt]} { + # we have an explicitly set option + set val [::dict get $argsDict $opt] + } else { if {[string length $val] == 0} { - set val $default_val + set val $default_val } - } + } set myObj [uplevel 1 set this] #puts stderr "myObj!$myObj!" - set ::itcl::internal::variables::${myObj}::itcl_options($opt) $val - set ::itcl::internal::variables::${myObj}::__itcl_option_infos($opt) [list $resource $class $default_val] + set ::itcl::internal::variables::${myObj}::itcl_options($opt) $val + set ::itcl::internal::variables::${myObj}::__itcl_option_infos($opt) [list $resource $class $default_val] #puts stderr "OPT1!$opt!$val!" uplevel 1 [list set itcl_options($opt) [list $val]] # if {[catch {uplevel 1 $myObj configure $opt [list $val]} msg]} { #puts stderr "initoptions ERR!$msg!$my_class!$my_win!configure!$opt!$val!" # } - } + } } # uplevel 1 $opt_lst } @@ -465,7 +465,7 @@ proc keepcomponentoption {args} { #puts stderr "KEEP!$args![uplevel 1 namespace current]!" if {[llength $args] < 2} { - puts stderr $usage + puts stderr $usage return -code error } set my_hull [uplevel 1 set itcl_hull] @@ -474,27 +474,27 @@ proc keepcomponentoption {args} { set args [lrange $args 1 end] set class_info_dict [dict get $::itcl::internal::dicts::classComponents $my_class] if {![dict exists $class_info_dict $comp]} { - puts stderr "keepcomponentoption cannot find component \"$comp\"" + puts stderr "keepcomponentoption cannot find component \"$comp\"" return -code error } set class_comp_dict [dict get $class_info_dict $comp] if {![dict exists $class_comp_dict -keptoptions]} { - dict set class_comp_dict -keptoptions [list] + dict set class_comp_dict -keptoptions [list] } foreach opt $args { #puts stderr "KEEP!$opt!" if {[string range $opt 0 0] ne "-"} { - puts stderr "keepcomponentoption: option must begin with a \"-\"!" + puts stderr "keepcomponentoption: option must begin with a \"-\"!" return -code error } - if {[lsearch [dict get $class_comp_dict -keptoptions] $opt] < 0} { - dict lappend class_comp_dict -keptoptions $opt + if {[lsearch [dict get $class_comp_dict -keptoptions] $opt] < 0} { + dict lappend class_comp_dict -keptoptions $opt } } if {![info exists ::itcl::internal::component_objects([lindex [uplevel 1 info context] 1])]} { - set comp_object $::itcl::internal::component_objects([lindex [uplevel 1 info context] 1]) + set comp_object $::itcl::internal::component_objects([lindex [uplevel 1 info context] 1]) } else { - set comp_object "unknown_comp_obj_$comp!" + set comp_object "unknown_comp_obj_$comp!" } dict set class_info_dict $comp $class_comp_dict dict set ::itcl::internal::dicts::classComponents $my_class $class_info_dict @@ -529,11 +529,11 @@ proc getEclassOptions {args} { #parray ::itcl::internal::variables::${win}::itcl_options set result [list] foreach opt [array names ::itcl::internal::variables::${win}::itcl_options] { - if {[catch { - foreach {res cls def} [set ::itcl::internal::variables::${win}::__itcl_option_infos($opt)] break - lappend result [list $opt $res $cls $def [set ::itcl::internal::variables::${win}::itcl_options($opt)]] - } msg]} { - } + if {[catch { + foreach {res cls def} [set ::itcl::internal::variables::${win}::__itcl_option_infos($opt)] break + lappend result [list $opt $res $cls $def [set ::itcl::internal::variables::${win}::itcl_options($opt)]] + } msg]} { + } } return $result } @@ -543,18 +543,18 @@ proc eclassConfigure {args} { #puts stderr "+++ eclassConfigure!$args!" if {[llength $args] > 1} { - foreach {opt val} $args break - if {[::info exists ::itcl::internal::variables::${win}::itcl_options($opt)]} { - set ::itcl::internal::variables::${win}::itcl_options($opt) $val + foreach {opt val} $args break + if {[::info exists ::itcl::internal::variables::${win}::itcl_options($opt)]} { + set ::itcl::internal::variables::${win}::itcl_options($opt) $val return - } + } } else { - foreach {opt} $args break - if {[::info exists ::itcl::internal::variables::${win}::itcl_options($opt)]} { + foreach {opt} $args break + if {[::info exists ::itcl::internal::variables::${win}::itcl_options($opt)]} { #puts stderr "OP![set ::itcl::internal::variables::${win}::itcl_options($opt)]!" - foreach {res cls def} [set ::itcl::internal::variables::${win}::__itcl_option_infos($opt)] break - return [list $opt $res $cls $def [set ::itcl::internal::variables::${win}::itcl_options($opt)]] - } + foreach {res cls def} [set ::itcl::internal::variables::${win}::__itcl_option_infos($opt)] break + return [list $opt $res $cls $def [set ::itcl::internal::variables::${win}::itcl_options($opt)]] + } } return -code error } diff --git a/library/itclWidget.tcl b/library/itclWidget.tcl index 6f5f4ac0..daa5309c 100644 --- a/library/itclWidget.tcl +++ b/library/itclWidget.tcl @@ -39,21 +39,21 @@ namespace eval ::itcl::internal::commands { proc initWidgetOptions {varNsName widgetName className} { set myDict [set ::itcl::internal::dicts::classOptions] if {$myDict eq ""} { - return + return } if {![dict exists $myDict $className]} { - return + return } set myDict [dict get $myDict $className] foreach option [dict keys $myDict] { - set infos [dict get $myDict $option] + set infos [dict get $myDict $option] set resource [dict get $infos -resource] set class [dict get $infos -class] set value [::option get $widgetName $resource $class] if {$value eq ""} { if {[dict exists $infos -default]} { - set defaultValue [dict get $infos -default] - uplevel 1 set ${varNsName}::itcl_options($option) $defaultValue + set defaultValue [dict get $infos -default] + uplevel 1 set ${varNsName}::itcl_options($option) $defaultValue } } else { uplevel 1 set ${varNsName}::itcl_options($option) $value @@ -64,14 +64,14 @@ proc initWidgetOptions {varNsName widgetName className} { proc initWidgetDelegatedOptions {varNsName widgetName className args} { set myDict [set ::itcl::internal::dicts::classDelegatedOptions] if {$myDict eq ""} { - return + return } if {![dict exists $myDict $className]} { - return + return } set myDict [dict get $myDict $className] foreach option [dict keys $myDict] { - set infos [dict get $myDict $option] + set infos [dict get $myDict $option] if {![dict exists $infos -resource]} { # this is the case when delegating "*" continue @@ -89,7 +89,7 @@ proc initWidgetDelegatedOptions {varNsName widgetName className args} { set noOptionSet 0 foreach {optName optVal} $args { if {$optName eq $myOption} { - set noOptionSet 1 + set noOptionSet 1 break } } @@ -104,8 +104,8 @@ proc initWidgetDelegatedOptions {varNsName widgetName className args} { if {$value ne ""} { set compVar [namespace eval ${varNsName}${className} "set $component"] if {$compVar ne ""} { - uplevel 1 $compVar configure $myOption $value - } + uplevel 1 $compVar configure $myOption $value + } } } } @@ -117,20 +117,20 @@ proc widgetinitobjectoptions {varNsName widgetName className} { proc deletehull {newName oldName what} { if {$what eq "delete"} { - set name [namespace tail $newName] - regsub {hull[0-9]+} $name {} name - rename $name {} + set name [namespace tail $newName] + regsub {hull[0-9]+} $name {} name + rename $name {} } if {$what eq "rename"} { - set name [namespace tail $newName] - regsub {hull[0-9]+} $name {} name - rename $name {} + set name [namespace tail $newName] + regsub {hull[0-9]+} $name {} name + rename $name {} } } proc hullandoptionsinstall {objectName className widgetClass hulltype args} { if {$hulltype eq ""} { - set hulltype frame + set hulltype frame } set idx 0 set found 0 @@ -140,13 +140,13 @@ proc hullandoptionsinstall {objectName className widgetClass hulltype args} { set widgetClass $optValue break } - incr idx + incr idx } if {$found} { - set args [lreplace $args $idx [expr {$idx + 1}]] + set args [lreplace $args $idx [expr {$idx + 1}]] } if {$widgetClass eq ""} { - set widgetClass $className + set widgetClass $className set widgetClass [string totitle $widgetClass] } set cmd "set win $objectName; ::itcl::builtin::installhull using $hulltype -class $widgetClass $args" @@ -177,7 +177,7 @@ proc installhull {args} { set widgetName $win set varNsName $::itcl::internal::varNsName($widgetName) - set widgetType [lindex $args 1] + set widgetType [lindex $args 1] incr replace if {[llength $args] > 3 && [lindex $args 2] eq "-class"} { set classNam [lindex $args 3] @@ -194,7 +194,7 @@ proc installhull {args} { set i 0 set nam ::itcl::internal::widgets::hull while {1} { - incr i + incr i set hullNam ${nam}${i}$widgetName if {[::info command $hullNam] eq ""} { break @@ -216,27 +216,27 @@ proc installcomponent {args} { set myType [${className}::info types [namespace tail $className]] set isType 0 if {$myType ne ""} { - set isType 1 + set isType 1 } set numArgs [llength $args] set usage "usage: installcomponent using ?-option value ...?" if {$numArgs < 4} { - error $usage + error $usage } foreach {componentName using widgetType widgetPath} $args break set opts [lrange $args 4 end] if {$using ne "using"} { - error $usage + error $usage } if {!$isType} { - set hullExists [uplevel 1 ::info exists itcl_hull] - if {!$hullExists} { - error "cannot install \"$componentName\" before \"itcl_hull\" exists" - } - set hullVal [uplevel 1 set itcl_hull] - if {$hullVal eq ""} { - error "cannot install \"$componentName\" before \"itcl_hull\" exists" - } + set hullExists [uplevel 1 ::info exists itcl_hull] + if {!$hullExists} { + error "cannot install \"$componentName\" before \"itcl_hull\" exists" + } + set hullVal [uplevel 1 set itcl_hull] + if {$hullVal eq ""} { + error "cannot install \"$componentName\" before \"itcl_hull\" exists" + } } # check for delegated option and ask the option database for the values # first check for number of delegated options @@ -244,17 +244,17 @@ proc installcomponent {args} { set starOption 0 set myDict [set ::itcl::internal::dicts::classDelegatedOptions] if {[dict exists $myDict $className]} { - set myDict [dict get $myDict $className] + set myDict [dict get $myDict $className] foreach option [dict keys $myDict] { if {$option eq "*"} { - set starOption 1 + set starOption 1 } incr numOpts } } set myOptionDict [set ::itcl::internal::dicts::classOptions] if {[dict exists $myOptionDict $className]} { - set myOptionDict [dict get $myOptionDict $className] + set myOptionDict [dict get $myOptionDict $className] } set cmd [list $widgetPath configure] set cmd1 "set $componentName \[$widgetType $widgetPath\]" @@ -262,10 +262,10 @@ proc installcomponent {args} { if {$starOption} { upvar $componentName compName set cmd1 [list $compName configure] - set configInfos [uplevel 1 $cmd1] + set configInfos [uplevel 1 $cmd1] foreach entry $configInfos { if {[llength $entry] > 2} { - foreach {optName resource class defaultValue} $entry break + foreach {optName resource class defaultValue} $entry break set val "" catch { set val [::option get $win $resource $class] @@ -273,41 +273,41 @@ proc installcomponent {args} { if {$val ne ""} { set addOpt 1 if {[dict exists $myDict $$optName]} { - set addOpt 0 + set addOpt 0 } else { - set starDict [dict get $myDict "*"] + set starDict [dict get $myDict "*"] if {[dict exists $starDict -except]} { set exceptions [dict get $starDict -except] if {[lsearch $exceptions $optName] >= 0} { - set addOpt 0 + set addOpt 0 } } if {[dict exists $myOptionDict $optName]} { set addOpt 0 } - } + } if {$addOpt} { - lappend cmd $optName $val + lappend cmd $optName $val } } } - } + } } else { - foreach optName [dict keys $myDict] { + foreach optName [dict keys $myDict] { set optInfos [dict get $myDict $optName] set resource [dict get $optInfos -resource] set class [namespace tail $className] set class [string totitle $class] set val "" catch { - set val [::option get $win $resource $class] - } + set val [::option get $win $resource $class] + } if {$val ne ""} { if {[dict exists $optInfos -as] } { - set optName [dict get $optInfos -as] + set optName [dict get $optInfos -as] } lappend cmd $optName $val } @@ -335,14 +335,14 @@ proc hulltypes {args} { set numArgs [llength $args] if {$numArgs > 1} { - error "wrong # args should be: info hulltypes ??" + error "wrong # args should be: info hulltypes ??" } set pattern "" if {$numArgs > 0} { - set pattern [lindex $args 0] + set pattern [lindex $args 0] } if {$pattern ne ""} { - return [lsearch -all -inline -glob $hullTypes $pattern] + return [lsearch -all -inline -glob $hullTypes $pattern] } return $hullTypes @@ -351,28 +351,28 @@ proc hulltypes {args} { proc widgetclasses {args} { set numArgs [llength $args] if {$numArgs > 1} { - error "wrong # args should be: info widgetclasses ??" + error "wrong # args should be: info widgetclasses ??" } set pattern "" if {$numArgs > 0} { - set pattern [lindex $args 0] + set pattern [lindex $args 0] } set myDict [set ::itcl::internal::dicts::classes] if {![dict exists $myDict widget]} { - return [list] + return [list] } set myDict [dict get $myDict widget] set result [list] if {$pattern ne ""} { - foreach key [dict keys $myDict] { + foreach key [dict keys $myDict] { set myInfo [dict get $myDict $key] set value [dict get $myInfo -widget] if {[string match $pattern $value]} { - lappend result $value - } - } + lappend result $value + } + } } else { - foreach key [dict keys $myDict] { + foreach key [dict keys $myDict] { set myInfo [dict get $myDict $key] lappend result [dict get $myInfo -widget] } @@ -383,28 +383,28 @@ proc widgetclasses {args} { proc widgets {args} { set numArgs [llength $args] if {$numArgs > 1} { - error "wrong # args should be: info widgets ??" + error "wrong # args should be: info widgets ??" } set pattern "" if {$numArgs > 0} { - set pattern [lindex $args 0] + set pattern [lindex $args 0] } set myDict [set ::itcl::internal::dicts::classes] if {![dict exists $myDict widget]} { - return [list] + return [list] } set myDict [dict get $myDict widget] set result [list] if {$pattern ne ""} { - foreach key [dict keys $myDict] { + foreach key [dict keys $myDict] { set myInfo [dict get $myDict $key] set value [dict get $myInfo -name] if {[string match $pattern $value]} { - lappend result $value - } - } + lappend result $value + } + } } else { - foreach key [dict keys $myDict] { + foreach key [dict keys $myDict] { set myInfo [dict get $myDict $key] lappend result [dict get $myInfo -name] } @@ -415,28 +415,28 @@ proc widgets {args} { proc widgetadaptors {args} { set numArgs [llength $args] if {$numArgs > 1} { - error "wrong # args should be: info widgetadaptors ??" + error "wrong # args should be: info widgetadaptors ??" } set pattern "" if {$numArgs > 0} { - set pattern [lindex $args 0] + set pattern [lindex $args 0] } set myDict [set ::itcl::internal::dicts::classes] if {![dict exists $myDict widgetadaptor]} { - return [list] + return [list] } set myDict [dict get $myDict widgetadaptor] set result [list] if {$pattern ne ""} { - foreach key [dict keys $myDict] { + foreach key [dict keys $myDict] { set myInfo [dict get $myDict $key] set value [dict get $myInfo -name] if {[string match $pattern $value]} { - lappend result $value - } - } + lappend result $value + } + } } else { - foreach key [dict keys $myDict] { + foreach key [dict keys $myDict] { set myInfo [dict get $myDict $key] lappend result [dict get $myInfo -name] } diff --git a/releasenotes.txt b/releasenotes.txt index d769abb8..e5edae88 100644 --- a/releasenotes.txt +++ b/releasenotes.txt @@ -1,4 +1,4 @@ -This is the release 4.2.5 of Itcl. +This is the release 4.2.6 of Itcl. It is intended to be script compatible with Itcl 4.0.* and Itcl 3.4.* . It very likely presents the same public C interface as Itcl 4.0.* .