Itk - the [incr Tk] extension

Check-in [9b412503a3]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Commit to the patch; code history is in code history.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-method-type
Files: files | file ages | folders
SHA1: 9b412503a36f59f4858224d7a99e6eeb396fa6fe
User & Date: dgp 2017-06-29 16:48:48
Context
2017-06-29
17:17
Bump to 4.1.0 check-in: c368859cb1 user: dgp tags: dgp-method-type
16:48
Commit to the patch; code history is in code history. check-in: 9b412503a3 user: dgp tags: dgp-method-type
16:23
merge trunk check-in: dde8dc2497 user: dgp tags: dgp-method-type
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/itkArchBase.c.

   190    190       ItclClass *contextClass;
   191    191       ItclClass *ownerClass;
   192    192       ItclObject *contextObj;
   193    193       ArchInfo *info;
   194    194       Tcl_Command accessCmd;
   195    195       Tcl_Obj *objPtr;
   196    196       Tcl_DString buffer;
   197         -#if 0
   198         -    Tcl_CallFrame frame;
   199         -    Tcl_CallFrame *uplevelFramePtr;
   200         -    Tcl_CallFrame *oldFramePtr = NULL;
   201         -    ItclObjectInfo *infoPtr;
   202         -    ItclCallContext *callContextPtr;
   203         -#endif
   204    197   
   205    198       ItclShowArgs(1, "Itk_ArchCompAddCmd", objc, objv);
   206    199       /*
   207    200        *  Get the Archetype info associated with this widget.
   208    201        */
   209    202       contextClass = NULL;
   210    203       if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
................................................................................
   303    296           }
   304    297       }
   305    298   
   306    299       /*
   307    300        *  Execute the <createCmds> to create the component widget.
   308    301        *  Do this one level up, in the scope of the calling routine.
   309    302        */
   310         -#if 0
   311         -    Itcl_SetCallFrameResolver(interp, contextClass->resolvePtr);
   312         -    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
   313         -    uplevelFramePtr = Itcl_GetUplevelCallFrame(interp, 1);
   314         -    oldFramePtr = Itcl_ActivateCallFrame(interp, uplevelFramePtr);
   315         -#endif
   316    303       result = Tcl_EvalObjEx(interp, objv[2], 0);
   317    304       if (result != TCL_OK) {
   318    305           goto compFail;
   319    306       }
   320    307   
   321    308       /*
   322    309        *  Take the result from the widget creation commands as the
................................................................................
   339    326           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   340    327              "cannot find component access command \"",
   341    328               path, "\" for component \"", name, "\"",
   342    329               (char*)NULL);
   343    330           goto compFail;
   344    331       }
   345    332   
   346         -#if 0
   347         -    (void) Itcl_ActivateCallFrame(interp, oldFramePtr);
   348         -    oldFramePtr = NULL;
   349         -#endif
   350    333       winNamePtr = Tcl_NewStringObj((char*)NULL, 0);
   351    334       Tcl_GetCommandFullName(interp, accessCmd, winNamePtr);
   352    335       Tcl_IncrRefCount(winNamePtr);
   353    336   
   354    337   
   355    338       /*
   356    339        *  Create the component record.  Set the protection level
................................................................................
   491    474       if (objc != 4) {
   492    475           objPtr = Tcl_NewStringObj("usual", -1);
   493    476           Tcl_IncrRefCount(objPtr);
   494    477       } else {
   495    478           objPtr = objv[3];
   496    479       }
   497    480   
   498         -//    result = Itcl_PushCallFrame(interp, &frame, parserNs,
   499         - //           /* isProcCallFrame */ 0);
   500         -
   501    481       Tcl_Import(interp, NULL, "::itk::option-parser::*", 1);
   502    482   
   503    483       if (result == TCL_OK) {
   504    484           result = Tcl_EvalObj(interp, objPtr);
   505         -  //      Itcl_PopCallFrame(interp);
   506    485   	Tcl_ForgetImport(interp, NULL, "::itk::option-parser::*");
   507    486       }
   508    487   
   509    488       if (objc != 4) {
   510    489           Tcl_DecrRefCount(objPtr);
   511    490       }
   512    491       if (result != TCL_OK) {
................................................................................
   537    516       Tcl_SetResult(interp, name, TCL_VOLATILE);
   538    517       return TCL_OK;
   539    518   
   540    519       /*
   541    520        *  If any errors were encountered, clean up and return.
   542    521        */
   543    522   compFail:
   544         -#if 0
   545         -    if (oldFramePtr) {
   546         -	(void) Itcl_ActivateCallFrame(interp, oldFramePtr);
   547         -    }
   548         -#endif
   549    523       if (archComp) {
   550    524           Itk_DelArchComponent(archComp);
   551    525       }
   552    526       if (entry) {
   553    527           Tcl_DeleteHashEntry(entry);
   554    528       }
   555    529       if (path) {
................................................................................
  1613   1587       /*
  1614   1588        *  Update the public variable with the new option value.
  1615   1589        *  There should already be a call frame installed for handling
  1616   1590        *  instance variables, but make sure that the namespace context
  1617   1591        *  is the most-specific class, so that the public variable can
  1618   1592        *  be found.
  1619   1593        */
  1620         -#if 0
  1621         -    result = Itcl_PushCallFrame(interp, &frame, contextObj->iclsPtr->nsPtr,
  1622         -            /*isProcCallFrame*/0);
  1623         -#endif
  1624   1594   
  1625   1595       if (result == TCL_OK) {
  1626   1596   	/*
  1627   1597   	 * Casting away CONST of newval only to satisfy Tcl 8.3 and
  1628   1598   	 * earlier headers.
  1629   1599   	 */
  1630   1600           val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), (char *) NULL,
  1631   1601               (char *) newval, TCL_LEAVE_ERR_MSG);
  1632   1602   
  1633   1603           if (!val) {
  1634   1604               result = TCL_ERROR;
  1635   1605           }
  1636         -#if 0
  1637         -        Itcl_PopCallFrame(interp);
  1638         -#endif
  1639   1606       }
  1640   1607   
  1641   1608       if (result != TCL_OK) {
  1642   1609           char msg[256];
  1643   1610           sprintf(msg, "\n    (error in configuration of public variable \"%.100s\")", Tcl_GetString(ivPtr->fullNamePtr));
  1644   1611           Tcl_AddErrorInfo(interp, msg);
  1645   1612           return TCL_ERROR;
................................................................................
  2121   2088       Tcl_Interp *interp,            /* interpreter managing the object */
  2122   2089       ArchInfo *info,                /* info for Archetype mega-widget */
  2123   2090       ArchOption *archOpt,           /* option to initialize */
  2124   2091       CONST char *defVal,            /* last-resort default value */
  2125   2092       char *currVal)                 /* current option value */
  2126   2093   {
  2127   2094       CONST char *init = NULL;
  2128         -
  2129         -#if 0
  2130         -    Tcl_CallFrame frame;
  2131         -    int result;
  2132         -#endif
  2133   2095       CONST char *ival;
  2134   2096       char c;
  2135   2097   
  2136   2098       /*
  2137   2099        *  If the option is already initialized, then abort.
  2138   2100        */
  2139   2101       if (archOpt->init) {
................................................................................
  2166   2128           (c == 's' && strcmp(archOpt->switchName,"-screen") == 0) ||
  2167   2129           (c == 'v' && strcmp(archOpt->switchName,"-visual") == 0)) {
  2168   2130           ival = currVal;
  2169   2131       } else {
  2170   2132           ival = init;
  2171   2133       }
  2172   2134   
  2173         -#if 1
  2174   2135       Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
  2175   2136               (char *)((ival) ? ival : ""), 0);
  2176         -#else
  2177         -    /*
  2178         -     *  Set the initial value in the itk_option array.
  2179         -     *  Since this might be called from the itk::option-parser
  2180         -     *  namespace, reinstall the object context.
  2181         -     */
  2182         -    result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0);
  2183         -
  2184         -    if (result == TCL_OK) {
  2185         -	/*
  2186         -	 * Casting away CONST of ival only to satisfy Tcl 8.3 and
  2187         -	 * earlier headers.
  2188         -	 */
  2189         -fprintf(stdout, "ARCH INIT OPTION '%s'\n", archOpt->switchName);
  2190         -fflush(stdout);
  2191         -char *res =        Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
  2192         -            (char *)((ival) ? ival : ""), 0);
  2193         -fprintf(stdout, "STORED: '%s'\n", res); fflush(stdout);
  2194         -fprintf(stdout, "CONTEXT: '%s'\n", Tcl_GetCurrentNamespace(interp)->fullName);
  2195         -    Itcl_PopCallFrame(interp);
  2196         -    }
  2197         -#endif
  2198   2137   
  2199   2138       if (ival) {
  2200   2139           archOpt->init = (char*)ckalloc((unsigned)(strlen(ival)+1));
  2201   2140           strcpy(archOpt->init, ival);
  2202   2141       }
  2203   2142   }
  2204   2143   
................................................................................
  2310   2249       char *resClass,                  /* resource class name in X11 database */
  2311   2250       CONST char *defVal,              /* last-resort default value */
  2312   2251       char *currVal,                   /* current value (or NULL) */
  2313   2252       ArchOptionPart *optPart,         /* part to be added in */
  2314   2253       ArchOption **raOpt)              /* returns: option containing new part */
  2315   2254   {
  2316   2255       CONST char *init = NULL;
  2317         -
  2318         -#if 0
  2319         -    Tcl_CallFrame frame;
  2320         -#endif
  2321   2256       int result;
  2322   2257       ArchOption *archOpt;
  2323   2258   
  2324   2259       *raOpt = NULL;
  2325   2260       archOpt = NULL;
  2326   2261   
  2327   2262       /*
................................................................................
  2340   2275        *  simply update this part to the current value.  Otherwise,
  2341   2276        *  leave the configuration to Itk_ArchInitCmd().
  2342   2277        */
  2343   2278       Itcl_AppendList(&archOpt->parts, (ClientData)optPart);
  2344   2279   
  2345   2280       if ((archOpt->flags & ITK_ARCHOPT_INIT) != 0) {
  2346   2281   
  2347         -//        result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0);
  2348         -
  2349   2282           if (result == TCL_OK) {
  2350   2283               init = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
  2351         - //           Itcl_PopCallFrame(interp);
  2352   2284           }
  2353   2285   
  2354   2286           if (!init) {
  2355   2287               Itk_ArchOptAccessError(interp, info, archOpt);
  2356   2288               return TCL_ERROR;
  2357   2289           }
  2358   2290   

Changes to generic/itkArchetype.c.

   423    423       Itcl_ParseNamespPath(cmd, &buffer, &head, &tail);
   424    424       if (objc < 2) {
   425    425           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   426    426               "wrong # args: should be one of...\n",
   427    427               "  ", tail, " add ?-protected? ?-private? ?--? name createCmds ?optionCmds?\n",
   428    428               "  ", tail, " delete name ?name name...?",
   429    429               (char*)NULL);
   430         -    Tcl_DStringFree(&buffer);
          430  +	Tcl_DStringFree(&buffer);
   431    431           return TCL_ERROR;
   432    432       }
   433    433   
   434    434       token = Tcl_GetString(objv[1]);
   435    435       c = *token;
   436    436       length = strlen(token);
   437    437   
................................................................................
   442    442           if (objc < 4) {
   443    443               Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   444    444                   "wrong # args: should be \"",
   445    445                   tail,
   446    446   		" add ?-protected? ?-private? ?--?",
   447    447   		" name createCmds ?optionCmds?\"",
   448    448                   (char*)NULL);
   449         -    Tcl_DStringFree(&buffer);
          449  +	    Tcl_DStringFree(&buffer);
   450    450               return TCL_ERROR;
   451    451           }
   452         -    Tcl_DStringFree(&buffer);
          452  +	Tcl_DStringFree(&buffer);
   453    453           return Itk_ArchCompAddCmd(dummy, interp, objc-1, objv+1);
   454    454       } else {
   455    455   
   456    456           /*
   457    457            *  Handle:  itk_component delete...
   458    458            */
   459    459           if (c == 'd' && strncmp(token, "delete", length) == 0) {
   460    460               if (objc < 3) {
   461    461                   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   462    462                       "wrong # args: should be \"",
   463    463                       tail,
   464    464   		    " delete name ?name name...?\"",
   465    465                       (char*)NULL);
   466         -    Tcl_DStringFree(&buffer);
          466  +		    Tcl_DStringFree(&buffer);
   467    467                   return TCL_ERROR;
   468    468               }
   469         -    Tcl_DStringFree(&buffer);
          469  +	    Tcl_DStringFree(&buffer);
   470    470               return Itk_ArchCompDeleteCmd(dummy, interp, objc-1, objv+1);
   471    471           }
   472    472       }
   473    473       Tcl_DStringFree(&buffer);
   474    474   
   475    475       /*
   476    476        *  Flag any errors.
................................................................................
   525    525       Itcl_ListElem *part;
   526    526       ArchOption *archOpt;
   527    527       ArchOptionPart *optPart;
   528    528       ItclHierIter hier;
   529    529       ItclVariable *ivPtr;
   530    530       Tcl_HashSearch place;
   531    531       Tcl_HashEntry *entry;
   532         -#if 0
   533         -    ItclObjectInfo *infoPtr;
   534         -    ItclCallContext *callContextPtr;
   535         -    Tcl_HashEntry *hPtr;
   536         -#endif
   537    532   
   538    533       ItclShowArgs(2, "Itk_ArchInitCmd", objc, objv);
   539    534       contextClass = NULL;
   540    535       if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
   541    536           !contextObj) {
   542    537   
   543    538           token = Tcl_GetString(objv[0]);
................................................................................
   545    540           Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
   546    541               "improper usage: should be \"object ",
   547    542               token, " ?-option value -option value...?\"",
   548    543               (char*)NULL);
   549    544           return TCL_ERROR;
   550    545       }
   551    546   
   552         -#if 0
   553         -    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
   554         -            ITCL_INTERP_DATA, NULL);
   555         -#endif
   556    547       if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
   557    548           return TCL_ERROR;
   558    549       }
   559    550   
   560    551       /*
   561    552        *  See what class is being initialized by getting the namespace
   562    553        *  for the calling context.
   563    554        */
   564         -#if 0
   565         -    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
   566         -    callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
   567         -            Itcl_GetStackSize(&infoPtr->contextStack)-2);
   568         -    hPtr = Tcl_FindHashEntry(
   569         -            &callContextPtr->ioPtr->iclsPtr->infoPtr->namespaceClasses,
   570         -            (char *)callContextPtr->nsPtr);
   571         -    if (hPtr != NULL) {
   572         -        contextClass = (ItclClass *)Tcl_GetHashValue(hPtr);
   573         -    }
   574         -#endif
   575         -
   576    555   
   577    556       /*
   578    557        *  Integrate all public variables for the current class
   579    558        *  context into the composite option list.
   580    559        */
   581    560       Itcl_InitHierIter(&hier, contextClass);
   582    561       while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
................................................................................
   888    867           return TCL_ERROR;
   889    868       }
   890    869   
   891    870       if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
   892    871           return TCL_ERROR;
   893    872       }
   894    873   
   895         -callingNs = Tcl_GetCurrentNamespace(interp);
          874  +    callingNs = Tcl_GetCurrentNamespace(interp);
   896    875   
   897         -#if 0
   898         -    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
   899         -            ITCL_INTERP_DATA, NULL);
   900         -    if (Itcl_GetStackSize(&infoPtr->contextStack) == 1) {
   901         -        callingNs = Tcl_GetGlobalNamespace(interp);
   902         -    } else {
   903         -	ItclCallContext *callContextPtr;
   904         -	callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
   905         -	        Itcl_GetStackSize(&infoPtr->contextStack)-2);
   906         -#ifdef NOTDEF
   907         -        callingNs = (Tcl_Namespace *)Itcl_GetStackValue(
   908         -	        &infoPtr->namespaceStack,
   909         -		Itcl_GetStackSize(&infoPtr->namespaceStack)-2);
   910         -#endif
   911         -        callingNs = callContextPtr->nsPtr;
   912         -    }
   913         -#endif
   914    876       /*
   915    877        *  With no arguments, return a list of components that can be
   916    878        *  accessed from the calling scope.
   917    879        */
   918    880       if (objc == 2) {
   919    881   	/* if the name of the component is the empty string ignore that arg */
   920    882           if (strlen(Tcl_GetString(objv[1])) == 0) {
................................................................................
  1102   1064   	}
  1103   1065       }
  1104   1066       ItclShowArgs(1, "Itk_ArchConfigureCmd2", objc, objv);
  1105   1067       if (objc == 1) {
  1106   1068           Tcl_DStringInit(&buffer);
  1107   1069   
  1108   1070           for (i=0; i < info->order.len; i++) {
  1109         -Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
         1071  +	    Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
  1110   1072               archOpt = (ArchOption*)Tcl_GetHashValue(info->order.list[i]);
  1111   1073   
  1112         -Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
         1074  +	    Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
  1113   1075               val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
  1114         -Itcl_SetCallFrameNamespace(interp, save);
         1076  +	    Itcl_SetCallFrameNamespace(interp, save);
  1115   1077               if (!val) {
  1116   1078                   Itk_ArchOptAccessError(interp, info, archOpt);
  1117   1079                   Tcl_DStringFree(&buffer);
  1118   1080                   return TCL_ERROR;
  1119   1081               }
  1120   1082   
  1121   1083               Tcl_DStringStartSublist(&buffer);
................................................................................
  1136   1098   
  1137   1099           /*
  1138   1100            *  If there is just one argument, then query the information
  1139   1101            *  for that one argument and return:
  1140   1102            *    {name resName resClass init value}
  1141   1103            */
  1142   1104           if (objc == 2) {
  1143         -Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
         1105  +	    Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
  1144   1106               token = Tcl_GetString(objv[1]);
  1145   1107               entry = Tcl_FindHashEntry(&info->options, token);
  1146   1108               if (!entry) {
  1147   1109                   Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1148   1110                       "unknown option \"", token, "\"",
  1149   1111                       (char*)NULL);
  1150   1112                   return TCL_ERROR;
  1151   1113               }
  1152   1114   
  1153   1115               archOpt = (ArchOption*)Tcl_GetHashValue(entry);
  1154         -Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
         1116  +	    Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
  1155   1117               val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
  1156         -Itcl_SetCallFrameNamespace(interp, save);
         1118  +	    Itcl_SetCallFrameNamespace(interp, save);
  1157   1119               if (!val) {
  1158   1120                   Itk_ArchOptAccessError(interp, info, archOpt);
  1159   1121                   return TCL_ERROR;
  1160   1122               }
  1161   1123   
  1162   1124               Tcl_AppendElement(interp, archOpt->switchName);
  1163   1125               Tcl_AppendElement(interp,
................................................................................
  1174   1136       /*
  1175   1137        *  Otherwise, it must be a series of "-option value" assignments.
  1176   1138        *  Look up each option and assign the new value.
  1177   1139        */
  1178   1140       for (objc--,objv++; objc > 0; objc-=2, objv+=2) {
  1179   1141   	char *value;
  1180   1142   	int code;
  1181         -Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
         1143  +	Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
  1182   1144           token = Tcl_GetString(objv[0]);
  1183   1145           if (objc < 2) {
  1184   1146               Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1185   1147                   "value for \"", token, "\" missing",
  1186   1148                   (char*)NULL);
  1187   1149               return TCL_ERROR;
  1188   1150           }
  1189   1151           value = Tcl_GetString(objv[1]);
  1190   1152   
  1191         -Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
         1153  +	Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
  1192   1154           code = Itk_ArchConfigOption(interp, info, token, value);
  1193         -Itcl_SetCallFrameNamespace(interp, save);
         1155  +	Itcl_SetCallFrameNamespace(interp, save);
  1194   1156           if (code != TCL_OK) {
  1195   1157               return TCL_ERROR;
  1196   1158           }
  1197   1159       }
  1198   1160   
  1199   1161       Tcl_ResetResult(interp);
  1200   1162       return TCL_OK;