summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdMZ.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdMZ.c')
-rw-r--r--generic/tclCmdMZ.c137
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:
+ */