/[dtapublic]/projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclresolve.c
ViewVC logotype

Diff of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclresolve.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.66  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25