Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Add routines to manage ItclObject context. Add routines to directly access instance variables. Revise instance variable access to agree with class resolution rules. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk | itcl-4-1-0 |
Files: | files | file ages | folders |
SHA1: |
0354a67b775dccc18122238193e60125 |
User & Date: | dgp 2017-07-28 16:42:57 |
Context
2017-09-21
| ||
12:24 | More robust tests from Andy Goth check-in: b7221f9f97 user: dgp tags: trunk | |
2017-09-18
| ||
00:44 | Update tests for new [string insert] command check-in: ac7c36ed01 user: andy tags: amg-string-insert | |
2017-07-28
| ||
16:42 | Add routines to manage ItclObject context. Add routines to directly access instance variables. Revise instance variable access to agree with class resolution rules. check-in: 0354a67b77 user: dgp tags: trunk, itcl-4-1-0 | |
16:39 | Remove dup stub Closed-Leaf check-in: 88967b5a00 user: dgp tags: experiment | |
2017-07-20
| ||
20:54 | Revert last commit and take the better approach. Stop ItclObjectCmd from going poking into Tcl's areas of the CallFrame. Use Itcl's own mechanisms for fetching proper context information. check-in: 3e21a7bc42 user: dgp tags: trunk | |
Changes
Changes to generic/itcl.decls.
︙ | ︙ | |||
605 606 607 608 609 610 611 | int ItclClassBaseCmd(ClientData clientData, Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr) } declare 181 { int ItclCreateComponent(Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr) } | > > > > > > > > > > | 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 | int ItclClassBaseCmd(ClientData clientData, Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr) } declare 181 { int ItclCreateComponent(Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr) } declare 182 { void Itcl_SetContext(Tcl_Interp *interp, ItclObject *ioPtr) } declare 183 { void Itcl_UnsetContext(Tcl_Interp *interp) } declare 184 { const char * ItclGetInstanceVar(Tcl_Interp *interp, const char *name, const char *name2, ItclObject *ioPtr, ItclClass *iclsPtr) } |
Changes to generic/itclDecls.h.
︙ | ︙ | |||
15 16 17 18 19 20 21 | #endif /* !BEGIN!: Do not edit below this line. */ #define ITCL_STUBS_EPOCH 0 | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | #endif /* !BEGIN!: Do not edit below this line. */ #define ITCL_STUBS_EPOCH 0 #define ITCL_STUBS_REVISION 150 #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: |
︙ | ︙ |
Changes to generic/itclInt.h.
︙ | ︙ | |||
737 738 739 740 741 742 743 | MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr, ItclOption *ioptPtr); MODULE_SCOPE int Itcl_CreateMethodVariable (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *name, Tcl_Obj *defaultPtr, Tcl_Obj *callbackPtr, ItclMethodVariable **imvPtr); MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr, ItclClass *iclsPtr); | < < < | 737 738 739 740 741 742 743 744 745 746 747 748 749 750 | MODULE_SCOPE int Itcl_CreateOption (Tcl_Interp *interp, ItclClass *iclsPtr, ItclOption *ioptPtr); MODULE_SCOPE int Itcl_CreateMethodVariable (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *name, Tcl_Obj *defaultPtr, Tcl_Obj *callbackPtr, ItclMethodVariable **imvPtr); MODULE_SCOPE int DelegationInstall(Tcl_Interp *interp, ItclObject *ioPtr, ItclClass *iclsPtr); MODULE_SCOPE const char* ItclGetCommonInstanceVar(Tcl_Interp *interp, const char *name, const char *name2, ItclObject *contextIoPtr, ItclClass *contextIclsPtr); MODULE_SCOPE int ItclCreateMethod(Tcl_Interp* interp, ItclClass *iclsPtr, Tcl_Obj *namePtr, const char* arglist, const char* body, ItclMemberFunc **imPtrPtr); MODULE_SCOPE int Itcl_WidgetParseInit(Tcl_Interp *interp, |
︙ | ︙ |
Changes to generic/itclIntDecls.h.
1 2 3 4 5 6 7 8 9 10 | /* * This file is (mostly) automatically generated from itcl.decls. */ #ifndef _ITCLINTDECLS #define _ITCLINTDECLS /* !BEGIN!: Do not edit below this line. */ #define ITCLINT_STUBS_EPOCH 0 | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * This file is (mostly) automatically generated from itcl.decls. */ #ifndef _ITCLINTDECLS #define _ITCLINTDECLS /* !BEGIN!: Do not edit below this line. */ #define ITCLINT_STUBS_EPOCH 0 #define ITCLINT_STUBS_REVISION 150 #ifdef __cplusplus extern "C" { #endif /* * Exported function declarations: |
︙ | ︙ | |||
508 509 510 511 512 513 514 515 516 517 518 519 520 521 | Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr); /* 181 */ ITCLAPI int ItclCreateComponent(Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr); typedef struct ItclIntStubs { int magic; int epoch; int revision; void *hooks; | > > > > > > > > > | 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 | Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr); /* 181 */ ITCLAPI int ItclCreateComponent(Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr); /* 182 */ ITCLAPI void Itcl_SetContext(Tcl_Interp *interp, ItclObject *ioPtr); /* 183 */ ITCLAPI void Itcl_UnsetContext(Tcl_Interp *interp); /* 184 */ ITCLAPI const char * ItclGetInstanceVar(Tcl_Interp *interp, const char *name, const char *name2, ItclObject *ioPtr, ItclClass *iclsPtr); typedef struct ItclIntStubs { int magic; int epoch; int revision; void *hooks; |
︙ | ︙ | |||
697 698 699 700 701 702 703 704 705 706 707 708 709 710 | void (*itcl_PopCallFrame) (Tcl_Interp *interp); /* 175 */ Tcl_CallFrame * (*itcl_GetUplevelCallFrame) (Tcl_Interp *interp, int level); /* 176 */ Tcl_CallFrame * (*itcl_ActivateCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr); /* 177 */ const char* (*itclSetInstanceVar) (Tcl_Interp *interp, const char *name, const char *name2, const char *value, ItclObject *contextIoPtr, ItclClass *contextIclsPtr); /* 178 */ Tcl_Obj * (*itclCapitalize) (const char *str); /* 179 */ int (*itclClassBaseCmd) (ClientData clientData, Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr); /* 180 */ int (*itclCreateComponent) (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr); /* 181 */ } ItclIntStubs; extern const ItclIntStubs *itclIntStubsPtr; #ifdef __cplusplus } #endif | > > > | 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 | void (*itcl_PopCallFrame) (Tcl_Interp *interp); /* 175 */ Tcl_CallFrame * (*itcl_GetUplevelCallFrame) (Tcl_Interp *interp, int level); /* 176 */ Tcl_CallFrame * (*itcl_ActivateCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr); /* 177 */ const char* (*itclSetInstanceVar) (Tcl_Interp *interp, const char *name, const char *name2, const char *value, ItclObject *contextIoPtr, ItclClass *contextIclsPtr); /* 178 */ Tcl_Obj * (*itclCapitalize) (const char *str); /* 179 */ int (*itclClassBaseCmd) (ClientData clientData, Tcl_Interp *interp, int flags, int objc, Tcl_Obj *const objv[], ItclClass **iclsPtrPtr); /* 180 */ int (*itclCreateComponent) (Tcl_Interp *interp, ItclClass *iclsPtr, Tcl_Obj *componentPtr, int type, ItclComponent **icPtrPtr); /* 181 */ void (*itcl_SetContext) (Tcl_Interp *interp, ItclObject *ioPtr); /* 182 */ void (*itcl_UnsetContext) (Tcl_Interp *interp); /* 183 */ const char * (*itclGetInstanceVar) (Tcl_Interp *interp, const char *name, const char *name2, ItclObject *ioPtr, ItclClass *iclsPtr); /* 184 */ } ItclIntStubs; extern const ItclIntStubs *itclIntStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 | (itclIntStubsPtr->itclSetInstanceVar) /* 178 */ #define ItclCapitalize \ (itclIntStubsPtr->itclCapitalize) /* 179 */ #define ItclClassBaseCmd \ (itclIntStubsPtr->itclClassBaseCmd) /* 180 */ #define ItclCreateComponent \ (itclIntStubsPtr->itclCreateComponent) /* 181 */ #endif /* defined(USE_ITCL_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _ITCLINTDECLS */ | > > > > > > | 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 | (itclIntStubsPtr->itclSetInstanceVar) /* 178 */ #define ItclCapitalize \ (itclIntStubsPtr->itclCapitalize) /* 179 */ #define ItclClassBaseCmd \ (itclIntStubsPtr->itclClassBaseCmd) /* 180 */ #define ItclCreateComponent \ (itclIntStubsPtr->itclCreateComponent) /* 181 */ #define Itcl_SetContext \ (itclIntStubsPtr->itcl_SetContext) /* 182 */ #define Itcl_UnsetContext \ (itclIntStubsPtr->itcl_UnsetContext) /* 183 */ #define ItclGetInstanceVar \ (itclIntStubsPtr->itclGetInstanceVar) /* 184 */ #endif /* defined(USE_ITCL_STUBS) */ /* !END!: Do not edit above this line. */ #endif /* _ITCLINTDECLS */ |
Changes to generic/itclMethod.c.
︙ | ︙ | |||
1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 | * Returns TCL_OK if the current namespace is a class namespace. * Also returns pointers to the class definition, and to object * data if an object context is active. Returns TCL_ERROR (along * with an error message in the interpreter) if a class namespace * is not active. * ------------------------------------------------------------------------ */ int Itcl_GetContext( Tcl_Interp *interp, /* current interpreter */ ItclClass **iclsPtrPtr, /* returns: class definition or NULL */ ItclObject **ioPtrPtr) /* returns: object data or NULL */ { Tcl_Namespace *nsPtr; | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 | * Returns TCL_OK if the current namespace is a class namespace. * Also returns pointers to the class definition, and to object * data if an object context is active. Returns TCL_ERROR (along * with an error message in the interpreter) if a class namespace * is not active. * ------------------------------------------------------------------------ */ void Itcl_SetContext( Tcl_Interp *interp, ItclObject *ioPtr) { int new; Itcl_Stack *stackPtr; Tcl_CallFrame *framePtr = Itcl_GetUplevelCallFrame(interp, 0); ItclObjectInfo *infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&infoPtr->frameContext, (char *)framePtr, &new); ItclCallContext *contextPtr = (ItclCallContext *) ckalloc(sizeof(ItclCallContext)); memset(contextPtr, 0, sizeof(ItclCallContext)); contextPtr->ioPtr = ioPtr; contextPtr->refCount = 1; if (!new) { Tcl_Panic("frame already has context?!"); } stackPtr = (Itcl_Stack *) ckalloc(sizeof(Itcl_Stack)); Itcl_InitStack(stackPtr); Tcl_SetHashValue(hPtr, stackPtr); Itcl_PushStack(contextPtr, stackPtr); } void Itcl_UnsetContext( Tcl_Interp *interp) { Tcl_CallFrame *framePtr = Itcl_GetUplevelCallFrame(interp, 0); ItclObjectInfo *infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL); Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&infoPtr->frameContext, (char *)framePtr); Itcl_Stack *stackPtr = (Itcl_Stack *) Tcl_GetHashValue(hPtr); ItclCallContext *contextPtr = Itcl_PopStack(stackPtr); if (Itcl_GetStackSize(stackPtr) > 0) { Tcl_Panic("frame context stack not empty!"); } Itcl_DeleteStack(stackPtr); ckfree((char *) stackPtr); Tcl_DeleteHashEntry(hPtr); contextPtr->refCount--; if (contextPtr->refCount) { Tcl_Panic("frame context ref count not zero!"); } ckfree((char *)contextPtr); } int Itcl_GetContext( Tcl_Interp *interp, /* current interpreter */ ItclClass **iclsPtrPtr, /* returns: class definition or NULL */ ItclObject **ioPtrPtr) /* returns: object data or NULL */ { Tcl_Namespace *nsPtr; |
︙ | ︙ | |||
1438 1439 1440 1441 1442 1443 1444 | ItclObject *ioPtr = contextPtr->ioPtr; *iclsPtrPtr = ioPtr->iclsPtr; *ioPtrPtr = ioPtr; return TCL_OK; } | | > | 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 | ItclObject *ioPtr = contextPtr->ioPtr; *iclsPtrPtr = ioPtr->iclsPtr; *ioPtrPtr = ioPtr; return TCL_OK; } *iclsPtrPtr = contextPtr->imPtr ? contextPtr->imPtr->iclsPtr : contextPtr->ioPtr->iclsPtr; *ioPtrPtr = contextPtr->ioPtr ? contextPtr->ioPtr : infoPtr->currIoPtr; return TCL_OK; } /* Frame has no Itcl context data. No way to get object context. */ *ioPtrPtr = NULL; |
︙ | ︙ |
Changes to generic/itclObject.c.
︙ | ︙ | |||
25 26 27 28 29 30 31 32 33 34 35 36 37 38 | * overhauled version author: Arnulf Wiedemann Copyright (c) 2007 * ======================================================================== * Copyright (c) 1993-1998 Lucent Technologies, Inc. * ------------------------------------------------------------------------ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "itclInt.h" /* * FORWARD DECLARATIONS */ static char* ItclTraceThisVar(ClientData cdata, Tcl_Interp *interp, const char *name1, const char *name2, int flags); | > | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | * overhauled version author: Arnulf Wiedemann Copyright (c) 2007 * ======================================================================== * Copyright (c) 1993-1998 Lucent Technologies, Inc. * ------------------------------------------------------------------------ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <tclInt.h> #include "itclInt.h" /* * FORWARD DECLARATIONS */ static char* ItclTraceThisVar(ClientData cdata, Tcl_Interp *interp, const char *name1, const char *name2, int flags); |
︙ | ︙ | |||
1720 1721 1722 1723 1724 1725 1726 | iclsPtr = contextIclsPtr; } ivPtr = NULL; hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, (char *)name1); if (hPtr != NULL) { vlookup = Tcl_GetHashValue(hPtr); ivPtr = vlookup->ivPtr; | < < > > > > > > > > > > > > > > > | 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 | iclsPtr = contextIclsPtr; } ivPtr = NULL; hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, (char *)name1); if (hPtr != NULL) { vlookup = Tcl_GetHashValue(hPtr); ivPtr = vlookup->ivPtr; /* * Install the object context and access the data member * like any other variable. */ hPtr = Tcl_FindHashEntry(&contextIoPtr->objectVariables, (char *)ivPtr); if (hPtr) { Tcl_Obj *varName = Tcl_NewObj(); Tcl_Var varPtr = Tcl_GetHashValue(hPtr); Tcl_GetVariableFullName(interp, varPtr, varName); val = Tcl_GetVar2(interp, Tcl_GetString(varName), name2, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(varName); if (val) { return val; } } } isItclOptions = 0; if (strcmp(name1, "itcl_options") == 0) { isItclOptions = 1; } if (strcmp(name1, "itcl_option_components") == 0) { isItclOptions = 1; } |
︙ | ︙ | |||
1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 | } else { return NULL; } /* * Install the object context and access the data member * like any other variable. */ isItclOptions = 0; if (strcmp(name1, "itcl_options") == 0) { isItclOptions = 1; } if (strcmp(name1, "itcl_option_components") == 0) { isItclOptions = 1; } | > > > > > > > > > > > > > | 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 | } else { return NULL; } /* * Install the object context and access the data member * like any other variable. */ hPtr = Tcl_FindHashEntry(&contextIoPtr->objectVariables, (char *)ivPtr); if (hPtr) { Tcl_Obj *varName = Tcl_NewObj(); Tcl_Var varPtr = Tcl_GetHashValue(hPtr); Tcl_GetVariableFullName(interp, varPtr, varName); val = Tcl_SetVar2(interp, Tcl_GetString(varName), name2, value, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(varName); return val; } isItclOptions = 0; if (strcmp(name1, "itcl_options") == 0) { isItclOptions = 1; } if (strcmp(name1, "itcl_option_components") == 0) { isItclOptions = 1; } |
︙ | ︙ |
Changes to generic/itclStubInit.c.
︙ | ︙ | |||
191 192 193 194 195 196 197 198 199 200 201 202 203 204 | Itcl_PopCallFrame, /* 175 */ Itcl_GetUplevelCallFrame, /* 176 */ Itcl_ActivateCallFrame, /* 177 */ ItclSetInstanceVar, /* 178 */ ItclCapitalize, /* 179 */ ItclClassBaseCmd, /* 180 */ ItclCreateComponent, /* 181 */ }; static const ItclStubHooks itclStubHooks = { &itclIntStubs }; const ItclStubs itclStubs = { | > > > | 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | Itcl_PopCallFrame, /* 175 */ Itcl_GetUplevelCallFrame, /* 176 */ Itcl_ActivateCallFrame, /* 177 */ ItclSetInstanceVar, /* 178 */ ItclCapitalize, /* 179 */ ItclClassBaseCmd, /* 180 */ ItclCreateComponent, /* 181 */ Itcl_SetContext, /* 182 */ Itcl_UnsetContext, /* 183 */ ItclGetInstanceVar, /* 184 */ }; static const ItclStubHooks itclStubHooks = { &itclIntStubs }; const ItclStubs itclStubs = { |
︙ | ︙ |