Attachment "itcl4.1.1_scope.patch" to
ticket [050ac21f73]
added by
schmitzu
2018-05-16 13:37:30.
diff -upr itcl4.1.1/generic/itclInfo.c itcl4.1.1_patched/generic/itclInfo.c
--- itcl4.1.1/generic/itclInfo.c 2017-12-08 14:09:27.000000000 +0100
+++ itcl4.1.1_patched/generic/itclInfo.c 2018-05-16 15:32:35.645126906 +0200
@@ -201,7 +201,7 @@ static const InfoMethod InfoMethodList[]
ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
},
{ "variable",
- "?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config?",
+ "?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config? ?-scope?",
Itcl_BiInfoVariableCmd,
ITCL_CLASS|ITCL_TYPE|ITCL_WIDGETADAPTOR|ITCL_WIDGET|ITCL_ECLASS
},
@@ -1264,6 +1264,7 @@ Itcl_BiInfoFunctionCmd(
* to indicate success/failure.
* ------------------------------------------------------------------------
*/
+/*&&&1*/
/* ARGSUSED */
int
Itcl_BiInfoVariableCmd(
@@ -1287,14 +1288,19 @@ Itcl_BiInfoVariableCmd(
int i;
int result;
+ ClientData cfClientData;
+ ItclObjectInfo *infoPtr;
+ Tcl_Object oPtr;
+ int doAppend;
+
static const char *options[] = {
"-config", "-init", "-name", "-protection", "-type",
- "-value", (char*)NULL
+ "-value", "-scope", (char*)NULL
};
enum BIvIdx {
BIvConfigIdx, BIvInitIdx, BIvNameIdx, BIvProtectIdx,
- BIvTypeIdx, BIvValueIdx
- } *ivlist, ivlistStorage[6];
+ BIvTypeIdx, BIvValueIdx, BIvScopeIdx
+ } *ivlist, ivlistStorage[7];
static enum BIvIdx DefInfoVariable[5] = {
BIvProtectIdx,
@@ -1313,7 +1319,6 @@ Itcl_BiInfoVariableCmd(
BIvValueIdx
};
-
ItclShowArgs(1, "Itcl_BiInfoVariableCmd", objc, objv);
resultPtr = NULL;
objPtr = NULL;
@@ -1335,7 +1340,7 @@ Itcl_BiInfoVariableCmd(
/*
* Process args:
- * ?varName? ?-protection? ?-type? ?-name? ?-init? ?-config? ?-value?
+ * ?varName? ?-protection? ?-type? ?-name? ?-init? ?-config? ?-value? ?-scope?
*/
objv++; /* skip over command name */
objc--;
@@ -1473,6 +1478,78 @@ Itcl_BiInfoVariableCmd(
}
objPtr = Tcl_NewStringObj((const char *)val, -1);
break;
+
+ case BIvScopeIdx:
+ entry = Tcl_FindHashEntry(&contextIclsPtr->resolveVars, varName);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "variable \"", varName, "\" not found in class \"",
+ Tcl_GetString(contextIclsPtr->fullNamePtr), "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+
+ if (vlookup->ivPtr->flags & ITCL_COMMON) {
+ objPtr = Tcl_NewStringObj("", -1);
+
+ if (vlookup->ivPtr->protection != ITCL_PUBLIC) {
+ Tcl_AppendToObj(objPtr, ITCL_VARIABLES_NAMESPACE, -1);
+ }
+ Tcl_AppendToObj(objPtr,
+ Tcl_GetString(vlookup->ivPtr->fullNamePtr), -1);
+ } else {
+ /*
+ * If this is not a common variable, then we better have
+ * an object context. Return the name as a fully qualified name.
+ */
+ infoPtr = contextIclsPtr->infoPtr;
+ cfClientData = Itcl_GetCallFrameClientData(interp);
+ if (cfClientData != NULL) {
+ oPtr = Tcl_ObjectContextObject((Tcl_ObjectContext)cfClientData);
+ if (oPtr != NULL) {
+ contextIoPtr = (ItclObject*)Tcl_ObjectGetMetadata(
+ oPtr, infoPtr->object_meta_type);
+ }
+ }
+
+ if (contextIoPtr == NULL) {
+ if (infoPtr->currIoPtr != NULL) {
+ contextIoPtr = infoPtr->currIoPtr;
+ }
+ }
+
+ if (contextIoPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't scope variable \"", varName,
+ "\": missing object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ doAppend = 1;
+ if (contextIclsPtr->flags & ITCL_ECLASS) {
+ if (strcmp(varName, "itcl_options") == 0) {
+ doAppend = 0;
+ }
+ }
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_AppendToObj(objPtr, ITCL_VARIABLES_NAMESPACE, -1);
+ Tcl_AppendToObj(objPtr,
+ (Tcl_GetObjectNamespace(contextIoPtr->oPtr))->fullName, -1);
+
+ if (doAppend) {
+ Tcl_AppendToObj(objPtr,
+ Tcl_GetString(vlookup->ivPtr->fullNamePtr), -1);
+ } else {
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr,
+ Tcl_GetString(vlookup->ivPtr->namePtr), -1);
+ }
+ }
+ break;
}
if (objc == 1) {
