Tcl Source Code

Artifact Content
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Artifact 33cd3cd5e643f570ec5956101f7b519ca3429fb1:

Attachment "nsinvoke.patch" to ticket [1577324fff] added by msofer 2006-10-15 02:07:26.
Index: doc/namespace.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/namespace.n,v
retrieving revision 1.21
diff -u -r1.21 namespace.n
--- doc/namespace.n	26 Aug 2006 13:00:38 -0000	1.21
+++ doc/namespace.n	14 Oct 2006 19:03:52 -0000
@@ -180,6 +180,11 @@
 If another command is defined and exported in this namespace later on,
 it will not be imported.
 .TP
+\fBnamespace invoke\fR \fInamespace cmd\fR ?\fIarg ...\fR?
+Invokes in caller's scope the command called \fIcmd\fR, as resolved from
+namespace \fInamespace\fR, with the supplied arguments. If
+\fInamespace\fR does not exist, the command returns an arror.
+.TP
 \fBnamespace inscope\fR \fInamespace\fR \fIscript\fR ?\fIarg ...\fR?
 Executes a script in the context of the specified \fInamespace\fR.
 This command is not expected to be used directly by programmers;
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.101
diff -u -r1.101 tclNamesp.c
--- generic/tclNamesp.c	10 Oct 2006 16:45:04 -0000	1.101
+++ generic/tclNamesp.c	14 Oct 2006 19:04:09 -0000
@@ -217,6 +217,8 @@
 static void		NamespaceFree(Namespace *nsPtr);
 static int		NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
+static int		NamespaceInvokeCmd(ClientData dummy,Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 static int		NamespaceInscopeCmd(ClientData dummy,
 			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static int		NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp,
@@ -2936,14 +2935,14 @@
     static const char *subCmds[] = {
 	"children", "code", "current", "delete", "ensemble",
 	"eval", "exists", "export", "forget", "import",
-	"inscope", "origin", "parent", "path", "qualifiers",
-	"tail", "unknown", "upvar", "which", NULL
+	"invoke", "inscope", "origin", "parent", "path",
+	"qualifiers", "tail", "unknown", "upvar", "which", NULL
     };
     enum NSSubCmdIdx {
 	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
 	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
-	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
-	NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
+	NSInvokeIdx, NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx,
+	NSQualifiersIdx, NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
     };
     int index, result;
 
@@ -2993,6 +2992,9 @@
     case NSImportIdx:
 	result = NamespaceImportCmd(clientData, interp, objc, objv);
 	break;
+    case NSInvokeIdx:
+	result = NamespaceInvokeCmd(clientData, interp, objc, objv);
+	break;
     case NSInscopeIdx:
 	result = NamespaceInscopeCmd(clientData, interp, objc, objv);
 	break;
@@ -3763,6 +3765,76 @@
 /*
  *----------------------------------------------------------------------
  *
+ * NamespaceInvokeCmd --
+ *
+ *	Invoked to implement the "namespace invoke" command that invokes a
+ *	command in a predefined namespace. Handles the syntax
+ *
+ *	    namespace invoke ns cmd ?arg1? ?arg2? ...
+ *
+ *      This invokes the command cmd, as resolved from namespace ns, with the
+ *      supplied arguments. It is similar to
+ *
+ *          namespace eval ns [list cmd ?arg1? ?arg2? ...]
+ *
+ *      up to the fact that it executes in the caller's context: it does *not*
+ *      push a new CallFrame.
+ *
+ * Results:
+ *	Returns TCL_OK if the namespace is found and the command is executed
+ *	successfully. Returns TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Returns the result of the command in the interpreter's result object.
+ *	If anything goes wrong, this function returns an error message as the
+ *	result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceInvokeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Namespace *namespacePtr;
+    int result;
+
+    if (objc < 4) {
+	Tcl_WrongNumArgs(interp, 2, objv, "name cmd ?arg...?");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Try to resolve the namespace reference, caching the result in the
+     * namespace object along the way. If the namespace is not found, return
+     * an error.
+     */
+
+    result = TclGetNamespaceFromObj(interp, objv[2], &namespacePtr);
+    if (result != TCL_OK) {
+	return result;
+    }
+    if (namespacePtr == NULL) {
+	Tcl_AppendResult(interp, "unknown namespace \"",
+		Tcl_GetString(objv[2]), "\"", NULL);
+	return TCL_ERROR;
+    }
+
+    /*
+     * Invoke the command in the requested namespace
+     */
+
+    iPtr->lookupNsPtr = (Namespace *) namespacePtr;
+    return Tcl_EvalObjv(interp, objc-3, objv+3, TCL_EVAL_INVOKE);
+}   
+
+/*
+ *----------------------------------------------------------------------
+ *
  * NamespaceInscopeCmd --
  *
  *	Invoked to implement the "namespace inscope" command that executes a