Tcl Source Code

    {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
    {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"upvar",		   TclInfoUpvarCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 *----------------------------------------------------------------------
 *

MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE Tcl_ObjCmdProc TclInfoExistsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoCoroutineCmd;
MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE Tcl_ObjCmdProc TclInfoGlobalsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoLocalsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoUpvarCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInfoVarsCmd;
MODULE_SCOPE void	TclInitAlloc(void);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TclInitEncodingSubsystem(void);

    if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown variable \"%s\"", name));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
    }
    return (Tcl_Var) varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoUpvarCmd --
 *
 *	Called to implement the "info upvar" command that returns the target
 *      of an upvar command given the alias. The return value is a list.
 *      If the argument is not an alias, the list is empty. Otherwise the
 *      list consists of 2 or 3 elements: level name ?subscript?
 *      The subscript element is only present if name is an array.
 *
 *	    info upvar name
 *
 *      If the argument is not a variable, an error is raised.
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

int
TclInfoUpvarCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr;
    Tcl_Obj *listPtr, *varObjPtr, *elemObjPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr;
    const char *errMsg = NULL;
    int index, level = 0;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "name");
        return TCL_ERROR;
    }
    varPtr = TclLookupSimpleVar(interp, objv[1], 
      TCL_LEAVE_ERR_MSG, 0, &errMsg, &index);
    if (varPtr == NULL) {
        TclObjVarErrMsg(interp, objv[1], NULL, "stat", errMsg, -1);
        return TCL_ERROR;
    }
    if (TclIsVarLink(varPtr)) {
        Tcl_HashTable *tablePtr;
        varPtr = varPtr->value.linkPtr;
        if (TclIsVarArrayElement(varPtr)) {
            ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
              ((VarInHash *) varPtr)->entry.tablePtr;
            elemObjPtr = VarHashGetKey(varPtr);
            varPtr = avhtPtr->table.arrayPtr;
        }

        /*
         * Walk up the call frames and compare the local variable hash table
         * against the hash table that contains the alias we're looking for
         */

        tablePtr = ((VarInHash *) varPtr)->entry.tablePtr;
        for (framePtr = iPtr->varFramePtr; framePtr != NULL;
          framePtr = framePtr->callerVarPtr) {
            if ((Tcl_HashTable *)framePtr->varTablePtr == tablePtr) {
                level = (int)framePtr->level;
                break;
            }
        }

        if (level == 0 && TclGetVarNsPtr(varPtr) != iPtr->globalNsPtr) {
            /*
             * The reference variable must be a namespace variable.
             * In that case thefull name must be reported.
             */
            TclNewObj(varObjPtr);
            Tcl_GetVariableFullName(interp, (Tcl_Var)varPtr, varObjPtr);
        } else {
            varObjPtr = VarHashGetKey(varPtr);
        }

        listPtr = Tcl_NewListObj(2, NULL);
        Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(level));
        Tcl_ListObjAppendElement(interp, listPtr, varObjPtr);
        if (elemObjPtr) {
            Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
        }
        Tcl_SetObjResult(interp, listPtr);
    }
    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoVarsCmd -- (moved over from tclCmdIL.c)
 *
 *	Called to implement the "info vars" command that returns the list of

unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, upvar, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, upvar, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, upvar, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, upvar, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path