summaryrefslogtreecommitdiffstats
path: root/generic/tclEnsemble.c
diff options
context:
space:
mode:
authorpooryorick <com.digitalsmarties@pooryorick.com>2017-11-25 16:53:59 (GMT)
committerpooryorick <com.digitalsmarties@pooryorick.com>2017-11-25 16:53:59 (GMT)
commitc2e98a86d40e2d5fc6f461c5c0a9beaf57a55151 (patch)
tree60deb493ca14c1cd57c5523d5b8af56fc9ef1bb9 /generic/tclEnsemble.c
parent48fb6e2c88c4b6966e52e0a8d34274e91eef47f3 (diff)
parent9b1ecce298fc120bc981d5182cc9c45bcfb0971d (diff)
downloadtcl-c2e98a86d40e2d5fc6f461c5c0a9beaf57a55151.zip
tcl-c2e98a86d40e2d5fc6f461c5c0a9beaf57a55151.tar.gz
tcl-c2e98a86d40e2d5fc6f461c5c0a9beaf57a55151.tar.bz2
merge pyk-command-named-colon
Diffstat (limited to 'generic/tclEnsemble.c')
-rw-r--r--generic/tclEnsemble.c148
1 files changed, 88 insertions, 60 deletions
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 392f430..c5ccd22 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -146,10 +146,12 @@ TclNamespaceEnsembleCmd(
Tcl_Obj *const objv[])
{
Tcl_Namespace *namespacePtr;
- Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
+ *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
Tcl_Command token;
Tcl_DictSearch search;
Tcl_Obj *listObj;
+ const char *simpleName;
int index, done;
if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
@@ -195,13 +197,8 @@ TclNamespaceEnsembleCmd(
objv += 2;
objc -= 2;
- /*
- * Work out what name to use for the command to create. If supplied,
- * it is either fully specified or relative to the current namespace.
- * If not supplied, it is exactly the name of the current namespace.
- */
-
- name = nsPtr->fullName;
+ name = nsPtr->name;
+ cxtPtr = (Namespace *) nsPtr->parentPtr;
/*
* Parse the option list, applying type checks as we go. Note that we
@@ -221,6 +218,7 @@ TclNamespaceEnsembleCmd(
switch ((enum EnsCreateOpts) index) {
case CRT_CMD:
name = TclGetString(objv[1]);
+ cxtPtr = nsPtr;
continue;
case CRT_SUBCMDS:
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
@@ -337,6 +335,10 @@ TclNamespaceEnsembleCmd(
}
}
+ TclGetNamespaceForQualName(interp, name, cxtPtr,
+ TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
+ &simpleName);
+
/*
* Create the ensemble. Note that this might delete another ensemble
* linked to the same namespace, so we must be careful. However, we
@@ -344,8 +346,9 @@ TclNamespaceEnsembleCmd(
* we've created it (and after any deletions have occurred.)
*/
- token = Tcl_CreateEnsemble(interp, name, NULL,
- (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
+ token = TclCreateEnsembleInNs(interp, simpleName,
+ (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
+ (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
@@ -636,48 +639,38 @@ TclNamespaceEnsembleCmd(
/*
*----------------------------------------------------------------------
*
- * Tcl_CreateEnsemble --
+ * TclCreateEnsembleInNs --
*
- * Create a simple ensemble attached to the given namespace.
- *
- * Results:
- * The token for the command created.
- *
- * Side effects:
- * The ensemble is created and marked for compilation.
+ * Like Tcl_CreateEnsemble, but additionally accepts as an argument the
+ * name of the namespace to create the command in.
*
*----------------------------------------------------------------------
*/
Tcl_Command
-Tcl_CreateEnsemble(
- Tcl_Interp *interp,
- const char *name,
- Tcl_Namespace *namespacePtr,
- int flags)
+TclCreateEnsembleInNs(
+ Tcl_Interp *interp,
+
+ const char *name, /* Simple name of command to create (no */
+ /* namespace components). */
+ Tcl_Namespace /* Name of namespace to create the command in. */
+ *nameNsPtr,
+ Tcl_Namespace
+ *ensembleNsPtr, /* Name of the namespace for the ensemble. */
+ int flags
+ )
{
- Namespace *nsPtr = (Namespace *) namespacePtr;
- EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
- Tcl_Obj *nameObj = NULL;
-
- if (nsPtr == NULL) {
- nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
- }
-
- /*
- * Make the name of the ensemble into a fully qualified name. This might
- * allocate a temporary object.
- */
+ Namespace *nsPtr = (Namespace *) ensembleNsPtr;
+ EnsembleConfig *ensemblePtr;
+ Tcl_Command token;
- if (!(name[0] == ':' && name[1] == ':')) {
- nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
- if (nsPtr->parentPtr == NULL) {
- Tcl_AppendStringsToObj(nameObj, name, NULL);
- } else {
- Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
- }
- Tcl_IncrRefCount(nameObj);
- name = TclGetString(nameObj);
+ ensemblePtr = ckalloc(sizeof(EnsembleConfig));
+ token = TclNRCreateCommandInNs(interp, name,
+ (Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
+ NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
+ if (token == NULL) {
+ ckfree(ensemblePtr);
+ return NULL;
}
ensemblePtr->nsPtr = nsPtr;
@@ -690,9 +683,7 @@ Tcl_CreateEnsemble(
ensemblePtr->numParameters = 0;
ensemblePtr->parameterList = NULL;
ensemblePtr->unknownHandler = NULL;
- ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
- NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
- ensemblePtr, DeleteEnsembleConfig);
+ ensemblePtr->token = token;
ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
@@ -709,11 +700,56 @@ Tcl_CreateEnsemble(
((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
}
+ return ensemblePtr->token;
+
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateEnsemble
+ *
+ * Create a simple ensemble attached to the given namespace.
+ *
+ * Deprecated by TclCreateEnsembleInNs.
+ *
+ * Value
+ *
+ * The token for the command created.
+ *
+ * Effect
+ * The ensemble is created and marked for compilation.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+Tcl_CreateEnsemble(
+ Tcl_Interp *interp,
+ const char *name,
+ Tcl_Namespace *namespacePtr,
+ int flags)
+{
+ Tcl_Obj *nameObj = NULL;
+ Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
+ *actualNsPtr;
+ const char * simpleName;
+
+ if (nsPtr == NULL) {
+ nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ }
+
+ TclGetNamespaceForQualName(interp, name, nsPtr, 0,
+ &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
if (nameObj != NULL) {
- TclDecrRefCount(nameObj);
+ TclDecrRefCount(nameObj);
}
- return ensemblePtr->token;
+ return TclCreateEnsembleInNs(interp, simpleName,
+ (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
}
+
/*
*----------------------------------------------------------------------
@@ -1885,6 +1921,7 @@ NsEnsembleImplementationCmdNR(
TclSkipTailcall(interp);
Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+ ((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
@@ -2577,12 +2614,7 @@ BuildEnsembleConfig(
* the programmer's responsibility (or [::unknown] of course).
*/
- cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
- if (ensemblePtr->nsPtr->parentPtr != NULL) {
- Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
- } else {
- Tcl_AppendStringsToObj(cmdObj, name, NULL);
- }
+ cmdObj = Tcl_NewStringObj(name, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);
@@ -2646,11 +2678,7 @@ BuildEnsembleConfig(
if (isNew) {
Tcl_Obj *cmdObj, *cmdPrefixObj;
- TclNewObj(cmdObj);
- Tcl_AppendStringsToObj(cmdObj,
- ensemblePtr->nsPtr->fullName,
- (ensemblePtr->nsPtr->parentPtr ? "::" : ""),
- nsCmdName, NULL);
+ cmdObj = Tcl_NewStringObj(nsCmdName, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
Tcl_IncrRefCount(cmdPrefixObj);