diff options
Diffstat (limited to 'generic/tclCmdMZ.c')
| -rw-r--r-- | generic/tclCmdMZ.c | 137 |
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: + */ |