Tk Source Code

Check-in [acaae00e]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Tk_InitStubs("8.6",1) would succeed in an "8.60" interp. Fixed. No longer use Tcl_SetResult() for setting the error message, but Tcl_ResetResult/Tcl_AppendResult, as all other stub libraries do. This will allow us to remove Tcl_SetResult() in Tcl 9.0, eventually
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: acaae00e8d287a67797ec2b2345303841655f246
User & Date: jan.nijtmans 2013-01-04 13:42:27
Context
2013-01-04
13:43
merge-mark check-in: d6c9479c user: jan.nijtmans tags: trunk
13:42
Tk_InitStubs("8.6",1) would succeed in an "8.60" interp. Fixed. No longer use Tcl_SetResult() for setting the error message, but Tcl_ResetResult/Tcl_AppendResult, as all other stub libraries do. This will allow us to remove Tcl_SetResult() in Tcl 9.0, eventually check-in: acaae00e user: jan.nijtmans tags: trunk
2012-12-21
06:10
merge release check-in: 8c48e231 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkStubLib.c. 

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

/*
 * tkStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that wish
 *	to access Tk.
 *
 * Copyright (c) 1998 Paul Duffin.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * We need to ensure that we use the stub macros so that this file contains no
 * references to any of the stub functions. This will make it possible to
 * build an extension that references Tk_InitStubs but doesn't end up
 * including the rest of the stub functions.
 */

#undef USE_TCL_STUBS
#define USE_TCL_STUBS

#define USE_TK_STUBS

#include "tkInt.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#ifdef MAC_OSX_TK




|


|
|





<
<
<
<
<
<
<
<
<
<
<
<








1
2
3
4
5
6
7
8
9
10
11
12
13












14
15
16
17
18
19
20

/*
 * tkStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */













#include "tkInt.h"

#ifdef __WIN32__
#include "tkWinInt.h"
#endif

#ifdef MAC_OSX_TK
︙︙
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69

const TkIntXlibStubs *tkIntXlibStubsPtr = NULL;

/*
 * Use our own isdigit to avoid linking to libc on windows
 */

static int
isDigit(
    const int c)
{
    return (c >= '0' && c <= '9');
}

/*
 *----------------------------------------------------------------------
 *








|
<








42
43
44
45
46
47
48
49

50
51
52
53
54
55
56

const TkIntXlibStubs *tkIntXlibStubsPtr = NULL;

/*
 * Use our own isdigit to avoid linking to libc on windows
 */

static int
isDigit(const int c)

{
    return (c >= '0' && c <= '9');
}

/*
 *----------------------------------------------------------------------
 *
︙︙
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
121
122
123
124
125
126
127
128
129
130
131

132
133
134
135


136


137
138






139
140
141
142
143
144
145
146
147

 *	indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */

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;






}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */








|






>
>
|
|
|
|

|


>

|
|

|
|
|
|






|

|
|
|
|
>
|
|
|
|
|

<
|
|
<
<
|
|
>
|
|
|
|
>
>
|
>
>
|
|
>
>
>
>
>
>










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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146

 *	indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */
#undef Tk_InitStubs
MODULE_SCOPE const char *
Tk_InitStubs(
    Tcl_Interp *interp,
    const char *version,
    int exact)
{
    const char *packageName = "Tk";
    const char *errMsg = NULL;
    ClientData clientData = NULL;
    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
	    packageName, version, 0, &clientData);
    const TkStubs *stubsPtr = clientData;

    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 || isDigit(*q)) {
		/* Construct error message */
		tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, 1, NULL);
		return NULL;
	    }
	} else {
	    actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, packageName,
		    version, 1, NULL);
	    if (actualVersion == NULL) {
		return NULL;
	    }
	}
    }

    if (stubsPtr == NULL) {
	errMsg = "missing stub table pointer";


    } else {
	tkStubsPtr = stubsPtr;
	if (stubsPtr->hooks) {
	    tkPlatStubsPtr = stubsPtr->hooks->tkPlatStubs;
	    tkIntStubsPtr = stubsPtr->hooks->tkIntStubs;
	    tkIntPlatStubsPtr = stubsPtr->hooks->tkIntPlatStubs;
	    tkIntXlibStubsPtr = stubsPtr->hooks->tkIntXlibStubs;
	} else {
	    tkPlatStubsPtr = NULL;
	    tkIntStubsPtr = NULL;
	    tkIntPlatStubsPtr = NULL;
	    tkIntXlibStubsPtr = NULL;
	}
	return actualVersion;
    }
    tclStubsPtr->tcl_ResetResult(interp);
    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
	    " (requested version ", version, ", actual version ",
	    actualVersion, "): ", errMsg, NULL);
    return NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

This page was generated in about 0.013s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19