diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tk.h | 6 | ||||
| -rw-r--r-- | generic/tkConsole.c | 4 | ||||
| -rw-r--r-- | generic/tkMain.c | 4 | ||||
| -rw-r--r-- | generic/tkStubLib.c | 22 | ||||
| -rw-r--r-- | generic/tkWindow.c | 50 |
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 |