MODULE_SCOPE const char *
Tk_InitStubs(
Tcl_Interp *interp,
const char *version,
int exact)
{
ClientData pkgClientData = NULL;
const char *actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0,
&pkgClientData);
const TkStubs *stubsPtr = pkgClientData;
if (!actualVersion) {
return NULL;
}
if (exact) {
const char *p = version;
int count = 0;
while (*p) {
count += !isDigit(*p++);
}
if (count == 1) {
const char *q = actualVersion;
p = version;
while (*p && (*p == *q)) {
p++; q++;
}
if (*p) {
/* Construct error message */
Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL);
return NULL;
}
} else {
actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL);
if (actualVersion == NULL) {
return NULL;
}
}
}
if (!stubsPtr) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"this implementation of Tk does not support stubs", -1));
return NULL;
}
tkPlatStubsPtr = stubsPtr->hooks->tkPlatStubs;
tkIntStubsPtr = stubsPtr->hooks->tkIntStubs;
tkIntPlatStubsPtr = stubsPtr->hooks->tkIntPlatStubs;
tkIntXlibStubsPtr = stubsPtr->hooks->tkIntXlibStubs;
tkStubsPtr = stubsPtr;
return actualVersion;
}
MODULE_SCOPE const char *
Tk_InitStubs(
Tcl_Interp *interp,
const char *version,
int exact)
{
const char *actualVersion;
const TkStubs **stubsPtrPtr = &tkStubsPtr; /* squelch warning */
actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0,
(ClientData *) stubsPtrPtr);
if (!actualVersion) {
return NULL;
}
if (exact) {
const char *p = version;
int count = 0;
while (*p) {
count += !isDigit(*p++);
}
if (count == 1) {
const char *q = actualVersion;
p = version;
while (*p && (*p == *q)) {
p++; q++;
}
if (*p) {
/* Construct error message */
Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL);
return NULL;
}
} else {
actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL);
if (actualVersion == NULL) {
return NULL;
}
}
}
if (!tkStubsPtr) {
Tcl_SetResult(interp,
"This implementation of Tk does not support stubs",
TCL_STATIC);
return NULL;
}
tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs;
tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs;
tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs;
tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs;
return actualVersion;
}
CONST char*
TclTomMathInitializeStubs(
Tcl_Interp* interp, /* Tcl interpreter */
CONST char* version, /* Tcl version needed */
int epoch, /* Stubs table epoch from the header files */
int revision /* Stubs table revision number from the
* header files */
) {
int exact = 0;
const char* packageName = "tcl::tommath";
const char* errMsg = NULL;
ClientData pkgClientData = NULL;
const char* actualVersion =
Tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
TclTomMathStubs* stubsPtr = (TclTomMathStubs*) pkgClientData;
if (actualVersion == NULL) {
return NULL;
}
if (pkgClientData == NULL) {
errMsg = "missing stub table pointer";
} else if ((stubsPtr->tclBN_epoch)() != epoch) {
errMsg = "epoch number mismatch";
} else if ((stubsPtr->tclBN_revision)() != revision) {
errMsg = "requires a later revision";
} else {
tclTomMathStubsPtr = stubsPtr;
return actualVersion;
}
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "error loading ", packageName,
" (requested version ", version,
", actual version ", actualVersion,
"): ", errMsg, NULL);
return NULL;
}
CONST char *
Tdom_InitStubs (
Tcl_Interp *interp,
char *version,
int exact
)
{
CONST char *actualVersion;
ClientData clientData = NULL;
#if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 0)
Tcl_SetResult(interp, "Too old Tcl version. Binary extensions "
"to tDOM are not possible, with a that outdated "
"Tcl version.", TCL_STATIC);
return NULL;
#else
actualVersion = Tcl_PkgRequireEx(interp, "tdom", version, exact,
(ClientData*) &clientData);
tdomStubsPtr = (TdomStubs*)clientData;
if (!actualVersion) {
return NULL;
}
if (!tdomStubsPtr) {
Tcl_SetResult(interp, "This implementation of Tdom does not "
"support stubs", TCL_STATIC);
return NULL;
}
return actualVersion;
#endif
}
const char*
TdbcInitializeStubs(
Tcl_Interp* interp, /* Tcl interpreter */
const char* version, /* Version of TDBC requested */
int epoch, /* Epoch number of the Stubs table */
int revision /* Revision number within the epoch */
) {
const int exact = 0; /* Set this to 1 to require exact version */
const char* packageName = "tdbc";
/* Name of the package */
const char* errorMsg = NULL;
/* Error message if an error occurs */
ClientData clientData = NULL;
/* Client data for the package */
const char* actualVersion; /* Actual version of the package */
const TdbcStubs* stubsPtr; /* Stubs table for the public API */
/* Load the package */
actualVersion =
Tcl_PkgRequireEx(interp, packageName, version, exact, &clientData);
if (clientData == NULL) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Error loading ", packageName, " package: "
"package not present, incomplete or misconfigured.",
(char*) NULL);
return NULL;
}
/* Test that all version information matches the request */
if (actualVersion == NULL) {
return NULL;
} else {
stubsPtr = (const TdbcStubs*) clientData;
if (stubsPtr->epoch != epoch) {
errorMsg = "mismatched epoch number";
} else if (stubsPtr->revision < revision) {
errorMsg = "Stubs table provides too early a revision";
} else {
/* Everything is ok. Return the package information */
tdbcStubsPtr = stubsPtr;
return actualVersion;
}
}
/* Try to explain what went wrong when a mismatched version is found. */
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Error loading ", packageName, " package "
"(requested version \"", version, "\", loaded version \"",
actualVersion, "\"): ", errorMsg, (char*) NULL);
return NULL;
}
static int
MyInitTkStubs (Tcl_Interp *ip)
{
if (Tcl_PkgRequireEx(ip, "Tk", "8.1", 0, (ClientData*) &tkStubsPtr) == NULL) return 0;
if (tkStubsPtr == NULL || tkStubsPtr->hooks == NULL) {
Tcl_SetResult(ip, "This extension requires Tk stubs-support.", TCL_STATIC);
return 0;
}
tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs;
tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs;
tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs;
tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs;
return 1;
}
CONST char *
Itk_InitStubs (
Tcl_Interp *interp,
const char *version,
int exact)
{
CONST char *actualVersion;
actualVersion = Tcl_PkgRequireEx(interp, "itk", (const char *)version,
exact, (ClientData *) &itkStubsPtr);
if (actualVersion == NULL) {
itkStubsPtr = NULL;
return NULL;
}
return actualVersion;
}
MODULE_SCOPE const char *
Zlibtcl_InitStubs(
Tcl_Interp *interp,
const char *version,
int exact
) {
const char *result;
void *data;
result = Tcl_PkgRequireEx(interp, PACKAGE_NAME, (CONST84 char *) version, exact, &data);
if (!result || !data) {
return NULL;
}
zlibtclStubsPtr = data;
return result;
}
MODULE_SCOPE const char *
TclOOInitializeStubs(
Tcl_Interp *interp, const char *version)
{
int exact = 0;
const char *packageName = "TclOO";
const char *errMsg = NULL;
ClientData clientData = NULL;
const char *actualVersion =
Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData);
if (clientData == NULL) {
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"error loading %s package; package not present or incomplete",
packageName));
return NULL;
} else {
const TclOOStubs * const stubsPtr = clientData;
const TclOOIntStubs * const intStubsPtr = stubsPtr->hooks ?
stubsPtr->hooks->tclOOIntStubs : NULL;
if (!actualVersion) {
return NULL;
}
if (!stubsPtr || !intStubsPtr) {
errMsg = "missing stub table pointer";
goto error;
}
tclOOStubsPtr = stubsPtr;
tclOOIntStubsPtr = intStubsPtr;
return actualVersion;
error:
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package"
" (requested version '%s', loaded version '%s'): %s",
packageName, version, actualVersion, errMsg));
return NULL;
}
}
const char *
Itcl_InitStubs(
Tcl_Interp *interp,
const char *version,
int exact)
{
const char *packageName = "itcl";
const char *errMsg = NULL;
ClientData clientData = NULL;
const ItclStubs *stubsPtr;
const ItclIntStubs *intStubsPtr;
const char *actualVersion;
const struct ItclStubAPI *stubsAPIPtr;
actualVersion =
Tcl_PkgRequireEx(interp, packageName, version, exact, &clientData);
stubsAPIPtr = clientData;
if ((actualVersion == NULL) || (clientData == NULL)) {
return NULL;
}
stubsPtr = (const ItclStubs *) clientData;
if (stubsPtr->magic == TCL_STUB_MAGIC) {
errMsg = "incompatible stub table pointer";
goto error;
}
stubsPtr = stubsAPIPtr->stubsPtr;
intStubsPtr = stubsAPIPtr->intStubsPtr;
if (!stubsPtr || !intStubsPtr) {
errMsg = "missing stub table pointer";
goto error;
}
itclStubsPtr = stubsPtr;
itclIntStubsPtr = intStubsPtr;
return actualVersion;
error:
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Error loading ", packageName, " package",
" (requested version '", version, "', loaded version '",
actualVersion, "'): ", errMsg, NULL);
return NULL;
}
/*
*----------------------------------------------------------------------
*
* TtkInitializeStubs --
* Load the Ttk package, initialize stub table pointer.
* Do not call this function directly, use Ttk_InitStubs() 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.
*
*/
MODULE_SCOPE const char *
TtkInitializeStubs(
Tcl_Interp *interp, const char *version, int epoch, int revision)
{
int exact = 0;
const char *packageName = "Ttk";
const char *errMsg = NULL;
ClientData pkgClientData = NULL;
const char *actualVersion = Tcl_PkgRequireEx(
interp, packageName, version, exact, &pkgClientData);
const TtkStubs *stubsPtr = pkgClientData;
if (!actualVersion) {
return NULL;
}
if (!stubsPtr) {
errMsg = "missing stub table pointer";
goto error;
}
if (stubsPtr->epoch != epoch) {
errMsg = "epoch number mismatch";
goto error;
}
if (stubsPtr->revision < revision) {
errMsg = "require later revision";
goto error;
}
ttkStubsPtr = stubsPtr;
return actualVersion;
error:
Tcl_ResetResult(interp);
Tcl_AppendResult(interp,
"Error loading ", packageName, " package",
" (requested version '", version,
"', loaded version '", actualVersion, "'): ",
errMsg,
NULL);
return NULL;
}
const char *
Togl_InitStubs(Tcl_Interp *interp, const char *version, int exact)
{
const char *actualVersion;
actualVersion = Tcl_PkgRequireEx(interp, "Togl", version, exact,
(ClientData *) &toglStubsPtr);
if (!actualVersion) {
return NULL;
}
if (!toglStubsPtr) {
Tcl_SetResult(interp,
"This implementation of Togl does not support stubs",
TCL_STATIC);
return NULL;
}
return actualVersion;
}
CONST char *
Tcl_InitStubs(
Tcl_Interp *interp,
CONST char *version,
int exact)
{
CONST char *actualVersion = NULL;
ClientData pkgData = NULL;
/*
* We can't optimize this check by caching tclStubsPtr because that
* prevents apps from being able to load/unload Tcl dynamically multiple
* times. [Bug 615304]
*/
tclStubsPtr = HasStubSupport(interp);
if (!tclStubsPtr) {
return NULL;
}
actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
if (actualVersion == NULL) {
return NULL;
}
if (exact) {
CONST char *p = version;
int count = 0;
while (*p) {
count += !isDigit(*p++);
}
if (count == 1) {
CONST char *q = actualVersion;
p = version;
while (*p && (*p == *q)) {
p++; q++;
}
if (*p) {
/* Construct error message */
Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
return NULL;
}
} else {
actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
if (actualVersion == NULL) {
return NULL;
}
}
}
tclStubsPtr = (TclStubs*)pkgData;
if (tclStubsPtr->hooks) {
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
} else {
tclPlatStubsPtr = NULL;
tclIntStubsPtr = NULL;
tclIntPlatStubsPtr = NULL;
}
return actualVersion;
}
