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