/* 

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

     }

     return result;

 }

 /*

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

  *

  * InfoArgsCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoArgsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     register Interp *iPtr = (Interp *) interp;

     char *name;

     Proc *procPtr;

     CompiledLocal *localPtr;

     Tcl_Obj *listObjPtr;

     if (objc != 3) {

         Tcl_WrongNumArgs(interp, 2, objv, "procname");

         return TCL_ERROR;

     }

     name = Tcl_GetString(objv[2]);

     procPtr = TclFindProc(iPtr, name);

     if (procPtr == NULL) {

         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

                 "\"", name, "\" isn't a procedure", (char *) NULL);

         return TCL_ERROR;

     }

     /*

      * Build a return list containing the arguments.

      */

     listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);

     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;

             localPtr = localPtr->nextPtr) {

         if (TclIsVarArgument(localPtr)) {

             Tcl_ListObjAppendElement(interp, listObjPtr,

 		    Tcl_NewStringObj(localPtr->name, -1));

         }

     }

     Tcl_SetObjResult(interp, listObjPtr);

     return TCL_OK;

 }

 /*

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

  *

  * InfoBodyCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoBodyCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     register Interp *iPtr = (Interp *) interp;

     char *name;

     Proc *procPtr;

     Tcl_Obj *bodyPtr, *resultPtr;

     if (objc != 3) {

         Tcl_WrongNumArgs(interp, 2, objv, "procname");

         return TCL_ERROR;

     }

     name = Tcl_GetString(objv[2]);

     procPtr = TclFindProc(iPtr, name);

     if (procPtr == NULL) {

         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"\"", name, "\" isn't a procedure", (char *) NULL);

         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.

      */

     bodyPtr = procPtr->bodyPtr;

     if (bodyPtr->bytes == NULL) {

 	/*

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

     Tcl_SetObjResult(interp, resultPtr);

     return TCL_OK;

 }

 /*

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

  *

  * InfoCmdCountCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoCmdCountCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     Interp *iPtr = (Interp *) interp;

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 2, objv, NULL);

         return TCL_ERROR;

     }

     Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->cmdCount);

     return TCL_OK;

 }

 /*

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

  *

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

  *

  *          info commands ?pattern?

  *

  * Results:

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

  *

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

  */

 static int

 InfoCommandsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     char *cmdName, *pattern;

     CONST char *simplePattern;

     register Tcl_HashEntry *entryPtr;

     Tcl_HashSearch search;

     Namespace *nsPtr;

     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);

     Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);

     Tcl_Obj *listPtr, *elemObjPtr;

     int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */

     Tcl_Command cmd;

     /*

      * Get the pattern and find the "effective namespace" in which to

      * list commands.

      */

     if (objc == 2) {

         simplePattern = NULL;

 	nsPtr = currNsPtr;

 	specificNsInPattern = 0;

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

 	 */

 	Namespace *dummy1NsPtr, *dummy2NsPtr;

 	pattern = Tcl_GetString(objv[2]);

 	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,

            /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);

 	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */

 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);

 	}

     } else {

         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");

         return TCL_ERROR;

     }

     /*

      * Exit as quickly as possible if we couldn't find the namespace.

      */

     if (nsPtr == NULL) {

 	return TCL_OK;

     }

     /*

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

 	 */

 	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);

 	if (entryPtr != NULL) {

 	    if (specificNsInPattern) {

 		cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);

 		elemObjPtr = Tcl_NewObj();

 		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);

 	    } else {

 		cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);

 		elemObjPtr = Tcl_NewStringObj(cmdName, -1);

 	    }

 	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);

 	} else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {

 	    entryPtr = Tcl_FindHashEntry(&globalNsPtr->cmdTable,

 		    simplePattern);

 	    if (entryPtr != NULL) {

 		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);

 		Tcl_ListObjAppendElement(interp, listPtr,

 			Tcl_NewStringObj(cmdName, -1));

 	    }

 	}

     } else {

 	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);

 	while (entryPtr != NULL) {

 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);

 	    if ((simplePattern == NULL)

 	            || Tcl_StringMatch(cmdName, simplePattern)) {

 		if (specificNsInPattern) {

 		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);

 		    elemObjPtr = Tcl_NewObj();

 		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);

 		} else {

 		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);

 		}

 		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);

 	    }

 	    entryPtr = Tcl_NextHashEntry(&search);

 	}

 	/*

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

 	 */

 	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {

 	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);

 	    while (entryPtr != NULL) {

 		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);

 		if ((simplePattern == NULL)

 	                || Tcl_StringMatch(cmdName, simplePattern)) {

 		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {

 			Tcl_ListObjAppendElement(interp, listPtr,

 				Tcl_NewStringObj(cmdName, -1));

 		    }

 		}

 		entryPtr = Tcl_NextHashEntry(&search);

 	    }

 	}

     }

     Tcl_SetObjResult(interp, listPtr);

     return TCL_OK;

 }

 /*

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

  *

  * InfoCompleteCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoCompleteCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     if (objc != 3) {

         Tcl_WrongNumArgs(interp, 2, objv, "command");

         return TCL_ERROR;

     }

     if (TclObjCommandComplete(objv[2])) {

 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);

     } else {

 	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);

     }

     return TCL_OK;

 }

 /*

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

  *

  * InfoDefaultCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoDefaultCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     Interp *iPtr = (Interp *) interp;

     char *procName, *argName, *varName;

     Proc *procPtr;

     CompiledLocal *localPtr;

     Tcl_Obj *valueObjPtr;

     if (objc != 5) {

         Tcl_WrongNumArgs(interp, 2, objv, "procname arg varname");

         return TCL_ERROR;

     }

     procName = Tcl_GetString(objv[2]);

     argName = Tcl_GetString(objv[3]);

     procPtr = TclFindProc(iPtr, procName);

     if (procPtr == NULL) {

 	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 		"\"", procName, "\" isn't a procedure", (char *) NULL);

         return TCL_ERROR;

     }

     for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;

             localPtr = localPtr->nextPtr) {

         if (TclIsVarArgument(localPtr)

 		&& (strcmp(argName, localPtr->name) == 0)) {

             if (localPtr->defValuePtr != NULL) {

 		valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,

 			localPtr->defValuePtr, 0);

                 if (valueObjPtr == NULL) {

                     defStoreError:

 		    varName = Tcl_GetString(objv[4]);

 		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 	                    "couldn't store default value in variable \"",

 			    varName, "\"", (char *) NULL);

                     return TCL_ERROR;

                 }

 		Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);

             } else {

                 Tcl_Obj *nullObjPtr = Tcl_NewObj();

 		Tcl_IncrRefCount(nullObjPtr);

                 valueObjPtr = Tcl_ObjSetVar2(interp, objv[4], NULL,

 			nullObjPtr, 0);

 		Tcl_DecrRefCount(nullObjPtr); /* free unneeded obj */

                 if (valueObjPtr == NULL) {

                     goto defStoreError;

                 }

 		Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);

             }

             return TCL_OK;

         }

     }

     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 	    "procedure \"", procName, "\" doesn't have an argument \"",

 	    argName, "\"", (char *) NULL);

     return TCL_ERROR;

 }

 /*

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

  *

  * InfoExistsCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoExistsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     char *varName;

     Var *varPtr;

     if (objc != 3) {

         Tcl_WrongNumArgs(interp, 2, objv, "varName");

         return TCL_ERROR;

     }

     varName = Tcl_GetString(objv[2]);

     varPtr = TclVarTraceExists(interp, varName);

     if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {

         Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);

     } else {

         Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);

     }

     return TCL_OK;

 }

 #ifdef TCL_TIP280

 /*

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

  *

  * InfoFrameCmd --

  *	TIP #280

  *

  *      Called to implement the "info frame" command that returns the

  *      location of either the currently executing command, or its caller.

  *      Handles the following syntax:

  *

  *          info frame ?number?

  *

  * Results:

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

  *

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

  */

 static int

 InfoFrameCmd(dummy, interp, objc, objv)

      ClientData dummy;		/* Not used. */

      Tcl_Interp *interp;		/* Current interpreter. */

      int objc;			/* Number of arguments. */

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

 {

     Interp *iPtr = (Interp *) interp;

     if (objc == 2) {

 	/* just "info frame" */

         int levels = (iPtr->cmdFramePtr == NULL

 		      ? 0

 		      : iPtr->cmdFramePtr->level);

         Tcl_SetIntObj(Tcl_GetObjResult(interp), levels);

         return TCL_OK;

     } else if (objc == 3) {

 	/* "info frame level" */

         int       level;

 	CmdFrame *framePtr;

         if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {

             return TCL_ERROR;

         }

         if (level <= 0) {

 	    /* Relative adressing */

             if (iPtr->cmdFramePtr == NULL) {

                 levelError:

 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			"bad level \"",

 			Tcl_GetString(objv[2]),

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

                 return TCL_ERROR;

             }

             /* Convert to absolute. */

             level += iPtr->cmdFramePtr->level;

         }

         for (framePtr = iPtr->cmdFramePtr;

 	     framePtr != NULL;

 	     framePtr = framePtr->nextPtr) {

 	    if (framePtr->level == level) {

                 break;

             }

         }

         if (framePtr == NULL) {

             goto levelError;

         }

 	/*

 	 * Pull the information and construct the dictionary to return, as

 	 * list. Regarding use of the CmdFrame fields see tclInt.h, and its

 	 * definition.

 	 */

 	{

 	    Tcl_Obj* lv [20]; /* Keep uptodate when more keys are added to the dict */

 	    int      lc = 0;

 	    /* This array is indexed by the TCL_LOCATION_... values, except

 	     * for _LAST.

 	     */

 	    static CONST char* typeString [TCL_LOCATION_LAST] = {

 	       "eval", "eval", "eval", "precompiled", "source", "proc"

 	    };

 	    switch (framePtr->type) {

 	    case TCL_LOCATION_EVAL:

 	        /* Evaluation, dynamic script. Type, line, cmd, the latter

 		 * through str. */

 	        lv [lc ++] = Tcl_NewStringObj ("type",-1);

 		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);

 		lv [lc ++] = Tcl_NewStringObj ("line",-1);

 		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);

 		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);

 		lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd,

 					       framePtr->cmd.str.len);

 		break;

 	    case TCL_LOCATION_EVAL_LIST:

 	        /* List optimized evaluation. Type, line, cmd, the latter

 		 * through listPtr, possibly a frame. */

 	        lv [lc ++] = Tcl_NewStringObj ("type",-1);

 		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);

 		lv [lc ++] = Tcl_NewStringObj ("line",-1);

 		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);

 		/* We put a duplicate of the command list obj into the result

 		 * to ensure that the 'pure List'-property of the command

 		 * itself is not destroyed. Otherwise the query here would

 		 * disable the list optimization path in Tcl_EvalObjEx.

 		 */

 		lv [lc ++] =  Tcl_NewStringObj ("cmd",-1);

 		lv [lc ++] =  Tcl_DuplicateObj (framePtr->cmd.listPtr);

 		break;

 	    case TCL_LOCATION_PREBC:

 	        /* Precompiled. Result contains the type as signal, nothing

 		 * else */

 	        lv [lc ++] = Tcl_NewStringObj ("type",-1);

 		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);

 		break;

 	    case TCL_LOCATION_BC: {

 	        /* Execution of bytecode. Talk to the BC engine to fill out

 		 * the frame. */

 	        CmdFrame f       =  *framePtr;

 	        Proc*    procPtr = f.framePtr ? f.framePtr->procPtr : NULL;

 		/* Note: Type BC => f.data.eval.path    is not used.

 		 *                  f.data.tebc.codePtr is used instead.

 		 */

 	        TclGetSrcInfoForPc (&f);

 		/* Now filled:        cmd.str.(cmd,len), line */

 		/* Possibly modified: type, path! */

 	        lv [lc ++] = Tcl_NewStringObj ("type",-1);

 		lv [lc ++] = Tcl_NewStringObj (typeString [f.type],-1);

 		lv [lc ++] = Tcl_NewStringObj ("line",-1);

 		lv [lc ++] = Tcl_NewIntObj    (f.line[0]);

 		if (f.type == TCL_LOCATION_SOURCE) {

 		    lv [lc ++] = Tcl_NewStringObj ("file",-1);

 		    lv [lc ++] = f.data.eval.path;

 		    /* Death of reference by TclGetSrcInfoForPc */

 		    Tcl_DecrRefCount (f.data.eval.path);

 		}

 		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);

 		lv [lc ++] = Tcl_NewStringObj (f.cmd.str.cmd, f.cmd.str.len);

 		if (procPtr != NULL) {

 		    Tcl_HashEntry* namePtr  = procPtr->cmdPtr->hPtr;

 		    char*          procName = Tcl_GetHashKey (namePtr->tablePtr, namePtr);

 		    char*          nsName   = procPtr->cmdPtr->nsPtr->fullName;

 		    lv [lc ++] = Tcl_NewStringObj ("proc",-1);

 		    lv [lc ++] = Tcl_NewStringObj (nsName,-1);

 		    if (strcmp (nsName, "::") != 0) {

 		        Tcl_AppendToObj (lv [lc-1], "::", -1);

 		    }

 		    Tcl_AppendToObj (lv [lc-1], procName, -1);

 		}

 	        break;

 	    }

 	    case TCL_LOCATION_SOURCE:

 	        /* Evaluation of a script file */

 	        lv [lc ++] = Tcl_NewStringObj ("type",-1);

 		lv [lc ++] = Tcl_NewStringObj (typeString [framePtr->type],-1);

 		lv [lc ++] = Tcl_NewStringObj ("line",-1);

 		lv [lc ++] = Tcl_NewIntObj    (framePtr->line[0]);

 		lv [lc ++] = Tcl_NewStringObj ("file",-1);

 		lv [lc ++] = framePtr->data.eval.path;

 		/* Refcount framePtr->data.eval.path goes up when lv

 		 * is converted into the result list object.

 		 */

 		lv [lc ++] = Tcl_NewStringObj ("cmd",-1);

 		lv [lc ++] = Tcl_NewStringObj (framePtr->cmd.str.cmd,

 					       framePtr->cmd.str.len);

 		break;

 	    case TCL_LOCATION_PROC:

 		Tcl_Panic ("TCL_LOCATION_PROC found in standard frame");

 		break;

 	    }

 	    /* 'level'. Common to all frame types. Conditional on having an

 	     * associated _visible_ CallFrame */

 	    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {

 	        CallFrame* current = framePtr->framePtr;

 		CallFrame* top     = iPtr->varFramePtr;

 		CallFrame* idx;

 		for (idx = top;

 		     idx != NULL;

 		     idx = idx->callerVarPtr) {

 		    if (idx == current) {

 		        int c = framePtr->framePtr->level;

 			int t = iPtr->varFramePtr->level;

 			lv [lc ++] = Tcl_NewStringObj ("level",-1);

 			lv [lc ++] = Tcl_NewIntObj (t - c);

 			break;

 		    }

 		}

 	    }

 	    Tcl_SetObjResult(interp, Tcl_NewListObj (lc, lv));

 	    return TCL_OK;

 	}

     }

     Tcl_WrongNumArgs(interp, 2, objv, "?number?");

     return TCL_ERROR;

 }

 #endif

 /*

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

  *

  * InfoFunctionsCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoFunctionsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     char *pattern;

     Tcl_Obj *listPtr;

     if (objc == 2) {

         pattern = NULL;

     } else if (objc == 3) {

         pattern = Tcl_GetString(objv[2]);

     } else {

         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");

         return TCL_ERROR;

     }

     listPtr = Tcl_ListMathFuncs(interp, pattern);

     if (listPtr == NULL) {

 	return TCL_ERROR;

     }

     Tcl_SetObjResult(interp, listPtr);

     return TCL_OK;

 }

 /*

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

  *

  * InfoGlobalsCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoGlobalsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     char *varName, *pattern;

     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);

     register Tcl_HashEntry *entryPtr;

     Tcl_HashSearch search;

     Var *varPtr;

     Tcl_Obj *listPtr;

     if (objc == 2) {

         pattern = NULL;

     } else if (objc == 3) {

 	pattern = Tcl_GetString(objv[2]);

 	/*

 	 * Strip leading global-namespace qualifiers. [Bug 1057461]

 	 */

 	if (pattern[0] == ':' && pattern[1] == ':') {

 	    while (*pattern == ':') {

 		pattern++;

 	    }

 	}

     } else {

         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");

         return TCL_ERROR;

     }

     /*

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

     if (pattern != NULL && TclMatchIsTrivial(pattern)) {

 	entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern);

  	if (entryPtr != NULL) {

 	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);

 	    if (!TclIsVarUndefined(varPtr)) {

 		Tcl_ListObjAppendElement(interp, listPtr,

 			Tcl_NewStringObj(pattern, -1));

 	    }

 	}

     } else {

 	for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);

 		entryPtr != NULL;

 		entryPtr = Tcl_NextHashEntry(&search)) {

 	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);

 	    if (TclIsVarUndefined(varPtr)) {

 		continue;

 	    }

 	    varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);

 	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {

 		Tcl_ListObjAppendElement(interp, listPtr,

 			Tcl_NewStringObj(varName, -1));

 	    }

 	}

     }

     Tcl_SetObjResult(interp, listPtr);

     return TCL_OK;

 }

 /*

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

  *

  * InfoHostnameCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoHostnameCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     CONST char *name;

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 2, objv, NULL);

         return TCL_ERROR;

     }

     name = Tcl_GetHostName();

     if (name) {

 	Tcl_SetStringObj(Tcl_GetObjResult(interp), name, -1);

 	return TCL_OK;

     } else {

 	Tcl_SetStringObj(Tcl_GetObjResult(interp),

 		"unable to determine name of host", -1);

 	return TCL_ERROR;

     }

 }

 /*

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

  *

  * InfoLevelCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoLevelCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     Interp *iPtr = (Interp *) interp;

     int level;

     CallFrame *framePtr;

     Tcl_Obj *listPtr;

     if (objc == 2) {		/* just "info level" */

         if (iPtr->varFramePtr == NULL) {

             Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);

         } else {

             Tcl_SetIntObj(Tcl_GetObjResult(interp), iPtr->varFramePtr->level);

         }

         return TCL_OK;

     } else if (objc == 3) {

         if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {

             return TCL_ERROR;

         }

         if (level <= 0) {

             if (iPtr->varFramePtr == NULL) {

                 levelError:

 		Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

 			"bad level \"",

 			Tcl_GetString(objv[2]),

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

                 return TCL_ERROR;

             }

             level += iPtr->varFramePtr->level;

         }

         for (framePtr = iPtr->varFramePtr;  framePtr != NULL;

                 framePtr = framePtr->callerVarPtr) {

             if (framePtr->level == level) {

                 break;

             }

         }

         if (framePtr == NULL) {

             goto levelError;

         }

         listPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv);

         Tcl_SetObjResult(interp, listPtr);

         return TCL_OK;

     }

     Tcl_WrongNumArgs(interp, 2, objv, "?number?");

     return TCL_ERROR;

 }

 /*

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

  *

  * InfoLibraryCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoLibraryCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     CONST char *libDirName;

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 2, objv, NULL);

         return TCL_ERROR;

     }

     libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);

     if (libDirName != NULL) {

         Tcl_SetStringObj(Tcl_GetObjResult(interp), libDirName, -1);

         return TCL_OK;

     }

     Tcl_SetStringObj(Tcl_GetObjResult(interp), 

             "no library has been specified for Tcl", -1);

     return TCL_ERROR;

 }

 /*

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

  *

  * InfoLoadedCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoLoadedCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     char *interpName;

     int result;

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

         Tcl_WrongNumArgs(interp, 2, objv, "?interp?");

         return TCL_ERROR;

     }

     if (objc == 2) {		/* get loaded pkgs in all interpreters */

 	interpName = NULL;

     } else {			/* get pkgs just in specified interp */

 	interpName = Tcl_GetString(objv[2]);

     }

     result = TclGetLoadedPackages(interp, interpName);

     return result;

 }

 /*

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

  *

  * InfoLocalsCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoLocalsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     Interp *iPtr = (Interp *) interp;

     char *pattern;

     Tcl_Obj *listPtr;

     if (objc == 2) {

         pattern = NULL;

     } else if (objc == 3) {

         pattern = Tcl_GetString(objv[2]);

     } else {

         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");

         return TCL_ERROR;

     }

     if (iPtr->varFramePtr == NULL || !iPtr->varFramePtr->isProcCallFrame) {

         return TCL_OK;

     }

     /*

      * Return a list containing names of first the compiled locals (i.e. the

      * ones stored in the call frame), then the variables in the local hash

      * table (if one exists).

      */

     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);

     AppendLocals(interp, listPtr, pattern, 0);

     Tcl_SetObjResult(interp, listPtr);

     return TCL_OK;

 }

 /*

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

  *

  * AppendLocals --

  *

  *	Append the local variables for the current frame to the

  *	specified list object.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	None.

  *

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

  */

 static void

 AppendLocals(interp, listPtr, pattern, includeLinks)

     Tcl_Interp *interp;		/* Current interpreter. */

     Tcl_Obj *listPtr;		/* List object to append names to. */

     CONST char *pattern;	/* Pattern to match against. */

     int includeLinks;		/* 1 if upvars should be included, else 0. */

 {

     Interp *iPtr = (Interp *) interp;

     CompiledLocal *localPtr;

     Var *varPtr;

     int i, localVarCt;

     char *varName;

     Tcl_HashTable *localVarTablePtr;

     register Tcl_HashEntry *entryPtr;

     Tcl_HashSearch search;

     localPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;

     localVarCt = iPtr->varFramePtr->numCompiledLocals;

     varPtr = iPtr->varFramePtr->compiledLocals;

     localVarTablePtr = iPtr->varFramePtr->varTablePtr;

     for (i = 0; i < localVarCt; i++) {

 	/*

 	 * Skip nameless (temporary) variables and undefined variables

 	 */

 	if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)

 	        && (includeLinks || !TclIsVarLink(varPtr))) {

 	    varName = varPtr->name;

 	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {

 		Tcl_ListObjAppendElement(interp, listPtr,

 		        Tcl_NewStringObj(varName, -1));

 	    }

         }

 	varPtr++;

 	localPtr = localPtr->nextPtr;

     }

     if (localVarTablePtr != NULL) {

 	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);

 	        entryPtr != NULL;

                 entryPtr = Tcl_NextHashEntry(&search)) {

 	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);

 	    if (!TclIsVarUndefined(varPtr)

 		    && (includeLinks || !TclIsVarLink(varPtr))) {

 		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);

 		if ((pattern == NULL)

 		        || Tcl_StringMatch(varName, pattern)) {

 		    Tcl_ListObjAppendElement(interp, listPtr,

 			    Tcl_NewStringObj(varName, -1));

 		}

 	    }

 	}

     }

 }

 /*

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

  *

  * InfoNameOfExecutableCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoNameOfExecutableCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     CONST char *nameOfExecutable;

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 2, objv, NULL);

         return TCL_ERROR;

     }

     nameOfExecutable = Tcl_GetNameOfExecutable();

     if (nameOfExecutable != NULL) {

 	Tcl_SetStringObj(Tcl_GetObjResult(interp), nameOfExecutable, -1);

     }

     return TCL_OK;

 }

 /*

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

  *

  * InfoPatchLevelCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoPatchLevelCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     CONST char *patchlevel;

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 2, objv, NULL);

         return TCL_ERROR;

     }

     patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",

             (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));

     if (patchlevel != NULL) {

         Tcl_SetStringObj(Tcl_GetObjResult(interp), patchlevel, -1);

         return TCL_OK;

     }

     return TCL_ERROR;

 }

 /*

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

  *

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

  *

  *          info procs ?pattern?

  *

  * Results:

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

  *

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

  */

 static int

 InfoProcsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     char *cmdName, *pattern;

     CONST char *simplePattern;

     Namespace *nsPtr;

 #ifdef INFO_PROCS_SEARCH_GLOBAL_NS

     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);

 #endif

     Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);

     Tcl_Obj *listPtr, *elemObjPtr;

     int specificNsInPattern = 0;  /* Init. to avoid compiler warning. */

     register Tcl_HashEntry *entryPtr;

     Tcl_HashSearch search;

     Command *cmdPtr, *realCmdPtr;

     /*

      * Get the pattern and find the "effective namespace" in which to

      * list procs.

      */

     if (objc == 2) {

 	simplePattern = NULL;

 	nsPtr = currNsPtr;

 	specificNsInPattern = 0;

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

 	 */

 	Namespace *dummy1NsPtr, *dummy2NsPtr;

 	pattern = Tcl_GetString(objv[2]);

 	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,

 		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,

 		&simplePattern);

 	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */

 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);

 	}

     } else {

         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");

         return TCL_ERROR;

     }

     if (nsPtr == NULL) {

 	return TCL_OK;

     }

     /*

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

 #ifndef INFO_PROCS_SEARCH_GLOBAL_NS

     if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {

 	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);

 	if (entryPtr != NULL) {

 	    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);

 	    if (!TclIsProc(cmdPtr)) {

 		realCmdPtr = (Command *)

 			TclGetOriginalCommand((Tcl_Command) cmdPtr);

 		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {

 		    goto simpleProcOK;

 		}

 	    } else {

 	      simpleProcOK:

 		if (specificNsInPattern) {

 		    elemObjPtr = Tcl_NewObj();

 		    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,

 			    elemObjPtr);

 		} else {

 		    elemObjPtr = Tcl_NewStringObj(simplePattern, -1);

 		}

 		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);

 	    }

 	}

     } else

 #endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */

     {

 	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);

 	while (entryPtr != NULL) {

 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);

 	    if ((simplePattern == NULL)

 	            || Tcl_StringMatch(cmdName, simplePattern)) {

 		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);

 		if (!TclIsProc(cmdPtr)) {

 		    realCmdPtr = (Command *)

 			    TclGetOriginalCommand((Tcl_Command) cmdPtr);

 		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {

 			goto procOK;

 		    }

 		} else {

 		  procOK:

 		    if (specificNsInPattern) {

 			elemObjPtr = Tcl_NewObj();

 			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,

 				elemObjPtr);

 		    } else {

 			elemObjPtr = Tcl_NewStringObj(cmdName, -1);

 		    }

 		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);

 		}

 	    }

 	    entryPtr = Tcl_NextHashEntry(&search);

 	}

 	/*

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

 	 */

 #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 ((nsPtr != globalNsPtr) && !specificNsInPattern) {

 	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);

 	    while (entryPtr != NULL) {

 		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);

 		if ((simplePattern == NULL)

 	                || Tcl_StringMatch(cmdName, simplePattern)) {

 		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {

 			cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);

 			realCmdPtr = (Command *) TclGetOriginalCommand(

 			        (Tcl_Command) cmdPtr);

 			if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)

 				&& TclIsProc(realCmdPtr))) {

 			    Tcl_ListObjAppendElement(interp, listPtr,

 			            Tcl_NewStringObj(cmdName, -1));

 			}

 		    }

 		}

 		entryPtr = Tcl_NextHashEntry(&search);

 	    }

 	}

 #endif

     }

     Tcl_SetObjResult(interp, listPtr);

     return TCL_OK;

 }

 /*

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

  *

  * InfoScriptCmd --

  *

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

  *

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

  *

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

  */

 static int

 InfoScriptCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     Interp *iPtr = (Interp *) interp;

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

         Tcl_WrongNumArgs(interp, 2, objv, "?filename?");

         return TCL_ERROR;

     }

     if (objc == 3) {

 	if (iPtr->scriptFile != NULL) {

 	    Tcl_DecrRefCount(iPtr->scriptFile);

 	}

 	iPtr->scriptFile = objv[2];

 	Tcl_IncrRefCount(iPtr->scriptFile);

     }

     if (iPtr->scriptFile != NULL) {

         Tcl_SetObjResult(interp, iPtr->scriptFile);

     }

     return TCL_OK;

 }

 /*

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

  *

  * InfoSharedlibCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoSharedlibCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 2, objv, NULL);

         return TCL_ERROR;

     }

 #ifdef TCL_SHLIB_EXT

     Tcl_SetStringObj(Tcl_GetObjResult(interp), TCL_SHLIB_EXT, -1);

 #endif

     return TCL_OK;

 }

 /*

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

  *

  * InfoTclVersionCmd --

  *

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

  *

  * Side effects:

  *      Returns a result in the interpreter's result object. If there is

  *	an error, the result is an error message.

  *

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

  */

 static int

 InfoTclVersionCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     CONST char *version;

     if (objc != 2) {

         Tcl_WrongNumArgs(interp, 2, objv, NULL);

         return TCL_ERROR;

     }

     version = Tcl_GetVar(interp, "tcl_version",

         (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));

     if (version != NULL) {

         Tcl_SetStringObj(Tcl_GetObjResult(interp), version, -1);

         return TCL_OK;

     }

     return TCL_ERROR;

 }

 /*

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

  *

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

  *

  *          info vars ?pattern?

  *

  * Results:

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

  *

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

  */

 static int

 InfoVarsCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     Interp *iPtr = (Interp *) interp;

     char *varName, *pattern;

     CONST char *simplePattern;

     register Tcl_HashEntry *entryPtr;

     Tcl_HashSearch search;

     Var *varPtr;

     Namespace *nsPtr;

     Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);

     Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);

     Tcl_Obj *listPtr, *elemObjPtr;

     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.

      */

     if (objc == 2) {

         simplePattern = NULL;

 	nsPtr = currNsPtr;

 	specificNsInPattern = 0;

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

 	 */

 	Namespace *dummy1NsPtr, *dummy2NsPtr;

         pattern = Tcl_GetString(objv[2]);

 	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,

 		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,

 		&simplePattern);

 	if (nsPtr != NULL) {	/* we successfully found the pattern's ns */

 	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);

 	}

     } else {

         Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");

         return TCL_ERROR;

     }

     /*

      * If the namespace specified in the pattern wasn't found, just return.

      */

     if (nsPtr == NULL) {

 	return TCL_OK;

     }

     listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);

     if ((iPtr->varFramePtr == NULL)

 	    || !iPtr->varFramePtr->isProcCallFrame

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

 	 */

 	if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {

 	    /*

 	     * If we can just do hash lookups, that simplifies things

 	     * a lot.

 	     */

 	    entryPtr = Tcl_FindHashEntry(&nsPtr->varTable, simplePattern);

 	    if (entryPtr != NULL) {

 		varPtr = (Var *) Tcl_GetHashValue(entryPtr);

 		if (!TclIsVarUndefined(varPtr)

 			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {

 		    if (specificNsInPattern) {

 			elemObjPtr = Tcl_NewObj();

 			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,

 				    elemObjPtr);

 		    } else {

 			elemObjPtr = Tcl_NewStringObj(simplePattern, -1);

 		    }

 		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);

 		}

 	    } else if ((nsPtr != globalNsPtr) && !specificNsInPattern) {

 		entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable,

 			simplePattern);

 		if (entryPtr != NULL) {

 		    varPtr = (Var *) Tcl_GetHashValue(entryPtr);

 		    if (!TclIsVarUndefined(varPtr)

 			    || (varPtr->flags & VAR_NAMESPACE_VAR)) {

 			Tcl_ListObjAppendElement(interp, listPtr,

 				Tcl_NewStringObj(simplePattern, -1));

 		    }

 		}

 	    }

 	} else {

 	    /*

 	     * Have to scan the tables of variables.

 	     */

 	    entryPtr = Tcl_FirstHashEntry(&nsPtr->varTable, &search);

 	    while (entryPtr != NULL) {

 		varPtr = (Var *) Tcl_GetHashValue(entryPtr);

 		if (!TclIsVarUndefined(varPtr)

 			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {

 		    varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);

 		    if ((simplePattern == NULL)

 			    || Tcl_StringMatch(varName, simplePattern)) {

 			if (specificNsInPattern) {

 			    elemObjPtr = Tcl_NewObj();

 			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,

 				    elemObjPtr);

 			} else {

 			    elemObjPtr = Tcl_NewStringObj(varName, -1);

 			}

 			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);

 		    }

 		}

 		entryPtr = Tcl_NextHashEntry(&search);

 	    }

 	    /*

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

 	     */

 	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {

 		entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);

 		while (entryPtr != NULL) {

 		    varPtr = (Var *) Tcl_GetHashValue(entryPtr);

 		    if (!TclIsVarUndefined(varPtr)

 			    || (varPtr->flags & VAR_NAMESPACE_VAR)) {

 			varName = Tcl_GetHashKey(&globalNsPtr->varTable,

 				entryPtr);

 			if ((simplePattern == NULL)

 				|| Tcl_StringMatch(varName, simplePattern)) {

 			    if (Tcl_FindHashEntry(&nsPtr->varTable,

 				    varName) == NULL) {

 				Tcl_ListObjAppendElement(interp, listPtr,

 					Tcl_NewStringObj(varName, -1));

 			    }

 			}

 		    }

 		    entryPtr = Tcl_NextHashEntry(&search);

 		}

 	    }

 	}

     } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {

 	AppendLocals(interp, listPtr, simplePattern, 1);

     }

     Tcl_SetObjResult(interp, listPtr);

     return TCL_OK;

 }

 /*

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

  *

  * Tcl_JoinObjCmd --

  *

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

  *

  * Side effects:

  *	See the user documentation.

  *

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

  */

 	/* ARGSUSED */

 int

 Tcl_JoinObjCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

     Tcl_Obj *CONST objv[];	/* The argument objects. */

 {

     char *joinString, *bytes;

     int joinLength, listLen, length, i, result;

     Tcl_Obj **elemPtrs;

     Tcl_Obj *resObjPtr;

     if (objc == 2) {

 	joinString = " ";

 	joinLength = 1;

     } else if (objc == 3) {

 	joinString = Tcl_GetStringFromObj(objv[2], &joinLength);

     } else {

 	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");

 	return TCL_ERROR;

     }

     /*

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

     if (result != TCL_OK) {

 	return result;

     }

     /*

      * Now concatenate strings to form the "joined" result. We append

      * directly into the interpreter's result object.

      */

     resObjPtr = Tcl_GetObjResult(interp);

     for (i = 0;  i < listLen;  i++) {

 	bytes = Tcl_GetStringFromObj(elemPtrs[i], &length);

 	if (i > 0) {

 	    Tcl_AppendToObj(resObjPtr, joinString, joinLength);

 	}

 	Tcl_AppendToObj(resObjPtr, bytes, length);

     }

     return TCL_OK;

 }

 /*

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

  *

  * Tcl_LindexObjCmd --

  *

  *	This object-based procedure is invoked to process the "lindex" Tcl

  *	command. See the user documentation for details on what it does.

  *

  * Results:

  *	A standard Tcl object result.

  *

  * Side effects:

  *	See the user documentation.

  *

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

  */

     /* ARGSUSED */

 int

 Tcl_LindexObjCmd(dummy, interp, objc, objv)

     ClientData dummy;		/* Not used. */

     Tcl_Interp *interp;		/* Current interpreter. */

     int objc;			/* Number of arguments. */

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

 {

     Tcl_Obj *elemPtr;		/* Pointer to the element being extracted */

     if (objc < 2) {

 	Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?");

 	return TCL_ERROR;

     }

     /*

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

 	elemPtr = TclLindexList( interp, objv[ 1 ], objv[ 2 ] );

     } else {

 	elemPtr = TclLindexFlat( interp, objv[ 1 ], objc-2, objv+2 );

     }

     /*

      * Set the interpreter's object result to the last element extracted

      */

     if ( elemPtr == NULL ) {

 	return TCL_ERROR;

     } else {

 	Tcl_SetObjResult(interp, elemPtr);

 	Tcl_DecrRefCount( elemPtr );

 	return TCL_OK;

     }

 }

 /*

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

  *

  * TclLindexList --

  *

  *	This procedure handles the 'lindex' command when objc==3.

  *

  * Results:

  *	Returns a pointer to the object extracted, or NULL if an

  *	error occurred.

  *

  * Side effects:

  *	None.

  *

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

  *	Tcl_SetObjResult( interp, result );

  *	Tcl_DecrRefCount( result );

  *

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

  */

 Tcl_Obj *

 TclLindexList( interp, listPtr, argPtr )

     Tcl_Interp* interp;		/* Tcl interpreter */

     Tcl_Obj* listPtr;		/* List being unpacked */

     Tcl_Obj* argPtr;		/* Index or index list */

 {

     Tcl_Obj **elemPtrs;		/* Elements of the list being manipulated. */

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

     /*

      * 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 

 	 && TclGetIntForIndex( NULL , argPtr, 0, &index ) == TCL_OK ) {

 	/*

 	 * argPtr designates a single index.

 	 */

 	return TclLindexFlat( interp, listPtr, 1, &argPtr );

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

     }

     /*

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

      */

     for ( i = 0; i < indexCount; ++i ) {

 	/*

 	 * Convert the current listPtr to a list if necessary.

 	 */

 	result = Tcl_ListObjGetElements( interp, listPtr,

 					 &listLen, &elemPtrs);

 	if (result != TCL_OK) {

 	    Tcl_DecrRefCount( listPtr );

 	    return NULL;

 	}

 	/*

 	 * Get the index from indices[ i ]

 	 */

 	result = TclGetIntForIndex( interp, indices[ i ],

 				    /*endValue*/ (listLen - 1),

 				    &index );

 	if ( result != TCL_OK ) {

 	    /*

 	     * Index could not be parsed

 	     */

 	    Tcl_DecrRefCount( listPtr );

 	    return NULL;

 	} else if ( index < 0

 		    || index >= listLen ) {

 	    /*

 	     * Index is out of range

 	     */

 	    Tcl_DecrRefCount( listPtr );

 	    listPtr = Tcl_NewObj();

 	    Tcl_IncrRefCount( listPtr );

 	    return listPtr;

 	}

 	/*

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

 	    if (result != TCL_OK) {

 		Tcl_DecrRefCount( listPtr );

 		return NULL;

 	    }

 	}

 	/*

 	 * Extract the pointer to the appropriate element

 	 */

 	oldListPtr = listPtr;

 	listPtr = elemPtrs[ index ];

 	Tcl_IncrRefCount( listPtr );

 	Tcl_DecrRefCount( oldListPtr );

 	/*

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

 	}

     } /* end for */

     /*

      * Return the last object extracted.  Its reference count will include

      * the reference being returned.

      */

     return listPtr;

 }

 /*

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

  *

  * TclLindexFlat --

  *

  *	This procedure handles the 'lindex' command, given that the