summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-02-06 21:15:14 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-02-06 21:15:14 (GMT)
commiteb7de2c4e26d9f1c416f9047ec735393b0d36578 (patch)
treeab403dae21912d5c25bfedc3a16d25d9eb69b9ca /generic
parent11d70a65e6f7578f2d0e486b978142e3bcdcc304 (diff)
downloadtcl-eb7de2c4e26d9f1c416f9047ec735393b0d36578.zip
tcl-eb7de2c4e26d9f1c416f9047ec735393b0d36578.tar.gz
tcl-eb7de2c4e26d9f1c416f9047ec735393b0d36578.tar.bz2
Function header/whitespace police/general format fixes
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdAH.c268
-rw-r--r--generic/tclCmdIL.c1163
-rw-r--r--generic/tclCmdMZ.c309
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 */
generated by cgit v0.12 at 2024-11-08 08:52:48 (GMT)