/* * 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. */ #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. */ CONST 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. */ CONST 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. */ CONST 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, CONST 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, CONST 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, CONST 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; } c Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
path: root/generic/tclPlatDecls.h
blob: e9b92fe6797bc9c10468d139c3882646d107e50f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
/*
 * tclPlatDecls.h --
 *
 *	Declarations of platform specific Tcl APIs.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * All rights reserved.
 */

#ifndef _TCLPLATDECLS
#define _TCLPLATDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tcl.decls script.
 */

/*
 * TCHAR is needed here for win32, so if it is not defined yet do it here.
 * This way, we don't need to include <tchar.h> just for one define.
 */
#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED)
#   if defined(_UNICODE)
	typedef wchar_t TCHAR;
#   else
	typedef char TCHAR;
#   endif
#   define _TCHAR_DEFINED
#endif

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
/* 0 */
EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
				Tcl_DString *dsPtr);
/* 1 */
EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
				Tcl_DString *dsPtr);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				const char *bundleName, int hasResourceFile,
				int maxPathLen, char *libraryPath);
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, int maxPathLen,
				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    void *hooks;

#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
    TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
    char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
#endif /* MACOSX */
} TclPlatStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclPlatStubs *tclPlatStubsPtr;
#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#define Tcl_WinUtfToTChar \
	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define Tcl_MacOSXOpenBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLPLATDECLS */