Itk - the [incr Tk] extension

Check-in [fc469d3c3b]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Repurpose the trunk for ongoing development of Itk 4.1.*.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:fc469d3c3b6ccf7365554ace2a3e21e6304621bc
User & Date: dgp 2017-07-28 17:04:52
Context
2018-06-13
19:12
Stop using obsolete [source -rsrc]. check-in: d40921fe23 user: stu tags: trunk
2017-07-28
17:04
Repurpose the trunk for ongoing development of Itk 4.1.*. check-in: fc469d3c3b user: dgp tags: trunk
16:57
Several revisions to get evaluation contexts more reliably correct. Closed-Leaf check-in: b46f3c3fe0 user: dgp tags: dgp-method-type
2017-07-07
18:21
Don't allow Itk 4.0.3 to bring in Itcl 4.1+, which will break it. check-in: 755afe01e1 user: dgp tags: trunk, itk-4-0-3
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to configure.

     1      1   #! /bin/sh
     2      2   # Guess values for system-dependent variables and create Makefiles.
     3         -# Generated by GNU Autoconf 2.69 for itk 4.0.3.
            3  +# Generated by GNU Autoconf 2.69 for itk 4.1.0.
     4      4   #
     5      5   #
     6      6   # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
     7      7   #
     8      8   #
     9      9   # This configure script is free software; the Free Software Foundation
    10     10   # gives unlimited permission to copy, distribute and modify it.
................................................................................
   573    573   subdirs=
   574    574   MFLAGS=
   575    575   MAKEFLAGS=
   576    576   
   577    577   # Identity of this package.
   578    578   PACKAGE_NAME='itk'
   579    579   PACKAGE_TARNAME='itk'
   580         -PACKAGE_VERSION='4.0.3'
   581         -PACKAGE_STRING='itk 4.0.3'
          580  +PACKAGE_VERSION='4.1.0'
          581  +PACKAGE_STRING='itk 4.1.0'
   582    582   PACKAGE_BUGREPORT=''
   583    583   PACKAGE_URL=''
   584    584   
   585    585   # Factoring default headers for most tests.
   586    586   ac_includes_default="\
   587    587   #include <stdio.h>
   588    588   #ifdef HAVE_SYS_TYPES_H
................................................................................
  1319   1319   #
  1320   1320   # Report the --help message.
  1321   1321   #
  1322   1322   if test "$ac_init_help" = "long"; then
  1323   1323     # Omit some internal or obsolete options to make the list less imposing.
  1324   1324     # This message is too long to be a string in the A/UX 3.1 sh.
  1325   1325     cat <<_ACEOF
  1326         -\`configure' configures itk 4.0.3 to adapt to many kinds of systems.
         1326  +\`configure' configures itk 4.1.0 to adapt to many kinds of systems.
  1327   1327   
  1328   1328   Usage: $0 [OPTION]... [VAR=VALUE]...
  1329   1329   
  1330   1330   To assign environment variables (e.g., CC, CFLAGS...), specify them as
  1331   1331   VAR=VALUE.  See below for descriptions of some of the useful variables.
  1332   1332   
  1333   1333   Defaults for the options are specified in brackets.
................................................................................
  1384   1384     --x-includes=DIR    X include files are in DIR
  1385   1385     --x-libraries=DIR   X library files are in DIR
  1386   1386   _ACEOF
  1387   1387   fi
  1388   1388   
  1389   1389   if test -n "$ac_init_help"; then
  1390   1390     case $ac_init_help in
  1391         -     short | recursive ) echo "Configuration of itk 4.0.3:";;
         1391  +     short | recursive ) echo "Configuration of itk 4.1.0:";;
  1392   1392      esac
  1393   1393     cat <<\_ACEOF
  1394   1394   
  1395   1395   Optional Features:
  1396   1396     --disable-option-checking  ignore unrecognized --enable/--with options
  1397   1397     --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  1398   1398     --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
................................................................................
  1488   1488       cd "$ac_pwd" || { ac_status=$?; break; }
  1489   1489     done
  1490   1490   fi
  1491   1491   
  1492   1492   test -n "$ac_init_help" && exit $ac_status
  1493   1493   if $ac_init_version; then
  1494   1494     cat <<\_ACEOF
  1495         -itk configure 4.0.3
         1495  +itk configure 4.1.0
  1496   1496   generated by GNU Autoconf 2.69
  1497   1497   
  1498   1498   Copyright (C) 2012 Free Software Foundation, Inc.
  1499   1499   This configure script is free software; the Free Software Foundation
  1500   1500   gives unlimited permission to copy, distribute and modify it.
  1501   1501   _ACEOF
  1502   1502     exit
................................................................................
  1853   1853     eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  1854   1854   
  1855   1855   } # ac_fn_c_check_header_mongrel
  1856   1856   cat >config.log <<_ACEOF
  1857   1857   This file contains any messages produced by compilers while
  1858   1858   running configure, to aid debugging if configure makes a mistake.
  1859   1859   
  1860         -It was created by itk $as_me 4.0.3, which was
         1860  +It was created by itk $as_me 4.1.0, which was
  1861   1861   generated by GNU Autoconf 2.69.  Invocation command line was
  1862   1862   
  1863   1863     $ $0 $@
  1864   1864   
  1865   1865   _ACEOF
  1866   1866   exec 5>>config.log
  1867   1867   {
................................................................................
  9981   9981   test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
  9982   9982   
  9983   9983   cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
  9984   9984   # Save the log message, to keep $0 and so on meaningful, and to
  9985   9985   # report actual input values of CONFIG_FILES etc. instead of their
  9986   9986   # values after options handling.
  9987   9987   ac_log="
  9988         -This file was extended by itk $as_me 4.0.3, which was
         9988  +This file was extended by itk $as_me 4.1.0, which was
  9989   9989   generated by GNU Autoconf 2.69.  Invocation command line was
  9990   9990   
  9991   9991     CONFIG_FILES    = $CONFIG_FILES
  9992   9992     CONFIG_HEADERS  = $CONFIG_HEADERS
  9993   9993     CONFIG_LINKS    = $CONFIG_LINKS
  9994   9994     CONFIG_COMMANDS = $CONFIG_COMMANDS
  9995   9995     $ $0 $@
................................................................................
 10034  10034   
 10035  10035   Report bugs to the package provider."
 10036  10036   
 10037  10037   _ACEOF
 10038  10038   cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 10039  10039   ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
 10040  10040   ac_cs_version="\\
 10041         -itk config.status 4.0.3
        10041  +itk config.status 4.1.0
 10042  10042   configured by $0, generated by GNU Autoconf 2.69,
 10043  10043     with options \\"\$ac_cs_config\\"
 10044  10044   
 10045  10045   Copyright (C) 2012 Free Software Foundation, Inc.
 10046  10046   This config.status script is free software; the Free Software Foundation
 10047  10047   gives unlimited permission to copy, distribute and modify it."
 10048  10048   

Changes to configure.in.

     6      6   
     7      7   #-----------------------------------------------------------------------
     8      8   # This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
     9      9   # set as provided.  These will also be added as -D defs in your Makefile
    10     10   # so you can encode the package version directly into the source files.
    11     11   #-----------------------------------------------------------------------
    12     12   
    13         -AC_INIT([itk], [4.0.3])
           13  +AC_INIT([itk], [4.1.0])
    14     14   
    15     15   #--------------------------------------------------------------------
    16     16   # Call TEA_INIT as the first TEA_ macro to set up initial vars.
    17     17   # This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
    18     18   # as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
    19     19   #--------------------------------------------------------------------
    20     20   

Changes to generic/itk.h.

    62     62   #endif
    63     63   #ifndef TCL_FINAL_RELEASE
    64     64   #   define TCL_FINAL_RELEASE	2
    65     65   #endif
    66     66   
    67     67   
    68     68   #define ITK_MAJOR_VERSION	4
    69         -#define ITK_MINOR_VERSION	0
           69  +#define ITK_MINOR_VERSION	1
    70     70   #define ITK_RELEASE_LEVEL	TCL_FINAL_RELEASE
    71         -#define ITK_RELEASE_SERIAL	3
           71  +#define ITK_RELEASE_SERIAL	0
    72     72   
    73         -#define ITK_VERSION		"4.0"
    74         -#define ITK_PATCH_LEVEL		"4.0.3"
           73  +#define ITK_VERSION		"4.1"
           74  +#define ITK_PATCH_LEVEL		"4.1.0"
    75     75   
    76     76   
    77     77   /*
    78     78    * A special definition used to allow this header file to be included
    79     79    * in resource files so that they can get obtain version information from
    80     80    * this file.  Resource compilers don't like all the C stuff, like typedefs
    81     81    * and procedure declarations, that occur below.

Changes to generic/itkArchBase.c.

   181    181       int pLevel = ITCL_PUBLIC;
   182    182   
   183    183       int newEntry;
   184    184       int result;
   185    185       CONST char *cmd;
   186    186       CONST char *token;
   187    187       CONST char *resultStr;
   188         -    Tcl_CallFrame frame;
   189    188       char *name;
   190    189       Tcl_Namespace *parserNs;
   191    190       ItclClass *contextClass;
   192    191       ItclClass *ownerClass;
   193    192       ItclObject *contextObj;
   194    193       ArchInfo *info;
   195    194       Tcl_Command accessCmd;
   196    195       Tcl_Obj *objPtr;
   197    196       Tcl_DString buffer;
   198         -    Tcl_CallFrame *uplevelFramePtr;
   199         -    Tcl_CallFrame *oldFramePtr = NULL;
   200         -    ItclObjectInfo *infoPtr;
   201         -    ItclCallContext *callContextPtr;
   202         -    Tcl_Namespace *ownerNsPtr;
   203    197   
   204    198       ItclShowArgs(1, "Itk_ArchCompAddCmd", objc, objv);
   205    199       /*
   206    200        *  Get the Archetype info associated with this widget.
   207    201        */
   208    202       contextClass = NULL;
   209    203       if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
................................................................................
   302    296           }
   303    297       }
   304    298   
   305    299       /*
   306    300        *  Execute the <createCmds> to create the component widget.
   307    301        *  Do this one level up, in the scope of the calling routine.
   308    302        */
   309         -    Itcl_SetCallFrameResolver(interp, contextClass->resolvePtr);
   310         -    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
   311         -    uplevelFramePtr = Itcl_GetUplevelCallFrame(interp, 1);
   312         -    oldFramePtr = Itcl_ActivateCallFrame(interp, uplevelFramePtr);
   313    303       result = Tcl_EvalObjEx(interp, objv[2], 0);
   314    304       if (result != TCL_OK) {
   315    305           goto compFail;
   316    306       }
   317    307   
   318    308       /*
   319    309        *  Take the result from the widget creation commands as the
................................................................................
   336    326           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   337    327              "cannot find component access command \"",
   338    328               path, "\" for component \"", name, "\"",
   339    329               (char*)NULL);
   340    330           goto compFail;
   341    331       }
   342    332   
   343         -    (void) Itcl_ActivateCallFrame(interp, oldFramePtr);
   344         -    oldFramePtr = NULL;
   345    333       winNamePtr = Tcl_NewStringObj((char*)NULL, 0);
   346    334       Tcl_GetCommandFullName(interp, accessCmd, winNamePtr);
   347    335       Tcl_IncrRefCount(winNamePtr);
   348    336   
   349    337   
   350    338       /*
   351    339        *  Create the component record.  Set the protection level
   352    340        *  according to the "-protected" or "-private" option.
   353    341        */
   354    342       ownerClass = contextClass;
   355         -    callContextPtr = Itcl_PeekStack(&infoPtr->contextStack);
   356         -    ownerNsPtr = callContextPtr->nsPtr;
   357         -    if (ownerNsPtr != NULL) {
   358         -        Tcl_HashEntry *hPtr;
   359         -	int idx = 2;
   360         -	if (Itcl_GetStackSize(&infoPtr->contextStack) == 1) {
   361         -	   idx = 1;
   362         -	}
   363         -        callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
   364         -	        Itcl_GetStackSize(&infoPtr->contextStack)-idx);
   365         -        hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses,
   366         -                (char *)callContextPtr->nsPtr);
   367         -        ownerClass = (ItclClass*)Tcl_GetHashValue(hPtr);
   368         -    }
   369    343   
   370    344       archComp = Itk_CreateArchComponent(interp, info, name, ownerClass,
   371    345               accessCmd);
   372    346   
   373    347       if (!archComp) {
   374    348           goto compFail;
   375    349       }
................................................................................
   413    387            *  Add a binding onto the new component, so that when its
   414    388            *  window is destroyed, it will automatically remove itself
   415    389            *  from its parent's component list.  Avoid doing these things
   416    390            *  for the "hull" component, since it is a special case and
   417    391            *  these things are not really necessary.
   418    392            */
   419    393           Tcl_DStringSetLength(&buffer, 0);
   420         -        Tcl_DStringAppend(&buffer, "bindtags ", -1);
          394  +        Tcl_DStringAppend(&buffer, "::bindtags ", -1);
   421    395           Tcl_DStringAppend(&buffer, path, -1);
   422    396           if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
   423    397               goto compFail;
   424    398           }
   425    399   
          400  +	/*
          401  +	 * NOTE: We need the [::itcl::code] because the itk_component
          402  +	 * method is protected.
          403  +	 */
          404  +
   426    405           Tcl_DStringSetLength(&buffer, 0);
   427         -        Tcl_DStringAppend(&buffer, "bind itk-destroy-", -1);
          406  +        Tcl_DStringAppend(&buffer, "::bind itk-destroy-", -1);
   428    407           Tcl_DStringAppend(&buffer, path, -1);
   429         -        Tcl_DStringAppend(&buffer, " <Destroy> [itcl::code ", -1);
          408  +        Tcl_DStringAppend(&buffer, " <Destroy> [::itcl::code ", -1);
   430    409   
   431    410           Tcl_DStringAppend(&buffer,
   432    411               Tcl_GetStringFromObj(objNamePtr,(int*)NULL), -1);
   433    412   
   434    413           Tcl_DStringAppend(&buffer, " itk_component delete ", -1);
   435    414           Tcl_DStringAppend(&buffer, name, -1);
   436    415           Tcl_DStringAppend(&buffer, "]\n", -1);
   437         -        Tcl_DStringAppend(&buffer, "bindtags ", -1);
          416  +        Tcl_DStringAppend(&buffer, "::bindtags ", -1);
   438    417           Tcl_DStringAppend(&buffer, path, -1);
   439    418           Tcl_DStringAppend(&buffer, " {itk-destroy-", -1);
   440    419           Tcl_DStringAppend(&buffer, path, -1);
   441    420           Tcl_DStringAppend(&buffer, " ", -1);
   442    421           Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
   443    422           Tcl_DStringAppend(&buffer, "}", -1);
          423  +
   444    424           if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
   445    425               goto compFail;
   446    426           }
   447    427       }
   448    428   
   449    429       /*
   450    430        *  Query the list of configuration options for this widget,
................................................................................
   500    480       if (objc != 4) {
   501    481           objPtr = Tcl_NewStringObj("usual", -1);
   502    482           Tcl_IncrRefCount(objPtr);
   503    483       } else {
   504    484           objPtr = objv[3];
   505    485       }
   506    486   
   507         -    result = Itcl_PushCallFrame(interp, &frame, parserNs,
   508         -            /* isProcCallFrame */ 0);
   509         -
   510         -    if (result == TCL_OK) {
   511         -        result = Tcl_EvalObj(interp, objPtr);
   512         -        Itcl_PopCallFrame(interp);
   513         -    }
          487  +    Tcl_Eval(interp, "::namespace path [::lreplace [::namespace path] end+1 end ::itk::option-parser]");
          488  +    result = Tcl_EvalObj(interp, objPtr);
          489  +    Tcl_Eval(interp, "::namespace path [::lrange [::namespace path] 0 end-1]");
   514    490   
   515    491       if (objc != 4) {
   516    492           Tcl_DecrRefCount(objPtr);
   517    493       }
   518    494       if (result != TCL_OK) {
   519    495           goto compFail;
   520    496       }
................................................................................
   543    519       Tcl_SetResult(interp, name, TCL_VOLATILE);
   544    520       return TCL_OK;
   545    521   
   546    522       /*
   547    523        *  If any errors were encountered, clean up and return.
   548    524        */
   549    525   compFail:
   550         -    if (oldFramePtr) {
   551         -	(void) Itcl_ActivateCallFrame(interp, oldFramePtr);
   552         -    }
   553    526       if (archComp) {
   554    527           Itk_DelArchComponent(archComp);
   555    528       }
   556    529       if (entry) {
   557    530           Tcl_DeleteHashEntry(entry);
   558    531       }
   559    532       if (path) {
................................................................................
   673    646   
   674    647          /*
   675    648           *  Clean up the binding tag that causes the widget to
   676    649           *  call this method automatically when destroyed.
   677    650           *  Ignore errors if anything goes wrong.
   678    651           */
   679    652           Tcl_DStringInit(&buffer);
   680         -        Tcl_DStringAppend(&buffer, "itk::remove_destroy_hook ", -1);
          653  +        Tcl_DStringAppend(&buffer, "::itk::remove_destroy_hook ", -1);
   681    654           Tcl_DStringAppend(&buffer, archComp->pathName, -1);
   682    655           (void) Tcl_Eval(interp, Tcl_DStringValue(&buffer));
   683    656           Tcl_ResetResult(interp);
   684    657           Tcl_DStringFree(&buffer);
   685    658   
   686    659           Tcl_UnsetVar2(interp, "itk_component", token, 0);
   687    660           Tcl_DeleteHashEntry(entry);
................................................................................
  1606   1579       Tcl_Interp *interp,        /* interpreter managing the class */
  1607   1580       ItclObject *contextObj,    /* itcl object being configured */
  1608   1581       ClientData cdata,          /* command prefix to use for configuration */
  1609   1582       CONST char *newval)        /* new value for this option */
  1610   1583   {
  1611   1584       ItclVariable *ivPtr = (ItclVariable*)cdata;
  1612   1585   
  1613         -    Tcl_CallFrame frame;
  1614         -    int result;
         1586  +    int result = TCL_OK;
  1615   1587       CONST char *val;
  1616   1588       ItclMemberCode *mcode;
  1617   1589   
  1618   1590       /*
  1619   1591        *  Update the public variable with the new option value.
  1620   1592        *  There should already be a call frame installed for handling
  1621   1593        *  instance variables, but make sure that the namespace context
  1622   1594        *  is the most-specific class, so that the public variable can
  1623   1595        *  be found.
  1624   1596        */
  1625         -    result = Itcl_PushCallFrame(interp, &frame, contextObj->iclsPtr->nsPtr,
  1626         -            /*isProcCallFrame*/0);
  1627   1597   
  1628   1598       if (result == TCL_OK) {
  1629   1599   	/*
  1630   1600   	 * Casting away CONST of newval only to satisfy Tcl 8.3 and
  1631   1601   	 * earlier headers.
  1632   1602   	 */
         1603  +
         1604  +#if 1
         1605  +	val = ItclSetInstanceVar(interp, Tcl_GetString(ivPtr->fullNamePtr),
         1606  +		NULL, newval, contextObj, ivPtr->iclsPtr);
         1607  +#else
  1633   1608           val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), (char *) NULL,
  1634   1609               (char *) newval, TCL_LEAVE_ERR_MSG);
         1610  +#endif
  1635   1611   
  1636   1612           if (!val) {
  1637   1613               result = TCL_ERROR;
  1638   1614           }
  1639         -        Itcl_PopCallFrame(interp);
  1640   1615       }
  1641   1616   
  1642   1617       if (result != TCL_OK) {
  1643   1618           char msg[256];
  1644   1619           sprintf(msg, "\n    (error in configuration of public variable \"%.100s\")", Tcl_GetString(ivPtr->fullNamePtr));
  1645   1620           Tcl_AddErrorInfo(interp, msg);
  1646   1621           return TCL_ERROR;
................................................................................
  1650   1625        *  If this variable has some "config" code, invoke it now.
  1651   1626        *
  1652   1627        *  NOTE:  Invoke the "config" code in the class scope
  1653   1628        *    containing the data member.
  1654   1629        */
  1655   1630       mcode = ivPtr->codePtr;
  1656   1631       if (mcode && mcode->bodyPtr) {
  1657         -        Tcl_Namespace *saveNsPtr;
  1658         -        Itcl_SetCallFrameResolver(interp, ivPtr->iclsPtr->resolvePtr);
  1659         -        saveNsPtr = Tcl_GetCurrentNamespace(interp);
  1660         -        Itcl_SetCallFrameNamespace(interp, ivPtr->iclsPtr->nsPtr);
         1632  +	Tcl_CallFrame frame;
         1633  +
         1634  +	Itcl_PushCallFrame(interp, &frame, ivPtr->iclsPtr->nsPtr, 1);
         1635  +	Itcl_SetContext(interp, contextObj);
         1636  +
  1661   1637           result = Tcl_EvalObjEx(interp, mcode->bodyPtr, 0);
  1662         -        Itcl_SetCallFrameNamespace(interp, saveNsPtr);
         1638  +
         1639  +	Itcl_UnsetContext(interp);
         1640  +	Itcl_PopCallFrame(interp);
  1663   1641   
  1664   1642           if (result == TCL_OK) {
  1665   1643               Tcl_ResetResult(interp);
  1666   1644           } else {
  1667   1645               char msg[256];
  1668   1646               sprintf(msg, "\n    (error in configuration of public variable \"%.100s\")", Tcl_GetString(ivPtr->fullNamePtr));
  1669   1647               Tcl_AddErrorInfo(interp, msg);
................................................................................
  1755   1733       CONST char *v; 
  1756   1734       char *lastval;
  1757   1735       Tcl_HashEntry *entry;
  1758   1736       ArchOption *archOpt;
  1759   1737       Itcl_ListElem *part;
  1760   1738       ArchOptionPart *optPart;
  1761   1739       Itcl_InterpState istate;
         1740  +    ItclClass *iclsPtr;
         1741  +    ItclObject *ioPtr;
  1762   1742   
  1763   1743       /*
  1764   1744        *  Query the "itk_option" array to get the current setting.
  1765   1745        */
  1766   1746       entry = Tcl_FindHashEntry(&info->options, name);
  1767   1747       if (!entry) {
  1768   1748           /* Bug 227876
................................................................................
  1773   1753           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1774   1754               "unknown option \"", name, "\"",
  1775   1755               (char*)NULL);
  1776   1756           return TCL_ERROR;
  1777   1757       }
  1778   1758       archOpt = (ArchOption*)Tcl_GetHashValue(entry);
  1779   1759   
         1760  +#if 0
  1780   1761       v = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
         1762  +#else
         1763  +    Itcl_GetContext(interp, &iclsPtr, &ioPtr);
         1764  +
         1765  +    v = ItclGetInstanceVar(interp, "itk_option", archOpt->switchName,
         1766  +	    ioPtr, iclsPtr);
         1767  +#endif
         1768  +
  1781   1769       if (v) {
  1782   1770           lastval = (char*)ckalloc((unsigned)(strlen(v)+1));
  1783   1771           strcpy(lastval, v);
  1784   1772       } else {
  1785   1773           lastval = NULL;
  1786   1774       }
  1787   1775   
  1788   1776       /*
  1789   1777        *  Update the "itk_option" array with the new setting.
  1790   1778        */
         1779  +#if 0
  1791   1780       if (!Tcl_SetVar2(interp, "itk_option", archOpt->switchName, value, 0)) {
         1781  +#else
         1782  +    if (!ItclSetInstanceVar(interp, "itk_option", archOpt->switchName, value,
         1783  +	    ioPtr, iclsPtr)) {
         1784  +#endif
  1792   1785           Itk_ArchOptAccessError(interp, info, archOpt);
  1793   1786           result = TCL_ERROR;
  1794   1787           goto configDone;
  1795   1788       }
  1796   1789   
  1797   1790       /*
  1798   1791        *  Scan through all option parts to handle the new setting.
................................................................................
  1816   1809        *  If the option configuration failed, then set the option
  1817   1810        *  back to its previous settings.  Scan back through all of
  1818   1811        *  the option parts and sync them up with the old value.
  1819   1812        */
  1820   1813       if (result == TCL_ERROR) {
  1821   1814           istate = Itcl_SaveInterpState(interp, result);
  1822   1815   
         1816  +#if 0
  1823   1817           Tcl_SetVar2(interp, "itk_option", archOpt->switchName, lastval, 0);
         1818  +#else
         1819  +	ItclSetInstanceVar(interp, "itk_option", archOpt->switchName, lastval,
         1820  +	    ioPtr, iclsPtr);
         1821  +#endif
  1824   1822   
  1825   1823           part = Itcl_FirstListElem(&archOpt->parts);
  1826   1824           while (part) {
  1827   1825               optPart = (ArchOptionPart*)Itcl_GetListValue(part);
  1828   1826               (*optPart->configProc)(interp, info->itclObj,
  1829   1827                   optPart->clientData, lastval);
  1830   1828   
................................................................................
  2122   2120       Tcl_Interp *interp,            /* interpreter managing the object */
  2123   2121       ArchInfo *info,                /* info for Archetype mega-widget */
  2124   2122       ArchOption *archOpt,           /* option to initialize */
  2125   2123       CONST char *defVal,            /* last-resort default value */
  2126   2124       char *currVal)                 /* current option value */
  2127   2125   {
  2128   2126       CONST char *init = NULL;
  2129         -
  2130         -    Tcl_CallFrame frame;
  2131         -    int result;
  2132   2127       CONST char *ival;
  2133   2128       char c;
  2134   2129   
  2135   2130       /*
  2136   2131        *  If the option is already initialized, then abort.
  2137   2132        */
  2138   2133       if (archOpt->init) {
................................................................................
  2165   2160           (c == 's' && strcmp(archOpt->switchName,"-screen") == 0) ||
  2166   2161           (c == 'v' && strcmp(archOpt->switchName,"-visual") == 0)) {
  2167   2162           ival = currVal;
  2168   2163       } else {
  2169   2164           ival = init;
  2170   2165       }
  2171   2166   
  2172         -    /*
  2173         -     *  Set the initial value in the itk_option array.
  2174         -     *  Since this might be called from the itk::option-parser
  2175         -     *  namespace, reinstall the object context.
  2176         -     */
  2177         -    result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0);
  2178         -
  2179         -    if (result == TCL_OK) {
  2180         -	/*
  2181         -	 * Casting away CONST of ival only to satisfy Tcl 8.3 and
  2182         -	 * earlier headers.
  2183         -	 */
  2184         -        Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
         2167  +    Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
  2185   2168               (char *)((ival) ? ival : ""), 0);
  2186         -    Itcl_PopCallFrame(interp);
  2187         -    }
  2188   2169   
  2189   2170       if (ival) {
  2190   2171           archOpt->init = (char*)ckalloc((unsigned)(strlen(ival)+1));
  2191   2172           strcpy(archOpt->init, ival);
  2192   2173       }
  2193   2174   }
  2194   2175   
................................................................................
  2300   2281       char *resClass,                  /* resource class name in X11 database */
  2301   2282       CONST char *defVal,              /* last-resort default value */
  2302   2283       char *currVal,                   /* current value (or NULL) */
  2303   2284       ArchOptionPart *optPart,         /* part to be added in */
  2304   2285       ArchOption **raOpt)              /* returns: option containing new part */
  2305   2286   {
  2306   2287       CONST char *init = NULL;
  2307         -
  2308         -    Tcl_CallFrame frame;
  2309   2288       int result;
  2310   2289       ArchOption *archOpt;
         2290  +    Itcl_ListElem *elemPtr;
  2311   2291   
  2312   2292       *raOpt = NULL;
  2313   2293       archOpt = NULL;
  2314   2294   
  2315   2295       /*
  2316   2296        *  Find or create a composite option for the mega-widget.
  2317   2297        */
................................................................................
  2324   2304   
  2325   2305       /*
  2326   2306        *  Add the option part to the composite option.  If the
  2327   2307        *  composite option has already been configured, then
  2328   2308        *  simply update this part to the current value.  Otherwise,
  2329   2309        *  leave the configuration to Itk_ArchInitCmd().
  2330   2310        */
  2331         -    Itcl_AppendList(&archOpt->parts, (ClientData)optPart);
         2311  +    elemPtr = Itcl_AppendList(&archOpt->parts, (ClientData)optPart);
  2332   2312   
  2333   2313       if ((archOpt->flags & ITK_ARCHOPT_INIT) != 0) {
  2334   2314   
  2335         -        result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0);
  2336         -
  2337   2315           if (result == TCL_OK) {
  2338   2316               init = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
  2339         -            Itcl_PopCallFrame(interp);
  2340   2317           }
  2341   2318   
  2342   2319           if (!init) {
  2343   2320               Itk_ArchOptAccessError(interp, info, archOpt);
         2321  +	    Itcl_DeleteListElem(elemPtr);
  2344   2322               return TCL_ERROR;
  2345   2323           }
  2346   2324   
  2347   2325           if (!currVal || (strcmp(init,currVal) != 0)) {
  2348   2326               result  = (*optPart->configProc)(interp, info->itclObj,
  2349   2327                   optPart->clientData, init);
  2350   2328   
  2351   2329               if (result != TCL_OK) {
  2352   2330                   Itk_ArchOptConfigError(interp, info, archOpt);
         2331  +		Itcl_DeleteListElem(elemPtr);
  2353   2332                   return TCL_ERROR;
  2354   2333               }
  2355   2334           }
  2356   2335       }
  2357   2336   
  2358   2337       *raOpt = archOpt;
  2359   2338       return TCL_OK;

Changes to generic/itkArchetype.c.

    62     62   struct NameProcMap { const char *name; Tcl_ObjCmdProc *proc; };
    63     63   
    64     64   /*
    65     65    * List of commands that are used to implement the [info object] subcommands.
    66     66    */
    67     67   
    68     68   static const struct NameProcMap archetypeCmds[] = {
    69         -    { "::itcl::builtin::Archetype::cget", Itk_ArchCgetCmd },
    70         -    { "::itcl::builtin::Archetype::component", Itk_ArchCompAccessCmd },
    71         -    { "::itcl::builtin::Archetype::configure", Itk_ArchConfigureCmd },
    72     69       { "::itcl::builtin::Archetype::delete", Itk_ArchDeleteOptsCmd },
    73     70       { "::itcl::builtin::Archetype::init", Itk_ArchInitOptsCmd },
    74         -    { "::itcl::builtin::Archetype::itk_component", Itk_ArchComponentCmd },
    75         -    { "::itcl::builtin::Archetype::itk_initialize", Itk_ArchInitCmd },
    76         -    { "::itcl::builtin::Archetype::itk_option", Itk_ArchOptionCmd },
    77     71       { NULL, NULL }
    78     72   };
    79     73   
    80     74   
    81     75   /*
    82     76    * ------------------------------------------------------------------------
    83     77    *  Itk_ArchetypeInit()
................................................................................
   422    416   
   423    417       ItclShowArgs(2, "Itk_ArchComponentCmd", objc, objv);
   424    418       /*
   425    419        *  Check arguments and handle the various options...
   426    420        */
   427    421       cmd = Tcl_GetString(objv[0]);
   428    422       Itcl_ParseNamespPath(cmd, &buffer, &head, &tail);
   429         -    Tcl_DStringFree(&buffer);
   430    423       if (objc < 2) {
   431    424           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   432    425               "wrong # args: should be one of...\n",
   433    426               "  ", tail, " add ?-protected? ?-private? ?--? name createCmds ?optionCmds?\n",
   434    427               "  ", tail, " delete name ?name name...?",
   435    428               (char*)NULL);
          429  +	Tcl_DStringFree(&buffer);
   436    430           return TCL_ERROR;
   437    431       }
   438    432   
   439    433       token = Tcl_GetString(objv[1]);
   440    434       c = *token;
   441    435       length = strlen(token);
   442    436   
................................................................................
   447    441           if (objc < 4) {
   448    442               Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   449    443                   "wrong # args: should be \"",
   450    444                   tail,
   451    445   		" add ?-protected? ?-private? ?--?",
   452    446   		" name createCmds ?optionCmds?\"",
   453    447                   (char*)NULL);
          448  +	    Tcl_DStringFree(&buffer);
   454    449               return TCL_ERROR;
   455    450           }
          451  +	Tcl_DStringFree(&buffer);
   456    452           return Itk_ArchCompAddCmd(dummy, interp, objc-1, objv+1);
   457    453       } else {
   458    454   
   459    455           /*
   460    456            *  Handle:  itk_component delete...
   461    457            */
   462    458           if (c == 'd' && strncmp(token, "delete", length) == 0) {
   463    459               if (objc < 3) {
   464    460                   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   465    461                       "wrong # args: should be \"",
   466    462                       tail,
   467    463   		    " delete name ?name name...?\"",
   468    464                       (char*)NULL);
          465  +		    Tcl_DStringFree(&buffer);
   469    466                   return TCL_ERROR;
   470    467               }
          468  +	    Tcl_DStringFree(&buffer);
   471    469               return Itk_ArchCompDeleteCmd(dummy, interp, objc-1, objv+1);
   472    470           }
   473    471       }
          472  +    Tcl_DStringFree(&buffer);
   474    473   
   475    474       /*
   476    475        *  Flag any errors.
   477    476        */
   478    477       cmd = Tcl_GetStringFromObj(objv[0], (int*)NULL);
   479    478       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   480    479           "bad option \"", token,
................................................................................
   525    524       Itcl_ListElem *part;
   526    525       ArchOption *archOpt;
   527    526       ArchOptionPart *optPart;
   528    527       ItclHierIter hier;
   529    528       ItclVariable *ivPtr;
   530    529       Tcl_HashSearch place;
   531    530       Tcl_HashEntry *entry;
   532         -    ItclObjectInfo *infoPtr;
   533         -    ItclCallContext *callContextPtr;
   534         -    Tcl_HashEntry *hPtr;
   535    531   
   536    532       ItclShowArgs(2, "Itk_ArchInitCmd", objc, objv);
   537    533       contextClass = NULL;
   538    534       if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
   539    535           !contextObj) {
   540    536   
   541    537           token = Tcl_GetString(objv[0]);
................................................................................
   543    539           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   544    540               "improper usage: should be \"object ",
   545    541               token, " ?-option value -option value...?\"",
   546    542               (char*)NULL);
   547    543           return TCL_ERROR;
   548    544       }
   549    545   
   550         -    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
   551         -            ITCL_INTERP_DATA, NULL);
   552    546       if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
   553    547           return TCL_ERROR;
   554    548       }
   555    549   
   556    550       /*
   557    551        *  See what class is being initialized by getting the namespace
   558    552        *  for the calling context.
   559    553        */
   560         -    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
   561         -    callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
   562         -            Itcl_GetStackSize(&infoPtr->contextStack)-2);
   563         -    hPtr = Tcl_FindHashEntry(
   564         -            &callContextPtr->ioPtr->iclsPtr->infoPtr->namespaceClasses,
   565         -            (char *)callContextPtr->nsPtr);
   566         -    if (hPtr != NULL) {
   567         -        contextClass = (ItclClass *)Tcl_GetHashValue(hPtr);
   568         -    }
   569         -
   570    554   
   571    555       /*
   572    556        *  Integrate all public variables for the current class
   573    557        *  context into the composite option list.
   574    558        */
   575    559       Itcl_InitHierIter(&hier, contextClass);
   576    560       while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
................................................................................
   863    847       Tcl_HashSearch place;
   864    848       ArchInfo *info;
   865    849       ArchComponent *archComp;
   866    850       int cmdlinec;
   867    851       Tcl_Obj *objPtr;
   868    852       Tcl_Obj *cmdlinePtr;
   869    853       Tcl_Obj **cmdlinev;
   870         -    ItclObjectInfo *infoPtr;
   871    854   
   872    855       ItclShowArgs(2, "Itk_ArchCompAccessCmd", objc, objv);
   873    856       contextClass = NULL;
   874    857       if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
   875    858           !contextObj) {
   876    859   
   877    860           token = Tcl_GetString(objv[0]);
................................................................................
   883    866           return TCL_ERROR;
   884    867       }
   885    868   
   886    869       if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
   887    870           return TCL_ERROR;
   888    871       }
   889    872   
   890         -    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
   891         -            ITCL_INTERP_DATA, NULL);
   892         -    if (Itcl_GetStackSize(&infoPtr->contextStack) == 1) {
   893         -        callingNs = Tcl_GetGlobalNamespace(interp);
   894         -    } else {
   895         -	ItclCallContext *callContextPtr;
   896         -	callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
   897         -	        Itcl_GetStackSize(&infoPtr->contextStack)-2);
   898         -#ifdef NOTDEF
   899         -        callingNs = (Tcl_Namespace *)Itcl_GetStackValue(
   900         -	        &infoPtr->namespaceStack,
   901         -		Itcl_GetStackSize(&infoPtr->namespaceStack)-2);
   902         -#endif
   903         -        callingNs = callContextPtr->nsPtr;
   904         -    }
          873  +    callingNs = Tcl_GetCurrentNamespace(interp);
          874  +
   905    875       /*
   906    876        *  With no arguments, return a list of components that can be
   907    877        *  accessed from the calling scope.
   908    878        */
   909    879       if (objc == 2) {
   910    880   	/* if the name of the component is the empty string ignore that arg */
   911    881           if (strlen(Tcl_GetString(objv[1])) == 0) {
................................................................................
   957    927       }
   958    928   
   959    929       /*
   960    930        *  If only the component name is specified, then return the
   961    931        *  window name for this component.
   962    932        */
   963    933       if (objc == 2) {
   964         -	Tcl_Obj *objPtr;
   965         -	Tcl_DString buffer;
   966         -	Tcl_Namespace *nsPtr;
   967         -	Tcl_CallFrame frame;
   968         -	objPtr = Tcl_NewObj();
   969         -	Tcl_GetCommandFullName(interp, archComp->accessCmd, objPtr);
   970         -	Tcl_IncrRefCount(objPtr);
   971         -	Tcl_DStringInit(&buffer);
   972         -	Tcl_DStringAppend(&buffer, ITCL_VARIABLES_NAMESPACE, -1);
   973         -	Tcl_DStringAppend(&buffer, Tcl_GetString(objPtr), -1);
   974         -	Tcl_DecrRefCount(objPtr);
   975         -	Tcl_DStringAppend(&buffer, archComp->iclsPtr->nsPtr->fullName, -1);
   976         -	nsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buffer), NULL, 0);
   977         -	Itcl_PushCallFrame(interp, &frame, nsPtr, /*isProcCallFrame*/0);
          934  +
          935  +	/*
          936  + 	 * This is moderately ugly.  We want to resolve the instance
          937  + 	 * variable "itk_component".  We have the contextObj context,
          938  + 	 * but the only way to make that context control variable
          939  + 	 * resolution is to force the context namespace to be the class
          940  + 	 * namespace of the contextObj, while at the same time, not
          941  + 	 * pushing any frame, so that the same contextObj context is
          942  + 	 * still in force, when that custom resolver attached to that
          943  + 	 * namespace finally gets the chance to resolve.
          944  + 	 *
          945  + 	 * Instance variable resolution, even (especially?) in C code,
          946  + 	 * shouldn't need quite so many contortions.
          947  + 	 */
          948  +
          949  +	Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
          950  +
          951  +	Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
   978    952           val = Tcl_GetVar2(interp, "itk_component", token, 0);
   979         -	Tcl_DStringFree(&buffer);
   980         -	Itcl_PopCallFrame(interp);
          953  +	Itcl_SetCallFrameNamespace(interp, save);
   981    954           if (!val) {
   982    955               Tcl_ResetResult(interp);
   983    956               Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   984    957                   "internal error: cannot access itk_component(", token, ")",
   985    958                   (char*)NULL);
   986    959   
   987    960               if (contextObj->accessCmd) {
................................................................................
  1091   1064       }
  1092   1065       ItclShowArgs(1, "Itk_ArchConfigureCmd2", objc, objv);
  1093   1066       if (objc == 1) {
  1094   1067           Tcl_DStringInit(&buffer);
  1095   1068   
  1096   1069           for (i=0; i < info->order.len; i++) {
  1097   1070               archOpt = (ArchOption*)Tcl_GetHashValue(info->order.list[i]);
  1098         -            val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
         1071  +
         1072  +	    val = ItclGetInstanceVar(interp, "itk_option", archOpt->switchName,
         1073  +		    contextObj, contextClass);
  1099   1074               if (!val) {
  1100   1075                   Itk_ArchOptAccessError(interp, info, archOpt);
  1101   1076                   Tcl_DStringFree(&buffer);
  1102   1077                   return TCL_ERROR;
  1103   1078               }
  1104   1079   
  1105   1080               Tcl_DStringStartSublist(&buffer);
................................................................................
  1130   1105                   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1131   1106                       "unknown option \"", token, "\"",
  1132   1107                       (char*)NULL);
  1133   1108                   return TCL_ERROR;
  1134   1109               }
  1135   1110   
  1136   1111               archOpt = (ArchOption*)Tcl_GetHashValue(entry);
  1137         -            val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
         1112  +
         1113  +	    val = ItclGetInstanceVar(interp, "itk_option", archOpt->switchName,
         1114  +		    contextObj, contextClass);
  1138   1115               if (!val) {
  1139   1116                   Itk_ArchOptAccessError(interp, info, archOpt);
  1140   1117                   return TCL_ERROR;
  1141   1118               }
  1142   1119   
  1143   1120               Tcl_AppendElement(interp, archOpt->switchName);
  1144   1121               Tcl_AppendElement(interp,
................................................................................
  1154   1131   
  1155   1132       /*
  1156   1133        *  Otherwise, it must be a series of "-option value" assignments.
  1157   1134        *  Look up each option and assign the new value.
  1158   1135        */
  1159   1136       for (objc--,objv++; objc > 0; objc-=2, objv+=2) {
  1160   1137   	char *value;
         1138  +	int code;
         1139  +//	Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
  1161   1140           token = Tcl_GetString(objv[0]);
  1162   1141           if (objc < 2) {
  1163   1142               Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1164   1143                   "value for \"", token, "\" missing",
  1165   1144                   (char*)NULL);
  1166   1145               return TCL_ERROR;
  1167   1146           }
  1168   1147           value = Tcl_GetString(objv[1]);
  1169   1148   
  1170         -        if (Itk_ArchConfigOption(interp, info, token, value) != TCL_OK) {
         1149  +//	Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
         1150  +        code = Itk_ArchConfigOption(interp, info, token, value);
         1151  +//	Itcl_SetCallFrameNamespace(interp, save);
         1152  +        if (code != TCL_OK) {
  1171   1153               return TCL_ERROR;
  1172   1154           }
  1173   1155       }
  1174   1156   
  1175   1157       Tcl_ResetResult(interp);
  1176   1158       return TCL_OK;
  1177   1159   }
................................................................................
  1199   1181       CONST char *token;
  1200   1182       CONST char *val;
  1201   1183       ItclClass *contextClass;
  1202   1184       ItclObject *contextObj;
  1203   1185       ArchInfo *info;
  1204   1186       Tcl_HashEntry *entry;
  1205   1187       ArchOption *archOpt;
         1188  +    Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
  1206   1189   
  1207   1190       ItclShowArgs(2, "Itk_ArchCgetCmd", objc, objv);
  1208   1191       contextClass = NULL;
  1209   1192       if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
  1210   1193           !contextObj) {
  1211   1194   
  1212   1195           token = Tcl_GetString(objv[0]);
................................................................................
  1235   1218           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1236   1219               "unknown option \"", token, "\"",
  1237   1220               (char*)NULL);
  1238   1221           return TCL_ERROR;
  1239   1222       }
  1240   1223   
  1241   1224       archOpt = (ArchOption*)Tcl_GetHashValue(entry);
         1225  +    Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
  1242   1226       val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
         1227  +    Itcl_SetCallFrameNamespace(interp, save);
  1243   1228       if (!val) {
  1244   1229           Itk_ArchOptAccessError(interp, info, archOpt);
  1245   1230           return TCL_ERROR;
  1246   1231       }
  1247   1232   
  1248   1233       /*
  1249   1234        * Casting away CONST is safe because TCL_VOLATILE guarantees
  1250   1235        * CONST treatment.
  1251   1236        */
  1252   1237       Tcl_SetResult(interp, (char *) val, TCL_VOLATILE);
  1253   1238       return TCL_OK;
  1254   1239   }

Changes to generic/itkBase.c.

   120    120   
   121    121       if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
   122    122         return TCL_ERROR;
   123    123       }
   124    124       if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {
   125    125   	return TCL_ERROR;
   126    126       };
   127         -    if (Itcl_InitStubs(interp, "4.0-4.1", 0) == NULL) {
          127  +    if (Itcl_InitStubs(interp, "4.1", 0) == NULL) {
   128    128   	return TCL_ERROR;
   129    129       }
   130    130   
   131    131       /*
   132    132        *  Add the "itk_option" ensemble to the itcl class definition parser.
   133    133        */
   134    134       parserNs = Tcl_FindNamespace(interp, "::itcl::parser",

Changes to generic/itkOption.c.

   213    213       ItclObject *contextObj,    /* object being configured */
   214    214       ClientData cdata,          /* class option */
   215    215       CONST char *newval)        /* new value for this option */
   216    216   {
   217    217       ItkClassOption *opt = (ItkClassOption*)cdata;
   218    218       int result = TCL_OK;
   219    219       ItclMemberCode *mcode;
          220  +    Tcl_CallFrame frame;
   220    221   
   221    222       /*
   222    223        *  If the option has any config code, execute it now.
   223    224        *  Make sure that the namespace context is set up correctly.
   224    225        */
   225    226       mcode = opt->codePtr;
   226    227       if (mcode && mcode->bodyPtr) {
   227         -        Tcl_Namespace *saveNsPtr;
   228         -//fprintf(stderr, "EXE!%s!\n", Tcl_GetString(mcode->bodyPtr));
   229         -        Itcl_SetCallFrameResolver(interp, opt->iclsPtr->resolvePtr);
   230         -        saveNsPtr = Tcl_GetCurrentNamespace(interp);
   231         -//fprintf(stderr, "MCNS!%s!\n", saveNsPtr->fullName);
   232         -        Itcl_SetCallFrameNamespace(interp, opt->iclsPtr->nsPtr);
          228  +
          229  +	Itcl_PushCallFrame(interp, &frame, opt->iclsPtr->nsPtr, 1);
          230  +	Itcl_SetContext(interp, contextObj);
          231  +
   233    232           result = Tcl_EvalObjEx(interp, mcode->bodyPtr, 0);
   234         -        Itcl_SetCallFrameNamespace(interp, saveNsPtr);
          233  +
          234  +	Itcl_UnsetContext(interp);
          235  +	Itcl_PopCallFrame(interp);
   235    236   
   236    237   	/* 
   237    238   	 * Here we engage in some ugly hackery workaround until
   238    239   	 * someone has time to come back and implement this
   239    240   	 * properly.
   240    241   	 *
   241    242   	 * In Itcl/Itk 3, the same machinery was used to implement

Changes to library/Archetype.itk.

    58     58           eval itk_initialize $args
    59     59       }
    60     60   
    61     61       destructor {
    62     62           ::itcl::builtin::Archetype delete
    63     63       }
    64     64   
    65         -    method cget {option} {
    66         -        ::itcl::builtin::Archetype cget $option
    67         -    }
           65  +    method cget {option} @Archetype-cget
           66  +
           67  +    method configure {{option ""} args} @Archetype-configure
           68  +
           69  +    method config {{option ""} args} @Archetype-configure
           70  +
           71  +    method component {{name ""} args} @Archetype-component
    68     72   
    69         -    method configure {{option ""} args} {
    70         -        ::itcl::builtin::Archetype configure $option {*}$args
    71         -    }
           73  +    protected method itk_component {option args} @Archetype-itk_component
    72     74   
    73         -    method config {{option ""} args} {
    74         -        eval configure $option $args
    75         -    }
           75  +    protected method itk_option {option args} @Archetype-itk_option
    76     76   
    77         -    method component {{name ""} args} {
    78         -        ::itcl::builtin::Archetype component $name {*}$args
    79         -    }
    80         -
    81         -    protected method itk_component {option args} {
    82         -        ::itcl::builtin::Archetype itk_component $option {*}$args
    83         -    }
    84         -
    85         -    protected method itk_option {option args} {
    86         -        ::itcl::builtin::Archetype itk_option $option {*}$args
    87         -    }
    88         -
    89         -    protected method itk_initialize {args} {
    90         -        ::itcl::builtin::Archetype itk_initialize {*}$args
    91         -    }
           77  +    protected method itk_initialize {args} @Archetype-itk_initialize
    92     78   
    93     79       protected variable itk_option
    94     80       protected variable itk_component
    95     81       protected variable itk_interior ""
    96     82   
    97     83       # ------------------------------------------------------------------
    98     84       #  Options common to all widgets

Changes to library/itk.tcl.

    10     10   #            http://www.tcltk.com/itcl
    11     11   # ----------------------------------------------------------------------
    12     12   #            Copyright (c) 1993-1998  Lucent Technologies, Inc.
    13     13   # ======================================================================
    14     14   # See the file "license.terms" for information on usage and
    15     15   # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    16     16   
    17         -package require -exact Itk 4.0.3
           17  +package require -exact Itk 4.1.0
    18     18   #
    19     19   # Provide transparent access to all [incr Tk] commands
    20     20   #
    21     21   if {$tcl_platform(os) == "MacOS"} {
    22     22       source -rsrc itk:tclIndex
    23     23   } else {
    24     24       lappend auto_path ${itk::library}

Changes to pkgIndex.tcl.in.

     1      1   # Tcl package index file, version 1.0
     2      2   
     3      3   if {![package vsatisfies [package provide Tcl] 8.6]} return
     4         -if {[string length [package provide Itcl]] && (![package vsatisfies [package provide Itcl] 4] || [package vsatisfies [package provide Itcl] 4.1])} return
            4  +if {[string length [package provide Itcl]] && ![package vsatisfies [package provide Itcl] 4.1]} return
     5      5   package ifneeded itk @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] Itk]
     6      6   package ifneeded Itk @PACKAGE_VERSION@ [list load [file join $dir "@PKG_LIB_FILE@"] Itk]

Changes to tests/widget.test.

   256    256       set comp [.testWidget component test2]
   257    257       list [bindtags $comp] \
   258    258            [bind itk-destroy-$comp <Destroy>] \
   259    259         [catch {.testWidget do {itk_component delete test2}}] \
   260    260            [bindtags $comp] \
   261    261            [bind itk-destroy-$comp <Destroy>] \
   262    262            [.testWidget configure]
   263         -} {{itk-destroy-.testWidget.t2 .testWidget.t2 Button . all} {namespace inscope ::itk::Archetype {::.testWidget itk_component delete test2}} 0 {.testWidget.t2 Button . all} {} {{-background background Background linen linen} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor {} {}} {-status status Status {} {}}}}
          263  +} {{itk-destroy-.testWidget.t2 .testWidget.t2 Button . all} {namespace inscope ::TestWidget {::.testWidget itk_component delete test2}} 0 {.testWidget.t2 Button . all} {} {{-background background Background linen linen} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor {} {}} {-status status Status {} {}}}}
   264    264   
   265    265   test widget-1.27 {when a mega-widget object is deleted, its window and any
   266    266           components are destroyed (even if in another window) } {
   267    267       catch {destroy .t1}
   268    268       catch {rename .t1.bw {}}
   269    269       catch {itcl::delete class ButtonWidget}
   270    270