summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclCmdAH.c318
-rw-r--r--generic/tclCmdIL.c358
-rw-r--r--generic/tclCmdMZ.c291
3 files changed, 445 insertions, 522 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index e2e64e1..9e9ab9c 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1,17 +1,16 @@
/*
* tclCmdAH.c --
*
- * This file contains the top-level command routines for most of
- * the Tcl built-in commands whose names begin with the letters
- * A to H.
+ * This file contains the top-level command routines for most of the Tcl
+ * built-in commands whose names begin with the letters A to H.
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * 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.65 2005/07/17 21:46:31 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.66 2005/08/26 13:26:55 dkf Exp $
*/
#include "tclInt.h"
@@ -21,21 +20,20 @@
* Prototypes for local procedures defined in this file:
*/
-static int CheckAccess _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr, int mode));
-static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *pathPtr, Tcl_FSStatProc *statProc,
- Tcl_StatBuf *statPtr));
-static char * GetTypeFromMode _ANSI_ARGS_((int mode));
-static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *varName, Tcl_StatBuf *statPtr));
+static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ int mode);
+static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+ Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
+static char * GetTypeFromMode(int mode);
+static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
+ Tcl_StatBuf *statPtr);
/*
*----------------------------------------------------------------------
*
* Tcl_BreakObjCmd --
*
- * This procedure is invoked to process the "break" Tcl command. See the
+ * This procedure is invoked to process the "break" Tcl command. See the
* user documentation for details on what it does.
*
* With the bytecode compiler, this procedure is only called when a
@@ -54,10 +52,10 @@ static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
/* 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. */
+ 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);
@@ -71,7 +69,7 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv)
*
* Tcl_CaseObjCmd --
*
- * This procedure is invoked to process the "case" Tcl command. See the
+ * This procedure is invoked to process the "case" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -291,7 +289,7 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
*
* Tcl_CdObjCmd --
*
- * This procedure is invoked to process the "cd" Tcl command. See the
+ * This procedure is invoked to process the "cd" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -377,7 +375,7 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv)
*
* Tcl_ContinueObjCmd --
*
- * This procedure is invoked to process the "continue" Tcl command. See
+ * This procedure is invoked to process the "continue" Tcl command. See
* the user documentation for details on what it does.
*
* With the bytecode compiler, this procedure is only called when a
@@ -572,7 +570,7 @@ TclEncodingDirsObjCmd(dummy, interp, objc, objv)
*
* Tcl_ErrorObjCmd --
*
- * This procedure is invoked to process the "error" Tcl command. See the
+ * This procedure is invoked to process the "error" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -655,9 +653,10 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
} else {
/*
* More than one argument: concatenate them together with spaces
- * between, then evaluate the result. Tcl_EvalObjEx will delete the
+ * between, then evaluate the result. Tcl_EvalObjEx will delete the
* object when it decrements its refcount after eval'ing it.
*/
+
objPtr = Tcl_ConcatObj(objc-1, objv+1);
result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
}
@@ -675,7 +674,7 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
*
* Tcl_ExitObjCmd --
*
- * This procedure is invoked to process the "exit" Tcl command. See the
+ * This procedure is invoked to process the "exit" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -760,7 +759,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;
@@ -836,10 +835,12 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
switch ((enum options) index) {
- case FCMD_ATIME: {
+ {
Tcl_StatBuf buf;
struct utimbuf tval;
+ case FCMD_ATIME:
+ case FCMD_MTIME:
if ((objc < 3) || (objc > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
return TCL_ERROR;
@@ -859,27 +860,35 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- tval.actime = newTime;
- tval.modtime = buf.st_mtime;
+ if (index == FCMD_ATIME) {
+ tval.actime = newTime;
+ tval.modtime = buf.st_mtime;
+ } else { /* index == FCMD_MTIME */
+ tval.actime = buf.st_atime;
+ tval.modtime = newTime;
+ }
+
if (Tcl_FSUtime(objv[2], &tval) != 0) {
- Tcl_AppendResult(interp,
- "could not set access time for file \"",
- TclGetString(objv[2]), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
+ Tcl_AppendResult(interp, "could not set ",
+ (index == FCMD_ATIME ? "access" : "modification"),
+ " time for file \"", TclGetString(objv[2]), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
/*
* Do another stat to ensure that the we return the new recognized
- * atime - hopefully the same as the one we sent in. However,
- * fs's like FAT don't even know what atime is.
+ * atime - hopefully the same as the one we sent in. However, fs's
+ * like FAT don't even know what atime is.
*/
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
}
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_atime));
+
+ Tcl_SetObjResult(interp, Tcl_NewLongObj((long)
+ (index == FCMD_ATIME ? buf.st_atime : buf.st_mtime)));
return TCL_OK;
}
case FCMD_ATTRIBUTES:
@@ -935,10 +944,11 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
}
- case FCMD_ISDIRECTORY: {
+ {
int value;
Tcl_StatBuf buf;
+ case FCMD_ISDIRECTORY:
if (objc != 3) {
goto only3Args;
}
@@ -948,11 +958,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
return TCL_OK;
- }
- case FCMD_ISFILE: {
- int value;
- Tcl_StatBuf buf;
-
+ case FCMD_ISFILE:
if (objc != 3) {
goto only3Args;
}
@@ -962,6 +968,25 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
return TCL_OK;
+ case FCMD_OWNED:
+ if (objc != 3) {
+ goto only3Args;
+ }
+ value = 0;
+ if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
+ /*
+ * For Windows, there are no user ids associated with a file, so
+ * we always return 1.
+ */
+
+#if defined(__WIN32__)
+ value = 1;
+#else
+ value = (geteuid() == buf.st_uid);
+#endif
+ }
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
+ return TCL_OK;
}
case FCMD_JOIN: {
Tcl_Obj *resObj;
@@ -1100,9 +1125,10 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
return TCL_OK;
}
- case FCMD_LSTAT: {
+ {
Tcl_StatBuf buf;
+ case FCMD_LSTAT:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "name varName");
return TCL_ERROR;
@@ -1111,51 +1137,34 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
return StoreStatData(interp, objv[3], &buf);
- }
- case FCMD_MTIME: {
- Tcl_StatBuf buf;
- struct utimbuf tval;
-
- if ((objc < 3) || (objc > 4)) {
- Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
+ case FCMD_STAT:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name varName");
return TCL_ERROR;
}
if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
- if (objc == 4) {
- /*
- * Need separate variable for reading longs from an object on
- * 64-bit platforms. [Bug #698146]
- */
-
- long newTime;
-
- if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) {
- return TCL_ERROR;
- }
-
- tval.actime = buf.st_atime;
- tval.modtime = newTime;
- if (Tcl_FSUtime(objv[2], &tval) != 0) {
- Tcl_AppendResult(interp,
- "could not set modification time for file \"",
- TclGetString(objv[2]), "\": ", Tcl_PosixError(interp),
- (char *) NULL);
- return TCL_ERROR;
- }
-
- /*
- * Do another stat to ensure that the we return the new recognized
- * atime - hopefully the same as the one we sent in. However, fs's
- * like FAT don't even know what atime is.
- */
-
- if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
+ return StoreStatData(interp, objv[3], &buf);
+ case FCMD_SIZE:
+ if (objc != 3) {
+ goto only3Args;
+ }
+ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_mtime));
+ Tcl_SetObjResult(interp,
+ Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
+ return TCL_OK;
+ case FCMD_TYPE:
+ if (objc != 3) {
+ goto only3Args;
+ }
+ if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ GetTypeFromMode((unsigned short) buf.st_mode), -1));
return TCL_OK;
}
case FCMD_MKDIR:
@@ -1196,29 +1205,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
Tcl_SetObjResult(interp, fileName);
return TCL_OK;
}
- case FCMD_OWNED: {
- int value;
- Tcl_StatBuf buf;
-
- if (objc != 3) {
- goto only3Args;
- }
- value = 0;
- if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
- /*
- * For Windows, there are no user ids associated with a file, so
- * we always return 1.
- */
-
-#if defined(__WIN32__)
- value = 1;
-#else
- value = (geteuid() == buf.st_uid);
-#endif
- }
- Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
- return TCL_OK;
- }
case FCMD_PATHTYPE:
if (objc != 3) {
goto only3Args;
@@ -1308,19 +1294,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
}
}
return TCL_OK;
- case FCMD_SIZE: {
- Tcl_StatBuf buf;
-
- if (objc != 3) {
- goto only3Args;
- }
- if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp,
- Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
- return TCL_OK;
- }
case FCMD_SPLIT: {
Tcl_Obj *res;
@@ -1340,18 +1313,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_OK;
}
}
- case FCMD_STAT: {
- Tcl_StatBuf buf;
-
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "stat name varName");
- return TCL_ERROR;
- }
- if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- return StoreStatData(interp, objv[3], &buf);
- }
case FCMD_SYSTEM: {
Tcl_Obj* fsInfo;
@@ -1382,19 +1343,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
return TCL_OK;
}
}
- case FCMD_TYPE: {
- Tcl_StatBuf buf;
-
- if (objc != 3) {
- goto only3Args;
- }
- if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
- return TCL_ERROR;
- }
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- GetTypeFromMode((unsigned short) buf.st_mode), -1));
- return TCL_OK;
- }
case FCMD_VOLUMES:
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -1423,7 +1371,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
* available through the access() system call.
*
* Results:
- * Always returns TCL_OK. Sets interp's result to boolean true or false
+ * Always returns TCL_OK. Sets interp's result to boolean true or false
* depending on whether the file has the specified attribute.
*
* Side effects:
@@ -1462,9 +1410,9 @@ CheckAccess(interp, pathPtr, mode)
*
* Results:
* The return value is TCL_OK if the specified file exists and can be
- * stat'ed, TCL_ERROR otherwise. If TCL_ERROR is returned, an error
- * message is left in interp's result. If TCL_OK is returned, *statPtr
- * is filled with information about the specified file.
+ * stat'ed, TCL_ERROR otherwise. If TCL_ERROR is returned, an error
+ * message is left in interp's result. If TCL_OK is returned, *statPtr is
+ * filled with information about the specified file.
*
* Side effects:
* None.
@@ -1474,7 +1422,7 @@ CheckAccess(interp, pathPtr, mode)
static int
GetStatBuf(interp, pathPtr, statProc, statPtr)
- Tcl_Interp *interp; /* Interp for error return. May be NULL. */
+ 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. */
@@ -1510,8 +1458,8 @@ GetStatBuf(interp, pathPtr, statProc, statPtr)
* associative array.
*
* Results:
- * Returns a standard Tcl return value. If an error occurs then a
- * message is left in interp's result.
+ * Returns a standard Tcl return value. If an error occurs then a message
+ * is left in interp's result.
*
* Side effects:
* Elements of the associative array given by "varName" are modified.
@@ -1521,11 +1469,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 to store stat results. */
- Tcl_StatBuf *statPtr; /* Pointer to buffer containing stat
- * data to store in varName. */
+ 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
+ * store in varName. */
{
Tcl_Obj *field = Tcl_NewObj();
Tcl_Obj *value;
@@ -1622,7 +1570,7 @@ GetTypeFromMode(mode)
*
* Tcl_ForObjCmd --
*
- * This procedure is invoked to process the "for" Tcl command. See the
+ * This procedure is invoked to process the "for" Tcl command. See the
* user documentation for details on what it does.
*
* With the bytecode compiler, this procedure is only called when a
@@ -1642,10 +1590,10 @@ 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. */
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int result, value;
@@ -1664,7 +1612,7 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
while (1) {
/*
* We need to reset the result before passing it off to
- * Tcl_ExprBooleanObj. Otherwise, any error message will be appended
+ * Tcl_ExprBooleanObj. Otherwise, any error message will be appended
* to the result of the last evaluation.
*/
@@ -1711,7 +1659,7 @@ Tcl_ForObjCmd(dummy, interp, objc, objv)
* Tcl_ForeachObjCmd --
*
* This object-based procedure is invoked to process the "foreach" Tcl
- * command. See the user documentation for details on what it does.
+ * command. See the user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -1755,11 +1703,11 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
int argcListArray[STATIC_LIST_SIZE];
Tcl_Obj **argvListArray[STATIC_LIST_SIZE];
- int *index = indexArray; /* Array of value list indices */
- int *varcList = varcListArray; /* # loop variables per list */
- 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 */
+ int *index = indexArray; /* Array of value list indices */
+ int *varcList = varcListArray; /* # loop variables per list */
+ 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 */
if (objc < 4 || (objc%2 != 0)) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -1932,7 +1880,7 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv)
*
* Tcl_FormatObjCmd --
*
- * This procedure is invoked to process the "format" Tcl command. See
+ * This procedure is invoked to process the "format" Tcl command. See
* the user documentation for details on what it does.
*
* Results:
@@ -1976,13 +1924,13 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* doubleValue has the value to pass to
* sprintf, according to the following
* definitions: */
-# define INT_VALUE 0
-# define CHAR_VALUE 1
-# define PTR_VALUE 2
-# define DOUBLE_VALUE 3
-# define STRING_VALUE 4
-# define WIDE_VALUE 5
-# define MAX_FLOAT_SIZE 320
+#define INT_VALUE 0
+#define CHAR_VALUE 1
+#define PTR_VALUE 2
+#define DOUBLE_VALUE 3
+#define STRING_VALUE 4
+#define WIDE_VALUE 5
+#define MAX_FLOAT_SIZE 320
Tcl_Obj *resultPtr; /* Where result is stored finally. */
char staticBuf[MAX_FLOAT_SIZE + 1];
@@ -2003,8 +1951,8 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
* seen. */
int useShort; /* Value to be printed is short (half word). */
char *end; /* Used to locate end of numerical fields. */
- int stringLen = 0; /* Length of string in characters rather
- * than bytes. Used for %s substitution. */
+ int stringLen = 0; /* Length of string in characters rather than
+ * bytes. Used for %s substitution. */
int gotMinus; /* Non-zero indicates that a minus flag has
* been seen in the current field. */
int gotPrecision; /* Non-zero indicates that a precision has
@@ -2014,13 +1962,13 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
int useWide; /* Value to be printed is Tcl_WideInt. */
/*
- * This procedure is a bit nasty. The goal is to use sprintf to do most
- * of the dirty work. There are several problems:
+ * This procedure is a bit nasty. The goal is to use sprintf to do most of
+ * the dirty work. There are several problems:
* 1. this procedure can't trust its arguments.
* 2. we must be able to provide a large enough result area to hold
- * whatever's generated. This is hard to estimate.
+ * whatever's generated. This is hard to estimate.
* 3. there's no way to move the arguments from objv to the call to
- * sprintf in a reasonable way. This is particularly nasty because
+ * sprintf in a reasonable way. This is particularly nasty because
* some of the arguments may be two-word values (doubles and
* wide-ints).
* So, what happens here is to scan the format string one % group at a
@@ -2167,7 +2115,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
gotPrecision = 1;
}
if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */
- precision = strtoul(format, &end, 10); /* INTL: "C" locale. */
+ precision = strtoul(format, &end, 10); /* INTL: "C" locale. */
format = end;
} else if (*format == '*') {
if (objIndex >= objc) {
@@ -2191,7 +2139,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
/*
* Only add a 'll' modifier for integer values as it makes some
- * libc's go into spasm otherwise. [Bug #702622]
+ * libc's go into spasm otherwise. [Bug #702622]
*/
switch (format[1]) {
@@ -2247,7 +2195,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
*
* Do not add this if we're going to pass in a short (i.e. if
* we've got an 'h' modifier already in the string); some libc
- * implementations of sprintf() do not like it at all. [Bug
+ * implementations of sprintf() do not like it at all. [Bug
* 1154163]
*/
@@ -2263,7 +2211,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
case 's':
/*
* Compute the length of the string in characters and add any
- * additional space required by the field width. All of the extra
+ * additional space required by the field width. All of the extra
* characters will be spaces, so one byte per character is
* adequate.
*/
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 558f206..bbcab68 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* 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.79 2005/07/29 14:47:46 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.80 2005/08/26 13:26:55 dkf Exp $
*/
#include "tclInt.h"
@@ -29,10 +29,10 @@
*/
typedef struct SortElement {
- Tcl_Obj *objPtr; /* Object being sorted. */
- int count; /* number of same elements in list */
- struct SortElement *nextPtr; /* Next element in the list, or NULL
- * for end of list. */
+ Tcl_Obj *objPtr; /* Object being sorted. */
+ int count; /* number of same elements in list */
+ struct SortElement *nextPtr;/* Next element in the list, or NULL for end
+ * of list. */
} SortElement;
/*
@@ -40,9 +40,8 @@ typedef struct SortElement {
* commands to facilitate the "-nocase" option.
*/
-typedef int (*SortStrCmpFn_t) _ANSI_ARGS_((const char *, const char *));
-typedef int (*SortMemCmpFn_t) _ANSI_ARGS_((const void *, const void *,
- size_t));
+typedef int (*SortStrCmpFn_t) (const char *, const char *);
+typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
/*
* The "lsort" command needs to pass certain information down to the function
@@ -53,12 +52,12 @@ typedef int (*SortMemCmpFn_t) _ANSI_ARGS_((const void *, const void *,
typedef struct SortInfo {
int isIncreasing; /* Nonzero means sort in increasing order. */
- int sortMode; /* The sort mode. One of SORTMODE_* values
+ int sortMode; /* The sort mode. One of SORTMODE_* values
* defined below */
SortStrCmpFn_t strCmpFn; /* Basic string compare command (used with
* ASCII mode). */
Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is
- * SORTMODE_COMMAND. Pre-initialized to hold
+ * SORTMODE_COMMAND. Pre-initialized to hold
* base of command.*/
int *indexv; /* If the -index option was specified, this
* holds the indexes contained in the list
@@ -70,7 +69,7 @@ typedef struct SortInfo {
int singleIndex; /* Static space for common index case. */
Tcl_Interp *interp; /* The interpreter in which the sort is being
* done. */
- int resultCode; /* Completion code for the lsort command. If
+ int resultCode; /* Completion code for the lsort command. If
* an error occurs during the sort this is
* changed from TCL_OK to TCL_ERROR. */
} SortInfo;
@@ -87,101 +86,77 @@ typedef struct SortInfo {
#define SORTMODE_DICTIONARY 4
/*
- * Magic values for the index field of the SortInfo structure. Note that the
+ * Magic values for the index field of the SortInfo structure. Note that the
* index "end-1" will be translated to SORTIDX_END-1, etc.
*/
-#define SORTIDX_NONE -1 /* Not indexed; use whole value. */
-#define SORTIDX_END -2 /* Indexed from end. */
+#define SORTIDX_NONE -1 /* Not indexed; use whole value. */
+#define SORTIDX_END -2 /* Indexed from end. */
/*
* Forward declarations for procedures defined in this file:
*/
-static void AppendLocals _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Obj *listPtr, CONST char *pattern,
- int includeLinks));
-static int DictionaryCompare _ANSI_ARGS_((char *left,
- char *right));
-static int InfoArgsCmd _ANSI_ARGS_((ClientData dummy,
+static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
+ CONST char *pattern, int includeLinks);
+static int DictionaryCompare(char *left, char *right);
+static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoExistsCmd(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,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoNameOfExecutableCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoBodyCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoCmdCountCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoCommandsCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoCompleteCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoDefaultCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoExistsCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoFunctionsCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoHostnameCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoLevelCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoLibraryCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoLoadedCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoLocalsCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoNameOfExecutableCmd _ANSI_ARGS_((
- ClientData dummy, Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoPatchLevelCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoProcsCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoScriptCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoSharedlibCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoTclVersionCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static int InfoVarsCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]));
-static SortElement * MergeSort _ANSI_ARGS_((SortElement *headPt,
- SortInfo *infoPtr));
-static SortElement * MergeLists _ANSI_ARGS_((SortElement *leftPtr,
- SortElement *rightPtr, SortInfo *infoPtr));
-static int SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
- Tcl_Obj *second, SortInfo *infoPtr));
-static Tcl_Obj * SelectObjFromSublist _ANSI_ARGS_((Tcl_Obj *firstPtr,
- SortInfo *infoPtr));
-
+ Tcl_Obj *CONST objv[]);
+static int InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static int InfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[]);
+static SortElement * MergeSort(SortElement *headPt, SortInfo *infoPtr);
+static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr,
+ SortInfo *infoPtr);
+static int SortCompare(Tcl_Obj *firstPtr, Tcl_Obj *second,
+ SortInfo *infoPtr);
+static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr,
+ SortInfo *infoPtr);
/*
*----------------------------------------------------------------------
*
* Tcl_IfObjCmd --
*
- * This procedure is invoked to process the "if" Tcl command. See the
+ * This procedure is invoked to process the "if" Tcl command. See the
* user documentation for details on what it does.
*
* With the bytecode compiler, this procedure is only called when a
@@ -214,7 +189,7 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
/*
* At this point in the loop, objv and objc refer to an expression to
* test, either for the main expression or an expression following an
- * "elseif". The arguments after the expression must be "then"
+ * "elseif". The arguments after the expression must be "then"
* (optional) and a script to execute if the expression is true.
*/
@@ -251,7 +226,7 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
}
/*
- * The expression evaluated to false. Skip the command, then see if
+ * The expression evaluated to false. Skip the command, then see if
* there is an "else" or "elseif" clause.
*/
@@ -271,8 +246,8 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
}
/*
- * Couldn't find a "then" or "elseif" clause to execute. Check now for an
- * "else" clause. We know that there's at least one more argument when we
+ * Couldn't find a "then" or "elseif" clause to execute. Check now for an
+ * "else" clause. We know that there's at least one more argument when we
* get here.
*/
@@ -302,7 +277,7 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
*
* Tcl_IncrObjCmd --
*
- * This procedure is invoked to process the "incr" Tcl command. See the
+ * This procedure is invoked to process the "incr" Tcl command. See the
* user documentation for details on what it does.
*
* With the bytecode compiler, this procedure is only called when a
@@ -400,7 +375,7 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv)
*
* Tcl_InfoObjCmd --
*
- * This procedure is invoked to process the "info" Tcl command. See the
+ * This procedure is invoked to process the "info" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -635,7 +610,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
if (bodyPtr->bytes == NULL) {
/*
* The string rep might not be valid if the procedure has never been
- * run before. [Bug #545644]
+ * run before. [Bug #545644]
*/
(void) Tcl_GetString(bodyPtr);
@@ -691,10 +666,10 @@ InfoCmdCountCmd(dummy, interp, objc, objv)
* InfoCommandsCmd --
*
* Called to implement the "info commands" command that returns the list
- * of commands in the interpreter that match an optional pattern. The
+ * of commands in the interpreter that match an optional pattern. The
* pattern, if any, consists of an optional sequence of namespace names
* separated by "::" qualifiers, which is followed by a glob-style
- * pattern that restricts which commands are returned. Handles the
+ * pattern that restricts which commands are returned. Handles the
* following syntax:
*
* info commands ?pattern?
@@ -722,9 +697,9 @@ InfoCommandsCmd(dummy, interp, objc, objv)
Tcl_HashSearch search;
Namespace *nsPtr;
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
Tcl_Obj *listPtr, *elemObjPtr;
- int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
+ int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
Tcl_Command cmd;
int i;
@@ -1718,10 +1693,10 @@ InfoPatchLevelCmd(dummy, interp, objc, objv)
* InfoProcsCmd --
*
* Called to implement the "info procs" command that returns the list of
- * procedures in the interpreter that match an optional pattern. The
+ * procedures in the interpreter that match an optional pattern. The
* pattern, if any, consists of an optional sequence of namespace names
* separated by "::" qualifiers, which is followed by a glob-style
- * pattern that restricts which commands are returned. Handles the
+ * pattern that restricts which commands are returned. Handles the
* following syntax:
*
* info procs ?pattern?
@@ -1749,9 +1724,9 @@ InfoProcsCmd(dummy, interp, objc, objv)
#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
#endif
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
Tcl_Obj *listPtr, *elemObjPtr;
- int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
+ int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Command *cmdPtr, *realCmdPtr;
@@ -1842,7 +1817,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
goto procOK;
}
} else {
- procOK:
+ procOK:
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1868,7 +1843,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
/*
* If "info procs" worked like "info commands", returning the commands
* also seen in the global namespace, then you would include this
- * code. As this could break backwards compatibilty with 8.0-8.2, we
+ * code. As this could break backwards compatibilty with 8.0-8.2, we
* decided not to "fix" it in 8.3, leaving the behavior slightly
* different.
*/
@@ -1918,7 +1893,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
*
* Side effects:
* Returns a result in the interpreter's result object. If there is an
- * error, the result is an error message. It may change the internal
+ * error, the result is an error message. It may change the internal
* script filename.
*
*----------------------------------------------------------------------
@@ -2024,7 +1999,7 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
}
version = Tcl_GetVar2Ex(interp, "tcl_version", NULL,
- (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
+ (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
if (version != NULL) {
Tcl_SetObjResult(interp, version);
return TCL_OK;
@@ -2038,10 +2013,10 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
* InfoVarsCmd --
*
* Called to implement the "info vars" command that returns the list of
- * variables in the interpreter that match an optional pattern. The
+ * variables in the interpreter that match an optional pattern. The
* pattern, if any, consists of an optional sequence of namespace names
* separated by "::" qualifiers, which is followed by a glob-style
- * pattern that restricts which variables are returned. Handles the
+ * pattern that restricts which variables are returned. Handles the
* following syntax:
*
* info vars ?pattern?
@@ -2071,9 +2046,9 @@ InfoVarsCmd(dummy, interp, objc, objv)
Var *varPtr;
Namespace *nsPtr;
Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
- Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
Tcl_Obj *listPtr, *elemObjPtr;
- int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
+ int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
/*
* Get the pattern and find the "effective namespace" in which to list
@@ -2101,7 +2076,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
&simplePattern);
- if (nsPtr != NULL) { /* we successfully found the pattern's ns */
+ if (nsPtr != NULL) { /* We successfully found the pattern's ns */
specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
}
} else {
@@ -2175,7 +2150,8 @@ InfoVarsCmd(dummy, interp, objc, objv)
|| Tcl_StringMatch(varName, simplePattern)) {
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
- Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, elemObjPtr);
+ Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
+ elemObjPtr);
} else {
elemObjPtr = Tcl_NewStringObj(varName, -1);
}
@@ -2228,7 +2204,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
*
* Tcl_JoinObjCmd --
*
- * This procedure is invoked to process the "join" Tcl command. See the
+ * This procedure is invoked to process the "join" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -2375,7 +2351,7 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
* Now place a list of any values left over into the interpreter result.
*
* First, figure out how many values were not assigned by getting the
- * length of the list. Note that I do not expect this operation to fail.
+ * length of the list. Note that I do not expect this operation to fail.
*/
if (Tcl_ListObjGetElements(interp, objv[1],
@@ -2385,7 +2361,7 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
if (listObjc > objc-2) {
/*
- * OK, there were left-overs. Make a list of them and slap that back
+ * OK, there were left-overs. Make a list of them and slap that back
* in the interpreter result.
*/
@@ -2431,7 +2407,7 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
/*
* If objc==3, then objv[2] may be either a single index or a list of
- * indices: go to TclLindexList to determine which. If objc>=4, or
+ * indices: go to TclLindexList to determine which. If objc>=4, or
* objc==2, then objv[2 .. objc-2] are all single indices and processed as
* such in TclLindexFlat.
*/
@@ -2471,11 +2447,11 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
*
* Notes:
* If objv[1] can be parsed as a list, TclLindexList handles extraction
- * of the desired element locally. Otherwise, it invokes TclLindexFlat
- * to treat objv[1] as a scalar.
+ * of the desired element locally. Otherwise, it invokes TclLindexFlat to
+ * treat objv[1] as a scalar.
*
* The reference count of the returned object includes one reference
- * corresponding to the pointer returned. Thus, the calling code will
+ * corresponding to the pointer returned. Thus, the calling code will
* usually do something like:
* Tcl_SetObjResult(interp, result);
* Tcl_DecrRefCount(result);
@@ -2518,7 +2494,7 @@ TclLindexList(interp, listPtr, argPtr)
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.
+ * well-formed list. Report the error via TclLindexFlat.
*/
return TclLindexFlat(interp, listPtr, 1, &argPtr);
@@ -2573,7 +2549,7 @@ TclLindexList(interp, listPtr, argPtr)
}
/*
- * Make sure listPtr still refers to a list object. If it shared a
+ * Make sure listPtr still refers to a list object. If it shared a
* Tcl_Obj structure with the arguments, then it might have just been
* converted to something else.
*/
@@ -2598,7 +2574,7 @@ TclLindexList(interp, listPtr, argPtr)
/*
* The work we did above may have caused the internal rep of *argPtr
- * to change to something else. Get it back.
+ * to change to something else. Get it back.
*/
result = Tcl_ListObjGetElements(interp, argPtr, &indexCount, &indices);
@@ -2613,7 +2589,7 @@ TclLindexList(interp, listPtr, argPtr)
}
/*
- * Return the last object extracted. Its reference count will include the
+ * Return the last object extracted. Its reference count will include the
* reference being returned.
*/
@@ -2636,7 +2612,7 @@ TclLindexList(interp, listPtr, argPtr)
*
* Notes:
* This procedure is called from either tclExecute.c or Tcl_LindexObjCmd
- * whenever either is presented with objc==2 or objc>=4. It is also
+ * whenever either is presented with objc==2 or objc>=4. It is also
* called from TclLindexList for the objc==3 case once it is determined
* that objv[2] cannot be parsed as a list.
*
@@ -2659,7 +2635,7 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
Tcl_Obj** elemPtrs; /* Array of pointers to the elements of the
* current list. */
int index; /* Parsed version of the current element of
- * indexArray. */
+ * indexArray. */
Tcl_Obj* oldListPtr; /* Temporary to hold listPtr so that its ref
* count can be decremented. */
@@ -2707,9 +2683,9 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
}
/*
- * Make sure listPtr still refers to a list object. It might have
- * been converted to something else above if objv[1] overlaps with one
- * of the other parameters.
+ * Make sure listPtr still refers to a list object. It might have been
+ * converted to something else above if objv[1] overlaps with one of
+ * the other parameters.
*/
if (listPtr->typePtr != &tclListType) {
@@ -2774,7 +2750,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
}
/*
- * Get the index. "end" is interpreted to be the index after the last
+ * Get the index. "end" is interpreted to be the index after the last
* element, such that using it will cause any inserted elements to be
* appended to the list.
*/
@@ -2829,7 +2805,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
*
* Tcl_ListObjCmd --
*
- * This procedure is invoked to process the "list" Tcl command. See the
+ * This procedure is invoked to process the "list" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -2866,7 +2842,7 @@ Tcl_ListObjCmd(dummy, interp, objc, objv)
* Tcl_LlengthObjCmd --
*
* This object-based procedure is invoked to process the "llength" Tcl
- * command. See the user documentation for details on what it does.
+ * command. See the user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -2911,8 +2887,8 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
*
* Tcl_LrangeObjCmd --
*
- * This procedure is invoked to process the "lrange" Tcl command. See
- * the user documentation for details on what it does.
+ * This procedure is invoked to process the "lrange" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -3005,7 +2981,7 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
*
* Tcl_LrepeatObjCmd --
*
- * This procedure is invoked to process the "lrepeat" Tcl command. See
+ * This procedure is invoked to process the "lrepeat" Tcl command. See
* the user documentation for details on what it does.
*
* Results:
@@ -3020,10 +2996,11 @@ 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[]; /* The argument objects. */
+ 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;
Tcl_Obj *listPtr, **dataArray;
@@ -3066,7 +3043,7 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
dataArray = &listRepPtr->elements;
/*
- * Set the elements. Note that we handle the common degenerate case of a
+ * Set the elements. Note that we handle the common degenerate case of a
* single value being repeated separately to permit the compiler as much
* room as possible to optimize a loop that might be run a very large
* number of times.
@@ -3135,7 +3112,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
}
/*
- * Get the first and last indexes. "end" is interpreted to be the index
+ * Get the first and last indexes. "end" is interpreted to be the index
* for the last element, such that using it will cause that element to be
* included for deletion.
*/
@@ -3150,13 +3127,13 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
return result;
}
- if (first < 0) {
+ if (first < 0) {
first = 0;
}
/*
* Complain if the user asked for a start element that is greater than the
- * list length. This won't ever trigger for the "end*" case as that will
+ * list length. This won't ever trigger for the "end*" case as that will
* be properly constrained by TclGetIntForIndex because we use listLen-1
* (to allow for replacing the last elem).
*/
@@ -3213,7 +3190,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
*
* Tcl_LsearchObjCmd --
*
- * This procedure is invoked to process the "lsearch" Tcl command. See
+ * This procedure is invoked to process the "lsearch" Tcl command. See
* the user documentation for details on what it does.
*
* Results:
@@ -3364,9 +3341,9 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
i++;
if (objv[i] == objv[objc - 2]) {
/*
- * Take copy to prevent shimmering problems. Note that it
+ * Take copy to prevent shimmering problems. Note that it
* does not matter if the index obj is also a component of the
- * list being searched. We only need to copy where the list
+ * list being searched. We only need to copy where the list
* and the index are one-and-the-same.
*/
@@ -3394,7 +3371,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
/*
* Store the extracted indices for processing by sublist
- * extraction. Note that we don't do this using objects because
+ * extraction. Note that we don't do this using objects because
* that has shimmering problems.
*/
@@ -3419,7 +3396,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
/*
- * Fill the array by parsing each index. We don't know whether
+ * Fill the array by parsing each index. We don't know whether
* their scale is sensible yet, but we at least perform the
* syntactic check here.
*/
@@ -3556,7 +3533,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
/*
- * If the data is sorted, we can do a more intelligent search. Note
+ * If the data is sorted, we can do a more intelligent search. Note
* that there is no point in being smart when -all was specified; in
* that case, we have to look at all items anyway, and there is no
* sense in doing this when the match sense is inverted.
@@ -3618,13 +3595,13 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
if (match == 0) {
/*
* Normally, binary search is written to stop when it finds a
- * match. If there are duplicates of an element in the list,
+ * match. If there are duplicates of an element in the list,
* our first match might not be the first occurance.
- * Consider: 0 0 0 1 1 1 2 2 2
+ * Consider: 0 0 0 1 1 1 2 2 2
*
* To maintain consistancy with standard lsearch semantics, we
* must find the leftmost occurance of the pattern in the
- * list. Thus we don't just stop searching here. This
+ * list. Thus we don't just stop searching here. This
* variation means that a search always makes log n
* comparisons (normal binary search might "get lucky" with an
* early comparison).
@@ -3802,7 +3779,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
} else if (index < 0) {
/*
- * Is this superfluous? The result should be a blank object by
+ * Is this superfluous? The result should be a blank object by
* default...
*/
@@ -3826,7 +3803,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*
* Tcl_LsetObjCmd --
*
- * This procedure is invoked to process the "lset" Tcl command. See the
+ * This procedure is invoked to process the "lset" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -3868,7 +3845,7 @@ Tcl_LsetObjCmd(clientData, interp, objc, objv)
}
/*
- * Substitute the value in the value. Return either the value or else an
+ * Substitute the value in the value. Return either the value or else an
* unshared copy of it.
*/
@@ -3911,7 +3888,7 @@ Tcl_LsetObjCmd(clientData, interp, objc, objv)
*
* Tcl_LsortObjCmd --
*
- * This procedure is invoked to process the "lsort" Tcl command. See the
+ * This procedure is invoked to process the "lsort" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -4034,7 +4011,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
}
/*
- * Fill the array by parsing each index. We don't know whether
+ * Fill the array by parsing each index. We don't know whether
* their scale is sensible yet, but we at least perform the
* syntactic check here.
*/
@@ -4178,13 +4155,13 @@ 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 operator. */
+ SortElement *headPtr; /* First element on the list. */
+ SortInfo *infoPtr; /* Information needed by the comparison
+ * operator. */
{
/*
* The subList array below holds pointers to temporary lists built during
- * the merge sort. Element i of the array holds a list of length 2**i.
+ * the merge sort. Element i of the array holds a list of length 2**i.
*/
# define NUM_LISTS 30
@@ -4234,12 +4211,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 operator. */
+ 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;
SortElement *tailPtr;
@@ -4297,7 +4272,7 @@ MergeLists(leftPtr, rightPtr, infoPtr)
* Results:
* A negative results means the the first element comes before the
* second, and a positive results means that the second element should
- * come first. A result of zero means the two elements are equal and it
+ * come first. A result of zero means the two elements are equal and it
* doesn't matter which comes first.
*
* Side effects:
@@ -4308,9 +4283,9 @@ 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 "lsort" command. */
+ Tcl_Obj *objPtr1, *objPtr2; /* Values to be compared. */
+ SortInfo *infoPtr; /* Information passed from the top-level
+ * "lsort" command. */
{
int order;
@@ -4372,7 +4347,7 @@ SortCompare(objPtr1, objPtr2, infoPtr)
paramObjv[0] = objPtr1;
paramObjv[1] = objPtr2;
- /*
+ /*
* We made space in the command list for the two things to compare.
* Replace them and evaluate the result.
*/
@@ -4380,12 +4355,12 @@ SortCompare(objPtr1, objPtr2, infoPtr)
Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
2, 2, paramObjv);
- Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
+ Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
&objc, &objv);
infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);
- if (infoPtr->resultCode != TCL_OK) {
+ if (infoPtr->resultCode != TCL_OK) {
Tcl_AddErrorInfo(infoPtr->interp,
"\n (-compare command)");
return order;
@@ -4416,16 +4391,16 @@ SortCompare(objPtr1, objPtr2, infoPtr)
* DictionaryCompare
*
* This function compares two strings as if they were being used in an
- * index or card catalog. The case of alphabetic characters is ignored,
- * except to break ties. Thus "B" comes before "b" but after "a". Also,
- * integers embedded in the strings compare in numerical order. In other
+ * index or card catalog. The case of alphabetic characters is ignored,
+ * except to break ties. Thus "B" comes before "b" but after "a". Also,
+ * integers embedded in the strings compare in numerical order. In other
* words, "x10y" comes after "x9y", not * before it as it would when
* using strcmp().
*
* Results:
* A negative result means that the first element comes before the
* second, and a positive result means that the second element should
- * come first. A result of zero means the two elements are equal and it
+ * come first. A result of zero means the two elements are equal and it
* doesn't matter which comes first.
*
* Side effects:
@@ -4436,7 +4411,7 @@ SortCompare(objPtr1, objPtr2, infoPtr)
static int
DictionaryCompare(left, right)
- char *left, *right; /* The strings to compare. */
+ char *left, *right; /* The strings to compare. */
{
Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
int diff, zeros;
@@ -4446,8 +4421,8 @@ DictionaryCompare(left, right)
if (isdigit(UCHAR(*right)) /* INTL: digit */
&& isdigit(UCHAR(*left))) { /* INTL: digit */
/*
- * There are decimal numbers embedded in the two strings. Compare
- * them as numbers, rather than strings. If one number has more
+ * There are decimal numbers embedded in the two strings. Compare
+ * them as numbers, rather than strings. If one number has more
* leading zeros than the other, the number with more leading
* zeros sorts later, but only as a secondary choice.
*/
@@ -4467,7 +4442,7 @@ DictionaryCompare(left, right)
/*
* The code below compares the numbers in the two strings without
- * ever converting them to integers. It does this by first
+ * ever converting them to integers. It does this by first
* comparing the lengths of the numbers and then comparing the
* digit values.
*/
@@ -4501,7 +4476,7 @@ DictionaryCompare(left, right)
}
/*
- * Convert character to Unicode for comparison purposes. If either
+ * Convert character to Unicode for comparison purposes. If either
* string is at the terminating null, do a byte-wise comparison and
* bail out immediately.
*/
@@ -4512,7 +4487,7 @@ DictionaryCompare(left, right)
/*
* Convert both chars to lower for the comparison, because
- * dictionary sorts are case insensitve. Covert to lower, not
+ * dictionary sorts are case insensitve. Covert to lower, not
* upper, so chars between Z and a will sort before A (where most
* other interesting punctuations occur)
*/
@@ -4547,7 +4522,7 @@ DictionaryCompare(left, right)
*
* SelectObjFromSublist --
*
- * This procedure is invoked from lsearch and SortCompare. It is used
+ * This procedure is invoked from lsearch and SortCompare. It is used
* for implementing the -index option, for the lsort and lsearch
* commands.
*
@@ -4567,10 +4542,9 @@ 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 "lsearch" or "lsort"
- * command. */
+ Tcl_Obj *objPtr; /* Obj to select sublist from. */
+ SortInfo *infoPtr; /* Information passed from the top-level
+ * "lsearch" or "lsort" command. */
{
int i;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 094dcac..2a94eb8 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -2,8 +2,8 @@
* tclCmdMZ.c --
*
* This file contains the top-level command routines for most of the Tcl
- * built-in commands whose names begin with the letters M to Z. It
- * contains only commands in the generic core (i.e. those that don't
+ * built-in commands whose names begin with the letters M to Z. It
+ * contains only commands in the generic core (i.e. those that don't
* depend much upon UNIX facilities).
*
* Copyright (c) 1987-1993 The Regents of the University of California.
@@ -15,18 +15,18 @@
* 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.127 2005/07/17 21:17:37 dkf Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.128 2005/08/26 13:26:55 dkf Exp $
*/
#include "tclInt.h"
#include "tclRegexp.h"
-
+
/*
*----------------------------------------------------------------------
*
* Tcl_PwdObjCmd --
*
- * This procedure is invoked to process the "pwd" Tcl command. See the
+ * This procedure is invoked to process the "pwd" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -41,10 +41,10 @@
/* 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. */
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
Tcl_Obj *retVal;
@@ -67,7 +67,7 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv)
*
* Tcl_RegexpObjCmd --
*
- * This procedure is invoked to process the "regexp" Tcl command. See
+ * This procedure is invoked to process the "regexp" Tcl command. See
* the user documentation for details on what it does.
*
* Results:
@@ -82,10 +82,10 @@ 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. */
+ 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;
@@ -103,13 +103,13 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
REGEXP_NOCASE, REGEXP_START, REGEXP_LAST
};
- indices = 0;
- about = 0;
- cflags = TCL_REG_ADVANCED;
- eflags = 0;
- offset = 0;
- all = 0;
- doinline = 0;
+ indices = 0;
+ about = 0;
+ cflags = TCL_REG_ADVANCED;
+ eflags = 0;
+ offset = 0;
+ all = 0;
+ doinline = 0;
for (i = 1; i < objc; i++) {
char *name;
@@ -172,7 +172,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
}
}
- endOfForLoop:
+ endOfForLoop:
if ((objc - i) < (2 - about)) {
Tcl_WrongNumArgs(interp, 1, objv,
"?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
@@ -199,7 +199,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
if (about) {
regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) {
- optionError:
+ optionError:
if (startIndex) {
Tcl_DecrRefCount(startIndex);
}
@@ -210,7 +210,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
/*
* Get the length of the string that we are matching against so we can do
- * the termination test for -all matches. Do this before getting the
+ * the termination test for -all matches. Do this before getting the
* regexp to avoid shimmering problems.
*/
@@ -260,8 +260,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
/*
* The following loop is to handle multiple matches within the same source
- * string; each iteration handles one match. If "-all" hasn't been
- * specified then the loop body only gets executed once. We terminate the
+ * string; each iteration handles one match. If "-all" hasn't been
+ * specified then the loop body only gets executed once. We terminate the
* loop when the starting offset is past the end of the string.
*/
@@ -269,8 +269,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
match = Tcl_RegExpExecObj(interp, regExpr, objPtr,
offset /* offset */, numMatchesSaved, eflags
| ((offset > 0 &&
- (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n'))
- ? TCL_REG_NOTBOL : 0));
+ (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n'))
+ ? TCL_REG_NOTBOL : 0));
if (match < 0) {
return TCL_ERROR;
@@ -323,12 +323,12 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
/*
* Only adjust the match area if there was a match for that
- * area. (Scriptics Bug 4391/SF Bug #219232)
+ * area. (Scriptics Bug 4391/SF Bug #219232)
*/
if (i <= info.nsubs && info.matches[i].start >= 0) {
start = offset + info.matches[i].start;
- end = offset + info.matches[i].end;
+ end = offset + info.matches[i].end;
/*
* Adjust index so it refers to the last character in the
@@ -340,7 +340,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
}
} else {
start = -1;
- end = -1;
+ end = -1;
}
objs[0] = Tcl_NewLongObj(start);
@@ -382,8 +382,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
/*
* Adjust the offset to the character just after the last one in the
* matchVar and increment all to count how many times we are making a
- * match. We always increment the offset by at least one to prevent
- * endless looping (as in the case: regexp -all {a*} a). Otherwise,
+ * match. We always increment the offset by at least one to prevent
+ * endless looping (as in the case: regexp -all {a*} a). Otherwise,
* when we match the NULL string at the end of the input string, we
* will loop indefinately (because the length of the match is 0, so
* offset never changes).
@@ -419,8 +419,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv)
*
* Tcl_RegsubObjCmd --
*
- * This procedure is invoked to process the "regsub" Tcl command. See
- * the user documentation for details on what it does.
+ * This procedure is invoked to process the "regsub" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -434,10 +434,10 @@ 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. */
+ 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;
@@ -542,28 +542,27 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
&& (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
&& (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
/*
- * This is a simple one pair string map situation. We make use of a
+ * This is a simple one pair string map situation. We make use of a
* slightly modified version of the one pair STR_MAP code.
*/
int slen, nocase;
- int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar *, CONST Tcl_UniChar *,
- unsigned long));
+ int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long);
Tcl_UniChar *p, wsrclc;
numMatches = 0;
- nocase = (cflags & TCL_REG_NOCASE);
- strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
+ nocase = (cflags & TCL_REG_NOCASE);
+ strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
- wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
- wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
+ wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
+ wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
- wend = wstring + wlen - (slen ? slen - 1 : 0);
- result = TCL_OK;
+ wend = wstring + wlen - (slen ? slen - 1 : 0);
+ result = TCL_OK;
if (slen == 0) {
/*
- * regsub behavior for "" matches between each character. 'string
+ * regsub behavior for "" matches between each character. 'string
* map' skips the "" case.
*/
@@ -616,7 +615,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
}
/*
- * Make sure to avoid problems where the objects are shared. This can
+ * Make sure to avoid problems where the objects are shared. This can
* cause RegExpObj <> UnicodeObj shimmering that causes data corruption.
* [Bug #461322]
*/
@@ -639,8 +638,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
/*
* The following loop is to handle multiple matches within the same source
* string; each iteration handles one match and its corresponding
- * substitution. If "-all" hasn't been specified then the loop body only
- * gets executed once. We must use 'offset <= wlen' in particular for the
+ * substitution. If "-all" hasn't been specified then the loop body only
+ * gets executed once. We must use 'offset <= wlen' in particular for the
* case where the regexp pattern can match the empty string - this is
* useful when doing, say, 'regsub -- ^ $str ...' when $str might be
* empty.
@@ -656,8 +655,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
10 /* matches */, ((offset > 0 &&
- (wstring[offset-1] != (Tcl_UniChar)'\n'))
- ? TCL_REG_NOTBOL : 0));
+ (wstring[offset-1] != (Tcl_UniChar)'\n'))
+ ? TCL_REG_NOTBOL : 0));
if (match < 0) {
result = TCL_ERROR;
@@ -692,7 +691,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
/*
* Append the subSpec argument to the variable, making appropriate
- * substitutions. This code is a bit hairy because of the backslash
+ * substitutions. This code is a bit hairy because of the backslash
* conventions and because the code saves up ranges of characters in
* subSpec to reduce the number of calls to Tcl_SetVar.
*/
@@ -779,7 +778,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
* result variable.
*/
- regsubDone:
+ regsubDone:
if (numMatches == 0) {
/*
* On zero matches, just ignore the offset, since it shouldn't matter
@@ -812,7 +811,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
Tcl_SetObjResult(interp, resultPtr);
}
- done:
+ done:
if (objPtr && (objv[1] == objv[0])) {
Tcl_DecrRefCount(objPtr);
}
@@ -830,8 +829,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
*
* Tcl_RenameObjCmd --
*
- * This procedure is invoked to process the "rename" Tcl command. See
- * the user documentation for details on what it does.
+ * This procedure is invoked to process the "rename" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -915,8 +914,8 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv)
*
* Tcl_SourceObjCmd --
*
- * This procedure is invoked to process the "source" Tcl command. See
- * the user documentation for details on what it does.
+ * This procedure is invoked to process the "source" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -966,7 +965,7 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv)
*
* Tcl_SplitObjCmd --
*
- * This procedure is invoked to process the "split" Tcl command. See the
+ * This procedure is invoked to process the "split" Tcl command. See the
* user documentation for details on what it does.
*
* Results:
@@ -1019,7 +1018,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
* Handle the special case of splitting on every character.
*
* Uses a hash table to ensure that each kind of character has only
- * one Tcl_Obj instance (multiply-referenced) in the final list. This
+ * one Tcl_Obj instance (multiply-referenced) in the final list. This
* is a *major* win when splitting on a long string (especially in the
* megabyte range!) - DKF
*/
@@ -1053,9 +1052,9 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
char *p;
/*
- * Handle the special case of splitting on a single character. This
- * is only true for the one-char ASCII case, as one unicode char is >
- * 1 byte in length.
+ * Handle the special case of splitting on a single character. This is
+ * only true for the one-char ASCII case, as one unicode char is > 1
+ * byte in length.
*/
while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) {
@@ -1071,7 +1070,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
Tcl_UniChar splitChar;
/*
- * Normal case: split on any of a given set of characters. Discard
+ * Normal case: split on any of a given set of characters. Discard
* instances of the split characters.
*/
@@ -1102,14 +1101,14 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv)
*
* Tcl_StringObjCmd --
*
- * This procedure is invoked to process the "string" Tcl command. See
- * the user documentation for details on what it does. Note that this
- * command only functions correctly on properly formed Tcl UTF strings.
+ * This procedure is invoked to process the "string" Tcl command. See the
+ * user documentation for details on what it does. Note that this command
+ * only functions correctly on properly formed Tcl UTF strings.
*
- * Note that the primary methods here (equal, compare, match, ...) have
- * bytecode equivalents. You will find the code for those in
- * tclExecute.c. The code here will only be used in the non-bc case
- * (like in an 'eval').
+ * Note that the primary methods here (equal, compare, match, ...) have
+ * bytecode equivalents. You will find the code for those in
+ * tclExecute.c. The code here will only be used in the non-bc case (like
+ * in an 'eval').
*
* Results:
* A standard Tcl result.
@@ -1149,7 +1148,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
};
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
return TCL_ERROR;
}
@@ -1169,8 +1168,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*/
int i, match, length, nocase = 0, reqlength = -1;
- typedef int (*strCmpFn_t) _ANSI_ARGS_((const char *, const char *,
- unsigned int));
+ typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
strCmpFn_t strCmpFn;
if (objc < 4 || objc > 7) {
@@ -1220,7 +1218,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
objv[1]->typePtr == &tclByteArrayType) {
/*
* Use binary versions of comparisons since that won't cause undue
- * type conversions and it is much faster. Only do this if we're
+ * type conversions and it is much faster. Only do this if we're
* case-sensitive (which is all that really makes sense with byte
* arrays anyway, and we have no memcasecmp() for some
* reason... :^)
@@ -1233,7 +1231,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
&& (objv[1]->typePtr == &tclStringType)) {
/*
* Do a unicode-specific comparison if both of the args are of
- * String type. In benchmark testing this proved the most
+ * String type. In benchmark testing this proved the most
* efficient check between the unicode and string comparison
* operations.
*/
@@ -1244,9 +1242,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
} else {
/*
- * As a catch-all we will work with UTF-8. We cannot use memcmp()
+ * As a catch-all we will work with UTF-8. We cannot use memcmp()
* as that is unsafe with any string containing NULL (\xC0\x80 in
- * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if
+ * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if
* we are case-sensitive and no specific length was requested.
*/
@@ -1315,7 +1313,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if (objc == 5) {
/*
* If a startIndex is specified, we will need to fast forward to
- * that point in the string before we think about a match
+ * that point in the string before we think about a match.
*/
if (TclGetIntForIndex(interp, objv[4], length2 - 1,
@@ -1326,7 +1324,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
goto str_first_done;
} else if (start > 0) {
ustring2 += start;
- length2 -= start;
+ length2 -= start;
} else if (start < 0) {
/*
* Invalid start index mapped to string start; Bug #423581
@@ -1373,7 +1371,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
/*
* If we have a ByteArray object, avoid indexing in the Utf string
- * since the byte array contains one byte per character. Otherwise,
+ * since the byte array contains one byte per character. Otherwise,
* use the Unicode string rep to get the index'th char.
*/
@@ -1418,7 +1416,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
* The UniChar comparison function
*/
- int (*chcomp)_ANSI_ARGS_((int)) = NULL;
+ int (*chcomp)(int) = NULL;
int i, failat = 0, result = 1, strict = 0;
Tcl_Obj *objPtr, *failVarObj = NULL;
Tcl_WideInt w;
@@ -1542,8 +1540,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*
* The danger in this function is that "12345678901234567890" is
* an acceptable 'double', but will later be interp'd as an int by
- * something like [expr]. Therefore, we check to see if it looks
- * like an int, and if so we do a range check on it. If strtoul
+ * something like [expr]. Therefore, we check to see if it looks
+ * like an int, and if so we do a range check on it. If strtoul
* gets to the end, we know we either received an acceptable int,
* or over/underflow.
*/
@@ -1653,7 +1651,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
/*
- * Like STR_IS_DOUBLE, but we use strtoll. Since
+ * Like STR_IS_DOUBLE, but we use strtoll. Since
* Tcl_GetWideIntFromObj already failed, we set result to 0.
*/
@@ -1767,7 +1765,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
if (length1 > 0) {
- for (; p >= ustring2; p--) {
+ for (; p >= ustring2; p--) {
/*
* Scan backwards to find the first character.
*/
@@ -1813,8 +1811,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
int mapElemc, nocase = 0, mapWithDict = 0, copySource = 0;
Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
Tcl_UniChar *ustring1, *ustring2, *p, *end;
- int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar *, CONST Tcl_UniChar *,
- unsigned long));
+ int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long);
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
@@ -1846,7 +1843,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
/*
* We know the type exactly, so all dict operations will succeed
- * for sure. This shortens this code quite a bit.
+ * for sure. This shortens this code quite a bit.
*/
Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
@@ -1974,9 +1971,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
int *mapLens;
/*
- * Precompute pointers to the unicode string and length. This
+ * Precompute pointers to the unicode string and length. This
* saves us repeated function calls later, significantly speeding
- * up the algorithm. We only need the lowercase first char in the
+ * up the algorithm. We only need the lowercase first char in the
* nocase case.
*/
@@ -2001,7 +1998,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*/
ustring2 = mapStrings[index];
- length2 = mapLens[index];
+ length2 = mapLens[index];
if ((length2 > 0) && ((*ustring1 == *ustring2) ||
(nocase && (Tcl_UniCharToLower(*ustring1) ==
u2lc[index/2]))) &&
@@ -2094,7 +2091,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
/*
* If we have a ByteArray object, avoid indexing in the Utf string
- * since the byte array contains one byte per character. Otherwise,
+ * since the byte array contains one byte per character. Otherwise,
* use the Unicode string rep to get the range.
*/
@@ -2151,16 +2148,18 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
string1 = Tcl_GetStringFromObj(objv[2], &length1);
if (length1 > 0) {
/*
- * Only build up a string that has data. Instead of building
+ * Only build up a string that has data. Instead of building
* it up with repeated appends, we just allocate the necessary
- * space once and copy the string value in. Check for
- * overflow with back-division. [Bug #714106]
+ * space once and copy the string value in. Check for overflow
+ * with back-division. [Bug #714106]
*/
Tcl_Obj *resultPtr;
+
length2 = length1 * count;
if ((length2 / count) != length1) {
char buf[TCL_INTEGER_SPACE+1];
+
sprintf(buf, "%d", INT_MAX);
Tcl_AppendResult(interp,
"string size overflow, must be less than ",
@@ -2361,8 +2360,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
end = string1;
/*
- * The outer loop iterates over the string. The inner loop
- * iterates over the trim characters. The loops terminate as soon
+ * The outer loop iterates over the string. The inner loop
+ * iterates over the trim characters. The loops terminate as soon
* as a non-trim character is discovered and length1 marks the
* last non-trim character.
*/
@@ -2468,9 +2467,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*
* Tcl_SubstObjCmd --
*
- * This procedure is invoked to process the "subst" Tcl command. See the
- * user documentation for details on what it does. This command relies
- * on Tcl_SubstObj() for its implementation.
+ * This procedure is invoked to process the "subst" Tcl command. See the
+ * user documentation for details on what it does. This command relies on
+ * Tcl_SubstObj() for its implementation.
*
* Results:
* A standard Tcl result.
@@ -2484,16 +2483,16 @@ 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. */
+ 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", (char *) NULL
};
enum substOptions {
- SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
+ SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
};
Tcl_Obj *resultPtr;
int optionIndex, flags, i;
@@ -2585,7 +2584,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP,
OPT_LAST
};
- typedef int (*strCmpFn_t) _ANSI_ARGS_((const char *, const char *));
+ typedef int (*strCmpFn_t)(const char *, const char *);
strCmpFn_t strCmpFn = strcmp;
mode = OPT_EXACT;
@@ -2730,7 +2729,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
}
/*
- * Complain if the last body is a continuation. Note that this check
+ * Complain if the last body is a continuation. Note that this check
* assumes that the list is non-empty!
*/
@@ -2754,7 +2753,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
/*
* If either indexVarObj or matchVarObj are non-NULL, we're in
- * REGEXP mode but have reached the default clause anyway. TIP#75
+ * REGEXP mode but have reached the default clause anyway. TIP#75
* specifies that we set the variables to empty lists (== empty
* objects) in that case.
*/
@@ -2865,10 +2864,10 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
Tcl_DecrRefCount(indicesObj);
/*
- * Careful! Check to see if we have allocated the list of
+ * Careful! Check to see if we have allocated the list of
* matched strings; if so (but there was an error assigning
* the indices list) we have a potential memory leak because
- * the match list has not been written to a variable. Except
+ * the match list has not been written to a variable. Except
* that we'll clean that up right now.
*/
@@ -2906,6 +2905,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
* This shouldn't happen since we've checked that the last body is
* not a continuation...
*/
+
Tcl_Panic("fall-out when searching for body to match pattern");
}
if (strcmp(TclGetString(objv[j]), "-") != 0) {
@@ -2922,6 +2922,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
if (result == TCL_ERROR) {
Tcl_Obj *msg = Tcl_NewStringObj("\n (\"", -1);
Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine);
+
Tcl_IncrRefCount(msg);
Tcl_IncrRefCount(errorLine);
TclAppendLimitedToObj(msg, pattern, -1, 50, "");
@@ -2941,7 +2942,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
* Tcl_TimeObjCmd --
*
* This object-based procedure is invoked to process the "time" Tcl
- * command. See the user documentation for details on what it does.
+ * command. See the user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -3021,62 +3022,62 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv)
*
* Tcl_WhileObjCmd --
*
- * This procedure is invoked to process the "while" Tcl command. See the
- * user documentation for details on what it does.
+ * This procedure is invoked to process the "while" Tcl command. See the
+ * user documentation for details on what it does.
*
* With the bytecode compiler, this procedure is only called when a
* command name is computed at runtime, and is "while" or the name to
* which "while" was renamed: e.g., "set z while; $z {$i<100} {}"
*
* Results:
- * A standard Tcl result.
+ * A standard Tcl result.
*
* Side effects:
- * See the user documentation.
+ * See the user documentation.
*
*----------------------------------------------------------------------
*/
- /* ARGSUSED */
+ /* 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. */
+ ClientData dummy; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int result, value;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "test command");
- return TCL_ERROR;
+ return TCL_ERROR;
}
while (1) {
- result = Tcl_ExprBooleanObj(interp, objv[1], &value);
- if (result != TCL_OK) {
- return result;
- }
- if (!value) {
- break;
- }
- result = Tcl_EvalObjEx(interp, objv[2], 0);
- if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
- if (result == TCL_ERROR) {
- char msg[32 + TCL_INTEGER_SPACE];
-
- sprintf(msg, "\n (\"while\" body line %d)",
- interp->errorLine);
- Tcl_AddErrorInfo(interp, msg);
- }
- break;
- }
+ result = Tcl_ExprBooleanObj(interp, objv[1], &value);
+ if (result != TCL_OK) {
+ return result;
+ }
+ if (!value) {
+ break;
+ }
+ result = Tcl_EvalObjEx(interp, objv[2], 0);
+ if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
+ if (result == TCL_ERROR) {
+ char msg[32 + TCL_INTEGER_SPACE];
+
+ sprintf(msg, "\n (\"while\" body line %d)",
+ interp->errorLine);
+ Tcl_AddErrorInfo(interp, msg);
+ }
+ break;
+ }
}
if (result == TCL_BREAK) {
- result = TCL_OK;
+ result = TCL_OK;
}
if (result == TCL_OK) {
- Tcl_ResetResult(interp);
+ Tcl_ResetResult(interp);
}
return result;
}