summaryrefslogtreecommitdiffstats
path: root/generic/tclCmdIL.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCmdIL.c')
-rw-r--r--generic/tclCmdIL.c1138
1 files changed, 582 insertions, 556 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 31a3749..21aebe3 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -1,10 +1,10 @@
-/*
+/*
* tclCmdIL.c --
*
- * This file contains the top-level command routines for most of
- * the Tcl built-in commands whose names begin with the letters
- * I through L. It contains only commands in the generic core
- * (i.e. those that don't depend much upon UNIX facilities).
+ * This file contains the top-level command routines for most of the Tcl
+ * built-in commands whose names begin with the letters I through L. 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.
* Copyright (c) 1993-1997 Lucent Technologies.
@@ -13,26 +13,26 @@
* 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.
+ * 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.77 2005/07/14 12:17:35 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.78 2005/07/17 21:17:30 dkf Exp $
*/
#include "tclInt.h"
#include "tclRegexp.h"
/*
- * During execution of the "lsort" command, structures of the following
- * type are used to arrange the objects being sorted into a collection
- * of linked lists.
+ * During execution of the "lsort" command, structures of the following type
+ * are used to arrange the objects being sorted into a collection of linked
+ * lists.
*/
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. */
+ struct SortElement *nextPtr; /* Next element in the list, or NULL
+ * for end of list. */
} SortElement;
/*
@@ -45,35 +45,34 @@ typedef int (*SortMemCmpFn_t) _ANSI_ARGS_((const void *, const void *,
size_t));
/*
- * The "lsort" command needs to pass certain information down to the
- * function that compares two list elements, and the comparison function
- * needs to pass success or failure information back up to the top-level
- * "lsort" command. The following structure is used to pass this
- * information.
+ * The "lsort" command needs to pass certain information down to the function
+ * that compares two list elements, and the comparison function needs to pass
+ * success or failure information back up to the top-level "lsort" command.
+ * The following structure is used to pass this information.
*/
typedef struct SortInfo {
int isIncreasing; /* Nonzero means sort in increasing order. */
- int sortMode; /* The sort mode. One of SORTMODE_*
- * values defined below */
- SortStrCmpFn_t strCmpFn; /* Basic string compare command (used with
+ 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 base of command.*/
+ Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is
+ * 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
* supplied as an argument to that option.
- * NULL if no indexes supplied, and points
- * to singleIndex field when only one
+ * NULL if no indexes supplied, and points to
+ * singleIndex field when only one
* supplied. */
int indexc; /* Number of indexes in indexv array. */
int singleIndex; /* Static space for common index case. */
- Tcl_Interp *interp; /* The interpreter in which the sortis
- * being done. */
- int resultCode; /* Completion code for the lsort command.
- * If an error occurs during the sort this
- * is changed from TCL_OK to TCL_ERROR. */
+ Tcl_Interp *interp; /* The interpreter in which the sort is being
+ * done. */
+ 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;
/*
@@ -81,16 +80,17 @@ typedef struct SortInfo {
* following values.
*/
-#define SORTMODE_ASCII 0
-#define SORTMODE_INTEGER 1
-#define SORTMODE_REAL 2
-#define SORTMODE_COMMAND 3
-#define SORTMODE_DICTIONARY 4
+#define SORTMODE_ASCII 0
+#define SORTMODE_INTEGER 1
+#define SORTMODE_REAL 2
+#define SORTMODE_COMMAND 3
+#define SORTMODE_DICTIONARY 4
/*
- * Magic values for the index field of the SortInfo structure.
- * Note that the index "end-1" will be translated to SORTIDX_END-1, etc.
+ * 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. */
@@ -181,12 +181,12 @@ static Tcl_Obj * SelectObjFromSublist _ANSI_ARGS_((Tcl_Obj *firstPtr,
*
* Tcl_IfObjCmd --
*
- * This procedure is invoked to process the "if" Tcl command.
- * See the user documentation for details on what it does.
+ * 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 command name is computed at runtime, and is "if" or the name
- * to which "if" was renamed: e.g., "set z if; $z 1 {puts foo}"
+ * With the bytecode compiler, this procedure is only called when a
+ * command name is computed at runtime, and is "if" or the name to which
+ * "if" was renamed: e.g., "set z if; $z 1 {puts foo}"
*
* Results:
* A standard Tcl result.
@@ -205,17 +205,17 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int thenScriptIndex = 0; /* then script to be evaled after syntax check */
+ int thenScriptIndex = 0; /* "then" script to be evaled after
+ * syntax check */
int i, result, value;
char *clause;
i = 1;
while (1) {
/*
- * 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" (optional) and a script to execute if the expression is
- * true.
+ * 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"
+ * (optional) and a script to execute if the expression is true.
*/
if (i >= objc) {
@@ -251,8 +251,8 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
}
/*
- * The expression evaluated to false. Skip the command, then
- * see if there is an "else" or "elseif" clause.
+ * The expression evaluated to false. Skip the command, then see if
+ * there is an "else" or "elseif" clause.
*/
i++;
@@ -271,9 +271,9 @@ 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 get here.
+ * 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.
*/
if (strcmp(clause, "else") == 0) {
@@ -302,12 +302,12 @@ Tcl_IfObjCmd(dummy, interp, objc, objv)
*
* Tcl_IncrObjCmd --
*
- * This procedure is invoked to process the "incr" Tcl command.
- * See the user documentation for details on what it does.
+ * 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 command name is computed at runtime, and is "incr" or the name
- * to which "incr" was renamed: e.g., "set z incr; $z i -1"
+ * With the bytecode compiler, this procedure is only called when a
+ * command name is computed at runtime, and is "incr" or the name to
+ * which "incr" was renamed: e.g., "set z incr; $z i -1"
*
* Results:
* A standard Tcl result.
@@ -342,10 +342,11 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv)
if (objc == 3) {
/*
- * Need to be a bit cautious to ensure that [expr]-like rules
- * are enforced for interpretation of wide integers, despite
- * the fact that the underlying API itself is a 'long' only one.
+ * Need to be a bit cautious to ensure that [expr]-like rules are
+ * enforced for interpretation of wide integers, despite the fact that
+ * the underlying API itself is a 'long' only one.
*/
+
if (objv[2]->typePtr == &tclIntType) {
incrAmount = objv[2]->internalRep.longValue;
isWide = 0;
@@ -391,7 +392,7 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv)
*/
Tcl_SetObjResult(interp, newValuePtr);
- return TCL_OK;
+ return TCL_OK;
}
/*
@@ -399,8 +400,8 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv)
*
* Tcl_InfoObjCmd --
*
- * This procedure is invoked to process the "info" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "info" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -519,17 +520,17 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
*
* InfoArgsCmd --
*
- * Called to implement the "info args" command that returns the
- * argument list for a procedure. Handles the following syntax:
+ * Called to implement the "info args" command that returns the argument
+ * list for a procedure. Handles the following syntax:
*
* info args procName
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -581,17 +582,17 @@ InfoArgsCmd(dummy, interp, objc, objv)
*
* InfoBodyCmd --
*
- * Called to implement the "info body" command that returns the body
- * for a procedure. Handles the following syntax:
+ * Called to implement the "info body" command that returns the body for
+ * a procedure. Handles the following syntax:
*
* info body procName
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -621,21 +622,22 @@ InfoBodyCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- /*
+ /*
* Here we used to return procPtr->bodyPtr, except when the body was
- * bytecompiled - in that case, the return was a copy of the body's
- * string rep. In order to better isolate the implementation details
- * of the compiler/engine subsystem, we now always return a copy of
- * the string rep. It is important to return a copy so that later
- * manipulations of the object do not invalidate the internal rep.
+ * bytecompiled - in that case, the return was a copy of the body's string
+ * rep. In order to better isolate the implementation details of the
+ * compiler/engine subsystem, we now always return a copy of the string
+ * rep. It is important to return a copy so that later manipulations of
+ * the object do not invalidate the internal rep.
*/
bodyPtr = procPtr->bodyPtr;
if (bodyPtr->bytes == NULL) {
/*
- * The string rep might not be valid if the procedure has
- * never been run before. [Bug #545644]
+ * The string rep might not be valid if the procedure has never been
+ * run before. [Bug #545644]
*/
+
(void) Tcl_GetString(bodyPtr);
}
resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
@@ -649,18 +651,18 @@ InfoBodyCmd(dummy, interp, objc, objv)
*
* InfoCmdCountCmd --
*
- * Called to implement the "info cmdcount" command that returns the
- * number of commands that have been executed. Handles the following
- * syntax:
+ * Called to implement the "info cmdcount" command that returns the
+ * number of commands that have been executed. Handles the following
+ * syntax:
*
* info cmdcount
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -688,21 +690,21 @@ 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 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 following syntax:
+ * Called to implement the "info commands" command that returns the list
+ * 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
+ * following syntax:
*
* info commands ?pattern?
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -727,8 +729,8 @@ InfoCommandsCmd(dummy, interp, objc, objv)
int i;
/*
- * Get the pattern and find the "effective namespace" in which to
- * list commands.
+ * Get the pattern and find the "effective namespace" in which to list
+ * commands.
*/
if (objc == 2) {
@@ -738,10 +740,10 @@ InfoCommandsCmd(dummy, interp, objc, objv)
} else if (objc == 3) {
/*
* From the pattern, get the effective namespace and the simple
- * pattern (no namespace qualifiers or ::'s) at the end. If an
- * error was found while parsing the pattern, return it. Otherwise,
- * if the namespace wasn't found, just leave nsPtr NULL: we will
- * return an empty list since no commands there can be found.
+ * pattern (no namespace qualifiers or ::'s) at the end. If an error
+ * was found while parsing the pattern, return it. Otherwise, if the
+ * namespace wasn't found, just leave nsPtr NULL: we will return an
+ * empty list since no commands there can be found.
*/
Namespace *dummy1NsPtr, *dummy2NsPtr;
@@ -767,20 +769,20 @@ InfoCommandsCmd(dummy, interp, objc, objv)
}
/*
- * Scan through the effective namespace's command table and create a
- * list with all commands that match the pattern. If a specific
- * namespace was requested in the pattern, qualify the command names
- * with the namespace name.
+ * Scan through the effective namespace's command table and create a list
+ * with all commands that match the pattern. If a specific namespace was
+ * requested in the pattern, qualify the command names with the namespace
+ * name.
*/
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
/*
- * Special case for when the pattern doesn't include any of
- * glob's special characters. This lets us avoid scans of any
- * hash tables.
+ * Special case for when the pattern doesn't include any of glob's
+ * special characters. This lets us avoid scans of any hash tables.
*/
+
entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
if (entryPtr != NULL) {
if (specificNsInPattern) {
@@ -824,9 +826,9 @@ InfoCommandsCmd(dummy, interp, objc, objv)
}
} else if (nsPtr->commandPathLength == 0 || specificNsInPattern) {
/*
- * The pattern is non-trivial, but either there is no explicit
- * path or there is an explicit namespace in the pattern. In
- * both cases, the old matching scheme is perfect.
+ * The pattern is non-trivial, but either there is no explicit path or
+ * there is an explicit namespace in the pattern. In both cases, the
+ * old matching scheme is perfect.
*/
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
@@ -848,10 +850,10 @@ InfoCommandsCmd(dummy, interp, objc, objv)
/*
* If the effective namespace isn't the global :: namespace, and a
- * specific namespace wasn't requested in the pattern, then add in
- * all global :: commands that match the simple pattern. Of course,
- * we add in only those commands that aren't hidden by a command in
- * the effective namespace.
+ * specific namespace wasn't requested in the pattern, then add in all
+ * global :: commands that match the simple pattern. Of course, we add
+ * in only those commands that aren't hidden by a command in the
+ * effective namespace.
*/
if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
@@ -870,10 +872,10 @@ InfoCommandsCmd(dummy, interp, objc, objv)
}
} else {
/*
- * The pattern is non-trivial (can match more than one command
- * name), there is an explicit path, and there is no explicit
- * namespace in the pattern. This means that we have to
- * traverse the path to discover all the commands defined.
+ * The pattern is non-trivial (can match more than one command name),
+ * there is an explicit path, and there is no explicit namespace in
+ * the pattern. This means that we have to traverse the path to
+ * discover all the commands defined.
*/
Tcl_HashTable addedCommandsTable;
@@ -881,9 +883,9 @@ InfoCommandsCmd(dummy, interp, objc, objv)
int foundGlobal = (nsPtr == globalNsPtr);
/*
- * We keep a hash of the objects already added to the result
- * list.
+ * We keep a hash of the objects already added to the result list.
*/
+
Tcl_InitObjHashTable(&addedCommandsTable);
entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
@@ -932,10 +934,10 @@ InfoCommandsCmd(dummy, interp, objc, objv)
/*
* If the effective namespace isn't the global :: namespace, and a
- * specific namespace wasn't requested in the pattern, then add in
- * all global :: commands that match the simple pattern. Of course,
- * we add in only those commands that aren't hidden by a command in
- * the effective namespace.
+ * specific namespace wasn't requested in the pattern, then add in all
+ * global :: commands that match the simple pattern. Of course, we add
+ * in only those commands that aren't hidden by a command in the
+ * effective namespace.
*/
if (!foundGlobal) {
@@ -968,18 +970,18 @@ InfoCommandsCmd(dummy, interp, objc, objv)
*
* InfoCompleteCmd --
*
- * Called to implement the "info complete" command that determines
- * whether a string is a complete Tcl command. Handles the following
- * syntax:
+ * Called to implement the "info complete" command that determines
+ * whether a string is a complete Tcl command. Handles the following
+ * syntax:
*
* info complete command
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1010,18 +1012,17 @@ InfoCompleteCmd(dummy, interp, objc, objv)
*
* InfoDefaultCmd --
*
- * Called to implement the "info default" command that returns the
- * default value for a procedure argument. Handles the following
- * syntax:
+ * Called to implement the "info default" command that returns the
+ * default value for a procedure argument. Handles the following syntax:
*
* info default procName arg varName
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1094,17 +1095,17 @@ InfoDefaultCmd(dummy, interp, objc, objv)
*
* InfoExistsCmd --
*
- * Called to implement the "info exists" command that determines
- * whether a variable exists. Handles the following syntax:
+ * Called to implement the "info exists" command that determines whether
+ * a variable exists. Handles the following syntax:
*
* info exists varName
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1139,18 +1140,18 @@ InfoExistsCmd(dummy, interp, objc, objv)
*
* InfoFunctionsCmd --
*
- * Called to implement the "info functions" command that returns the
- * list of math functions matching an optional pattern. Handles the
- * following syntax:
+ * Called to implement the "info functions" command that returns the list
+ * of math functions matching an optional pattern. Handles the following
+ * syntax:
*
* info functions ?pattern?
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1187,18 +1188,18 @@ InfoFunctionsCmd(dummy, interp, objc, objv)
*
* InfoGlobalsCmd --
*
- * Called to implement the "info globals" command that returns the list
- * of global variables matching an optional pattern. Handles the
- * following syntax:
+ * Called to implement the "info globals" command that returns the list
+ * of global variables matching an optional pattern. Handles the
+ * following syntax:
*
* info globals ?pattern?
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1224,6 +1225,7 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
/*
* Strip leading global-namespace qualifiers. [Bug 1057461]
*/
+
if (pattern[0] == ':' && pattern[1] == ':') {
while (*pattern == ':') {
pattern++;
@@ -1235,8 +1237,8 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
}
/*
- * Scan through the global :: namespace's variable table and create a
- * list of all global variables that match the pattern.
+ * Scan through the global :: namespace's variable table and create a list
+ * of all global variables that match the pattern.
*/
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
@@ -1270,17 +1272,17 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
*
* InfoHostnameCmd --
*
- * Called to implement the "info hostname" command that returns the
- * host name. Handles the following syntax:
+ * Called to implement the "info hostname" command that returns the host
+ * name. Handles the following syntax:
*
* info hostname
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1314,17 +1316,17 @@ InfoHostnameCmd(dummy, interp, objc, objv)
*
* InfoLevelCmd --
*
- * Called to implement the "info level" command that returns
- * information about the call stack. Handles the following syntax:
+ * Called to implement the "info level" command that returns information
+ * about the call stack. Handles the following syntax:
*
* info level ?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.
*
*----------------------------------------------------------------------
*/
@@ -1385,18 +1387,18 @@ InfoLevelCmd(dummy, interp, objc, objv)
*
* InfoLibraryCmd --
*
- * Called to implement the "info library" command that returns the
- * library directory for the Tcl installation. Handles the following
- * syntax:
+ * Called to implement the "info library" command that returns the
+ * library directory for the Tcl installation. Handles the following
+ * syntax:
*
* info library
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1430,18 +1432,18 @@ InfoLibraryCmd(dummy, interp, objc, objv)
*
* InfoLoadedCmd --
*
- * Called to implement the "info loaded" command that returns the
- * packages that have been loaded into an interpreter. Handles the
- * following syntax:
+ * Called to implement the "info loaded" command that returns the
+ * packages that have been loaded into an interpreter. Handles the
+ * following syntax:
*
* info loaded ?interp?
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1475,18 +1477,18 @@ InfoLoadedCmd(dummy, interp, objc, objv)
*
* InfoLocalsCmd --
*
- * Called to implement the "info locals" command to return a list of
- * local variables that match an optional pattern. Handles the
- * following syntax:
+ * Called to implement the "info locals" command to return a list of
+ * local variables that match an optional pattern. Handles the following
+ * syntax:
*
* info locals ?pattern?
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1533,8 +1535,8 @@ InfoLocalsCmd(dummy, interp, objc, objv)
*
* AppendLocals --
*
- * Append the local variables for the current frame to the
- * specified list object.
+ * Append the local variables for the current frame to the specified list
+ * object.
*
* Results:
* None.
@@ -1613,18 +1615,18 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
*
* InfoNameOfExecutableCmd --
*
- * Called to implement the "info nameofexecutable" command that returns
- * the name of the binary file running this application. Handles the
- * following syntax:
+ * Called to implement the "info nameofexecutable" command that returns
+ * the name of the binary file running this application. Handles the
+ * following syntax:
*
* info nameofexecutable
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1649,18 +1651,18 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv)
*
* InfoPatchLevelCmd --
*
- * Called to implement the "info patchlevel" command that returns the
- * default value for an argument to a procedure. Handles the following
- * syntax:
+ * Called to implement the "info patchlevel" command that returns the
+ * default value for an argument to a procedure. Handles the following
+ * syntax:
*
* info patchlevel
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1693,21 +1695,21 @@ 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 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 following syntax:
+ * Called to implement the "info procs" command that returns the list of
+ * 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
+ * following syntax:
*
* info procs ?pattern?
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1733,8 +1735,8 @@ InfoProcsCmd(dummy, interp, objc, objv)
Command *cmdPtr, *realCmdPtr;
/*
- * Get the pattern and find the "effective namespace" in which to
- * list procs.
+ * Get the pattern and find the "effective namespace" in which to list
+ * procs.
*/
if (objc == 2) {
@@ -1744,10 +1746,10 @@ InfoProcsCmd(dummy, interp, objc, objv)
} else if (objc == 3) {
/*
* From the pattern, get the effective namespace and the simple
- * pattern (no namespace qualifiers or ::'s) at the end. If an
- * error was found while parsing the pattern, return it. Otherwise,
- * if the namespace wasn't found, just leave nsPtr NULL: we will
- * return an empty list since no commands there can be found.
+ * pattern (no namespace qualifiers or ::'s) at the end. If an error
+ * was found while parsing the pattern, return it. Otherwise, if the
+ * namespace wasn't found, just leave nsPtr NULL: we will return an
+ * empty list since no commands there can be found.
*/
Namespace *dummy1NsPtr, *dummy2NsPtr;
@@ -1770,10 +1772,10 @@ InfoProcsCmd(dummy, interp, objc, objv)
}
/*
- * Scan through the effective namespace's command table and create a
- * list with all procs that match the pattern. If a specific
- * namespace was requested in the pattern, qualify the command names
- * with the namespace name.
+ * Scan through the effective namespace's command table and create a list
+ * with all procs that match the pattern. If a specific namespace was
+ * requested in the pattern, qualify the command names with the namespace
+ * name.
*/
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
@@ -1790,7 +1792,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
goto simpleProcOK;
}
} else {
- simpleProcOK:
+ simpleProcOK:
if (specificNsInPattern) {
elemObjPtr = Tcl_NewObj();
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1834,20 +1836,21 @@ InfoProcsCmd(dummy, interp, objc, objv)
/*
* If the effective namespace isn't the global :: namespace, and a
- * specific namespace wasn't requested in the pattern, then add in
- * all global :: procs that match the simple pattern. Of course,
- * we add in only those procs that aren't hidden by a proc in
- * the effective namespace.
+ * specific namespace wasn't requested in the pattern, then add in all
+ * global :: procs that match the simple pattern. Of course, we add in
+ * only those procs that aren't hidden by a proc in the effective
+ * namespace.
*/
#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
/*
- * 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 decided not to "fix" it in 8.3, leaving the
- * behavior slightly different.
+ * 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
+ * decided not to "fix" it in 8.3, leaving the behavior slightly
+ * different.
*/
+
if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
while (entryPtr != NULL) {
@@ -1881,21 +1884,20 @@ InfoProcsCmd(dummy, interp, objc, objv)
*
* InfoScriptCmd --
*
- * Called to implement the "info script" command that returns the
- * script file that is currently being evaluated. Handles the
- * following syntax:
+ * Called to implement the "info script" command that returns the script
+ * file that is currently being evaluated. Handles the following syntax:
*
* info script ?newName?
*
* If newName is specified, it will set that as the internal name.
*
* 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. It may change the
- * internal script filename.
+ * 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
+ * script filename.
*
*----------------------------------------------------------------------
*/
@@ -1931,18 +1933,18 @@ InfoScriptCmd(dummy, interp, objc, objv)
*
* InfoSharedlibCmd --
*
- * Called to implement the "info sharedlibextension" command that
- * returns the file extension used for shared libraries. Handles the
- * following syntax:
+ * Called to implement the "info sharedlibextension" command that returns
+ * the file extension used for shared libraries. Handles the following
+ * syntax:
*
* info sharedlibextension
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1970,17 +1972,17 @@ InfoSharedlibCmd(dummy, interp, objc, objv)
*
* InfoTclVersionCmd --
*
- * Called to implement the "info tclversion" command that returns the
- * version number for this Tcl library. Handles the following syntax:
+ * Called to implement the "info tclversion" command that returns the
+ * version number for this Tcl library. Handles the following syntax:
*
* info tclversion
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -2013,21 +2015,21 @@ 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 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 following syntax:
+ * Called to implement the "info vars" command that returns the list of
+ * 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
+ * following syntax:
*
* info vars ?pattern?
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -2052,9 +2054,9 @@ InfoVarsCmd(dummy, interp, objc, objv)
int specificNsInPattern = 0; /* Init. to avoid compiler warning. */
/*
- * Get the pattern and find the "effective namespace" in which to
- * list variables. We only use this effective namespace if there's
- * no active Tcl procedure frame.
+ * Get the pattern and find the "effective namespace" in which to list
+ * variables. We only use this effective namespace if there's no active
+ * Tcl procedure frame.
*/
if (objc == 2) {
@@ -2064,10 +2066,10 @@ InfoVarsCmd(dummy, interp, objc, objv)
} else if (objc == 3) {
/*
* From the pattern, get the effective namespace and the simple
- * pattern (no namespace qualifiers or ::'s) at the end. If an
- * error was found while parsing the pattern, return it. Otherwise,
- * if the namespace wasn't found, just leave nsPtr NULL: we will
- * return an empty list since no variables there can be found.
+ * pattern (no namespace qualifiers or ::'s) at the end. If an error
+ * was found while parsing the pattern, return it. Otherwise, if the
+ * namespace wasn't found, just leave nsPtr NULL: we will return an
+ * empty list since no variables there can be found.
*/
Namespace *dummy1NsPtr, *dummy2NsPtr;
@@ -2099,16 +2101,15 @@ InfoVarsCmd(dummy, interp, objc, objv)
|| !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
|| specificNsInPattern) {
/*
- * There is no frame pointer, the frame pointer was pushed only
- * to activate a namespace, or we are in a procedure call frame
- * but a specific namespace was specified. Create a list containing
- * only the variables in the effective namespace's variable table.
+ * There is no frame pointer, the frame pointer was pushed only to
+ * activate a namespace, or we are in a procedure call frame but a
+ * specific namespace was specified. Create a list containing only the
+ * variables in the effective namespace's variable table.
*/
if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
/*
- * If we can just do hash lookups, that simplifies things
- * a lot.
+ * If we can just do hash lookups, that simplifies things a lot.
*/
entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern);
@@ -2163,12 +2164,11 @@ InfoVarsCmd(dummy, interp, objc, objv)
}
/*
- * If the effective namespace isn't the global ::
- * namespace, and a specific namespace wasn't requested in
- * the pattern (i.e., the pattern only specifies variable
- * names), then add in all global :: variables that match
- * the simple pattern. Of course, add in only those
- * variables that aren't hidden by a variable in the
+ * If the effective namespace isn't the global :: namespace, and a
+ * specific namespace wasn't requested in the pattern (i.e., the
+ * pattern only specifies variable names), then add in all global
+ * :: variables that match the simple pattern. Of course, add in
+ * only those variables that aren't hidden by a variable in the
* effective namespace.
*/
@@ -2206,8 +2206,8 @@ InfoVarsCmd(dummy, interp, objc, objv)
*
* Tcl_JoinObjCmd --
*
- * This procedure is invoked to process the "join" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "join" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -2242,8 +2242,8 @@ Tcl_JoinObjCmd(dummy, interp, objc, objv)
}
/*
- * Make sure the list argument is a list object and get its length and
- * a pointer to its array of element pointers.
+ * Make sure the list argument is a list object and get its length and a
+ * pointer to its array of element pointers.
*/
result = Tcl_ListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
@@ -2313,9 +2313,10 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
for (i=0 ; i+2<objc ; i++) {
/*
- * We do this each time round the loop because that is robust
- * against shimmering nasties.
+ * We do this each time round the loop because that is robust against
+ * shimmering nasties.
*/
+
if (Tcl_ListObjIndex(interp, objv[1], i, &valueObj) != TCL_OK) {
return TCL_ERROR;
}
@@ -2326,11 +2327,13 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
}
valueObj = emptyObj;
}
+
/*
- * Make sure the reference count for the value being assigned
- * is greater than one (other reference minimally in the list)
- * so we can't get hammered by shimmering.
+ * Make sure the reference count for the value being assigned is
+ * greater than one (other reference minimally in the list) so we
+ * can't get hammered by shimmering.
*/
+
Tcl_IncrRefCount(valueObj);
if (Tcl_ObjSetVar2(interp, objv[i+2], NULL, valueObj,
TCL_LEAVE_ERR_MSG) == NULL) {
@@ -2347,12 +2350,10 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
}
/*
- * Now place a list of any values left over into the interpreter
- * result.
+ * 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.
+ * 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.
*/
if (Tcl_ListObjGetElements(interp, objv[1],
@@ -2362,9 +2363,10 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv)
if (listObjc > objc-2) {
/*
- * OK, there were left-overs. Make a list of them and slap
- * that back in the interpreter result.
+ * OK, there were left-overs. Make a list of them and slap that back
+ * in the interpreter result.
*/
+
Tcl_SetObjResult(interp,
Tcl_NewListObj(listObjc - objc + 2, listObjv + objc - 2));
}
@@ -2406,10 +2408,10 @@ 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 objc==2, then objv[2 .. objc-2] are all single
- * indices and processed as such in TclLindexFlat.
+ * 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
+ * objc==2, then objv[2 .. objc-2] are all single indices and processed as
+ * such in TclLindexFlat.
*/
if (objc == 3) {
@@ -2419,7 +2421,7 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
}
/*
- * Set the interpreter's object result to the last element extracted
+ * Set the interpreter's object result to the last element extracted.
*/
if (elemPtr == NULL) {
@@ -2439,20 +2441,20 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv)
* This procedure handles the 'lindex' command when objc==3.
*
* Results:
- * Returns a pointer to the object extracted, or NULL if an
- * error occurred.
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred.
*
* Side effects:
* None.
*
* 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.
+ * 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.
*
- * The reference count of the returned object includes one
- * reference corresponding to the pointer returned. Thus, the
- * calling code will usually do something like:
+ * The reference count of the returned object includes one reference
+ * corresponding to the pointer returned. Thus, the calling code will
+ * usually do something like:
* Tcl_SetObjResult(interp, result);
* Tcl_DecrRefCount(result);
*
@@ -2468,48 +2470,48 @@ TclLindexList(interp, listPtr, argPtr)
Tcl_Obj **elemPtrs; /* Elements of the list being manipulated. */
int listLen; /* Length of the list being manipulated. */
- int index; /* Index into the list */
- int result; /* Result returned from a Tcl library call */
- int i; /* Current index number */
- Tcl_Obj **indices; /* Array of list indices */
- int indexCount; /* Size of the array of list indices */
- Tcl_Obj *oldListPtr; /* Temp location to preserve the list
- * pointer when replacing it with a sublist */
+ int index; /* Index into the list. */
+ int result; /* Result returned from a Tcl library call. */
+ int i; /* Current index number. */
+ Tcl_Obj **indices; /* Array of list indices. */
+ int indexCount; /* Size of the array of list indices. */
+ Tcl_Obj *oldListPtr; /* Temp location to preserve the list pointer
+ * when replacing it with a sublist. */
/*
- * Determine whether argPtr designates a list or a single index.
- * We have to be careful about the order of the checks to avoid
- * repeated shimmering; see TIP#22 and TIP#33 for the details.
+ * Determine whether argPtr designates a list or a single index. We have
+ * to be careful about the order of the checks to avoid repeated
+ * shimmering; see TIP#22 and TIP#33 for the details.
*/
- if (argPtr->typePtr != &tclListType
+ if (argPtr->typePtr != &tclListType
&& TclGetIntForIndex(NULL , argPtr, 0, &index) == TCL_OK) {
/*
* argPtr designates a single index.
*/
return TclLindexFlat(interp, listPtr, 1, &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.
*/
- return TclLindexFlat( interp, listPtr, 1, &argPtr );
+ return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
/*
- * Record the reference to the list that we are maintaining in
- * the activation record.
+ * Record the reference to the list that we are maintaining in the
+ * activation record.
*/
Tcl_IncrRefCount(listPtr);
/*
- * argPtr designates a list, and the 'else if' above has parsed it
- * into indexCount and indices.
+ * argPtr designates a list, and the 'else if' above has parsed it into
+ * indexCount and indices.
*/
for (i=0 ; i<indexCount ; i++) {
@@ -2541,6 +2543,7 @@ TclLindexList(interp, listPtr, argPtr)
/*
* Index is out of range
*/
+
Tcl_DecrRefCount(listPtr);
listPtr = Tcl_NewObj();
Tcl_IncrRefCount(listPtr);
@@ -2548,14 +2551,14 @@ TclLindexList(interp, listPtr, argPtr)
}
/*
- * 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.
+ * 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.
*/
if (listPtr->typePtr != &tclListType) {
result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
- &elemPtrs);
+ &elemPtrs);
if (result != TCL_OK) {
Tcl_DecrRefCount(listPtr);
return NULL;
@@ -2572,23 +2575,24 @@ TclLindexList(interp, listPtr, argPtr)
Tcl_DecrRefCount(oldListPtr);
/*
- * The work we did above may have caused the internal rep
- * of *argPtr to change to something else. Get it back.
+ * The work we did above may have caused the internal rep of *argPtr
+ * to change to something else. Get it back.
*/
result = Tcl_ListObjGetElements(interp, argPtr, &indexCount, &indices);
if (result != TCL_OK) {
- /*
+ /*
* This can't happen unless some extension corrupted a Tcl_Obj.
*/
+
Tcl_DecrRefCount(listPtr);
return NULL;
}
}
/*
- * Return the last object extracted. Its reference count will include
- * the reference being returned.
+ * Return the last object extracted. Its reference count will include the
+ * reference being returned.
*/
return listPtr;
@@ -2599,8 +2603,8 @@ TclLindexList(interp, listPtr, argPtr)
*
* TclLindexFlat --
*
- * This procedure handles the 'lindex' command, given that the
- * arguments to the command are known to be a flat list.
+ * This procedure handles the 'lindex' command, given that the arguments
+ * to the command are known to be a flat list.
*
* Results:
* Returns a standard Tcl result.
@@ -2609,11 +2613,10 @@ TclLindexList(interp, listPtr, argPtr)
* None.
*
* 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 called from TclLindexList for the objc==3
- * case once it is determined that objv[2] cannot be parsed as a
- * list.
+ * This procedure is called from either tclExecute.c or Tcl_LindexObjCmd
+ * 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.
*
*----------------------------------------------------------------------
*/
@@ -2625,23 +2628,22 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
int indexCount; /* Count of indices */
Tcl_Obj *CONST indexArray[];
/* Array of pointers to Tcl objects
- * representing the indices in the
- * list */
+ * representing 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 current list */
- int index; /* Parsed version of the current element
- * of indexArray */
- Tcl_Obj* oldListPtr; /* Temporary to hold listPtr so that
- * its ref count can be decremented. */
+ 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
+ * current list. */
+ int index; /* Parsed version of the current element of
+ * indexArray. */
+ Tcl_Obj* oldListPtr; /* Temporary to hold listPtr so that its ref
+ * count can be decremented. */
/*
- * Record the reference to the 'listPtr' object that we are
- * maintaining in the C activation record.
+ * Record the reference to the 'listPtr' object that we are maintaining in
+ * the C activation record.
*/
Tcl_IncrRefCount(listPtr);
@@ -2658,14 +2660,14 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
}
/*
- * Get the index from objv[i]
+ * Get the index from objv[i].
*/
result = TclGetIntForIndex(interp, indexArray[i],
/*endValue*/ listLen-1, &index);
if (result != TCL_OK) {
/*
- * Index could not be parsed
+ * Index could not be parsed.
*/
Tcl_DecrRefCount(listPtr);
@@ -2673,7 +2675,7 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
} else if (index<0 || index>=listLen) {
/*
- * Index is out of range
+ * Index is out of range.
*/
Tcl_DecrRefCount(listPtr);
@@ -2683,14 +2685,14 @@ 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) {
result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
- &elemPtrs);
+ &elemPtrs);
if (result != TCL_OK) {
Tcl_DecrRefCount(listPtr);
return NULL;
@@ -2698,7 +2700,7 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
}
/*
- * Extract the pointer to the appropriate element
+ * Extract the pointer to the appropriate element.
*/
oldListPtr = listPtr;
@@ -2708,7 +2710,6 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
}
return listPtr;
-
}
/*
@@ -2720,8 +2721,8 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray)
* command. See the user documentation for details on what it does.
*
* Results:
- * A new Tcl list object formed by inserting zero or more elements
- * into a list.
+ * A new Tcl list object formed by inserting zero or more elements into a
+ * list.
*
* Side effects:
* See the user documentation.
@@ -2765,8 +2766,8 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
}
/*
- * If the list object is unshared we can modify it directly. Otherwise
- * we create a copy to modify: this is "copy on write".
+ * If the list object is unshared we can modify it directly. Otherwise we
+ * create a copy to modify: this is "copy on write".
*/
listPtr = objv[1];
@@ -2780,6 +2781,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
/*
* Special case: insert one element at the end of the list.
*/
+
result = Tcl_ListObjAppendElement(interp, listPtr, objv[3]);
} else if (objc > 3) {
result = Tcl_ListObjReplace(interp, listPtr, index, 0,
@@ -2805,8 +2807,8 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv)
*
* Tcl_ListObjCmd --
*
- * This procedure is invoked to process the "list" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "list" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -2875,7 +2877,7 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv)
/*
* Set the interpreter's object result to an integer object holding the
- * length.
+ * length.
*/
Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen));
@@ -2887,8 +2889,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.
@@ -2917,8 +2919,8 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
}
/*
- * Make sure the list argument is a list object and get its length and
- * a pointer to its array of element pointers.
+ * Make sure the list argument is a list object and get its length and a
+ * pointer to its array of element pointers.
*/
listPtr = objv[1];
@@ -2956,7 +2958,7 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
/*
* Make sure listPtr still refers to a list object. It might have been
* converted to an int above if the argument objects were shared.
- */
+ */
if (listPtr->typePtr != &tclListType) {
result = Tcl_ListObjGetElements(interp, listPtr, &listLen,
@@ -2967,8 +2969,8 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
}
/*
- * Extract a range of fields. We modify the interpreter's result object
- * to be a list object containing the specified elements.
+ * Extract a range of fields. We modify the interpreter's result object to
+ * be a list object containing the specified elements.
*/
numElems = (last - first + 1);
@@ -2981,8 +2983,8 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv)
*
* Tcl_LrepeatObjCmd --
*
- * This procedure is invoked to process the "lrepeat" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "lrepeat" Tcl command. See
+ * the user documentation for details on what it does.
*
* Results:
* A standard Tcl object result.
@@ -3004,8 +3006,8 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
int elementCount, i, result;
Tcl_Obj *listPtr, **dataArray;
List *listRepPtr;
-
- /*
+
+ /*
* Check arguments for legality:
* lrepeat posInt value ?value ...?
*/
@@ -3025,8 +3027,7 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
}
/*
- * Skip forward to the interesting arguments now we've finished
- * parsing.
+ * Skip forward to the interesting arguments now we've finished parsing.
*/
objc -= 2;
@@ -3043,10 +3044,10 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
dataArray = &listRepPtr->elements;
/*
- * 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.
+ * 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.
*/
if (objc == 1) {
@@ -3076,12 +3077,12 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv)
*
* Tcl_LreplaceObjCmd --
*
- * This object-based procedure is invoked to process the "lreplace"
- * Tcl command. See the user documentation for details on what it does.
+ * This object-based procedure is invoked to process the "lreplace" Tcl
+ * command. See the user documentation for details on what it does.
*
* Results:
- * A new Tcl list object formed by replacing zero or more elements of
- * a list.
+ * A new Tcl list object formed by replacing zero or more elements of a
+ * list.
*
* Side effects:
* See the user documentation.
@@ -3113,8 +3114,8 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
/*
* 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.
+ * for the last element, such that using it will cause that element to be
+ * included for deletion.
*/
result = TclGetIntForIndex(interp, objv[2], /*end*/ (listLen - 1), &first);
@@ -3153,8 +3154,8 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
}
/*
- * If the list object is unshared we can modify it directly, otherwise
- * we create a copy to modify: this is "copy on write".
+ * If the list object is unshared we can modify it directly, otherwise we
+ * create a copy to modify: this is "copy on write".
*/
listPtr = objv[1];
@@ -3165,7 +3166,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
}
if (objc > 4) {
result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
- (objc-4), &(objv[4]));
+ (objc-4), &(objv[4]));
} else {
result = Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
0, NULL);
@@ -3178,7 +3179,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
}
/*
- * Set the interpreter's object result.
+ * Set the interpreter's object result.
*/
Tcl_SetObjResult(interp, listPtr);
@@ -3190,8 +3191,8 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv)
*
* Tcl_LsearchObjCmd --
*
- * This procedure is invoked to process the "lsearch" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "lsearch" Tcl command. See
+ * the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -3211,8 +3212,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
{
char *bytes, *patternBytes;
int i, match, mode, index, result, listc, length, elemLen;
- int dataType, isIncreasing, lower, upper, patInt, objInt;
- int offset, allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
+ int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
+ int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
@@ -3324,10 +3325,10 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
break;
case LSEARCH_START: /* -start */
/*
- * If there was a previous -start option, release its saved
- * index because it will either be replaced or there will be
- * an error.
+ * If there was a previous -start option, release its saved index
+ * because it will either be replaced or there will be an error.
*/
+
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
}
@@ -3341,12 +3342,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
i++;
if (objv[i] == objv[objc - 2]) {
/*
- * 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 and the index are
- * one-and-the-same.
+ * 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
+ * and the index are one-and-the-same.
*/
+
startPtr = Tcl_DuplicateObj(objv[i]);
} else {
startPtr = objv[i];
@@ -3371,8 +3372,8 @@ 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 that has shimmering problems.
+ * extraction. Note that we don't do this using objects because
+ * that has shimmering problems.
*/
i++;
@@ -3396,16 +3397,16 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
/*
- * 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.
+ * 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.
*/
for (j=0 ; j<sortInfo.indexc ; j++) {
if (TclGetIntForIndex(interp, indices[j], SORTIDX_END,
&sortInfo.indexv[j]) != TCL_OK) {
char buffer[TCL_INTEGER_SPACE];
-
+
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
@@ -3440,6 +3441,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
* We can shimmer regexp/list if listv[i] == pattern, so get the
* regexp rep before the list rep.
*/
+
regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
TCL_REG_ADVANCED | TCL_REG_NOSUB |
(noCase ? TCL_REG_NOCASE : 0));
@@ -3455,8 +3457,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
/*
- * Make sure the list argument is a list object and get its length and
- * a pointer to its array of element pointers.
+ * Make sure the list argument is a list object and get its length and a
+ * pointer to its array of element pointers.
*/
result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
@@ -3473,6 +3475,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
/*
* Get the user-specified start offset.
*/
+
if (startPtr) {
result = TclGetIntForIndex(interp, startPtr, listc-1, &offset);
Tcl_DecrRefCount(startPtr);
@@ -3522,21 +3525,21 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
/*
- * Set default index value to -1, indicating failure; if we find the
- * item in the course of our search, index will be set to the correct
- * value.
+ * Set default index value to -1, indicating failure; if we find the item
+ * in the course of our search, index will be set to the correct value.
*/
+
index = -1;
match = 0;
if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
/*
- * 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.
+ * 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.
*/
+
lower = offset - 1;
upper = listc;
while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
@@ -3592,17 +3595,19 @@ 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, our first match might not be the first occurance.
+ * Normally, binary search is written to stop when it finds a
+ * 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
- * 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
+ *
+ * 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
* variation means that a search always makes log n
- * comparisons (normal binary search might "get lucky" with
- * an early comparison).
+ * comparisons (normal binary search might "get lucky" with an
+ * early comparison).
*/
+
index = i;
upper = i;
} else if (match > 0) {
@@ -3627,6 +3632,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
* - our matching sense is negated
* - we're building a list of all matched items
*/
+
if (allMatches) {
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
}
@@ -3650,9 +3656,10 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
bytes = Tcl_GetStringFromObj(itemPtr, &elemLen);
if (length == elemLen) {
/*
- * This split allows for more optimal
- * compilation of memcmp
+ * This split allows for more optimal compilation of
+ * memcmp/
*/
+
if (noCase) {
match = (strcasecmp(bytes, patternBytes) == 0);
} else {
@@ -3714,9 +3721,11 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
break;
}
+
/*
* Invert match condition for -not
*/
+
if (negatedMatch) {
match = !match;
}
@@ -3730,6 +3739,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
/*
* Note that these appends are not expected to fail.
*/
+
if (returnSubindices) {
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
} else {
@@ -3753,6 +3763,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
/*
* Return everything or a single value.
*/
+
if (allMatches) {
Tcl_SetObjResult(interp, listPtr);
} else if (!inlineReturn) {
@@ -3769,16 +3780,19 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
}
} else if (index < 0) {
/*
- * Is this superfluous? The result should be a blank object
- * by default...
+ * Is this superfluous? The result should be a blank object by
+ * default...
*/
+
Tcl_SetObjResult(interp, Tcl_NewObj());
} else {
Tcl_SetObjResult(interp, listv[index]);
}
+
/*
* Cleanup the index list array.
*/
+
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
@@ -3790,8 +3804,8 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*
* Tcl_LsetObjCmd --
*
- * This procedure is invoked to process the "lset" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "lset" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -3803,66 +3817,71 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
*/
int
-Tcl_LsetObjCmd( clientData, interp, objc, objv )
+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_Obj* listPtr; /* Pointer to the list being altered. */
- Tcl_Obj* finalValuePtr; /* Value finally assigned to the variable */
+ Tcl_Obj* finalValuePtr; /* Value finally assigned to the variable. */
- /* Check parameter count */
+ /*
+ * Check parameter count.
+ */
- if ( objc < 3 ) {
- Tcl_WrongNumArgs( interp, 1, objv, "listVar index ?index...? value" );
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "listVar index ?index...? value");
return TCL_ERROR;
}
- /* Look up the list variable's value */
+ /*
+ * Look up the list variable's value.
+ */
- listPtr = Tcl_ObjGetVar2( interp, objv[ 1 ], (Tcl_Obj*) NULL,
- TCL_LEAVE_ERR_MSG );
- if ( listPtr == NULL ) {
+ listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
+ TCL_LEAVE_ERR_MSG);
+ if (listPtr == NULL) {
return TCL_ERROR;
}
- /*
- * Substitute the value in the value. Return either the value or
- * else an unshared copy of it.
+ /*
+ * Substitute the value in the value. Return either the value or else an
+ * unshared copy of it.
*/
- if ( objc == 4 ) {
- finalValuePtr = TclLsetList( interp, listPtr,
- objv[ 2 ], objv[ 3 ] );
+ if (objc == 4) {
+ finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]);
} else {
- finalValuePtr = TclLsetFlat( interp, listPtr,
- objc-3, objv+2, objv[ objc-1 ] );
+ finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2,
+ objv[objc-1]);
}
/*
* If substitution has failed, bail out.
*/
- if ( finalValuePtr == NULL ) {
+ if (finalValuePtr == NULL) {
return TCL_ERROR;
}
- /* Finally, update the variable so that traces fire. */
+ /*
+ * Finally, update the variable so that traces fire.
+ */
- listPtr = Tcl_ObjSetVar2( interp, objv[1], NULL, finalValuePtr,
- TCL_LEAVE_ERR_MSG );
- Tcl_DecrRefCount( finalValuePtr );
- if ( listPtr == NULL ) {
+ listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr,
+ TCL_LEAVE_ERR_MSG);
+ Tcl_DecrRefCount(finalValuePtr);
+ if (listPtr == NULL) {
return TCL_ERROR;
}
- /* Return the new value of the variable as the interpreter result. */
+ /*
+ * Return the new value of the variable as the interpreter result.
+ */
- Tcl_SetObjResult( interp, listPtr );
+ Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
-
}
/*
@@ -3870,8 +3889,8 @@ Tcl_LsetObjCmd( clientData, interp, objc, objv )
*
* Tcl_LsortObjCmd --
*
- * This procedure is invoked to process the "lsort" Tcl command.
- * See the user documentation for details on what it does.
+ * This procedure is invoked to process the "lsort" Tcl command. See the
+ * user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -3894,10 +3913,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
int length;
Tcl_Obj *cmdPtr, **listObjPtrs;
SortElement *elementArray;
- SortElement *elementPtr;
- SortInfo sortInfo; /* Information about this sort that
- * needs to be passed to the
- * comparison function */
+ SortElement *elementPtr;
+ SortInfo sortInfo; /* Information about this sort that needs to
+ * be passed to the comparison function. */
static CONST char *switches[] = {
"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
"-index", "-indices", "-integer", "-nocase", "-real", "-unique",
@@ -3929,8 +3947,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
unique = 0;
indices = 0;
for (i = 1; i < objc-1; i++) {
- if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
- != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
+ &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum Lsort_Switches) index) {
@@ -3972,11 +3990,13 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
"followed by list index", NULL);
return TCL_ERROR;
}
+
/*
* Take copy to prevent shimmering problems.
*/
- if (Tcl_ListObjGetElements(interp, objv[i+1],
- &sortInfo.indexc, &indices) != TCL_OK) {
+
+ if (Tcl_ListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
+ &indices) != TCL_OK) {
return TCL_ERROR;
}
switch (sortInfo.indexc) {
@@ -3992,16 +4012,16 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
}
/*
- * 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.
+ * 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.
*/
for (j=0 ; j<sortInfo.indexc ; j++) {
if (TclGetIntForIndex(interp, indices[j], SORTIDX_END,
&sortInfo.indexv[j]) != TCL_OK) {
char buffer[TCL_INTEGER_SPACE];
-
+
if (sortInfo.indexc > 1) {
ckfree((char *) sortInfo.indexv);
}
@@ -4036,9 +4056,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
if (sortInfo.sortMode == SORTMODE_COMMAND) {
/*
- * The existing command is a list. We want to flatten it, append
- * two dummy arguments on the end, and replace these arguments
- * later.
+ * The existing command is a list. We want to flatten it, append two
+ * dummy arguments on the end, and replace these arguments later.
*/
Tcl_Obj *newCommandPtr = Tcl_DuplicateObj(cmdPtr);
@@ -4113,7 +4132,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.compareCmdPtr = NULL;
}
if (sortInfo.indexc > 1) {
- ckfree((char *) sortInfo.indexv);
+ ckfree((char *) sortInfo.indexv);
}
return sortInfo.resultCode;
}
@@ -4123,29 +4142,27 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
*
* MergeSort -
*
- * This procedure sorts a linked list of SortElement structures
- * use the merge-sort algorithm.
+ * This procedure sorts a linked list of SortElement structures use the
+ * merge-sort algorithm.
*
* Results:
- * A pointer to the head of the list after sorting is returned.
+ * A pointer to the head of the list after sorting is returned.
*
* Side effects:
- * None, unless a user-defined comparison command does something
- * weird.
+ * None, unless a user-defined comparison command does something weird.
*
*----------------------------------------------------------------------
*/
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 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.
*/
# define NUM_LISTS 30
@@ -4153,14 +4170,14 @@ MergeSort(headPtr, infoPtr)
SortElement *elementPtr;
int i;
- for(i = 0; i < NUM_LISTS; i++){
+ for (i=0 ; i<NUM_LISTS ; i++) {
subList[i] = NULL;
}
while (headPtr != NULL) {
elementPtr = headPtr;
headPtr = headPtr->nextPtr;
elementPtr->nextPtr = 0;
- for (i = 0; (i < NUM_LISTS) && (subList[i] != NULL); i++){
+ for (i=0 ; i<NUM_LISTS && subList[i]!=NULL ; i++) {
elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
subList[i] = NULL;
}
@@ -4170,7 +4187,7 @@ MergeSort(headPtr, infoPtr)
subList[i] = elementPtr;
}
elementPtr = NULL;
- for (i = 0; i < NUM_LISTS; i++){
+ for (i=0 ; i<NUM_LISTS ; i++) {
elementPtr = MergeLists(subList[i], elementPtr, infoPtr);
}
return elementPtr;
@@ -4185,22 +4202,21 @@ MergeSort(headPtr, infoPtr)
* into a single sorted list.
*
* Results:
- * The unified list of SortElement structures.
+ * The unified list of SortElement structures.
*
* Side effects:
- * None, unless a user-defined comparison command does something
- * weird.
+ * None, unless a user-defined comparison command does something weird.
*
*----------------------------------------------------------------------
*/
static SortElement *
MergeLists(leftPtr, rightPtr, infoPtr)
- SortElement *leftPtr; /* First list to be merged; may be
+ SortElement *leftPtr; /* First list to be merged; may be
* NULL. */
- SortElement *rightPtr; /* Second list to be merged; may be
+ SortElement *rightPtr; /* Second list to be merged; may be
* NULL. */
- SortInfo *infoPtr; /* Information needed by the
+ SortInfo *infoPtr; /* Information needed by the
* comparison operator. */
{
SortElement *headPtr;
@@ -4257,14 +4273,13 @@ MergeLists(leftPtr, rightPtr, infoPtr)
* ordering between two elements.
*
* 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 doesn't matter which comes first.
+ * 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
+ * doesn't matter which comes first.
*
* Side effects:
- * None, unless a user-defined comparison command does something
- * weird.
+ * None, unless a user-defined comparison command does something weird.
*
*----------------------------------------------------------------------
*/
@@ -4272,17 +4287,18 @@ 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 */
+ SortInfo *infoPtr; /* Information passed from the
+ * top-level "lsort" command. */
{
int order;
order = 0;
if (infoPtr->resultCode != TCL_OK) {
/*
- * Once an error has occurred, skip any future comparisons so
- * as to preserve the error message in sortInterp->result.
+ * Once an error has occurred, skip any future comparisons so as to
+ * preserve the error message in sortInterp->result.
*/
+
return order;
}
@@ -4317,9 +4333,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;
}
@@ -4336,8 +4351,8 @@ SortCompare(objPtr1, objPtr2, infoPtr)
paramObjv[1] = objPtr2;
/*
- * We made space in the command list for the two things to
- * compare. Replace them and evaluate the result.
+ * We made space in the command list for the two things to compare.
+ * Replace them and evaluate the result.
*/
Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
@@ -4378,18 +4393,18 @@ 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 words, "x10y" comes after "x9y", not
- * before it as it would when using strcmp().
+ * 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
+ * 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 doesn't matter which comes first.
+ * 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
+ * doesn't matter which comes first.
*
* Side effects:
* None.
@@ -4399,21 +4414,20 @@ 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;
int secondaryDiff = 0;
while (1) {
- if (isdigit(UCHAR(*right)) /* INTL: digit */
- && isdigit(UCHAR(*left))) { /* INTL: digit */
+ 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 leading zeros than
- * the other, the number with more leading zeros sorts
- * later, but only as a secondary choice.
+ * 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.
*/
zeros = 0;
@@ -4430,10 +4444,10 @@ DictionaryCompare(left, right)
}
/*
- * The code below compares the numbers in the two
- * strings without ever converting them to integers. It
- * does this by first comparing the lengths of the
- * numbers and then comparing the digit values.
+ * The code below compares the numbers in the two strings without
+ * ever converting them to integers. It does this by first
+ * comparing the lengths of the numbers and then comparing the
+ * digit values.
*/
diff = 0;
@@ -4443,13 +4457,13 @@ DictionaryCompare(left, right)
}
right++;
left++;
- if (!isdigit(UCHAR(*right))) { /* INTL: digit */
- if (isdigit(UCHAR(*left))) { /* INTL: digit */
+ if (!isdigit(UCHAR(*right))) { /* INTL: digit */
+ if (isdigit(UCHAR(*left))) { /* INTL: digit */
return 1;
} else {
/*
- * The two numbers have the same length. See
- * if their values are different.
+ * The two numbers have the same length. See if their
+ * values are different.
*/
if (diff != 0) {
@@ -4457,7 +4471,7 @@ DictionaryCompare(left, right)
}
break;
}
- } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
+ } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
return -1;
}
}
@@ -4473,12 +4487,14 @@ DictionaryCompare(left, right)
if ((*left != '\0') && (*right != '\0')) {
left += Tcl_UtfToUniChar(left, &uniLeft);
right += Tcl_UtfToUniChar(right, &uniRight);
+
/*
* Convert both chars to lower for the comparison, because
* 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)
*/
+
uniLeftLower = Tcl_UniCharToLower(uniLeft);
uniRightLower = Tcl_UniCharToLower(uniRight);
} else {
@@ -4490,8 +4506,7 @@ DictionaryCompare(left, right)
if (diff) {
return diff;
} else if (secondaryDiff == 0) {
- if (Tcl_UniCharIsUpper(uniLeft) &&
- Tcl_UniCharIsLower(uniRight)) {
+ if (Tcl_UniCharIsUpper(uniLeft) && Tcl_UniCharIsLower(uniRight)) {
secondaryDiff = -1;
} else if (Tcl_UniCharIsUpper(uniRight)
&& Tcl_UniCharIsLower(uniLeft)) {
@@ -4510,20 +4525,20 @@ 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. Otherwise returns the Tcl_Obj* to the item.
+ * Returns NULL if a failure occurs, and sets the result in the infoPtr.
+ * Otherwise returns the Tcl_Obj* to the item.
*
* Side effects:
- * None.
+ * None.
*
* Note:
- * No reference counting is done, as the result is only used
- * internally and never passed directly to user code.
+ * No reference counting is done, as the result is only used internally
+ * and never passed directly to user code.
*
*----------------------------------------------------------------------
*/
@@ -4546,8 +4561,8 @@ SelectObjFromSublist(objPtr, infoPtr)
}
/*
- * Iterate over the indices, traversing through the nested
- * sublists as we go.
+ * Iterate over the indices, traversing through the nested sublists as we
+ * go.
*/
for (i=0 ; i<infoPtr->indexc ; i++) {
@@ -4560,12 +4575,15 @@ SelectObjFromSublist(objPtr, infoPtr)
return NULL;
}
index = infoPtr->indexv[i];
+
/*
* Adjust for end-based indexing.
*/
+
if (index < SORTIDX_NONE) {
index += listLen + 1;
}
+
if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
&currentObj) != TCL_OK) {
infoPtr->resultCode = TCL_ERROR;
@@ -4584,3 +4602,11 @@ SelectObjFromSublist(objPtr, infoPtr)
}
return objPtr;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */