--- sf_code/esrgpcpj/shared/tcl_base/tclresolve.c 2016/10/08 06:43:03 25 +++ projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclresolve.c 2016/12/18 00:57:31 98 @@ -1,431 +1,421 @@ -/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $ */ - -/* - * tclResolve.c -- - * - * Contains hooks for customized command/variable name resolution - * schemes. These hooks allow extensions like [incr Tcl] to add - * their own name resolution rules to the Tcl language. Rules can - * be applied to a particular namespace, to the interpreter as a - * whole, or both. - * - * Copyright (c) 1998 Lucent Technologies, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $ - */ - -#include "tclInt.h" - -/* - * Declarations for procedures local to this file: - */ - -static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr)); - - -/* - *---------------------------------------------------------------------- - * - * Tcl_AddInterpResolvers -- - * - * Adds a set of command/variable resolution procedures to an - * interpreter. These procedures are consulted when commands - * are resolved in Tcl_FindCommand, and when variables are - * resolved in TclLookupVar and LookupCompiledLocal. Each - * namespace may also have its own set of resolution procedures - * which take precedence over those for the interpreter. - * - * When a name is resolved, it is handled as follows. First, - * the name is passed to the resolution procedures for the - * namespace. If not resolved, the name is passed to each of - * the resolution procedures added to the interpreter. Finally, - * if still not resolved, the name is handled using the default - * Tcl rules for name resolution. - * - * Results: - * Returns pointers to the current name resolution procedures - * in the cmdProcPtr, varProcPtr and compiledVarProcPtr - * arguments. - * - * Side effects: - * If a compiledVarProc is specified, this procedure bumps the - * compileEpoch for the interpreter, forcing all code to be - * recompiled. If a cmdProc is specified, this procedure bumps - * the cmdRefEpoch in all namespaces, forcing commands to be - * resolved again using the new rules. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc) - - Tcl_Interp *interp; /* Interpreter whose name resolution - * rules are being modified. */ - char *name; /* Name of this resolution scheme. */ - Tcl_ResolveCmdProc *cmdProc; /* New procedure for command - * resolution */ - Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution - * at runtime */ - Tcl_ResolveCompiledVarProc *compiledVarProc; - /* Procedure for variable resolution - * at compile time. */ -{ - Interp *iPtr = (Interp*)interp; - ResolverScheme *resPtr; - - /* - * Since we're adding a new name resolution scheme, we must force - * all code to be recompiled to use the new scheme. If there - * are new compiled variable resolution rules, bump the compiler - * epoch to invalidate compiled code. If there are new command - * resolution rules, bump the cmdRefEpoch in all namespaces. - */ - if (compiledVarProc) { - iPtr->compileEpoch++; - } - if (cmdProc) { - BumpCmdRefEpochs(iPtr->globalNsPtr); - } - - /* - * Look for an existing scheme with the given name. If found, - * then replace its rules. - */ - for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) { - if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { - resPtr->cmdResProc = cmdProc; - resPtr->varResProc = varProc; - resPtr->compiledVarResProc = compiledVarProc; - return; - } - } - - /* - * Otherwise, this is a new scheme. Add it to the FRONT - * of the linked list, so that it overrides existing schemes. - */ - resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme)); - resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1)); - strcpy(resPtr->name, name); - resPtr->cmdResProc = cmdProc; - resPtr->varResProc = varProc; - resPtr->compiledVarResProc = compiledVarProc; - resPtr->nextPtr = iPtr->resolverPtr; - iPtr->resolverPtr = resPtr; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetInterpResolvers -- - * - * Looks for a set of command/variable resolution procedures with - * the given name in an interpreter. These procedures are - * registered by calling Tcl_AddInterpResolvers. - * - * Results: - * If the name is recognized, this procedure returns non-zero, - * along with pointers to the name resolution procedures in - * the Tcl_ResolverInfo structure. If the name is not recognized, - * this procedure returns zero. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GetInterpResolvers(interp, name, resInfoPtr) - - Tcl_Interp *interp; /* Interpreter whose name resolution - * rules are being queried. */ - char *name; /* Look for a scheme with this name. */ - Tcl_ResolverInfo *resInfoPtr; /* Returns pointers to the procedures, - * if found */ -{ - Interp *iPtr = (Interp*)interp; - ResolverScheme *resPtr; - - /* - * Look for an existing scheme with the given name. If found, - * then return pointers to its procedures. - */ - for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) { - if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { - resInfoPtr->cmdResProc = resPtr->cmdResProc; - resInfoPtr->varResProc = resPtr->varResProc; - resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc; - return 1; - } - } - - return 0; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_RemoveInterpResolvers -- - * - * Removes a set of command/variable resolution procedures - * previously added by Tcl_AddInterpResolvers. The next time - * a command/variable name is resolved, these procedures - * won't be consulted. - * - * Results: - * Returns non-zero if the name was recognized and the - * resolution scheme was deleted. Returns zero otherwise. - * - * Side effects: - * If a scheme with a compiledVarProc was deleted, this procedure - * bumps the compileEpoch for the interpreter, forcing all code - * to be recompiled. If a scheme with a cmdProc was deleted, - * this procedure bumps the cmdRefEpoch in all namespaces, - * forcing commands to be resolved again using the new rules. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_RemoveInterpResolvers(interp, name) - - Tcl_Interp *interp; /* Interpreter whose name resolution - * rules are being modified. */ - char *name; /* Name of the scheme to be removed. */ -{ - Interp *iPtr = (Interp*)interp; - ResolverScheme **prevPtrPtr, *resPtr; - - /* - * Look for an existing scheme with the given name. - */ - prevPtrPtr = &iPtr->resolverPtr; - for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) { - if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { - break; - } - prevPtrPtr = &resPtr->nextPtr; - } - - /* - * If we found the scheme, delete it. - */ - if (resPtr) { - /* - * If we're deleting a scheme with compiled variable resolution - * rules, bump the compiler epoch to invalidate compiled code. - * If we're deleting a scheme with command resolution rules, - * bump the cmdRefEpoch in all namespaces. - */ - if (resPtr->compiledVarResProc) { - iPtr->compileEpoch++; - } - if (resPtr->cmdResProc) { - BumpCmdRefEpochs(iPtr->globalNsPtr); - } - - *prevPtrPtr = resPtr->nextPtr; - ckfree(resPtr->name); - ckfree((char *) resPtr); - - return 1; - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * - * BumpCmdRefEpochs -- - * - * This procedure is used to bump the cmdRefEpoch counters in - * the specified namespace and all of its child namespaces. - * It is used whenever name resolution schemes are added/removed - * from an interpreter, to invalidate all command references. - * - * Results: - * None. - * - * Side effects: - * Bumps the cmdRefEpoch in the specified namespace and its - * children, recursively. - * - *---------------------------------------------------------------------- - */ - -static void -BumpCmdRefEpochs(nsPtr) - Namespace *nsPtr; /* Namespace being modified. */ -{ - Tcl_HashEntry *entry; - Tcl_HashSearch search; - Namespace *childNsPtr; - - nsPtr->cmdRefEpoch++; - - for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search); - entry != NULL; - entry = Tcl_NextHashEntry(&search)) { - - childNsPtr = (Namespace *) Tcl_GetHashValue(entry); - BumpCmdRefEpochs(childNsPtr); - } -} - - -/* - *---------------------------------------------------------------------- - * - * Tcl_SetNamespaceResolvers -- - * - * Sets the command/variable resolution procedures for a namespace, - * thereby changing the way that command/variable names are - * interpreted. This allows extension writers to support different - * name resolution schemes, such as those for object-oriented - * packages. - * - * Command resolution is handled by a procedure of the following - * type: - * - * typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_(( - * Tcl_Interp* interp, char* name, Tcl_Namespace *context, - * int flags, Tcl_Command *rPtr)); - * - * Whenever a command is executed or Tcl_FindCommand is invoked - * within the namespace, this procedure is called to resolve the - * command name. If this procedure is able to resolve the name, - * it should return the status code TCL_OK, along with the - * corresponding Tcl_Command in the rPtr argument. Otherwise, - * the procedure can return TCL_CONTINUE, and the command will - * be treated under the usual name resolution rules. Or, it can - * return TCL_ERROR, and the command will be considered invalid. - * - * Variable resolution is handled by two procedures. The first - * is called whenever a variable needs to be resolved at compile - * time: - * - * typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_(( - * Tcl_Interp* interp, char* name, Tcl_Namespace *context, - * Tcl_ResolvedVarInfo *rPtr)); - * - * If this procedure is able to resolve the name, it should return - * the status code TCL_OK, along with variable resolution info in - * the rPtr argument; this info will be used to set up compiled - * locals in the call frame at runtime. The procedure may also - * return TCL_CONTINUE, and the variable will be treated under - * the usual name resolution rules. Or, it can return TCL_ERROR, - * and the variable will be considered invalid. - * - * Another procedure is used whenever a variable needs to be - * resolved at runtime but it is not recognized as a compiled local. - * (For example, the variable may be requested via - * Tcl_FindNamespaceVar.) This procedure has the following type: - * - * typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_(( - * Tcl_Interp* interp, char* name, Tcl_Namespace *context, - * int flags, Tcl_Var *rPtr)); - * - * This procedure is quite similar to the compile-time version. - * It returns the same status codes, but if variable resolution - * succeeds, this procedure returns a Tcl_Var directly via the - * rPtr argument. - * - * Results: - * Nothing. - * - * Side effects: - * Bumps the command epoch counter for the namespace, invalidating - * all command references in that namespace. Also bumps the - * resolver epoch counter for the namespace, forcing all code - * in the namespace to be recompiled. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc) - Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules - * are being modified. */ - Tcl_ResolveCmdProc *cmdProc; /* Procedure for command resolution */ - Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution - * at runtime */ - Tcl_ResolveCompiledVarProc *compiledVarProc; - /* Procedure for variable resolution - * at compile time. */ -{ - Namespace *nsPtr = (Namespace*)namespacePtr; - - /* - * Plug in the new command resolver, and bump the epoch counters - * so that all code will have to be recompiled and all commands - * will have to be resolved again using the new policy. - */ - nsPtr->cmdResProc = cmdProc; - nsPtr->varResProc = varProc; - nsPtr->compiledVarResProc = compiledVarProc; - - nsPtr->cmdRefEpoch++; - nsPtr->resolverEpoch++; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_GetNamespaceResolvers -- - * - * Returns the current command/variable resolution procedures - * for a namespace. By default, these procedures are NULL. - * New procedures can be installed by calling - * Tcl_SetNamespaceResolvers, to provide new name resolution - * rules. - * - * Results: - * Returns non-zero if any name resolution procedures have been - * assigned to this namespace; also returns pointers to the - * procedures in the Tcl_ResolverInfo structure. Returns zero - * otherwise. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr) - - Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules - * are being modified. */ - Tcl_ResolverInfo *resInfoPtr; /* Returns: pointers for all - * name resolution procedures - * assigned to this namespace. */ -{ - Namespace *nsPtr = (Namespace*)namespacePtr; - - resInfoPtr->cmdResProc = nsPtr->cmdResProc; - resInfoPtr->varResProc = nsPtr->varResProc; - resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc; - - if (nsPtr->cmdResProc != NULL || - nsPtr->varResProc != NULL || - nsPtr->compiledVarResProc != NULL) { - return 1; - } - return 0; -} - - -/* $History: tclresolve.c $ - * - * ***************** Version 1 ***************** - * User: Dtashley Date: 1/02/01 Time: 1:04a - * Created in $/IjuScripter, IjuConsole/Source/Tcl Base - * Initial check-in. - */ - -/* End of TCLRESOLVE.C */ \ No newline at end of file +/* $Header$ */ +/* + * tclResolve.c -- + * + * Contains hooks for customized command/variable name resolution + * schemes. These hooks allow extensions like [incr Tcl] to add + * their own name resolution rules to the Tcl language. Rules can + * be applied to a particular namespace, to the interpreter as a + * whole, or both. + * + * Copyright (c) 1998 Lucent Technologies, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * RCS: @(#) $Id: tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $ + */ + +#include "tclInt.h" + +/* + * Declarations for procedures local to this file: + */ + +static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr)); + + +/* + *---------------------------------------------------------------------- + * + * Tcl_AddInterpResolvers -- + * + * Adds a set of command/variable resolution procedures to an + * interpreter. These procedures are consulted when commands + * are resolved in Tcl_FindCommand, and when variables are + * resolved in TclLookupVar and LookupCompiledLocal. Each + * namespace may also have its own set of resolution procedures + * which take precedence over those for the interpreter. + * + * When a name is resolved, it is handled as follows. First, + * the name is passed to the resolution procedures for the + * namespace. If not resolved, the name is passed to each of + * the resolution procedures added to the interpreter. Finally, + * if still not resolved, the name is handled using the default + * Tcl rules for name resolution. + * + * Results: + * Returns pointers to the current name resolution procedures + * in the cmdProcPtr, varProcPtr and compiledVarProcPtr + * arguments. + * + * Side effects: + * If a compiledVarProc is specified, this procedure bumps the + * compileEpoch for the interpreter, forcing all code to be + * recompiled. If a cmdProc is specified, this procedure bumps + * the cmdRefEpoch in all namespaces, forcing commands to be + * resolved again using the new rules. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc) + + Tcl_Interp *interp; /* Interpreter whose name resolution + * rules are being modified. */ + char *name; /* Name of this resolution scheme. */ + Tcl_ResolveCmdProc *cmdProc; /* New procedure for command + * resolution */ + Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution + * at runtime */ + Tcl_ResolveCompiledVarProc *compiledVarProc; + /* Procedure for variable resolution + * at compile time. */ +{ + Interp *iPtr = (Interp*)interp; + ResolverScheme *resPtr; + + /* + * Since we're adding a new name resolution scheme, we must force + * all code to be recompiled to use the new scheme. If there + * are new compiled variable resolution rules, bump the compiler + * epoch to invalidate compiled code. If there are new command + * resolution rules, bump the cmdRefEpoch in all namespaces. + */ + if (compiledVarProc) { + iPtr->compileEpoch++; + } + if (cmdProc) { + BumpCmdRefEpochs(iPtr->globalNsPtr); + } + + /* + * Look for an existing scheme with the given name. If found, + * then replace its rules. + */ + for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) { + if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { + resPtr->cmdResProc = cmdProc; + resPtr->varResProc = varProc; + resPtr->compiledVarResProc = compiledVarProc; + return; + } + } + + /* + * Otherwise, this is a new scheme. Add it to the FRONT + * of the linked list, so that it overrides existing schemes. + */ + resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme)); + resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1)); + strcpy(resPtr->name, name); + resPtr->cmdResProc = cmdProc; + resPtr->varResProc = varProc; + resPtr->compiledVarResProc = compiledVarProc; + resPtr->nextPtr = iPtr->resolverPtr; + iPtr->resolverPtr = resPtr; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetInterpResolvers -- + * + * Looks for a set of command/variable resolution procedures with + * the given name in an interpreter. These procedures are + * registered by calling Tcl_AddInterpResolvers. + * + * Results: + * If the name is recognized, this procedure returns non-zero, + * along with pointers to the name resolution procedures in + * the Tcl_ResolverInfo structure. If the name is not recognized, + * this procedure returns zero. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetInterpResolvers(interp, name, resInfoPtr) + + Tcl_Interp *interp; /* Interpreter whose name resolution + * rules are being queried. */ + char *name; /* Look for a scheme with this name. */ + Tcl_ResolverInfo *resInfoPtr; /* Returns pointers to the procedures, + * if found */ +{ + Interp *iPtr = (Interp*)interp; + ResolverScheme *resPtr; + + /* + * Look for an existing scheme with the given name. If found, + * then return pointers to its procedures. + */ + for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) { + if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { + resInfoPtr->cmdResProc = resPtr->cmdResProc; + resInfoPtr->varResProc = resPtr->varResProc; + resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc; + return 1; + } + } + + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_RemoveInterpResolvers -- + * + * Removes a set of command/variable resolution procedures + * previously added by Tcl_AddInterpResolvers. The next time + * a command/variable name is resolved, these procedures + * won't be consulted. + * + * Results: + * Returns non-zero if the name was recognized and the + * resolution scheme was deleted. Returns zero otherwise. + * + * Side effects: + * If a scheme with a compiledVarProc was deleted, this procedure + * bumps the compileEpoch for the interpreter, forcing all code + * to be recompiled. If a scheme with a cmdProc was deleted, + * this procedure bumps the cmdRefEpoch in all namespaces, + * forcing commands to be resolved again using the new rules. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RemoveInterpResolvers(interp, name) + + Tcl_Interp *interp; /* Interpreter whose name resolution + * rules are being modified. */ + char *name; /* Name of the scheme to be removed. */ +{ + Interp *iPtr = (Interp*)interp; + ResolverScheme **prevPtrPtr, *resPtr; + + /* + * Look for an existing scheme with the given name. + */ + prevPtrPtr = &iPtr->resolverPtr; + for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) { + if (*name == *resPtr->name && strcmp(name, resPtr->name) == 0) { + break; + } + prevPtrPtr = &resPtr->nextPtr; + } + + /* + * If we found the scheme, delete it. + */ + if (resPtr) { + /* + * If we're deleting a scheme with compiled variable resolution + * rules, bump the compiler epoch to invalidate compiled code. + * If we're deleting a scheme with command resolution rules, + * bump the cmdRefEpoch in all namespaces. + */ + if (resPtr->compiledVarResProc) { + iPtr->compileEpoch++; + } + if (resPtr->cmdResProc) { + BumpCmdRefEpochs(iPtr->globalNsPtr); + } + + *prevPtrPtr = resPtr->nextPtr; + ckfree(resPtr->name); + ckfree((char *) resPtr); + + return 1; + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * BumpCmdRefEpochs -- + * + * This procedure is used to bump the cmdRefEpoch counters in + * the specified namespace and all of its child namespaces. + * It is used whenever name resolution schemes are added/removed + * from an interpreter, to invalidate all command references. + * + * Results: + * None. + * + * Side effects: + * Bumps the cmdRefEpoch in the specified namespace and its + * children, recursively. + * + *---------------------------------------------------------------------- + */ + +static void +BumpCmdRefEpochs(nsPtr) + Namespace *nsPtr; /* Namespace being modified. */ +{ + Tcl_HashEntry *entry; + Tcl_HashSearch search; + Namespace *childNsPtr; + + nsPtr->cmdRefEpoch++; + + for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search); + entry != NULL; + entry = Tcl_NextHashEntry(&search)) { + + childNsPtr = (Namespace *) Tcl_GetHashValue(entry); + BumpCmdRefEpochs(childNsPtr); + } +} + + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetNamespaceResolvers -- + * + * Sets the command/variable resolution procedures for a namespace, + * thereby changing the way that command/variable names are + * interpreted. This allows extension writers to support different + * name resolution schemes, such as those for object-oriented + * packages. + * + * Command resolution is handled by a procedure of the following + * type: + * + * typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_(( + * Tcl_Interp* interp, char* name, Tcl_Namespace *context, + * int flags, Tcl_Command *rPtr)); + * + * Whenever a command is executed or Tcl_FindCommand is invoked + * within the namespace, this procedure is called to resolve the + * command name. If this procedure is able to resolve the name, + * it should return the status code TCL_OK, along with the + * corresponding Tcl_Command in the rPtr argument. Otherwise, + * the procedure can return TCL_CONTINUE, and the command will + * be treated under the usual name resolution rules. Or, it can + * return TCL_ERROR, and the command will be considered invalid. + * + * Variable resolution is handled by two procedures. The first + * is called whenever a variable needs to be resolved at compile + * time: + * + * typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_(( + * Tcl_Interp* interp, char* name, Tcl_Namespace *context, + * Tcl_ResolvedVarInfo *rPtr)); + * + * If this procedure is able to resolve the name, it should return + * the status code TCL_OK, along with variable resolution info in + * the rPtr argument; this info will be used to set up compiled + * locals in the call frame at runtime. The procedure may also + * return TCL_CONTINUE, and the variable will be treated under + * the usual name resolution rules. Or, it can return TCL_ERROR, + * and the variable will be considered invalid. + * + * Another procedure is used whenever a variable needs to be + * resolved at runtime but it is not recognized as a compiled local. + * (For example, the variable may be requested via + * Tcl_FindNamespaceVar.) This procedure has the following type: + * + * typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_(( + * Tcl_Interp* interp, char* name, Tcl_Namespace *context, + * int flags, Tcl_Var *rPtr)); + * + * This procedure is quite similar to the compile-time version. + * It returns the same status codes, but if variable resolution + * succeeds, this procedure returns a Tcl_Var directly via the + * rPtr argument. + * + * Results: + * Nothing. + * + * Side effects: + * Bumps the command epoch counter for the namespace, invalidating + * all command references in that namespace. Also bumps the + * resolver epoch counter for the namespace, forcing all code + * in the namespace to be recompiled. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc) + Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules + * are being modified. */ + Tcl_ResolveCmdProc *cmdProc; /* Procedure for command resolution */ + Tcl_ResolveVarProc *varProc; /* Procedure for variable resolution + * at runtime */ + Tcl_ResolveCompiledVarProc *compiledVarProc; + /* Procedure for variable resolution + * at compile time. */ +{ + Namespace *nsPtr = (Namespace*)namespacePtr; + + /* + * Plug in the new command resolver, and bump the epoch counters + * so that all code will have to be recompiled and all commands + * will have to be resolved again using the new policy. + */ + nsPtr->cmdResProc = cmdProc; + nsPtr->varResProc = varProc; + nsPtr->compiledVarResProc = compiledVarProc; + + nsPtr->cmdRefEpoch++; + nsPtr->resolverEpoch++; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_GetNamespaceResolvers -- + * + * Returns the current command/variable resolution procedures + * for a namespace. By default, these procedures are NULL. + * New procedures can be installed by calling + * Tcl_SetNamespaceResolvers, to provide new name resolution + * rules. + * + * Results: + * Returns non-zero if any name resolution procedures have been + * assigned to this namespace; also returns pointers to the + * procedures in the Tcl_ResolverInfo structure. Returns zero + * otherwise. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr) + + Tcl_Namespace *namespacePtr; /* Namespace whose resolution rules + * are being modified. */ + Tcl_ResolverInfo *resInfoPtr; /* Returns: pointers for all + * name resolution procedures + * assigned to this namespace. */ +{ + Namespace *nsPtr = (Namespace*)namespacePtr; + + resInfoPtr->cmdResProc = nsPtr->cmdResProc; + resInfoPtr->varResProc = nsPtr->varResProc; + resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc; + + if (nsPtr->cmdResProc != NULL || + nsPtr->varResProc != NULL || + nsPtr->compiledVarResProc != NULL) { + return 1; + } + return 0; +} + +/* End of tclresolve.c */