diff options
| -rw-r--r-- | generic/tclCmdAH.c | 268 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 1163 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 309 |
3 files changed, 893 insertions, 847 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 414666a..79577e0 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.81 2006/11/28 22:20:28 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.82 2007/02/06 21:15:14 dkf Exp $ */ #include "tclInt.h" @@ -54,11 +54,11 @@ static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName, /* ARGSUSED */ int -Tcl_BreakObjCmd(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_BreakObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -73,7 +73,8 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv) * Tcl_CaseObjCmd -- * * This procedure is invoked to process the "case" Tcl command. See the - * user documentation for details on what it does. + * user documentation for details on what it does. THIS COMMAND IS + * OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0. * * Results: * A standard Tcl object result. @@ -86,11 +87,11 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_CaseObjCmd(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_CaseObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { register int i; int body, result, caseObjc; @@ -221,16 +222,16 @@ Tcl_CaseObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_CatchObjCmd(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_CatchObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *varNamePtr = NULL; Tcl_Obj *optionVarNamePtr = NULL; int result; - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -245,8 +246,11 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv) optionVarNamePtr = objv[3]; } - /* TIP #280. Make invoking context available to caught script */ - result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1); + /* + * TIP #280. Make invoking context available to caught script. + */ + + result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1); /* * We disable catch in interpreters where the limit has been exceeded. @@ -302,11 +306,11 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_CdObjCmd(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_CdObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *dir; int result; @@ -357,11 +361,11 @@ Tcl_CdObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_ConcatObjCmd(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_ConcatObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { if (objc >= 2) { Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1)); @@ -392,11 +396,11 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_ContinueObjCmd(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_ContinueObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -422,11 +426,11 @@ Tcl_ContinueObjCmd(dummy, interp, objc, objv) */ int -Tcl_EncodingObjCmd(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_EncodingObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int index; @@ -543,11 +547,11 @@ Tcl_EncodingObjCmd(dummy, interp, objc, objv) */ int -EncodingDirsObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +EncodingDirsObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?dirList?"); @@ -585,11 +589,11 @@ EncodingDirsObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_ErrorObjCmd(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_ErrorObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *options; @@ -600,13 +604,13 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv) options = Tcl_NewStringObj("-code error -level 0", -1); - if (objc >= 3) { /* process the optional info argument */ + if (objc >= 3) { /* Process the optional info argument */ Tcl_ListObjAppendElement(NULL, options, Tcl_NewStringObj("-errorinfo", -1)); Tcl_ListObjAppendElement(NULL, options, objv[2]); } - if (objc == 4) { /* process the optional code argument */ + if (objc == 4) { /* Process the optional code argument */ Tcl_ListObjAppendElement(NULL, options, Tcl_NewStringObj("-errorcode", -1)); Tcl_ListObjAppendElement(NULL, options, objv[3]); @@ -635,15 +639,15 @@ Tcl_ErrorObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_EvalObjCmd(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_EvalObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int result; register Tcl_Obj *objPtr; - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?"); @@ -651,9 +655,12 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) } if (objc == 2) { - /* TIP #280. Make invoking context available to eval'd script */ + /* + * TIP #280. Make invoking context available to eval'd script. + */ + result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT, - iPtr->cmdFramePtr,1); + iPtr->cmdFramePtr, 1); } else { /* * More than one argument: concatenate them together with spaces @@ -662,7 +669,11 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) */ objPtr = Tcl_ConcatObj(objc-1, objv+1); - /* TIP #280. Make invoking context available to eval'd script */ + + /* + * TIP #280. Make invoking context available to eval'd script. + */ + result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0); } if (result == TCL_ERROR) { @@ -691,11 +702,11 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_ExitObjCmd(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_ExitObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int value; @@ -711,7 +722,7 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv) } Tcl_Exit(value); /*NOTREACHED*/ - return TCL_OK; /* Better not ever reach this! */ + return TCL_OK; /* Better not ever reach this! */ } /* @@ -740,11 +751,11 @@ Tcl_ExitObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_ExprObjCmd(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_ExprObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { register Tcl_Obj *objPtr; Tcl_Obj *resultPtr; @@ -762,7 +773,7 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv) if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); - Tcl_DecrRefCount(resultPtr); /* done with the result object */ + Tcl_DecrRefCount(resultPtr); /* Done with the result object */ } return result; @@ -790,11 +801,11 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_FileObjCmd(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_FileObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int index, value; Tcl_StatBuf buf; @@ -1305,7 +1316,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } } case FCMD_SYSTEM: { - Tcl_Obj* fsInfo; + Tcl_Obj *fsInfo; if (objc != 3) { goto only3Args; @@ -1372,11 +1383,11 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) */ static int -CheckAccess(interp, pathPtr, mode) - Tcl_Interp *interp; /* Interp for status return. Must not be +CheckAccess( + Tcl_Interp *interp, /* Interp for status return. Must not be * NULL. */ - Tcl_Obj *pathPtr; /* Name of file to check. */ - int mode; /* Attribute to check; passed as argument to + Tcl_Obj *pathPtr, /* Name of file to check. */ + int mode) /* Attribute to check; passed as argument to * access(). */ { int value; @@ -1412,12 +1423,12 @@ CheckAccess(interp, pathPtr, mode) */ static int -GetStatBuf(interp, pathPtr, statProc, statPtr) - Tcl_Interp *interp; /* Interp for error return. May be NULL. */ - Tcl_Obj *pathPtr; /* Path name to examine. */ - Tcl_FSStatProc *statProc; /* Either stat() or lstat() depending on +GetStatBuf( + Tcl_Interp *interp, /* Interp for error return. May be NULL. */ + Tcl_Obj *pathPtr, /* Path name to examine. */ + Tcl_FSStatProc *statProc, /* Either stat() or lstat() depending on * desired behavior. */ - Tcl_StatBuf *statPtr; /* Filled with info about file obtained by + Tcl_StatBuf *statPtr) /* Filled with info about file obtained by * calling (*statProc)(). */ { int status; @@ -1459,11 +1470,11 @@ GetStatBuf(interp, pathPtr, statProc, statPtr) */ static int -StoreStatData(interp, varName, statPtr) - Tcl_Interp *interp; /* Interpreter for error reports. */ - Tcl_Obj *varName; /* Name of associative array variable in which +StoreStatData( + Tcl_Interp *interp, /* Interpreter for error reports. */ + Tcl_Obj *varName, /* Name of associative array variable in which * to store stat results. */ - Tcl_StatBuf *statPtr; /* Pointer to buffer containing stat data to + Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { Tcl_Obj *field = Tcl_NewObj(); @@ -1530,8 +1541,8 @@ StoreStatData(interp, varName, statPtr) */ static char * -GetTypeFromMode(mode) - int mode; +GetTypeFromMode( + int mode) { if (S_ISREG(mode)) { return "file"; @@ -1579,22 +1590,25 @@ GetTypeFromMode(mode) /* ARGSUSED */ int -Tcl_ForObjCmd(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_ForObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int result, value; - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; if (objc != 5) { Tcl_WrongNumArgs(interp, 1, objv, "start test next command"); return TCL_ERROR; } - /* TIP #280. Make invoking context available to initial script */ - result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr,1); + /* + * TIP #280. Make invoking context available to initial script. + */ + + result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1); if (result != TCL_OK) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (\"for\" initial command)"); @@ -1616,8 +1630,12 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) if (!value) { break; } - /* TIP #280. Make invoking context available to loop body */ - result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr,4); + + /* + * TIP #280. Make invoking context available to loop body. + */ + + result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr, 4); if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -1625,8 +1643,12 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) } break; } - /* TIP #280. Make invoking context available to next script */ - result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3); + + /* + * TIP #280. Make invoking context available to next script. + */ + + result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3); if (result == TCL_BREAK) { break; } else if (result != TCL_OK) { @@ -1664,11 +1686,11 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_ForeachObjCmd(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_ForeachObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int result = TCL_OK; int i; /* i selects a value list */ @@ -1700,7 +1722,7 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) Tcl_Obj ***varvList = varvListArray;/* Array of var name lists */ int *argcList = argcListArray; /* Array of value list sizes */ Tcl_Obj ***argvList = argvListArray;/* Array of value lists */ - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1810,7 +1832,7 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) if (k < argcList[i]) { valuePtr = argvList[i][k]; } else { - valuePtr = Tcl_NewObj(); /* empty string */ + valuePtr = Tcl_NewObj(); /* Empty string */ } varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL, valuePtr, 0); @@ -1824,8 +1846,11 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) } } - /* TIP #280. Make invoking context available to loop body */ - result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr,objc-1); + /* + * TIP #280. Make invoking context available to loop body. + */ + + result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr, objc-1); if (result != TCL_OK) { if (result == TCL_CONTINUE) { result = TCL_OK; @@ -1834,7 +1859,8 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) break; } else if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"foreach\" body line %d)", interp->errorLine)); + "\n (\"foreach\" body line %d)", + interp->errorLine)); break; } else { break; @@ -1880,11 +1906,11 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -Tcl_FormatObjCmd(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_FormatObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *resultPtr; /* Where result is stored finally. */ diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 712cbc0..74e94bc 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -10,13 +10,13 @@ * Copyright (c) 1993-1997 Lucent Technologies. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * Copyright (c) 1998-1999 by Scriptics Corporation. - * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. + * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. * Copyright (c) 2005 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.96 2006/11/28 22:20:28 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.97 2007/02/06 21:15:14 dkf Exp $ */ #include "tclInt.h" @@ -58,7 +58,7 @@ typedef struct SortInfo { * ASCII mode). */ Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is * SORTMODE_COMMAND. Pre-initialized to hold - * base of command.*/ + * base of command. */ int *indexv; /* If the -index option was specified, this * holds the indexes contained in the list * supplied as an argument to that option. @@ -115,9 +115,8 @@ static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp, static int InfoExistsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* TIP #280 - New 'info' subcommand 'frame' */ -static int InfoFrameCmd(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); +static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); static int InfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, @@ -176,19 +175,19 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_IfObjCmd(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_IfObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int thenScriptIndex = 0; /* "then" script to be evaled after - * syntax check */ - Interp* iPtr = (Interp*) interp; + int thenScriptIndex = 0; /* "then" script to be evaled after syntax + * check. */ + Interp *iPtr = (Interp *) interp; int i, result, value; char *clause; + i = 1; while (1) { /* @@ -200,8 +199,8 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) if (i >= objc) { clause = TclGetString(objv[i-1]); - Tcl_AppendResult(interp, "wrong # args: no expression after \"", - clause, "\" argument", (char *) NULL); + Tcl_AppendResult(interp, "wrong # args: ", + "no expression after \"", clause, "\" argument", NULL); return TCL_ERROR; } if (!thenScriptIndex) { @@ -212,10 +211,10 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) } i++; if (i >= objc) { - missingScript: + missingScript: clause = TclGetString(objv[i-1]); - Tcl_AppendResult(interp, "wrong # args: no script following \"", - clause, "\" argument", (char *) NULL); + Tcl_AppendResult(interp, "wrong # args: ", + "no script following \"", clause, "\" argument", NULL); return TCL_ERROR; } clause = TclGetString(objv[i]); @@ -238,9 +237,12 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) i++; if (i >= objc) { if (thenScriptIndex) { - /* TIP #280. Make invoking context available to branch */ + /* + * TIP #280. Make invoking context available to branch. + */ + return TclEvalObjEx(interp, objv[thenScriptIndex], 0, - iPtr->cmdFramePtr,thenScriptIndex); + iPtr->cmdFramePtr, thenScriptIndex); } return TCL_OK; } @@ -261,24 +263,25 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) if (strcmp(clause, "else") == 0) { i++; if (i >= objc) { - Tcl_AppendResult(interp, - "wrong # args: no script following \"else\" argument", - (char *) NULL); + Tcl_AppendResult(interp, "wrong # args: ", + "no script following \"else\" argument", NULL); return TCL_ERROR; } } if (i < objc - 1) { - Tcl_AppendResult(interp, - "wrong # args: extra words after \"else\" clause in \"if\" command", - (char *) NULL); + Tcl_AppendResult(interp, "wrong # args: ", + "extra words after \"else\" clause in \"if\" command", NULL); return TCL_ERROR; } if (thenScriptIndex) { - /* TIP #280. Make invoking context available to branch/else */ + /* + * TIP #280. Make invoking context available to branch/else. + */ + return TclEvalObjEx(interp, objv[thenScriptIndex], 0, - iPtr->cmdFramePtr,thenScriptIndex); + iPtr->cmdFramePtr, thenScriptIndex); } - return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr,i); + return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i); } /* @@ -302,13 +305,12 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_IncrObjCmd(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_IncrObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *newValuePtr, *incrPtr; @@ -357,27 +359,26 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_InfoObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Arbitrary value passed to the command. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_InfoObjCmd( + ClientData clientData, /* Arbitrary value passed to the command. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { static CONST char *subCmds[] = { - "args", "body", "cmdcount", "commands", - "complete", "default", "exists", "frame", "functions", - "globals", "hostname", "level", "library", "loaded", - "locals", "nameofexecutable", "patchlevel", "procs", - "script", "sharedlibextension", "tclversion", "vars", - (char *) NULL}; + "args", "body", "cmdcount", "commands", + "complete", "default", "exists", "frame", "functions", + "globals", "hostname", "level", "library", "loaded", + "locals", "nameofexecutable", "patchlevel", "procs", + "script", "sharedlibextension", "tclversion", "vars", + NULL}; enum ISubCmdIdx { - IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx, - ICompleteIdx, IDefaultIdx, IExistsIdx, IFrameIdx, IFunctionsIdx, - IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx, - ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx, - IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx + IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx, + ICompleteIdx, IDefaultIdx, IExistsIdx, IFrameIdx, IFunctionsIdx, + IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx, + ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx, + IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx }; int index, result; @@ -393,73 +394,73 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv) } switch (index) { - case IArgsIdx: - result = InfoArgsCmd(clientData, interp, objc, objv); - break; - case IBodyIdx: - result = InfoBodyCmd(clientData, interp, objc, objv); - break; - case ICmdCountIdx: - result = InfoCmdCountCmd(clientData, interp, objc, objv); - break; - case ICommandsIdx: - result = InfoCommandsCmd(clientData, interp, objc, objv); - break; - case ICompleteIdx: - result = InfoCompleteCmd(clientData, interp, objc, objv); - break; - case IDefaultIdx: - result = InfoDefaultCmd(clientData, interp, objc, objv); - break; - case IExistsIdx: - result = InfoExistsCmd(clientData, interp, objc, objv); - break; - case IFrameIdx: - /* TIP #280 - New method 'frame' */ - result = InfoFrameCmd(clientData, interp, objc, objv); - break; - case IFunctionsIdx: - result = InfoFunctionsCmd(clientData, interp, objc, objv); - break; - case IGlobalsIdx: - result = InfoGlobalsCmd(clientData, interp, objc, objv); - break; - case IHostnameIdx: - result = InfoHostnameCmd(clientData, interp, objc, objv); - break; - case ILevelIdx: - result = InfoLevelCmd(clientData, interp, objc, objv); - break; - case ILibraryIdx: - result = InfoLibraryCmd(clientData, interp, objc, objv); - break; - case ILoadedIdx: - result = InfoLoadedCmd(clientData, interp, objc, objv); - break; - case ILocalsIdx: - result = InfoLocalsCmd(clientData, interp, objc, objv); - break; - case INameOfExecutableIdx: - result = InfoNameOfExecutableCmd(clientData, interp, objc, objv); - break; - case IPatchLevelIdx: - result = InfoPatchLevelCmd(clientData, interp, objc, objv); - break; - case IProcsIdx: - result = InfoProcsCmd(clientData, interp, objc, objv); - break; - case IScriptIdx: - result = InfoScriptCmd(clientData, interp, objc, objv); - break; - case ISharedLibExtensionIdx: - result = InfoSharedlibCmd(clientData, interp, objc, objv); - break; - case ITclVersionIdx: - result = InfoTclVersionCmd(clientData, interp, objc, objv); - break; - case IVarsIdx: - result = InfoVarsCmd(clientData, interp, objc, objv); - break; + case IArgsIdx: + result = InfoArgsCmd(clientData, interp, objc, objv); + break; + case IBodyIdx: + result = InfoBodyCmd(clientData, interp, objc, objv); + break; + case ICmdCountIdx: + result = InfoCmdCountCmd(clientData, interp, objc, objv); + break; + case ICommandsIdx: + result = InfoCommandsCmd(clientData, interp, objc, objv); + break; + case ICompleteIdx: + result = InfoCompleteCmd(clientData, interp, objc, objv); + break; + case IDefaultIdx: + result = InfoDefaultCmd(clientData, interp, objc, objv); + break; + case IExistsIdx: + result = InfoExistsCmd(clientData, interp, objc, objv); + break; + case IFrameIdx: + /* TIP #280 - New method 'frame' */ + result = InfoFrameCmd(clientData, interp, objc, objv); + break; + case IFunctionsIdx: + result = InfoFunctionsCmd(clientData, interp, objc, objv); + break; + case IGlobalsIdx: + result = InfoGlobalsCmd(clientData, interp, objc, objv); + break; + case IHostnameIdx: + result = InfoHostnameCmd(clientData, interp, objc, objv); + break; + case ILevelIdx: + result = InfoLevelCmd(clientData, interp, objc, objv); + break; + case ILibraryIdx: + result = InfoLibraryCmd(clientData, interp, objc, objv); + break; + case ILoadedIdx: + result = InfoLoadedCmd(clientData, interp, objc, objv); + break; + case ILocalsIdx: + result = InfoLocalsCmd(clientData, interp, objc, objv); + break; + case INameOfExecutableIdx: + result = InfoNameOfExecutableCmd(clientData, interp, objc, objv); + break; + case IPatchLevelIdx: + result = InfoPatchLevelCmd(clientData, interp, objc, objv); + break; + case IProcsIdx: + result = InfoProcsCmd(clientData, interp, objc, objv); + break; + case IScriptIdx: + result = InfoScriptCmd(clientData, interp, objc, objv); + break; + case ISharedLibExtensionIdx: + result = InfoSharedlibCmd(clientData, interp, objc, objv); + break; + case ITclVersionIdx: + result = InfoTclVersionCmd(clientData, interp, objc, objv); + break; + case IVarsIdx: + result = InfoVarsCmd(clientData, interp, objc, objv); + break; } return result; } @@ -485,11 +486,11 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv) */ static int -InfoArgsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoArgsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; char *name; @@ -505,8 +506,7 @@ InfoArgsCmd(dummy, interp, objc, objv) name = TclGetString(objv[2]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", name, - "\" isn't a procedure", (char *) NULL); + Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL); return TCL_ERROR; } @@ -514,7 +514,7 @@ InfoArgsCmd(dummy, interp, objc, objv) * Build a return list containing the arguments. */ - listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + listObjPtr = Tcl_NewListObj(0, NULL); for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; localPtr = localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { @@ -547,11 +547,11 @@ InfoArgsCmd(dummy, interp, objc, objv) */ static int -InfoBodyCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoBodyCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; char *name; @@ -566,8 +566,7 @@ InfoBodyCmd(dummy, interp, objc, objv) name = TclGetString(objv[2]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", name, - "\" isn't a procedure", (char *) NULL); + Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL); return TCL_ERROR; } @@ -617,11 +616,11 @@ InfoBodyCmd(dummy, interp, objc, objv) */ static int -InfoCmdCountCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoCmdCountCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -659,11 +658,11 @@ InfoCmdCountCmd(dummy, interp, objc, objv) */ static int -InfoCommandsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoCommandsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *cmdName, *pattern; CONST char *simplePattern; @@ -724,7 +723,7 @@ InfoCommandsCmd(dummy, interp, objc, objv) * name. */ - listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + listPtr = Tcl_NewListObj(0, NULL); if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { /* @@ -811,7 +810,7 @@ InfoCommandsCmd(dummy, interp, objc, objv) cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) { + if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } @@ -936,11 +935,11 @@ InfoCommandsCmd(dummy, interp, objc, objv) */ static int -InfoCompleteCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoCompleteCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "command"); @@ -977,11 +976,11 @@ InfoCompleteCmd(dummy, interp, objc, objv) */ static int -InfoDefaultCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoDefaultCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; char *procName, *argName, *varName; @@ -999,8 +998,7 @@ InfoDefaultCmd(dummy, interp, objc, objv) procPtr = TclFindProc(iPtr, procName); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", procName, - "\" isn't a procedure", (char *) NULL); + Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL); return TCL_ERROR; } @@ -1012,12 +1010,7 @@ InfoDefaultCmd(dummy, interp, objc, objv) valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL, localPtr->defValuePtr, 0); if (valueObjPtr == NULL) { - defStoreError: - varName = TclGetString(objv[4]); - Tcl_AppendResult(interp, - "couldn't store default value in variable \"", - varName, "\"", (char *) NULL); - return TCL_ERROR; + goto defStoreError; } Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } else { @@ -1034,7 +1027,13 @@ InfoDefaultCmd(dummy, interp, objc, objv) } Tcl_AppendResult(interp, "procedure \"", procName, - "\" doesn't have an argument \"", argName, "\"", (char *) NULL); + "\" doesn't have an argument \"", argName, "\"", NULL); + return TCL_ERROR; + + defStoreError: + varName = TclGetString(objv[4]); + Tcl_AppendResult(interp, "couldn't store default value in variable \"", + varName, "\"", NULL); return TCL_ERROR; } @@ -1059,11 +1058,11 @@ InfoDefaultCmd(dummy, interp, objc, objv) */ static int -InfoExistsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoExistsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *varName; Var *varPtr; @@ -1089,247 +1088,270 @@ InfoExistsCmd(dummy, interp, objc, objv) * InfoFrameCmd -- * TIP #280 * - * Called to implement the "info frame" command that returns the - * location of either the currently executing command, or its caller. - * Handles the following syntax: + * Called to implement the "info frame" command that returns the location + * of either the currently executing command, or its caller. Handles the + * following syntax: * - * info frame ?number? + * info frame ?number? * * Results: - * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * Returns TCL_OK if successful and TCL_ERROR if there is an error. * * Side effects: - * Returns a result in the interpreter's result object. If there is - * an error, the result is an error message. + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. * *---------------------------------------------------------------------- */ static int -InfoFrameCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoFrameCmd( + 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_Obj *lv[20]; /* Keep uptodate when more keys are added to + * the dict. */ + int level, lc = 0; + CmdFrame *framePtr; + /* + * This array is indexed by the TCL_LOCATION_... values, except + * for _LAST. + */ + static CONST char *typeString[TCL_LOCATION_LAST] = { + "eval", "eval", "eval", "precompiled", "source", "proc" + }; if (objc == 2) { - /* just "info frame" */ - int levels = (iPtr->cmdFramePtr == NULL - ? 0 - : iPtr->cmdFramePtr->level); + /* + * Just "info frame" + */ - Tcl_SetIntObj(Tcl_GetObjResult(interp), levels); - return TCL_OK; + int levels = + (iPtr->cmdFramePtr == NULL ? 0 : iPtr->cmdFramePtr->level); - } else if (objc == 3) { - /* "info frame level" */ - int level; - CmdFrame *framePtr; - - if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) { - return TCL_ERROR; - } - if (level <= 0) { - /* Relative adressing */ - - if (iPtr->cmdFramePtr == NULL) { - levelError: - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), - "bad level \"", - Tcl_GetString(objv[2]), - "\"", (char *) NULL); - return TCL_ERROR; - } - /* Convert to absolute. */ - - level += iPtr->cmdFramePtr->level; - } - for (framePtr = iPtr->cmdFramePtr; - framePtr != NULL; - framePtr = framePtr->nextPtr) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), levels); + return TCL_OK; + } else if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?number?"); + return TCL_ERROR; + } - if (framePtr->level == level) { - break; - } - } - if (framePtr == NULL) { - goto levelError; - } + /* + * We've got "info frame level" and must parse the level first. + */ + if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) { + return TCL_ERROR; + } + if (level <= 0) { /* - * Pull the information and construct the dictionary to return, as - * list. Regarding use of the CmdFrame fields see tclInt.h, and its - * definition. + * Negative levels are adressing relative to the current frame's + * depth. */ - { - Tcl_Obj* lv [20]; /* Keep uptodate when more keys are added to the dict */ - int lc = 0; + if (iPtr->cmdFramePtr == NULL) { + levelError: + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"", + TclGetString(objv[2]), "\"", NULL); + return TCL_ERROR; + } - /* This array is indexed by the TCL_LOCATION_... values, except - * for _LAST. - */ + /* + * Convert to absolute. + */ - static CONST char* typeString [TCL_LOCATION_LAST] = { - "eval", "eval", "eval", "precompiled", "source", "proc" - }; - - switch (framePtr->type) { - case TCL_LOCATION_EVAL: - /* Evaluation, dynamic script. Type, line, cmd, the latter - * through str. */ - - lv [lc ++] = Tcl_NewStringObj ("type",-1); - lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); - lv [lc ++] = Tcl_NewStringObj ("line",-1); - lv [lc ++] = Tcl_NewIntObj (framePtr->line[0]); - lv [lc ++] = Tcl_NewStringObj ("cmd",-1); - lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd, - framePtr->cmd.str.len); - break; + level += iPtr->cmdFramePtr->level; + } - case TCL_LOCATION_EVAL_LIST: - /* List optimized evaluation. Type, line, cmd, the latter - * through listPtr, possibly a frame. */ + for (framePtr = iPtr->cmdFramePtr; framePtr != NULL; + framePtr = framePtr->nextPtr) { + if (framePtr->level == level) { + break; + } + } + if (framePtr == NULL) { + goto levelError; + } - lv [lc ++] = Tcl_NewStringObj ("type",-1); - lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); - lv [lc ++] = Tcl_NewStringObj ("line",-1); - lv [lc ++] = Tcl_NewIntObj (framePtr->line[0]); + /* + * Pull the information and construct the dictionary to return, as list. + * Regarding use of the CmdFrame fields see tclInt.h, and its definition. + */ - /* We put a duplicate of the command list obj into the result - * to ensure that the 'pure List'-property of the command - * itself is not destroyed. Otherwise the query here would - * disable the list optimization path in Tcl_EvalObjEx. - */ + switch (framePtr->type) { + case TCL_LOCATION_EVAL: + /* + * Evaluation, dynamic script. Type, line, cmd, the latter through + * str. + */ - lv [lc ++] = Tcl_NewStringObj ("cmd",-1); - lv [lc ++] = Tcl_DuplicateObj (framePtr->cmd.listPtr); - break; + lv[lc++] = Tcl_NewStringObj("type", -1); + lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1); + lv[lc++] = Tcl_NewStringObj("line", -1); + lv[lc++] = Tcl_NewIntObj(framePtr->line[0]); + lv[lc++] = Tcl_NewStringObj("cmd", -1); + lv[lc++] = Tcl_NewStringObj(framePtr->cmd.str.cmd, + framePtr->cmd.str.len); + break; - case TCL_LOCATION_PREBC: - /* Precompiled. Result contains the type as signal, nothing - * else */ + case TCL_LOCATION_EVAL_LIST: + /* + * List optimized evaluation. Type, line, cmd, the latter through + * listPtr, possibly a frame. + */ - lv [lc ++] = Tcl_NewStringObj ("type",-1); - lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); - break; + lv[lc++] = Tcl_NewStringObj("type", -1); + lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1); + lv[lc++] = Tcl_NewStringObj("line", -1); + lv[lc++] = Tcl_NewIntObj(framePtr->line[0]); + + /* + * We put a duplicate of the command list obj into the result to + * ensure that the 'pure List'-property of the command itself is not + * destroyed. Otherwise the query here would disable the list + * optimization path in Tcl_EvalObjEx. + */ - case TCL_LOCATION_BC: { - /* Execution of bytecode. Talk to the BC engine to fill out - * the frame. */ + lv[lc++] = Tcl_NewStringObj("cmd", -1); + lv[lc++] = Tcl_DuplicateObj(framePtr->cmd.listPtr); + break; - CmdFrame f = *framePtr; - Proc* procPtr = f.framePtr ? f.framePtr->procPtr : NULL; + case TCL_LOCATION_PREBC: + /* + * Precompiled. Result contains the type as signal, nothing else. + */ - /* Note: Type BC => f.data.eval.path is not used. - * f.data.tebc.codePtr is used instead. - */ + lv[lc++] = Tcl_NewStringObj("type", -1); + lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1); + break; - TclGetSrcInfoForPc (&f); - /* Now filled: cmd.str.(cmd,len), line */ - /* Possibly modified: type, path! */ + case TCL_LOCATION_BC: { + /* + * Execution of bytecode. Talk to the BC engine to fill out the frame. + */ - lv [lc ++] = Tcl_NewStringObj ("type",-1); - lv [lc ++] = Tcl_NewStringObj (typeString [f.type],-1); - lv [lc ++] = Tcl_NewStringObj ("line",-1); - lv [lc ++] = Tcl_NewIntObj (f.line[0]); + CmdFrame f = *framePtr; + Proc *procPtr = f.framePtr ? f.framePtr->procPtr : NULL; - if (f.type == TCL_LOCATION_SOURCE) { - lv [lc ++] = Tcl_NewStringObj ("file",-1); - lv [lc ++] = f.data.eval.path; - /* Death of reference by TclGetSrcInfoForPc */ - Tcl_DecrRefCount (f.data.eval.path); - } + /* + * Note: + * Type BC => f.data.eval.path is not used. + * f.data.tebc.codePtr is used instead. + */ - lv [lc ++] = Tcl_NewStringObj ("cmd",-1); - lv [lc ++] = Tcl_NewStringObj (f.cmd.str.cmd, f.cmd.str.len); + TclGetSrcInfoForPc(&f); - if (procPtr != NULL) { - Tcl_HashEntry* namePtr = procPtr->cmdPtr->hPtr; + /* + * Now filled: cmd.str.(cmd,len), line + * Possibly modified: type, path! + */ - if (namePtr) { - /* Regular command. */ - char* procName = Tcl_GetHashKey (namePtr->tablePtr, namePtr); - char* nsName = procPtr->cmdPtr->nsPtr->fullName; + lv[lc++] = Tcl_NewStringObj("type", -1); + lv[lc++] = Tcl_NewStringObj(typeString[f.type], -1); + lv[lc++] = Tcl_NewStringObj("line", -1); + lv[lc++] = Tcl_NewIntObj(f.line[0]); - lv [lc ++] = Tcl_NewStringObj ("proc",-1); - lv [lc ++] = Tcl_NewStringObj (nsName,-1); + if (f.type == TCL_LOCATION_SOURCE) { + lv[lc++] = Tcl_NewStringObj("file", -1); + lv[lc++] = f.data.eval.path; - if (strcmp (nsName, "::") != 0) { - Tcl_AppendToObj (lv [lc-1], "::", -1); - } - Tcl_AppendToObj (lv [lc-1], procName, -1); - } else { - /* Lambda execution. The lambda in question is stored - * in the clientData of the cmdPtr. See the #280 HACK - * in Tcl_ApplyObjCmd. There is no separate namespace - * to consider, if any is used it is part of the - * lambda term. - */ + /* + * Death of reference by TclGetSrcInfoForPc. + */ - lv [lc ++] = Tcl_NewStringObj ("lambda",-1); - lv [lc ++] = ((Tcl_Obj*) procPtr->cmdPtr->clientData); - } - } - break; - } + Tcl_DecrRefCount(f.data.eval.path); + } + + lv[lc++] = Tcl_NewStringObj("cmd", -1); + lv[lc++] = Tcl_NewStringObj(f.cmd.str.cmd, f.cmd.str.len); - case TCL_LOCATION_SOURCE: - /* Evaluation of a script file */ - - lv [lc ++] = Tcl_NewStringObj ("type",-1); - lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1); - lv [lc ++] = Tcl_NewStringObj ("line",-1); - lv [lc ++] = Tcl_NewIntObj (framePtr->line[0]); - lv [lc ++] = Tcl_NewStringObj ("file",-1); - lv [lc ++] = framePtr->data.eval.path; - /* Refcount framePtr->data.eval.path goes up when lv - * is converted into the result list object. + if (procPtr != NULL) { + Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; + + if (namePtr) { + /* + * This is a regular command. */ - lv [lc ++] = Tcl_NewStringObj ("cmd",-1); - lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd, - framePtr->cmd.str.len); - break; - case TCL_LOCATION_PROC: - Tcl_Panic ("TCL_LOCATION_PROC found in standard frame"); - break; + char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr); + char *nsName = procPtr->cmdPtr->nsPtr->fullName; + + lv[lc++] = Tcl_NewStringObj("proc", -1); + lv[lc++] = Tcl_NewStringObj(nsName, -1); + + if (strcmp(nsName, "::") != 0) { + Tcl_AppendToObj(lv[lc-1], "::", -1); + } + Tcl_AppendToObj(lv[lc-1], procName, -1); + } else { + /* + * Lambda execution. The lambda in question is stored in the + * clientData of the cmdPtr. See the #280 HACK in + * Tcl_ApplyObjCmd. There is no separate namespace to + * consider, if any is used it is part of the lambda term. + */ + + lv[lc++] = Tcl_NewStringObj("lambda", -1); + lv[lc++] = ((Tcl_Obj *) procPtr->cmdPtr->clientData); } + } + break; + } + case TCL_LOCATION_SOURCE: + /* + * Evaluation of a script file. + */ - /* 'level'. Common to all frame types. Conditional on having an - * associated _visible_ CallFrame */ + lv[lc++] = Tcl_NewStringObj("type", -1); + lv[lc++] = Tcl_NewStringObj(typeString[framePtr->type], -1); + lv[lc++] = Tcl_NewStringObj("line", -1); + lv[lc++] = Tcl_NewIntObj(framePtr->line[0]); + lv[lc++] = Tcl_NewStringObj("file", -1); + lv[lc++] = framePtr->data.eval.path; - if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) { - CallFrame* current = framePtr->framePtr; - CallFrame* top = iPtr->varFramePtr; - CallFrame* idx; + /* + * Refcount framePtr->data.eval.path goes up when lv is converted into + * the result list object. + */ - for (idx = top; - idx != NULL; - idx = idx->callerVarPtr) { - if (idx == current) { - int c = framePtr->framePtr->level; - int t = iPtr->varFramePtr->level; + lv[lc++] = Tcl_NewStringObj("cmd", -1); + lv[lc++] = Tcl_NewStringObj(framePtr->cmd.str.cmd, + framePtr->cmd.str.len); + break; - lv [lc ++] = Tcl_NewStringObj ("level",-1); - lv [lc ++] = Tcl_NewIntObj (t - c); - break; - } - } - } + case TCL_LOCATION_PROC: + Tcl_Panic("TCL_LOCATION_PROC found in standard frame"); + break; + } - Tcl_SetObjResult(interp, Tcl_NewListObj (lc, lv)); - return TCL_OK; + /* + * 'level'. Common to all frame types. Conditional on having an associated + * _visible_ CallFrame + */ + + if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) { + CallFrame *current = framePtr->framePtr; + CallFrame *top = iPtr->varFramePtr; + CallFrame *idx; + + for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) { + if (idx == current) { + int c = framePtr->framePtr->level; + int t = iPtr->varFramePtr->level; + + lv[lc++] = Tcl_NewStringObj("level", -1); + lv[lc++] = Tcl_NewIntObj(t - c); + break; + } } } - Tcl_WrongNumArgs(interp, 2, objv, "?number?"); - - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewListObj(lc, lv)); + return TCL_OK; } /* @@ -1354,11 +1376,11 @@ InfoFrameCmd(dummy, interp, objc, objv) */ static int -InfoFunctionsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoFunctionsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *pattern; Tcl_Obj *listPtr; @@ -1402,11 +1424,11 @@ InfoFunctionsCmd(dummy, interp, objc, objv) */ static int -InfoGlobalsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoGlobalsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *varName, *pattern; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); @@ -1438,7 +1460,7 @@ InfoGlobalsCmd(dummy, interp, objc, objv) * of all global variables that match the pattern. */ - listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + listPtr = Tcl_NewListObj(0, NULL); if (pattern != NULL && TclMatchIsTrivial(pattern)) { entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern); if (entryPtr != NULL) { @@ -1488,11 +1510,11 @@ InfoGlobalsCmd(dummy, interp, objc, objv) */ static int -InfoHostnameCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoHostnameCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { CONST char *name; if (objc != 2) { @@ -1532,11 +1554,11 @@ InfoHostnameCmd(dummy, interp, objc, objv) */ static int -InfoLevelCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoLevelCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; int level; @@ -1554,7 +1576,7 @@ InfoLevelCmd(dummy, interp, objc, objv) if (iPtr->varFramePtr == rootFramePtr) { levelError: Tcl_AppendResult(interp, "bad level \"", - TclGetString(objv[2]), "\"", (char *) NULL); + TclGetString(objv[2]), "\"", NULL); return TCL_ERROR; } level += iPtr->varFramePtr->level; @@ -1600,11 +1622,11 @@ InfoLevelCmd(dummy, interp, objc, objv) */ static int -InfoLibraryCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoLibraryCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { CONST char *libDirName; @@ -1645,11 +1667,11 @@ InfoLibraryCmd(dummy, interp, objc, objv) */ static int -InfoLoadedCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoLoadedCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *interpName; int result; @@ -1690,11 +1712,11 @@ InfoLoadedCmd(dummy, interp, objc, objv) */ static int -InfoLocalsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoLocalsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; char *pattern; @@ -1719,7 +1741,7 @@ InfoLocalsCmd(dummy, interp, objc, objv) * table (if one exists). */ - listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + listPtr = Tcl_NewListObj(0, NULL); AppendLocals(interp, listPtr, pattern, 0); Tcl_SetObjResult(interp, listPtr); return TCL_OK; @@ -1743,11 +1765,11 @@ InfoLocalsCmd(dummy, interp, objc, objv) */ static void -AppendLocals(interp, listPtr, pattern, includeLinks) - Tcl_Interp *interp; /* Current interpreter. */ - Tcl_Obj *listPtr; /* List object to append names to. */ - CONST char *pattern; /* Pattern to match against. */ - int includeLinks; /* 1 if upvars should be included, else 0. */ +AppendLocals( + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Obj *listPtr, /* List object to append names to. */ + CONST char *pattern, /* Pattern to match against. */ + int includeLinks) /* 1 if upvars should be included, else 0. */ { Interp *iPtr = (Interp *) interp; CompiledLocal *localPtr; @@ -1799,7 +1821,7 @@ AppendLocals(interp, listPtr, pattern, includeLinks) if (!TclIsVarUndefined(varPtr) && (includeLinks || !TclIsVarLink(varPtr))) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(pattern,-1)); + Tcl_NewStringObj(pattern, -1)); } } return; @@ -1846,11 +1868,11 @@ AppendLocals(interp, listPtr, pattern, includeLinks) */ static int -InfoNameOfExecutableCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoNameOfExecutableCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); @@ -1882,11 +1904,11 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv) */ static int -InfoPatchLevelCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoPatchLevelCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { CONST char *patchlevel; @@ -1929,11 +1951,11 @@ InfoPatchLevelCmd(dummy, interp, objc, objv) */ static int -InfoProcsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoProcsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *cmdName, *pattern; CONST char *simplePattern; @@ -1992,7 +2014,7 @@ InfoProcsCmd(dummy, interp, objc, objv) * name. */ - listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + listPtr = Tcl_NewListObj(0, NULL); #ifndef INFO_PROCS_SEARCH_GLOBAL_NS if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); @@ -2071,7 +2093,7 @@ InfoProcsCmd(dummy, interp, objc, objv) cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) { + if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); realCmdPtr = (Command *) TclGetOriginalCommand( (Tcl_Command) cmdPtr); @@ -2117,11 +2139,11 @@ InfoProcsCmd(dummy, interp, objc, objv) */ static int -InfoScriptCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoScriptCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; if ((objc != 2) && (objc != 3)) { @@ -2164,11 +2186,11 @@ InfoScriptCmd(dummy, interp, objc, objv) */ static int -InfoSharedlibCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoSharedlibCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); @@ -2202,11 +2224,11 @@ InfoSharedlibCmd(dummy, interp, objc, objv) */ static int -InfoTclVersionCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoTclVersionCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *version; @@ -2249,11 +2271,11 @@ InfoTclVersionCmd(dummy, interp, objc, objv) */ static int -InfoVarsCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +InfoVarsCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; char *varName, *pattern; @@ -2309,7 +2331,7 @@ InfoVarsCmd(dummy, interp, objc, objv) return TCL_OK; } - listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + listPtr = Tcl_NewListObj(0, NULL); if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC) || specificNsInPattern) { @@ -2387,7 +2409,7 @@ InfoVarsCmd(dummy, interp, objc, objv) */ if ((nsPtr != globalNsPtr) && !specificNsInPattern) { - entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search); + entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable,&search); while (entryPtr != NULL) { varPtr = (Var *) Tcl_GetHashValue(entryPtr); if (!TclIsVarUndefined(varPtr) @@ -2432,13 +2454,12 @@ InfoVarsCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_JoinObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* The argument objects. */ +Tcl_JoinObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* The argument objects. */ { char *joinString, *bytes; int joinLength, listLen, length, i, result; @@ -2498,13 +2519,12 @@ Tcl_JoinObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_LassignObjCmd(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_LassignObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *valueObj; /* Value to assign to variable, as read from * the list object or created in the emptyObj @@ -2606,13 +2626,12 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_LindexObjCmd(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_LindexObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *elemPtr; /* Pointer to the element being extracted */ @@ -2677,10 +2696,10 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv) */ Tcl_Obj * -TclLindexList(interp, listPtr, argPtr) - Tcl_Interp* interp; /* Tcl interpreter */ - Tcl_Obj* listPtr; /* List being unpacked */ - Tcl_Obj* argPtr; /* Index or index list */ +TclLindexList( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *listPtr, /* List being unpacked */ + Tcl_Obj *argPtr) /* Index or index list */ { Tcl_Obj **elemPtrs; /* Elements of the list being manipulated. */ @@ -2708,7 +2727,7 @@ TclLindexList(interp, listPtr, argPtr) return TclLindexFlat(interp, listPtr, 1, &argPtr); } - if (Tcl_ListObjGetElements(NULL, argPtr, &indexCount, &indices) != TCL_OK){ + if (Tcl_ListObjGetElements(NULL,argPtr, &indexCount, &indices) != TCL_OK){ /* * argPtr designates something that is neither an index nor a * well-formed list. Report the error via TclLindexFlat. @@ -2794,7 +2813,7 @@ TclLindexList(interp, listPtr, argPtr) * to change to something else. Get it back. */ - result = Tcl_ListObjGetElements(interp, argPtr, &indexCount, &indices); + result = Tcl_ListObjGetElements(interp,argPtr, &indexCount, &indices); if (result != TCL_OK) { /* * This can't happen unless some extension corrupted a Tcl_Obj. @@ -2837,23 +2856,23 @@ TclLindexList(interp, listPtr, argPtr) */ Tcl_Obj * -TclLindexFlat(interp, listPtr, indexCount, indexArray) - Tcl_Interp *interp; /* Tcl interpreter */ - Tcl_Obj *listPtr; /* Tcl object representing the list */ - int indexCount; /* Count of indices */ - Tcl_Obj *CONST indexArray[]; - /* Array of pointers to Tcl objects - * representing the indices in the list. */ +TclLindexFlat( + Tcl_Interp *interp, /* Tcl interpreter */ + Tcl_Obj *listPtr, /* Tcl object representing the list */ + int indexCount, /* Count of indices */ + Tcl_Obj *CONST indexArray[]) + /* Array of pointers to Tcl objects that + * represent the indices in the list. */ { int i; /* Current list index. */ int result; /* Result of Tcl library calls. */ int listLen; /* Length of the current list being * processed. */ - Tcl_Obj** elemPtrs; /* Array of pointers to the elements of the + Tcl_Obj **elemPtrs; /* Array of pointers to the elements of the * current list. */ int index; /* Parsed version of the current element of * indexArray. */ - Tcl_Obj* oldListPtr; /* Temporary to hold listPtr so that its ref + Tcl_Obj *oldListPtr; /* Temporary to hold listPtr so that its ref * count can be decremented. */ /* @@ -2945,13 +2964,12 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_LinsertObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - register int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_LinsertObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + register int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; int index, isDuplicate, len, result; @@ -3034,13 +3052,13 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_ListObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - register int objc; /* Number of arguments. */ - register Tcl_Obj *CONST objv[]; /* The argument objects. */ +Tcl_ListObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + register int objc, /* Number of arguments. */ + register Tcl_Obj *CONST objv[]) + /* The argument objects. */ { /* * If there are no list elements, the result is an empty object. @@ -3070,13 +3088,13 @@ Tcl_ListObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_LlengthObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - register Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_LlengthObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + register Tcl_Obj *CONST objv[]) + /* Argument objects. */ { int listLen, result; @@ -3116,13 +3134,13 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_LrangeObjCmd(notUsed, interp, objc, objv) - ClientData notUsed; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - register Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_LrangeObjCmd( + ClientData notUsed, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + register Tcl_Obj *CONST objv[]) + /* Argument objects. */ { Tcl_Obj *listPtr; Tcl_Obj **elemPtrs; @@ -3210,13 +3228,12 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_LrepeatObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - register int objc; /* Number of arguments. */ - register Tcl_Obj *CONST objv[]; +Tcl_LrepeatObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + register int objc, /* Number of arguments. */ + register Tcl_Obj *CONST objv[]) /* The argument objects. */ { int elementCount, i, result; @@ -3306,13 +3323,12 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_LreplaceObjCmd(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_LreplaceObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { register Tcl_Obj *listPtr; int isDuplicate, first, last, listLen, numToDelete, result; @@ -3334,12 +3350,12 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv) * included for deletion. */ - result = TclGetIntForIndex(interp, objv[2], /*end*/ (listLen - 1), &first); + result = TclGetIntForIndex(interp, objv[2], /*end*/ listLen-1, &first); if (result != TCL_OK) { return result; } - result = TclGetIntForIndex(interp, objv[3], /*end*/ (listLen - 1), &last); + result = TclGetIntForIndex(interp, objv[3], /*end*/ listLen-1, &last); if (result != TCL_OK) { return result; } @@ -3357,7 +3373,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv) if ((first >= listLen) && (listLen > 0)) { Tcl_AppendResult(interp, "list doesn't contain element ", - TclGetString(objv[2]), (int *) NULL); + TclGetString(objv[2]), NULL); return TCL_ERROR; } if (last >= listLen) { @@ -3486,11 +3502,11 @@ Tcl_LreverseObjCmd( */ int -Tcl_LsearchObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument values. */ +Tcl_LsearchObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument values. */ { char *bytes, *patternBytes; int i, match, mode, index, result, listc, length, elemLen; @@ -3505,8 +3521,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) "-exact", "-glob", "-increasing", "-index", "-inline", "-integer", "-nocase", "-not", "-real", "-regexp", "-sorted", "-start", - "-subindices", - NULL + "-subindices", NULL }; enum options { LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY, @@ -3639,6 +3654,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; int j; + if (sortInfo.indexc > 1) { ckfree((char *) sortInfo.indexv); } @@ -3939,7 +3955,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) */ if (allMatches) { - listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); + listPtr = Tcl_NewListObj(0, NULL); } for (i = offset; i < listc; i++) { match = 0; @@ -3962,7 +3978,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) if (length == elemLen) { /* * This split allows for more optimal compilation of - * memcmp/ + * memcmp. */ if (noCase) { @@ -3993,7 +4009,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) break; case REAL: - result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble); + result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble); if (result != TCL_OK) { if (listPtr) { Tcl_DecrRefCount(listPtr); @@ -4122,14 +4138,14 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) */ int -Tcl_LsetObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument values. */ +Tcl_LsetObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument values. */ { - Tcl_Obj* listPtr; /* Pointer to the list being altered. */ - Tcl_Obj* finalValuePtr; /* Value finally assigned to the variable. */ + Tcl_Obj *listPtr; /* Pointer to the list being altered. */ + Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ /* * Check parameter count. @@ -4207,11 +4223,11 @@ Tcl_LsetObjCmd(clientData, interp, objc, objv) */ int -Tcl_LsortObjCmd(clientData, interp, objc, objv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument values. */ +Tcl_LsortObjCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument values. */ { int i, index, unique, indices; Tcl_Obj *resultPtr; @@ -4223,8 +4239,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) * be passed to the comparison function. */ static CONST char *switches[] = { "-ascii", "-command", "-decreasing", "-dictionary", "-increasing", - "-index", "-indices", "-integer", "-nocase", "-real", "-unique", - (char *) NULL + "-index", "-indices", "-integer", "-nocase", "-real", "-unique", NULL }; enum Lsort_Switches { LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY, @@ -4395,7 +4410,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) resultPtr = Tcl_NewObj(); if (unique) { if (indices) { - for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { + for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){ if (elementPtr->count == 0) { Tcl_ListObjAppendElement(interp, resultPtr, Tcl_NewIntObj(elementPtr - &elementArray[0])); @@ -4409,24 +4424,22 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) } } } + } else if (indices) { + for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { + Tcl_ListObjAppendElement(interp, resultPtr, + Tcl_NewIntObj(elementPtr - &elementArray[0])); + } } else { - if (indices) { - for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { - Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewIntObj(elementPtr - &elementArray[0])); - } - } else { - for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){ - Tcl_ListObjAppendElement(interp, resultPtr, - elementPtr->objPtr); - } + for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) { + Tcl_ListObjAppendElement(interp, resultPtr, + elementPtr->objPtr); } } Tcl_SetObjResult(interp, resultPtr); } - ckfree((char*) elementArray); + ckfree((char *) elementArray); - done: + done: if (sortInfo.sortMode == SORTMODE_COMMAND) { Tcl_DecrRefCount(sortInfo.compareCmdPtr); sortInfo.compareCmdPtr = NULL; @@ -4455,9 +4468,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) */ static SortElement * -MergeSort(headPtr, infoPtr) - SortElement *headPtr; /* First element on the list. */ - SortInfo *infoPtr; /* Information needed by the comparison +MergeSort( + SortElement *headPtr, /* First element on the list. */ + SortInfo *infoPtr) /* Information needed by the comparison * operator. */ { /* @@ -4511,10 +4524,10 @@ MergeSort(headPtr, infoPtr) */ static SortElement * -MergeLists(leftPtr, rightPtr, infoPtr) - SortElement *leftPtr; /* First list to be merged; may be NULL. */ - SortElement *rightPtr; /* Second list to be merged; may be NULL. */ - SortInfo *infoPtr; /* Information needed by the comparison +MergeLists( + SortElement *leftPtr, /* First list to be merged; may be NULL. */ + SortElement *rightPtr, /* Second list to be merged; may be NULL. */ + SortInfo *infoPtr) /* Information needed by the comparison * operator. */ { SortElement *headPtr; @@ -4583,9 +4596,10 @@ MergeLists(leftPtr, rightPtr, infoPtr) */ static int -SortCompare(objPtr1, objPtr2, infoPtr) - Tcl_Obj *objPtr1, *objPtr2; /* Values to be compared. */ - SortInfo *infoPtr; /* Information passed from the top-level +SortCompare( + Tcl_Obj *objPtr1, Tcl_Obj *objPtr2, + /* Values to be compared. */ + SortInfo *infoPtr) /* Information passed from the top-level * "lsort" command. */ { int order; @@ -4610,7 +4624,8 @@ SortCompare(objPtr1, objPtr2, infoPtr) } if (infoPtr->sortMode == SORTMODE_ASCII) { - order = infoPtr->strCmpFn(TclGetString(objPtr1), TclGetString(objPtr2)); + order = infoPtr->strCmpFn(TclGetString(objPtr1), + TclGetString(objPtr2)); } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) { order = DictionaryCompare( TclGetString(objPtr1), TclGetString(objPtr2)); @@ -4631,8 +4646,8 @@ SortCompare(objPtr1, objPtr2, infoPtr) } else if (infoPtr->sortMode == SORTMODE_REAL) { double a, b; - if (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK - || Tcl_GetDoubleFromObj(infoPtr->interp,objPtr2,&b) != TCL_OK){ + if (Tcl_GetDoubleFromObj(infoPtr->interp, objPtr1, &a) != TCL_OK || + Tcl_GetDoubleFromObj(infoPtr->interp, objPtr2, &b) != TCL_OK){ infoPtr->resultCode = TCL_ERROR; return order; } @@ -4711,8 +4726,8 @@ SortCompare(objPtr1, objPtr2, infoPtr) */ static int -DictionaryCompare(left, right) - char *left, *right; /* The strings to compare. */ +DictionaryCompare( + char *left, char *right) /* The strings to compare. */ { Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower; int diff, zeros; @@ -4823,9 +4838,8 @@ DictionaryCompare(left, right) * * SelectObjFromSublist -- * - * This procedure is invoked from lsearch and SortCompare. It is used - * for implementing the -index option, for the lsort and lsearch - * commands. + * This procedure is invoked from lsearch and SortCompare. It is used for + * implementing the -index option, for the lsort and lsearch commands. * * Results: * Returns NULL if a failure occurs, and sets the result in the infoPtr. @@ -4841,10 +4855,10 @@ DictionaryCompare(left, right) *---------------------------------------------------------------------- */ -static Tcl_Obj* -SelectObjFromSublist(objPtr, infoPtr) - Tcl_Obj *objPtr; /* Obj to select sublist from. */ - SortInfo *infoPtr; /* Information passed from the top-level +static Tcl_Obj * +SelectObjFromSublist( + Tcl_Obj *objPtr, /* Obj to select sublist from. */ + SortInfo *infoPtr) /* Information passed from the top-level * "lsearch" or "lsort" command. */ { int i; @@ -4888,10 +4902,11 @@ SelectObjFromSublist(objPtr, infoPtr) } if (currentObj == NULL) { char buffer[TCL_INTEGER_SPACE]; + TclFormatInt(buffer, index); Tcl_AppendResult(infoPtr->interp, "element ", buffer, " missing from sublist \"", - TclGetString(objPtr), "\"", (char *) NULL); + TclGetString(objPtr), "\"", NULL); infoPtr->resultCode = TCL_ERROR; return NULL; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 5a39466..75c0570 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,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.143 2006/11/28 22:20:28 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.144 2007/02/06 21:15:14 dkf Exp $ */ #include "tclInt.h" @@ -38,13 +38,12 @@ *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_PwdObjCmd(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_PwdObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_Obj *retVal; @@ -79,13 +78,12 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_RegexpObjCmd(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_RegexpObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength; @@ -430,13 +428,12 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_RegsubObjCmd(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_RegsubObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int idx, result, cflags, all, wlen, wsublen, numMatches, offset; int start, end, subStart, subEnd, match; @@ -546,7 +543,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) */ int slen, nocase; - int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long); + int (*strCmpFn)(CONST Tcl_UniChar*,CONST Tcl_UniChar*,unsigned long); Tcl_UniChar *p, wsrclc; numMatches = 0; @@ -840,13 +837,12 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_RenameObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Arbitrary value passed to the command. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_RenameObjCmd( + ClientData dummy, /* Arbitrary value passed to the command. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { char *oldName, *newName; @@ -877,13 +873,12 @@ Tcl_RenameObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_ReturnObjCmd(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_ReturnObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int code, level; Tcl_Obj *returnOpts; @@ -925,13 +920,12 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_SourceObjCmd(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_SourceObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { CONST char *encodingName = NULL; Tcl_Obj *fileName; @@ -976,13 +970,12 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_SplitObjCmd(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_SplitObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { Tcl_UniChar ch; int len; @@ -1031,7 +1024,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) * Assume Tcl_UniChar is an integral type... */ - hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0 + ch, &isNew); + hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0+ch, &isNew); if (isNew) { objPtr = Tcl_NewStringObj(stringPtr, len); @@ -1118,13 +1111,12 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_StringObjCmd(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_StringObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int index, left, right; char *string1, *string2; @@ -1261,7 +1253,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) if (((enum options) index == STR_EQUAL) && (reqlength < 0) && (length1 != length2)) { - match = 1; /* this will be reversed below */ + match = 1; /* This will be reversed below. */ } else { length = (length1 < length2) ? length1 : length2; if (reqlength > 0 && reqlength < length) { @@ -1294,7 +1286,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) int match, start; if (objc < 4 || objc > 5) { - Tcl_WrongNumArgs(interp, 2, objv, "subString string ?startIndex?"); + Tcl_WrongNumArgs(interp, 2,objv, "subString string ?startIndex?"); return TCL_ERROR; } @@ -1452,7 +1444,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) strncmp(string2, "-strict", (size_t) length2) == 0) { strict = 1; } else if ((length2 > 1) && - strncmp(string2, "-failindex", (size_t) length2) == 0){ + strncmp(string2, "-failindex", (size_t)length2) == 0){ if (i+1 >= objc-1) { Tcl_WrongNumArgs(interp, 3, objv, "?-strict? ?-failindex var? str"); @@ -1685,7 +1677,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) w = strtoll(string1, &stop, 0); /* INTL: Tcl source. */ if (errno == ERANGE) { /* - * if (errno == ERANGE), then it was an over/underflow + * If (errno == ERANGE), then it was an over/underflow * problem, but in this method, we only want to know yes or * no, so bad flow returns 0 (false) and sets the failVarObj * to the string length. @@ -1714,7 +1706,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) break; case STR_IS_XDIGIT: for (; string1 < end; string1++, failat++) { - /* INTL: We assume unicode is bad for this class */ + /* INTL: We assume unicode is bad for this class. */ if ((*((unsigned char *)string1) >= 0xC0) || !isxdigit(*(unsigned char *)string1)) { result = 0; @@ -1845,7 +1837,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) if (objc == 5) { string2 = Tcl_GetStringFromObj(objv[2], &length2); if ((length2 > 1) && - strncmp(string2, "-nocase", (size_t) length2) == 0) { + strncmp(string2, "-nocase", (size_t) length2) == 0) { nocase = 1; } else { Tcl_AppendResult(interp, "bad option \"", string2, @@ -1873,7 +1865,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) Tcl_DictObjSize(interp, objv[objc-2], &mapElemc); if (mapElemc == 0) { /* - * empty charMap, just return whatever string was given + * Empty charMap, just return whatever string was given. */ Tcl_SetObjResult(interp, objv[objc-1]); @@ -1975,11 +1967,11 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0); for (; ustring1 < end; ustring1++) { if (((*ustring1 == *ustring2) || - (nocase && Tcl_UniCharToLower(*ustring1)==u2lc)) && + (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, (unsigned long) length2) == 0)) { if (p != ustring1) { - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; @@ -2026,7 +2018,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && - /* restrict max compare length */ + /* Restrict max compare length. */ ((end - ustring1) >= length2) && ((length2 == 1) || strCmpFn(ustring2, ustring1, (unsigned long) length2) == 0)) { @@ -2035,7 +2027,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * Put the skipped chars onto the result first. */ - Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p); + Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; } else { p += length2; @@ -2226,7 +2218,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) length1--; if (TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK || - TclGetIntForIndex(interp, objv[4], length1, &last) != TCL_OK) { + TclGetIntForIndex(interp, objv[4], length1, &last) != TCL_OK){ return TCL_ERROR; } @@ -2320,7 +2312,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; - if (TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK){ + if (TclGetIntForIndex(interp,objv[3],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { @@ -2433,7 +2425,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) for (p = string1 + length1; p > end; ) { p = Tcl_UtfPrev(p, string1); offset = TclUtfToUniChar(p, &ch); - for (check = string2; ; ) { + check = string2; + while (1) { if (check >= checkEnd) { p = end; break; @@ -2462,7 +2455,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) string1 = Tcl_GetStringFromObj(objv[2], &length1); numChars = Tcl_NumUtfChars(string1, length1); - if (TclGetIntForIndex(interp, objv[3], numChars-1, &index) != TCL_OK) { + if (TclGetIntForIndex(interp, objv[3], numChars-1, &index) != TCL_OK){ return TCL_ERROR; } if (index < 0) { @@ -2499,7 +2492,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) string1 = Tcl_GetStringFromObj(objv[2], &length1); numChars = Tcl_NumUtfChars(string1, length1); - if (TclGetIntForIndex(interp, objv[3], numChars-1, &index) != TCL_OK) { + if (TclGetIntForIndex(interp, objv[3], numChars-1, &index) != TCL_OK){ return TCL_ERROR; } if (index >= numChars) { @@ -2544,13 +2537,12 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_SubstObjCmd(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_SubstObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { static CONST char *substOptions[] = { "-nobackslashes", "-nocommands", "-novariables", NULL @@ -2621,27 +2613,25 @@ Tcl_SubstObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_SwitchObjCmd(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_SwitchObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { - int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved, noCase; - int patternLength; + int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved; + int noCase, patternLength; char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *CONST *savedObjv = objv; Tcl_RegExp regExpr = NULL; - 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 */ + 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 */ /* * If you add options that make -e and -g not unique prefixes of -exact or @@ -2741,15 +2731,15 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) stringObj = objv[i]; objc -= i + 1; objv += i + 1; - bidx = i+1; /* First after the match string */ + bidx = i+1; /* First after the match string. */ /* * 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. + * the same data for the list word itself. The cmdFramePtr line + * information is manipulated directly. */ splitObjs = 0; @@ -2757,7 +2747,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) Tcl_Obj **listv; blist = objv[0]; - if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) { + if (Tcl_ListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){ return TCL_ERROR; } @@ -2874,6 +2864,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) } else { int matched = Tcl_RegExpExecObj(interp, regExpr, stringObj, 0, numMatchesSaved, 0); + if (matched < 0) { return TCL_ERROR; } else if (matched) { @@ -2913,9 +2904,11 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end); + /* * Never fails; the object is always clean at this point. */ + Tcl_ListObjAppendElement(NULL, indicesObj, Tcl_NewListObj(2, rangeObjAry)); } @@ -2925,9 +2918,11 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) substringObj = Tcl_GetRange(stringObj, info.matches[j].start, info.matches[j].end-1); + /* * Never fails; the object is always clean at this point. */ + Tcl_ListObjAppendElement(NULL, matchesObj, substringObj); } } @@ -2972,7 +2967,8 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) ctx = *iPtr->cmdFramePtr; if (splitObjs) { - /* We have to perform the GetSrc and other type dependent handling of + /* + * 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 @@ -2980,38 +2976,42 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) */ if (ctx.type == TCL_LOCATION_BC) { - /* Note: Type BC => ctx.data.eval.path is not used. - * ctx.data.tebc.codePtr is used instead. + /* + * Type BC => ctx.data.eval.path is not used. + * ctx.data.tebc.codePtr is used instead. */ - TclGetSrcInfoForPc (&ctx); + + TclGetSrcInfoForPc(&ctx); pc = 1; - /* The line information in the cmdFrame is now a copy we do not - * own */ + + /* + * 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; + if (ctx.type == TCL_LOCATION_SOURCE && ctx.line[bidx] >= 0) { + int bline = ctx.line[bidx]; - TclListLines (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;} - } + ctx.line = (int *) ckalloc(objc * sizeof(int)); + ctx.nline = objc; + TclListLines(Tcl_GetString(blist), bline, objc, ctx.line); } else { + /* + * This is either a dynamic code word, when all elements are + * relative to themselves, or something else less expected and + * where we have no information. The result is the same in both + * cases; tell the code to come that it doesn't know where it is, + * which triggers reversion to the old behavior. + */ + int k; - /* Anything else ... No information, or dynamic ... */ - ctx.line = (int*) ckalloc (objc * sizeof(int)); + ctx.line = (int *) ckalloc(objc * sizeof(int)); ctx.nline = objc; - for (k=0; k < objc; k++) {ctx.line[k] = -1;} + for (k=0; k < objc; k++) { + ctx.line[k] = -1; + } } } @@ -3029,13 +3029,19 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) } } - /* TIP #280. Make invoking context available to switch branch */ + /* + * TIP #280. Make invoking context available to switch branch. + */ + result = TclEvalObjEx(interp, objv[j], 0, &ctx, j); if (splitObjs) { - ckfree ((char*) ctx.line); + ckfree((char *) ctx.line); if (pc && (ctx.type == TCL_LOCATION_SOURCE)) { - /* Death of SrcInfo reference */ - Tcl_DecrRefCount (ctx.data.eval.path); + /* + * Death of SrcInfo reference. + */ + + Tcl_DecrRefCount(ctx.data.eval.path); } } @@ -3046,6 +3052,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) if (result == TCL_ERROR) { int limit = 50; int overflow = (patternLength > limit); + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", (overflow ? limit : patternLength), pattern, @@ -3071,13 +3078,12 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_TimeObjCmd(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_TimeObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { register Tcl_Obj *objPtr; Tcl_Obj *objs[4]; @@ -3117,7 +3123,7 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv) } #ifndef TCL_WIDE_CLICKS Tcl_GetTime(&stop); - totalMicroSec = ((double) (stop.sec - start.sec))*1.0e6 + totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6 + (stop.usec - start.usec); #else stop = TclpGetWideClicks(); @@ -3168,16 +3174,15 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ - /* ARGSUSED */ int -Tcl_WhileObjCmd(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_WhileObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { int result, value; - Interp* iPtr = (Interp*) interp; + Interp *iPtr = (Interp *) interp; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "test command"); @@ -3192,8 +3197,9 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv) if (!value) { break; } + /* TIP #280. */ - result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr,2); + result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr, 2); if ((result != TCL_OK) && (result != TCL_CONTINUE)) { if (result == TCL_ERROR) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( @@ -3212,28 +3218,27 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv) } void -TclListLines(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 */ +TclListLines( + 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; + int i, length = strlen(listStr); + CONST char *element = NULL, *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; + 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 */ |