1/* 2 * tkStubLib.c -- 3 * 4 * Stub object that will be statically linked into extensions that wish 5 * to access Tk. 6 * 7 * Copyright (c) 1998 Paul Duffin. 8 * Copyright (c) 1998-1999 by Scriptics Corporation. 9 * 10 * See the file "license.terms" for information on usage and redistribution of 11 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 * 13 * RCS: @(#) $Id$ 14 */ 15 16/* 17 * We need to ensure that we use the stub macros so that this file contains no 18 * references to any of the stub functions. This will make it possible to 19 * build an extension that references Tk_InitStubs but doesn't end up 20 * including the rest of the stub functions. 21 */ 22 23#ifndef USE_TCL_STUBS 24#define USE_TCL_STUBS 25#endif 26#undef USE_TCL_STUB_PROCS 27 28#ifndef USE_TK_STUBS 29#define USE_TK_STUBS 30#endif 31#undef USE_TK_STUB_PROCS 32 33#include "tkInt.h" 34 35#ifdef __WIN32__ 36#include "tkWinInt.h" 37#endif 38 39#ifdef MAC_OSX_TK 40#include "tkMacOSXInt.h" 41#endif 42 43#if !(defined(__WIN32__) || defined(MAC_OSX_TK)) 44#include "tkUnixInt.h" 45#endif 46 47/* TODO: These ought to come in some other way */ 48#include "tkPlatDecls.h" 49#include "tkIntXlibDecls.h" 50 51TkStubs *tkStubsPtr = NULL; 52TkPlatStubs *tkPlatStubsPtr = NULL; 53TkIntStubs *tkIntStubsPtr = NULL; 54TkIntPlatStubs *tkIntPlatStubsPtr = NULL; 55TkIntXlibStubs *tkIntXlibStubsPtr = NULL; 56 57/* 58 * Use our own isdigit to avoid linking to libc on windows 59 */ 60 61static int isDigit(const int c) 62{ 63 return (c >= '0' && c <= '9'); 64} 65 66/* 67 *---------------------------------------------------------------------- 68 * 69 * Tk_InitStubs -- 70 * 71 * Checks that the correct version of Tk is loaded and that it supports 72 * stubs. It then initialises the stub table pointers. 73 * 74 * Results: 75 * The actual version of Tk that satisfies the request, or NULL to 76 * indicate that an error occurred. 77 * 78 * Side effects: 79 * Sets the stub table pointers. 80 * 81 *---------------------------------------------------------------------- 82 */ 83 84#ifdef Tk_InitStubs 85#undef Tk_InitStubs 86#endif 87 88CONST char * 89Tk_InitStubs( 90 Tcl_Interp *interp, 91 CONST char *version, 92 int exact) 93{ 94 CONST char *actualVersion; 95 TkStubs **stubsPtrPtr = &tkStubsPtr; /* squelch warning */ 96 97 actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0, 98 (ClientData *) stubsPtrPtr); 99 if (!actualVersion) { 100 return NULL; 101 } 102 if (exact) { 103 CONST char *p = version; 104 int count = 0; 105 106 while (*p) { 107 count += !isDigit(*p++); 108 } 109 if (count == 1) { 110 CONST char *q = actualVersion; 111 112 p = version; 113 while (*p && (*p == *q)) { 114 p++; q++; 115 } 116 if (*p) { 117 /* Construct error message */ 118 Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL); 119 return NULL; 120 121 } 122 } else { 123 actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL); 124 if (actualVersion == NULL) { 125 return NULL; 126 } 127 } 128 } 129 130 if (!tkStubsPtr) { 131 Tcl_SetResult(interp, 132 "This implementation of Tk does not support stubs", 133 TCL_STATIC); 134 return NULL; 135 } 136 137 tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs; 138 tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs; 139 tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs; 140 tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs; 141 142 return actualVersion; 143} 144 145/* 146 * Local Variables: 147 * mode: c 148 * c-basic-offset: 4 149 * fill-column: 78 150 * End: 151 */ 152