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: |
9b412503a36f59f4858224d7a99e6eeb |
| 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
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;