shared_source/tcl_base/tclresolve.c

/* $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 */
1	dashley	25	/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $ */
2
3			/*
4			* tclResolve.c --
5			*
6			* Contains hooks for customized command/variable name resolution
7			* schemes. These hooks allow extensions like [incr Tcl] to add
8			* their own name resolution rules to the Tcl language. Rules can
9			* be applied to a particular namespace, to the interpreter as a
10			* whole, or both.
11			*
12			* Copyright (c) 1998 Lucent Technologies, Inc.
13			*
14			* See the file "license.terms" for information on usage and redistribution
15			* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16			*
17			* RCS: @(#) $Id: tclresolve.c,v 1.1.1.1 2001/06/13 04:45:45 dtashley Exp $
18			*/
19
20			#include "tclInt.h"
21
22			/*
23			* Declarations for procedures local to this file:
24			*/
25
26			static void BumpCmdRefEpochs _ANSI_ARGS_((Namespace *nsPtr));
27
28
29			/*
30			*----------------------------------------------------------------------
31			*
32			* Tcl_AddInterpResolvers --
33			*
34			* Adds a set of command/variable resolution procedures to an
35			* interpreter. These procedures are consulted when commands
36			* are resolved in Tcl_FindCommand, and when variables are
37			* resolved in TclLookupVar and LookupCompiledLocal. Each
38			* namespace may also have its own set of resolution procedures
39			* which take precedence over those for the interpreter.
40			*
41			* When a name is resolved, it is handled as follows. First,
42			* the name is passed to the resolution procedures for the
43			* namespace. If not resolved, the name is passed to each of
44			* the resolution procedures added to the interpreter. Finally,
45			* if still not resolved, the name is handled using the default
46			* Tcl rules for name resolution.
47			*
48			* Results:
49			* Returns pointers to the current name resolution procedures
50			* in the cmdProcPtr, varProcPtr and compiledVarProcPtr
51			* arguments.
52			*
53			* Side effects:
54			* If a compiledVarProc is specified, this procedure bumps the
55			* compileEpoch for the interpreter, forcing all code to be
56			* recompiled. If a cmdProc is specified, this procedure bumps
57			* the cmdRefEpoch in all namespaces, forcing commands to be
58			* resolved again using the new rules.
59			*
60			*----------------------------------------------------------------------
61			*/
62
63			void
64			Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
65
66			Tcl_Interp interp; / Interpreter whose name resolution
67			* rules are being modified. */
68			char name; / Name of this resolution scheme. */
69			Tcl_ResolveCmdProc cmdProc; / New procedure for command
70			* resolution */
71			Tcl_ResolveVarProc varProc; / Procedure for variable resolution
72			* at runtime */
73			Tcl_ResolveCompiledVarProc *compiledVarProc;
74			/* Procedure for variable resolution
75			* at compile time. */
76			{
77			Interp iPtr = (Interp)interp;
78			ResolverScheme *resPtr;
79
80			/*
81			* Since we're adding a new name resolution scheme, we must force
82			* all code to be recompiled to use the new scheme. If there
83			* are new compiled variable resolution rules, bump the compiler
84			* epoch to invalidate compiled code. If there are new command
85			* resolution rules, bump the cmdRefEpoch in all namespaces.
86			*/
87			if (compiledVarProc) {
88			iPtr->compileEpoch++;
89			}
90			if (cmdProc) {
91			BumpCmdRefEpochs(iPtr->globalNsPtr);
92			}
93
94			/*
95			* Look for an existing scheme with the given name. If found,
96			* then replace its rules.
97			*/
98			for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
99			if (name == resPtr->name && strcmp(name, resPtr->name) == 0) {
100			resPtr->cmdResProc = cmdProc;
101			resPtr->varResProc = varProc;
102			resPtr->compiledVarResProc = compiledVarProc;
103			return;
104			}
105			}
106
107			/*
108			* Otherwise, this is a new scheme. Add it to the FRONT
109			* of the linked list, so that it overrides existing schemes.
110			*/
111			resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
112			resPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
113			strcpy(resPtr->name, name);
114			resPtr->cmdResProc = cmdProc;
115			resPtr->varResProc = varProc;
116			resPtr->compiledVarResProc = compiledVarProc;
117			resPtr->nextPtr = iPtr->resolverPtr;
118			iPtr->resolverPtr = resPtr;
119			}
120
121			/*
122			*----------------------------------------------------------------------
123			*
124			* Tcl_GetInterpResolvers --
125			*
126			* Looks for a set of command/variable resolution procedures with
127			* the given name in an interpreter. These procedures are
128			* registered by calling Tcl_AddInterpResolvers.
129			*
130			* Results:
131			* If the name is recognized, this procedure returns non-zero,
132			* along with pointers to the name resolution procedures in
133			* the Tcl_ResolverInfo structure. If the name is not recognized,
134			* this procedure returns zero.
135			*
136			* Side effects:
137			* None.
138			*
139			*----------------------------------------------------------------------
140			*/
141
142			int
143			Tcl_GetInterpResolvers(interp, name, resInfoPtr)
144
145			Tcl_Interp interp; / Interpreter whose name resolution
146			* rules are being queried. */
147			char name; / Look for a scheme with this name. */
148			Tcl_ResolverInfo resInfoPtr; / Returns pointers to the procedures,
149			* if found */
150			{
151			Interp iPtr = (Interp)interp;
152			ResolverScheme *resPtr;
153
154			/*
155			* Look for an existing scheme with the given name. If found,
156			* then return pointers to its procedures.
157			*/
158			for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
159			if (name == resPtr->name && strcmp(name, resPtr->name) == 0) {
160			resInfoPtr->cmdResProc = resPtr->cmdResProc;
161			resInfoPtr->varResProc = resPtr->varResProc;
162			resInfoPtr->compiledVarResProc = resPtr->compiledVarResProc;
163			return 1;
164			}
165			}
166
167			return 0;
168			}
169
170			/*
171			*----------------------------------------------------------------------
172			*
173			* Tcl_RemoveInterpResolvers --
174			*
175			* Removes a set of command/variable resolution procedures
176			* previously added by Tcl_AddInterpResolvers. The next time
177			* a command/variable name is resolved, these procedures
178			* won't be consulted.
179			*
180			* Results:
181			* Returns non-zero if the name was recognized and the
182			* resolution scheme was deleted. Returns zero otherwise.
183			*
184			* Side effects:
185			* If a scheme with a compiledVarProc was deleted, this procedure
186			* bumps the compileEpoch for the interpreter, forcing all code
187			* to be recompiled. If a scheme with a cmdProc was deleted,
188			* this procedure bumps the cmdRefEpoch in all namespaces,
189			* forcing commands to be resolved again using the new rules.
190			*
191			*----------------------------------------------------------------------
192			*/
193
194			int
195			Tcl_RemoveInterpResolvers(interp, name)
196
197			Tcl_Interp interp; / Interpreter whose name resolution
198			* rules are being modified. */
199			char name; / Name of the scheme to be removed. */
200			{
201			Interp iPtr = (Interp)interp;
202			ResolverScheme *prevPtrPtr, resPtr;
203
204			/*
205			* Look for an existing scheme with the given name.
206			*/
207			prevPtrPtr = &iPtr->resolverPtr;
208			for (resPtr = iPtr->resolverPtr; resPtr != NULL; resPtr = resPtr->nextPtr) {
209			if (name == resPtr->name && strcmp(name, resPtr->name) == 0) {
210			break;
211			}
212			prevPtrPtr = &resPtr->nextPtr;
213			}
214
215			/*
216			* If we found the scheme, delete it.
217			*/
218			if (resPtr) {
219			/*
220			* If we're deleting a scheme with compiled variable resolution
221			* rules, bump the compiler epoch to invalidate compiled code.
222			* If we're deleting a scheme with command resolution rules,
223			* bump the cmdRefEpoch in all namespaces.
224			*/
225			if (resPtr->compiledVarResProc) {
226			iPtr->compileEpoch++;
227			}
228			if (resPtr->cmdResProc) {
229			BumpCmdRefEpochs(iPtr->globalNsPtr);
230			}
231
232			*prevPtrPtr = resPtr->nextPtr;
233			ckfree(resPtr->name);
234			ckfree((char *) resPtr);
235
236			return 1;
237			}
238			return 0;
239			}
240
241			/*
242			*----------------------------------------------------------------------
243			*
244			* BumpCmdRefEpochs --
245			*
246			* This procedure is used to bump the cmdRefEpoch counters in
247			* the specified namespace and all of its child namespaces.
248			* It is used whenever name resolution schemes are added/removed
249			* from an interpreter, to invalidate all command references.
250			*
251			* Results:
252			* None.
253			*
254			* Side effects:
255			* Bumps the cmdRefEpoch in the specified namespace and its
256			* children, recursively.
257			*
258			*----------------------------------------------------------------------
259			*/
260
261			static void
262			BumpCmdRefEpochs(nsPtr)
263			Namespace nsPtr; / Namespace being modified. */
264			{
265			Tcl_HashEntry *entry;
266			Tcl_HashSearch search;
267			Namespace *childNsPtr;
268
269			nsPtr->cmdRefEpoch++;
270
271			for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
272			entry != NULL;
273			entry = Tcl_NextHashEntry(&search)) {
274
275			childNsPtr = (Namespace *) Tcl_GetHashValue(entry);
276			BumpCmdRefEpochs(childNsPtr);
277			}
278			}
279
280
281			/*
282			*----------------------------------------------------------------------
283			*
284			* Tcl_SetNamespaceResolvers --
285			*
286			* Sets the command/variable resolution procedures for a namespace,
287			* thereby changing the way that command/variable names are
288			* interpreted. This allows extension writers to support different
289			* name resolution schemes, such as those for object-oriented
290			* packages.
291			*
292			* Command resolution is handled by a procedure of the following
293			* type:
294			*
295			* typedef int (Tcl_ResolveCmdProc) _ANSI_ARGS_((
296			* Tcl_Interp* interp, char* name, Tcl_Namespace *context,
297			* int flags, Tcl_Command *rPtr));
298			*
299			* Whenever a command is executed or Tcl_FindCommand is invoked
300			* within the namespace, this procedure is called to resolve the
301			* command name. If this procedure is able to resolve the name,
302			* it should return the status code TCL_OK, along with the
303			* corresponding Tcl_Command in the rPtr argument. Otherwise,
304			* the procedure can return TCL_CONTINUE, and the command will
305			* be treated under the usual name resolution rules. Or, it can
306			* return TCL_ERROR, and the command will be considered invalid.
307			*
308			* Variable resolution is handled by two procedures. The first
309			* is called whenever a variable needs to be resolved at compile
310			* time:
311			*
312			* typedef int (Tcl_ResolveCompiledVarProc) _ANSI_ARGS_((
313			* Tcl_Interp* interp, char* name, Tcl_Namespace *context,
314			* Tcl_ResolvedVarInfo *rPtr));
315			*
316			* If this procedure is able to resolve the name, it should return
317			* the status code TCL_OK, along with variable resolution info in
318			* the rPtr argument; this info will be used to set up compiled
319			* locals in the call frame at runtime. The procedure may also
320			* return TCL_CONTINUE, and the variable will be treated under
321			* the usual name resolution rules. Or, it can return TCL_ERROR,
322			* and the variable will be considered invalid.
323			*
324			* Another procedure is used whenever a variable needs to be
325			* resolved at runtime but it is not recognized as a compiled local.
326			* (For example, the variable may be requested via
327			* Tcl_FindNamespaceVar.) This procedure has the following type:
328			*
329			* typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_((
330			* Tcl_Interp* interp, char* name, Tcl_Namespace *context,
331			* int flags, Tcl_Var *rPtr));
332			*
333			* This procedure is quite similar to the compile-time version.
334			* It returns the same status codes, but if variable resolution
335			* succeeds, this procedure returns a Tcl_Var directly via the
336			* rPtr argument.
337			*
338			* Results:
339			* Nothing.
340			*
341			* Side effects:
342			* Bumps the command epoch counter for the namespace, invalidating
343			* all command references in that namespace. Also bumps the
344			* resolver epoch counter for the namespace, forcing all code
345			* in the namespace to be recompiled.
346			*
347			*----------------------------------------------------------------------
348			*/
349
350			void
351			Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
352			Tcl_Namespace namespacePtr; / Namespace whose resolution rules
353			* are being modified. */
354			Tcl_ResolveCmdProc cmdProc; / Procedure for command resolution */
355			Tcl_ResolveVarProc varProc; / Procedure for variable resolution
356			* at runtime */
357			Tcl_ResolveCompiledVarProc *compiledVarProc;
358			/* Procedure for variable resolution
359			* at compile time. */
360			{
361			Namespace nsPtr = (Namespace)namespacePtr;
362
363			/*
364			* Plug in the new command resolver, and bump the epoch counters
365			* so that all code will have to be recompiled and all commands
366			* will have to be resolved again using the new policy.
367			*/
368			nsPtr->cmdResProc = cmdProc;
369			nsPtr->varResProc = varProc;
370			nsPtr->compiledVarResProc = compiledVarProc;
371
372			nsPtr->cmdRefEpoch++;
373			nsPtr->resolverEpoch++;
374			}
375
376			/*
377			*----------------------------------------------------------------------
378			*
379			* Tcl_GetNamespaceResolvers --
380			*
381			* Returns the current command/variable resolution procedures
382			* for a namespace. By default, these procedures are NULL.
383			* New procedures can be installed by calling
384			* Tcl_SetNamespaceResolvers, to provide new name resolution
385			* rules.
386			*
387			* Results:
388			* Returns non-zero if any name resolution procedures have been
389			* assigned to this namespace; also returns pointers to the
390			* procedures in the Tcl_ResolverInfo structure. Returns zero
391			* otherwise.
392			*
393			* Side effects:
394			* None.
395			*
396			*----------------------------------------------------------------------
397			*/
398
399			int
400			Tcl_GetNamespaceResolvers(namespacePtr, resInfoPtr)
401
402			Tcl_Namespace namespacePtr; / Namespace whose resolution rules
403			* are being modified. */
404			Tcl_ResolverInfo resInfoPtr; / Returns: pointers for all
405			* name resolution procedures
406			* assigned to this namespace. */
407			{
408			Namespace nsPtr = (Namespace)namespacePtr;
409
410			resInfoPtr->cmdResProc = nsPtr->cmdResProc;
411			resInfoPtr->varResProc = nsPtr->varResProc;
412			resInfoPtr->compiledVarResProc = nsPtr->compiledVarResProc;
413
414			if (nsPtr->cmdResProc != NULL \|\|
415			nsPtr->varResProc != NULL \|\|
416			nsPtr->compiledVarResProc != NULL) {
417			return 1;
418			}
419			return 0;
420			}
421
422
423			/* $History: tclresolve.c $
424			*
425			* *************** Version 1 ***************
426			* User: Dtashley Date: 1/02/01 Time: 1:04a
427			* Created in $/IjuScripter, IjuConsole/Source/Tcl Base
428			* Initial check-in.
429			*/
430
431			/* End of TCLRESOLVE.C */