TIP#250 IMPLEMENTATION

        * doc/namespace.n:      New command [namespace upvar].  [Patch 1275435]
        * generic/tclInt.h:
        * generic/tclNamesp.c:
        * generic/tclVar.c:
        * tests/namespace.test:
        * tests/upvar.test:

1 files changed, 83 insertions, 3 deletions

diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 2debd69..55b6dc1 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -21,7 +21,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclNamesp.c,v 1.91 2006/01/11 17:34:53 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.92 2006/02/01 17:48:11 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -228,6 +228,8 @@ static int		NamespaceQualifiersCmd(ClientData dummy,
 			    Tcl_Interp *interp,int objc,Tcl_Obj *CONST objv[]);
 static int		NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
+static int		NamespaceUpvarCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]);
 static int		NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
 static int		SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -2896,13 +2898,13 @@ Tcl_NamespaceObjCmd(
 	"children", "code", "current", "delete", "ensemble",
 	"eval", "exists", "export", "forget", "import",
 	"inscope", "origin", "parent", "path", "qualifiers",
-	"tail", "which", NULL
+	"tail", "upvar", "which", NULL
     };
     enum NSSubCmdIdx {
 	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
 	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
 	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
-	NSTailIdx, NSWhichIdx
+	NSTailIdx, NSUpvarIdx, NSWhichIdx
     };
     int index, result;
 
@@ -2969,6 +2971,9 @@ Tcl_NamespaceObjCmd(
 	break;
     case NSTailIdx:
 	result = NamespaceTailCmd(clientData, interp, objc, objv);
+	break;	
+    case NSUpvarIdx:
+	result = NamespaceUpvarCmd(clientData, interp, objc, objv);
 	break;
     case NSWhichIdx:
 	result = NamespaceWhichCmd(clientData, interp, objc, objv);
@@ -4332,6 +4337,81 @@ NamespaceTailCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * NamespaceUpvarCmd --
+ *
+ *	Invoked to implement the "namespace upvar" command, that creates
+ *	variables in the current scope linked to variables in another
+ *	namespace. Handles the following syntax:
+ *
+ *	    namespace upvar ns otherVar myVar ?otherVar myVar ...?
+ *
+ * Results:
+ *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ *	Creates new variables in the current scope, linked to the
+ *      corresponding variables in the stipulated nmamespace.
+ *      If anything goes wrong, the result is an error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NamespaceUpvarCmd(dummy, interp, objc, objv)
+    ClientData dummy;			/* Not used. */
+    Tcl_Interp *interp;			/* Current interpreter. */
+    int objc;				/* Number of arguments. */
+    Tcl_Obj *CONST objv[];		/* Argument objects. */
+{
+    Tcl_Namespace *nsPtr;
+    int result;
+    Var *otherPtr, *arrayPtr;
+    char *myName;
+    CallFrame frame, *framePtr = &frame;
+    
+    if (objc < 5 || !(objc & 1)) {
+	Tcl_WrongNumArgs(interp, 2, objv, "ns otherVar myVar ?otherVar myVar ...?");
+	return TCL_ERROR;
+    }
+
+    result = TclGetNamespaceFromObj(interp, objv[2], &nsPtr);
+    if (result != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    objc -= 3;
+    objv += 3;
+    
+    for (; objc>0 ; objc-=2, objv+=2) {
+	/*
+	 * Locate the other variable
+	 */
+	Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, nsPtr, 0);
+	otherPtr = TclObjLookupVar(interp, objv[0], NULL,
+		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	if (otherPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	Tcl_PopCallFrame(interp);
+
+	/*
+	 * Create the new variable and link it to otherPtr
+	 */
+	
+	myName = TclGetString(objv[1]);
+	result = TclPtrMakeUpvar(interp, otherPtr, myName, 0, -1);
+	if (result != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * NamespaceWhichCmd --
  *
  *	Invoked to implement the "namespace which" command that returns the