summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tk.h6
-rw-r--r--generic/tkConsole.c4
-rw-r--r--generic/tkMain.c4
-rw-r--r--generic/tkStubLib.c22
-rw-r--r--generic/tkWindow.c50
5 files changed, 75 insertions, 11 deletions
diff --git a/generic/tk.h b/generic/tk.h
index b75f136..3139d2d 100644
--- a/generic/tk.h
+++ b/generic/tk.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tk.h,v 1.99 2007/05/30 17:39:24 dgp Exp $
+ * RCS: @(#) $Id: tk.h,v 1.100 2007/09/17 14:58:04 dgp Exp $
*/
#ifndef _TK
@@ -1486,11 +1486,13 @@ typedef struct Tk_ElementSpec {
const char * Tk_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
const char *version, int exact));
+const char * Tk_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
+ const char *version, int exact));
#ifndef USE_TK_STUBS
#define Tk_InitStubs(interp, version, exact) \
- Tcl_PkgRequire(interp, "Tk", version, exact)
+ Tk_PkgInitStubsCheck(interp, version, exact)
#endif
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
index f5969ee..94ee6cb 100644
--- a/generic/tkConsole.c
+++ b/generic/tkConsole.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkConsole.c,v 1.33 2007/09/11 17:46:41 dgp Exp $
+ * RCS: @(#) $Id: tkConsole.c,v 1.34 2007/09/17 14:58:04 dgp Exp $
*/
#include "tk.h"
@@ -233,7 +233,7 @@ Tk_InitConsoleChannels(
* only an issue when Tk is loaded dynamically.
*/
- if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
return;
}
diff --git a/generic/tkMain.c b/generic/tkMain.c
index 19ec30a..509e527 100644
--- a/generic/tkMain.c
+++ b/generic/tkMain.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMain.c,v 1.26 2007/09/11 17:46:41 dgp Exp $
+ * RCS: @(#) $Id: tkMain.c,v 1.27 2007/09/17 14:58:04 dgp Exp $
*/
#include <ctype.h>
@@ -110,7 +110,7 @@ Tk_MainEx(
* only an issue when Tk is loaded dynamically.
*/
- if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
abort();
}
diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c
index 93033ae..6c884c5 100644
--- a/generic/tkStubLib.c
+++ b/generic/tkStubLib.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkStubLib.c,v 1.15 2007/09/07 00:34:53 dgp Exp $
+ * RCS: @(#) $Id: tkStubLib.c,v 1.16 2007/09/17 14:58:04 dgp Exp $
*/
/*
@@ -85,11 +85,29 @@ Tk_InitStubs(
CONST char *actualVersion;
TkStubs **stubsPtrPtr = &tkStubsPtr; /* squelch warning */
- actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, exact,
+ 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) {
+ if (0 != strncmp(version, actualVersion, strlen(version))) {
+ return NULL;
+ }
+ } else {
+ actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 1, NULL);
+ if (actualVersion == NULL) {
+ return NULL;
+ }
+ }
+ }
if (!tkStubsPtr) {
Tcl_SetResult(interp,
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index fb68d21..d9da81a 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkWindow.c,v 1.85 2007/09/11 18:24:41 dgp Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.86 2007/09/17 14:58:05 dgp Exp $
*/
#include "tkInt.h"
@@ -2948,7 +2948,7 @@ Initialize(
* only an issue when Tk is loaded dynamically.
*/
- if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
+ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
return TCL_ERROR;
}
@@ -3181,7 +3181,7 @@ Initialize(
geometry = NULL;
}
- if (Tcl_PkgRequire(interp, "Tcl", TCL_PATCH_LEVEL, 0) == NULL) {
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
code = TCL_ERROR;
goto done;
}
@@ -3273,6 +3273,50 @@ tkInit");
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PkgInitStubsCheck --
+ *
+ * This is a replacement routine for Tk_InitStubs() that is called
+ * from code where -DUSE_TK_STUBS has not been enabled.
+ *
+ * Results:
+ * Returns the version of a conforming Tk stubs table, or NULL, if
+ * the table version doesn't satisfy the requested requirements,
+ * according to historical practice.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CONST char *
+Tk_PkgInitStubsCheck(
+ Tcl_Interp *interp,
+ CONST char * version,
+ int exact)
+{
+ CONST char *actualVersion = Tcl_PkgRequire(interp, "Tk", version, 0);
+
+ if (exact && actualVersion) {
+ CONST char *p = version;
+ int count = 0;
+
+ while (*p) {
+ count += !isdigit(*p++);
+ }
+ if (count == 1) {
+ if (0 != strncmp(version, actualVersion, strlen(version))) {
+ return NULL;
+ }
+ } else {
+ return Tcl_PkgPresent(interp, "Tk", version, 1);
+ }
+ }
+ return actualVersion;
+}
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4