/* 

 * 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).

 *

 * Copyright (c) 1987-1993 The Regents of the University of California.

 * Copyright (c) 1993-1997 Lucent Technologies.

 * Copyright (c) 1994-1997 Sun Microsystems, Inc.

 * Copyright (c) 1998-1999 by Scriptics Corporation.

 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.

 *

 * 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.47.2.11 2007/03/10 14:57:38 dkf Exp $

 */

#include "tclInt.h"

#include "tclPort.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.

 */

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. */

} SortElement;

/*

 * 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 */

    Tcl_Obj *compareCmdPtr;     /* The Tcl comparison command when sortMode

				 * is SORTMODE_COMMAND.  Pre-initialized to

				 * hold base of command.*/

    int index;			/* If the -index option was specified, this

				 * holds the index of the list element

				 * to extract for comparison.  If -index

				 * wasn't specified, this is -1. */

    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. */

} SortInfo;

/*

 * The "sortMode" field of the SortInfo structure can take on any of the

 * following values.

 */

#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.

 */

#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,

			    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[]));

#ifdef TCL_TIP280

/* TIP #280 - New 'info' subcommand 'frame' */

static int		InfoFrameCmd _ANSI_ARGS_((ClientData dummy,

			    Tcl_Interp *interp, int objc,

			    Tcl_Obj *CONST objv[]));

#endif

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));

/*

 *----------------------------------------------------------------------

 *

 * Tcl_IfObjCmd --

 *

 *	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}"

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	See the user documentation.

 *

 *----------------------------------------------------------------------

 */

	/* ARGSUSED */

int

Tcl_IfObjCmd(dummy, interp, objc, objv)

    ClientData dummy;			/* Not used. */

    Tcl_Interp *interp;			/* Current interpreter. */

    int objc;				/* Number of arguments. */

    Tcl_Obj *CONST objv[];		/* Argument objects. */

{

    int thenScriptIndex = 0;	/* then script to be evaled after syntax check */

#ifdef TCL_TIP280

    Interp* iPtr = (Interp*) interp;

#endif

    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.

	 */

	if (i >= objc) {

	    clause = Tcl_GetString(objv[i-1]);

	    Tcl_AppendResult(interp, "wrong # args: no expression after \"",

		    clause, "\" argument", (char *) NULL);

	    return TCL_ERROR;

	}

	if (!thenScriptIndex) {

	    result = Tcl_ExprBooleanObj(interp, objv[i], &value);

	    if (result != TCL_OK) {

		return result;

	    }

	}

	i++;

	if (i >= objc) {

	    missingScript:

	    clause = Tcl_GetString(objv[i-1]);

	    Tcl_AppendResult(interp, "wrong # args: no script following \"",

		    clause, "\" argument", (char *) NULL);

	    return TCL_ERROR;

	}

	clause = Tcl_GetString(objv[i]);

	if ((i < objc) && (strcmp(clause, "then") == 0)) {

	    i++;

	}

	if (i >= objc) {

	    goto missingScript;

	}

	if (value) {

	    thenScriptIndex = i;

	    value = 0;

	}

	/*

	 * The expression evaluated to false.  Skip the command, then

	 * see if there is an "else" or "elseif" clause.

	 */

	i++;

	if (i >= objc) {

	    if (thenScriptIndex) {

#ifndef TCL_TIP280

		return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);

#else

		/* TIP #280. Make invoking context available to branch */

		return TclEvalObjEx(interp, objv[thenScriptIndex], 0,

				    iPtr->cmdFramePtr,thenScriptIndex);

#endif

	    }

	    return TCL_OK;

	}

	clause = Tcl_GetString(objv[i]);

	if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {

	    i++;

	    continue;

	}

	break;

    }

    /*

     * 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) {

	i++;

	if (i >= objc) {

	    Tcl_AppendResult(interp,

		    "wrong # args: no script following \"else\" argument",

		    (char *) NULL);

	    return TCL_ERROR;

	}

    }

    if (i < objc - 1) {

	Tcl_AppendResult(interp,

		"wrong # args: extra words after \"else\" clause in \"if\" command",

		(char *) NULL);

	return TCL_ERROR;

    }

    if (thenScriptIndex) {

#ifndef TCL_TIP280

	return Tcl_EvalObjEx(interp, objv[thenScriptIndex], 0);

#else

	/* TIP #280. Make invoking context available to branch/else */

	return TclEvalObjEx(interp, objv[thenScriptIndex], 0,

			    iPtr->cmdFramePtr,thenScriptIndex);

#endif

    }

#ifndef TCL_TIP280

    return Tcl_EvalObjEx(interp, objv[i], 0);

#else

    return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr,i);

#endif

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_IncrObjCmd --

 *

 *	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"

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	See the user documentation.

 *

 *----------------------------------------------------------------------

 */

    /* ARGSUSED */

int

Tcl_IncrObjCmd(dummy, interp, objc, objv)

    ClientData dummy;			/* Not used. */

    Tcl_Interp *interp;			/* Current interpreter. */

    int objc;				/* Number of arguments. */

    Tcl_Obj *CONST objv[];		/* Argument objects. */

{

    long incrAmount;

    Tcl_Obj *newValuePtr;

    if ((objc != 2) && (objc != 3)) {

        Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");

	return TCL_ERROR;

    }

    /*

     * Calculate the amount to increment by.

     */

    if (objc == 2) {

	incrAmount = 1;

    } else {

	if (Tcl_GetLongFromObj(interp, objv[2], &incrAmount) != TCL_OK) {

	    Tcl_AddErrorInfo(interp, "\n    (reading increment)");

	    return TCL_ERROR;

	}

	/*

	 * 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;

	} else if (objv[2]->typePtr == &tclWideIntType) {

	    TclGetLongFromWide(incrAmount,objv[2]);

	} else {

	    Tcl_WideInt wide;

	    if (Tcl_GetWideIntFromObj(interp, objv[2], &wide) != TCL_OK) {

		Tcl_AddErrorInfo(interp, "\n    (reading increment)");

		return TCL_ERROR;

	    }

	    incrAmount = Tcl_WideAsLong(wide);

	    if ((wide <= Tcl_LongAsWide(LONG_MAX))

		    && (wide >= Tcl_LongAsWide(LONG_MIN))) {

		objv[2]->typePtr = &tclIntType;

		objv[2]->internalRep.longValue = incrAmount;

	    }

	}

    }

    /*

     * Increment the variable's value.

     */

    newValuePtr = TclIncrVar2(interp, objv[1], (Tcl_Obj *) NULL, incrAmount,

	    TCL_LEAVE_ERR_MSG);

    if (newValuePtr == NULL) {

	return TCL_ERROR;

    }

    /*

     * Set the interpreter's object result to refer to the variable's new

     * value object.

     */

    Tcl_SetObjResult(interp, newValuePtr);

    return TCL_OK; 

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_InfoObjCmd --

 *

 *	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.

 *

 * Side effects:

 *	See the user documentation.

 *

 *----------------------------------------------------------------------

 */

	/* ARGSUSED */

int

Tcl_InfoObjCmd(clientData, interp, objc, objv)

    ClientData clientData;	/* Arbitrary value passed to the command. */

    Tcl_Interp *interp;		/* Current interpreter. */

    int objc;			/* Number of arguments. */

    Tcl_Obj *CONST objv[];	/* Argument objects. */

{

    static CONST char *subCmds[] = {

	     "args", "body", "cmdcount", "commands",

	     "complete", "default", "exists",

#ifdef TCL_TIP280

	     "frame",

#endif

	     "functions",

	     "globals", "hostname", "level", "library", "loaded",

	     "locals", "nameofexecutable", "patchlevel", "procs",

	     "script", "sharedlibextension", "tclversion", "vars",

	     (char *) NULL};

    enum ISubCmdIdx {

	    IArgsIdx, IBodyIdx, ICmdCountIdx, ICommandsIdx,

	    ICompleteIdx, IDefaultIdx, IExistsIdx,

#ifdef TCL_TIP280

	    IFrameIdx,

#endif

	    IFunctionsIdx,

	    IGlobalsIdx, IHostnameIdx, ILevelIdx, ILibraryIdx, ILoadedIdx,

	    ILocalsIdx, INameOfExecutableIdx, IPatchLevelIdx, IProcsIdx,

	    IScriptIdx, ISharedLibExtensionIdx, ITclVersionIdx, IVarsIdx

    };

    int index, result;

    if (objc < 2) {

        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");

        return TCL_ERROR;

    }

    result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option", 0,

	    (int *) &index);

    if (result != TCL_OK) {

	return result;

    }

    switch (index) {

        case IArgsIdx:

	    result = InfoArgsCmd(clientData, interp, objc, objv);

            break;

	case IBodyIdx:

	    result = InfoBodyCmd(clientData, interp, objc, objv);

	    break;

	case ICmdCountIdx:

	    result = InfoCmdCountCmd(clientData, interp, objc, objv);

	    break;

        case ICommandsIdx:

	    result = InfoCommandsCmd(clientData, interp, objc, objv);

	    break;

        case ICompleteIdx:

	    result = InfoCompleteCmd(clientData, interp, objc, objv);

	    break;

	case IDefaultIdx:

	    result = InfoDefaultCmd(clientData, interp, objc, objv);

	    break;

	case IExistsIdx:

	    result = InfoExistsCmd(clientData, interp, objc, objv);

	    break;

#ifdef TCL_TIP280

	case IFrameIdx:

	    /* TIP #280 - New method 'frame' */

	    result = InfoFrameCmd(clientData, interp, objc, objv);

	    break;

#endif

	case IFunctionsIdx:

	    result = InfoFunctionsCmd(clientData, interp, objc, objv);

	    break;

        case IGlobalsIdx:

	    result = InfoGlobalsCmd(clientData, interp, objc, objv);

	    break;

        case IHostnameIdx:

	    result = InfoHostnameCmd(clientData, interp, objc, objv);

	    break;

	case ILevelIdx:

	    result = InfoLevelCmd(clientData, interp, objc, objv);

	    break;

	case ILibraryIdx:

	    result = InfoLibraryCmd(clientData, interp, objc, objv);

	    break;

        case ILoadedIdx:

	    result = InfoLoadedCmd(clientData, interp, objc, objv);

	    break;

        case ILocalsIdx:

	    result = InfoLocalsCmd(clientData, interp, objc, objv);

	    break;

	case INameOfExecutableIdx:

	    result = InfoNameOfExecutableCmd(clientData, interp, objc, objv);

	    break;

	case IPatchLevelIdx:

	    result = InfoPatchLevelCmd(clientData, interp, objc, objv);

	    break;

        case IProcsIdx:

	    result = InfoProcsCmd(clientData, interp, objc, objv);

	    break;

        case IScriptIdx:

	    result = InfoScriptCmd(clientData, interp, objc, objv);

	    break;

	case ISharedLibExtensionIdx:

	    result = InfoSharedlibCmd(clientData, interp, objc, objv);

	    break;

	case ITclVersionIdx:

	    result = InfoTclVersionCmd(clientData, interp, objc, objv);

	    break;

	case IVarsIdx:

	    result = InfoVarsCmd(clientData, interp, objc, objv);

	    break;