diff options
author | dkf <dkf@noemail.net> | 2008-05-31 11:41:58 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2008-05-31 11:41:58 (GMT) |
commit | 2083cf32792cd39cc92d5b5e60e0ef76389dfce0 (patch) | |
tree | b68d9c4cbdbd0775c0419a152b70758bde998ca0 /generic/tclOOStubLib.c | |
parent | 46b841df19dfc6e42f8be903e025ba9636b58585 (diff) | |
download | tcl-2083cf32792cd39cc92d5b5e60e0ef76389dfce0.zip tcl-2083cf32792cd39cc92d5b5e60e0ef76389dfce0.tar.gz tcl-2083cf32792cd39cc92d5b5e60e0ef76389dfce0.tar.bz2 |
Implementation of TIP #257. Incomplete due to missing Win build support.
FossilOrigin-Name: e46e1575d392981d674e659a6c6649dc51ecf5dc
Diffstat (limited to 'generic/tclOOStubLib.c')
-rw-r--r-- | generic/tclOOStubLib.c | 82 |
1 files changed, 82 insertions, 0 deletions
diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c new file mode 100644 index 0000000..6988638 --- /dev/null +++ b/generic/tclOOStubLib.c @@ -0,0 +1,82 @@ +/* + * $Id: tclOOStubLib.c,v 1.1 2008/05/31 11:42:19 dkf Exp $ + * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17 + */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "tcl.h" + +#define USE_TCLOO_STUBS 1 +#include "tclOO.h" +#include "tclOOInt.h" + +const TclOOStubs *tclOOStubsPtr; +const TclOOIntStubs *tclOOIntStubsPtr; + +/* + *---------------------------------------------------------------------- + * + * TclOOInitializeStubs -- + * Load the tclOO package, initialize stub table pointer. Do not call + * this function directly, use Tcl_OOInitStubs() macro instead. + * + * Results: + * The actual version of the package that satisfies the request, or NULL + * to indicate that an error occurred. + * + * Side effects: + * Sets the stub table pointer. + * + */ + +const char *TclOOInitializeStubs( + Tcl_Interp *interp, const char *version, int epoch, int revision) +{ + int exact = 0; + const char *packageName = "TclOO"; + const char *errMsg = NULL; + ClientData clientData = NULL; + const char *actualVersion = + Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData); + struct TclOOStubAPI *stubsAPIPtr = clientData; + + if (stubsAPIPtr == NULL) { + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "Error loading ", packageName, " package; ", + "package not present or incomplete", NULL); + return NULL; + } else { + TclOOStubs *stubsPtr = stubsAPIPtr->stubsPtr; + TclOOIntStubs *intStubsPtr = stubsAPIPtr->intStubsPtr; + + if (!actualVersion) { + return NULL; + } + + if (!stubsPtr || !intStubsPtr) { + errMsg = "missing stub table pointer"; + goto error; + } + if (stubsPtr->epoch != epoch || intStubsPtr->epoch != epoch) { + errMsg = "epoch number mismatch"; + goto error; + } + if (stubsPtr->revision<revision || intStubsPtr->revision<revision) { + errMsg = "require later revision"; + goto error; + } + + tclOOStubsPtr = stubsPtr; + tclOOIntStubsPtr = intStubsPtr; + return actualVersion; + + error: + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "Error loading ", packageName, " package", + " (requested version '", version, "', loaded version '", + actualVersion, "'): ", errMsg, NULL); + return NULL; + } +} |