* generic/tclBasic.c: TIP #280 implementation, conditional on the define TCL_TIP280.

	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclCompCmds.c:
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclIOUtil.c:
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* tests/compile.test:
	* tests/info.test:
	* tests/platform.test:
	* tests/safe.test:

1 files changed, 135 insertions, 2 deletions

diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 1613799..d4a8732 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.26 2006/04/11 14:37:04 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.27 2006/11/28 22:20:00 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -138,6 +138,10 @@ static void		TraceCommandProc _ANSI_ARGS_((ClientData clientData,
                             CONST char *newName, int flags));
 static Tcl_CmdObjTraceProc TraceExecutionProc;
 
+#ifdef TCL_TIP280
+static void             ListLines _ANSI_ARGS_((CONST char* listStr, int line,
+					       int n, int* lines));
+#endif
 /*
  *----------------------------------------------------------------------
  *
@@ -2729,6 +2733,15 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
     char *string, *pattern;
     Tcl_Obj *stringObj;
     Tcl_Obj *CONST *savedObjv = objv;
+#ifdef TCL_TIP280
+    Interp*  iPtr  = (Interp*) interp;
+    int      pc    = 0;
+    int      bidx  = 0;    /* Index of body argument */
+    Tcl_Obj* blist = NULL; /* List obj which is the body */
+    CmdFrame ctx;          /* Copy of the topmost cmdframe,
+			    * to allow us to mess with the
+			    * line information */
+#endif
     static CONST char *options[] = {
 	"-exact",	"-glob",	"-regexp",	"--", 
 	NULL
@@ -2763,16 +2776,25 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
     stringObj = objv[i];
     objc -= i + 1;
     objv += i + 1;
+#ifdef TCL_TIP280
+    bidx = i+1; /* First after the match string */
+#endif
 
     /*
      * If all of the pattern/command pairs are lumped into a single
      * argument, split them out again.
+     *
+     * TIP #280: Determine the lines the words in the list start at, based on
+     * the same data for the list word itself. The cmdFramePtr line information
+     * is manipulated directly.
      */
 
     splitObjs = 0;
     if (objc == 1) {
 	Tcl_Obj **listv;
-
+#ifdef TCL_TIP280
+	blist = objv[0];
+#endif
 	if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -2871,8 +2893,58 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 	/*
 	 * We've got a match. Find a body to execute, skipping bodies
 	 * that are "-".
+	 *
+	 * TIP#280: Now is also the time to determine a line number for the
+	 * single-word case.
 	 */
 
+#ifdef TCL_TIP280
+	ctx = *iPtr->cmdFramePtr;
+
+	if (splitObjs) {
+	    /* We have to perform the GetSrc and other type dependent handling
+	     * of the frame here because we are munging with the line numbers,
+	     * something the other commands like if, etc. are not doing. Them
+	     * are fine with simply passing the CmdFrame through and having
+	     * the special handling done in 'info frame', or the bc compiler
+	     */
+
+	    if (ctx.type == TCL_LOCATION_BC) {
+		/* Note: Type BC => ctx.data.eval.path    is not used.
+		 *                  ctx.data.tebc.codePtr is used instead.
+		 */
+		TclGetSrcInfoForPc (&ctx);
+		pc = 1;
+		/* The line information in the cmdFrame is now a copy we do
+		 * not own */
+	    }
+
+	    if (ctx.type == TCL_LOCATION_SOURCE) {
+		int bline = ctx.line [bidx];
+		if (bline >= 0) {
+		    ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		    ctx.nline = objc;
+
+		    ListLines (Tcl_GetString (blist), bline, objc, ctx.line);
+		} else {
+		    int k;
+		    /* Dynamic code word ... All elements are relative to themselves */
+
+		    ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		    ctx.nline = objc;
+		    for (k=0; k < objc; k++) {ctx.line[k] = -1;}
+		}
+	    } else {
+		int k;
+		/* Anything else ... No information, or dynamic ... */
+
+		ctx.line  = (int*) ckalloc (objc * sizeof(int));
+		ctx.nline = objc;
+		for (k=0; k < objc; k++) {ctx.line[k] = -1;}
+	    }
+	}
+#endif
+
 	for (j = i + 1; ; j += 2) {
 	    if (j >= objc) {
 		/*
@@ -2885,7 +2957,19 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
 		break;
 	    }
 	}
+#ifndef TCL_TIP280
 	result = Tcl_EvalObjEx(interp, objv[j], 0);
+#else
+	/* TIP #280. Make invoking context available to switch branch */
+	result = TclEvalObjEx(interp, objv[j], 0, &ctx, j);
+	if (splitObjs) {
+	    ckfree ((char*) ctx.line);
+	    if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
+		/* Death of SrcInfo reference */
+		Tcl_DecrRefCount (ctx.data.eval.path);
+	    }
+	}
+#endif
 	if (result == TCL_ERROR) {
 	    char msg[100 + TCL_INTEGER_SPACE];
 
@@ -4860,6 +4944,9 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
     Tcl_Obj *CONST objv[];       	/* Argument objects. */
 {
     int result, value;
+#ifdef TCL_TIP280
+    Interp* iPtr = (Interp*) interp;
+#endif
 
     if (objc != 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "test command");
@@ -4874,7 +4961,12 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
         if (!value) {
             break;
         }
+#ifndef TCL_TIP280
         result = Tcl_EvalObjEx(interp, objv[2], 0);
+#else
+	/* TIP #280. */
+        result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr,2);
+#endif
         if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
             if (result == TCL_ERROR) {
                 char msg[32 + TCL_INTEGER_SPACE];
@@ -4894,4 +4986,45 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
     }
     return result;
 }
+
+#ifdef TCL_TIP280
+static void
+ListLines(listStr, line, n, lines)
+     CONST char* listStr; /* Pointer to string with list structure.
+			   * Assumed to be valid. Assumed to contain
+			   * n elements.
+			   */
+     int  line;           /* line the list as a whole starts on */
+     int  n;              /* #elements in lines */
+     int* lines;          /* Array of line numbers, to fill */
+{
+    int         i;
+    int         length  = strlen( listStr);
+    CONST char *element = NULL;
+    CONST char* next    = NULL;
+
+    for (i = 0; i < n; i++) {
+	TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);
+
+	TclAdvanceLines (&line, listStr, element); /* Leading whitespace */
+	lines [i] = line;
+	length   -= (next - listStr);
+	TclAdvanceLines (&line, element, next); /* Element */
+	listStr   = next;
+
+	if (*element == 0) {
+	    /* ASSERT i == n */
+	    break;
+	}
+    }
+}
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */