summaryrefslogtreecommitdiffstats
path: root/generic/tclDictObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclDictObj.c')
-rw-r--r--generic/tclDictObj.c99
1 files changed, 99 insertions, 0 deletions
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 428173d..4088883 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -51,6 +51,8 @@ static int DictSetCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
static int DictSizeCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
+static int DictSmartRefCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
static int DictUnsetCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
static int DictUpdateCmd(ClientData dummy, Tcl_Interp *interp,
@@ -98,6 +100,7 @@ static const EnsembleImplMap implementationMap[] = {
{"replace", DictReplaceCmd, NULL, NULL, NULL, 0 },
{"set", DictSetCmd, TclCompileDictSetCmd, NULL, NULL, 0 },
{"size", DictSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
+ {"smartref",DictSmartRefCmd,NULL, NULL, NULL, 0 },
{"unset", DictUnsetCmd, TclCompileDictUnsetCmd, NULL, NULL, 0 },
{"update", DictUpdateCmd, TclCompileDictUpdateCmd, NULL, NULL, 0 },
{"values", DictValuesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
@@ -1960,6 +1963,102 @@ DictSizeCmd(
/*
*----------------------------------------------------------------------
*
+ * Tcl_DictObjSmartRef --
+ *
+ * This function returns new tcl-object with the smart reference to
+ * dictionary object.
+ *
+ * Object returned with this function is a smart reference (pointer),
+ * so new object of type tclDictType, that directly references given
+ * dictionary object (with internally increased refCount).
+ *
+ * The usage of such pointer objects allows to hold more as one
+ * reference to the same real dictionary object, allows to make a pointer
+ * to part of another dictionary, allows to change the dictionary without
+ * regarding of the "shared" state of the dictionary object.
+ *
+ * Prevents "called with shared object" exception if object is multiple
+ * referenced.
+ *
+ * Results:
+ * The newly create object (contains smart reference) is returned.
+ * The returned object has a ref count of 0.
+ *
+ * Side effects:
+ * Increases ref count of the referenced dictionary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_DictObjSmartRef(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr)
+{
+ Tcl_Obj *result;
+ Dict *dict;
+
+ if (dictPtr->typePtr != &tclDictType
+ && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
+ }
+
+ dict = DICT(dictPtr);
+
+ result = Tcl_NewObj();
+ DICT(result) = dict;
+ dict->refCount++;
+ result->internalRep.twoPtrValue.ptr2 = NULL;
+ result->typePtr = &tclDictType;
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictSmartRefCmd --
+ *
+ * This function implements the "dict smartref" Tcl command.
+ *
+ * See description of Tcl_DictObjSmartRef for details.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DictSmartRefCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Tcl_Obj *result;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
+ return TCL_ERROR;
+ }
+
+ result = Tcl_DictObjSmartRef(interp, objv[1]);
+ if (result == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, result);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* DictExistsCmd --
*
* This function implements the "dict exists" Tcl command. See the user