summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tk.decls3
-rw-r--r--generic/tk.h117
-rw-r--r--generic/tkBind.c2
-rw-r--r--generic/tkCmds.c91
-rw-r--r--generic/tkConsole.c16
-rw-r--r--generic/tkDecls.h15
-rw-r--r--generic/tkInt.decls3
-rw-r--r--generic/tkIntDecls.h20
-rw-r--r--generic/tkListbox.c3
-rw-r--r--generic/tkMain.c17
-rw-r--r--generic/tkObj.c98
-rw-r--r--generic/tkStubInit.c8
-rw-r--r--generic/tkStubLib.c111
-rw-r--r--generic/tkStyle.c33
-rw-r--r--generic/tkTest.c4
-rw-r--r--generic/tkTextImage.c4
-rw-r--r--generic/tkTextIndex.c16
-rw-r--r--generic/tkTextWind.c8
-rw-r--r--generic/tkUtil.c83
-rw-r--r--generic/tkWindow.c14
-rw-r--r--generic/ttk/ttkManager.c2
-rw-r--r--generic/ttk/ttkScroll.c8
-rw-r--r--generic/ttk/ttkTheme.c2
-rw-r--r--generic/ttk/ttkTreeview.c5
24 files changed, 355 insertions, 328 deletions
diff --git a/generic/tk.decls b/generic/tk.decls
index 50b2837..2825111 100644
--- a/generic/tk.decls
+++ b/generic/tk.decls
@@ -1067,6 +1067,9 @@ declare 272 {
declare 273 {
void Tk_CreateOldPhotoImageFormat(Tk_PhotoImageFormat *formatPtr)
}
+declare 275 {
+ void TkUnusedStubEntry(void)
+}
# Define the platform specific public Tk interface. These functions are
# only available on the designated platform.
diff --git a/generic/tk.h b/generic/tk.h
index 8c13df2..7c686a3 100644
--- a/generic/tk.h
+++ b/generic/tk.h
@@ -17,10 +17,18 @@
#define _TK
#include <tcl.h>
-#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION != 5)
-# error Tk 8.5 must be compiled with tcl.h from Tcl 8.5
+#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION < 5)
+# error Tk 8.5 must be compiled with tcl.h from Tcl 8.5 or better
#endif
+#ifndef _ANSI_ARGS_
+# ifndef NO_PROTOTYPES
+# define _ANSI_ARGS_(x) x
+# else
+# define _ANSI_ARGS_(x) ()
+# endif
+#endif
+
/*
* For C++ compilers, use extern "C"
*/
@@ -69,11 +77,9 @@ extern "C" {
#ifndef RC_INVOKED
#ifndef _XLIB_H
-# if defined(MAC_OSX_TK)
-# include <X11/Xlib.h>
+# include <X11/Xlib.h>
+# ifdef MAC_OSX_TK
# include <X11/X.h>
-# else
-# include <X11/Xlib.h>
# endif
#endif
#ifdef __STDC__
@@ -81,18 +87,20 @@ extern "C" {
#endif
#ifdef BUILD_tk
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLEXPORT
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
#endif
-
+
/*
+ *----------------------------------------------------------------------
+ *
* Decide whether or not to use input methods.
*/
#ifdef XNQueryInputStyle
#define TK_USE_INPUT_METHODS
#endif
-
+
/*
* Dummy types that are used by clients:
*/
@@ -118,8 +126,10 @@ typedef struct Tk_StyledElement_ *Tk_StyledElement;
*/
typedef const char *Tk_Uid;
-
+
/*
+ *----------------------------------------------------------------------
+ *
* The enum below defines the valid types for Tk configuration options as
* implemented by Tk_InitOptions, Tk_SetOptions, etc.
*/
@@ -217,7 +227,7 @@ typedef void (Tk_CustomOptionFreeProc) _ANSI_ARGS_((ClientData clientData,
Tk_Window tkwin, char *internalPtr));
typedef struct Tk_ObjCustomOption {
- const char *name; /* Name of the custom option. */
+ const char *name; /* Name of the custom option. */
Tk_CustomOptionSetProc *setProc;
/* Function to use to set a record's option
* value from a Tcl_Obj */
@@ -293,7 +303,7 @@ typedef struct Tk_SavedOptions {
* old values in a single structure. NULL
* means no more structures. */
} Tk_SavedOptions;
-
+
/*
* Structure used to describe application-specific configuration options:
* indicates procedures to call to parse an option and to return a text string
@@ -392,7 +402,7 @@ typedef enum {
#define TK_CONFIG_OPTION_SPECIFIED (1 << 4)
#define TK_CONFIG_USER_BIT 0x100
#endif /* __NO_OLD_CONFIG */
-
+
/*
* Structure used to specify how to handle argv options.
*/
@@ -436,7 +446,7 @@ typedef struct {
#define TK_ARGV_NO_LEFTOVERS 0x2
#define TK_ARGV_NO_ABBREV 0x4
#define TK_ARGV_DONT_SKIP_FIRST_ARG 0x8
-
+
/*
* Enumerated type for describing actions to be taken in response to a
* restrictProc established by Tk_RestrictEvents.
@@ -494,7 +504,7 @@ typedef enum {
TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW,
TK_ANCHOR_CENTER
} Tk_Anchor;
-
+
/*
* Enumerated type for describing a style of justification:
*/
@@ -538,7 +548,7 @@ typedef struct Tk_FontMetrics {
#define TK_IGNORE_TABS 8
#define TK_IGNORE_NEWLINES 16
-
+
/*
* Widget class procedures used to implement platform specific widget
* behavior.
@@ -582,7 +592,7 @@ typedef struct Tk_ClassProcs {
#define Tk_GetClassProc(procs, which) \
(((procs) == NULL) ? NULL : \
(((procs)->size <= Tk_Offset(Tk_ClassProcs, which)) ? NULL:(procs)->which))
-
+
/*
* Each geometry manager (the packer, the placer, etc.) is represented by a
* structure of the following form, which indicates procedures to invoke in
@@ -616,13 +626,13 @@ typedef struct Tk_GeomMgr {
#define TK_SCROLL_PAGES 2
#define TK_SCROLL_UNITS 3
#define TK_SCROLL_ERROR 4
-
+
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Extensions to the X event set
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
#define VirtualEvent (MappingNotify + 1)
@@ -681,12 +691,12 @@ typedef XActivateDeactivateEvent XActivateEvent;
typedef XActivateDeactivateEvent XDeactivateEvent;
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Macros for querying Tk_Window structures. See the manual entries for
* documentation.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
#define Tk_Display(tkwin) (((Tk_FakeWin *) (tkwin))->display)
@@ -883,11 +893,11 @@ typedef struct Tk_FakeWin {
#define TK_WM_MANAGEABLE 0x80000
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Procedure prototypes and structures used for defining new canvas items:
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
typedef enum {
@@ -1124,7 +1134,7 @@ typedef struct Tk_CanvasTextInfo {
* should be displayed in focusItemPtr.
* Read-only to items.*/
} Tk_CanvasTextInfo;
-
+
/*
* Structures used for Dashing and Outline.
*/
@@ -1180,11 +1190,11 @@ typedef struct Tk_Outline {
} Tk_Outline;
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Procedure prototypes and structures used for managing images:
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
typedef struct Tk_ImageType Tk_ImageType;
@@ -1247,13 +1257,13 @@ struct Tk_ImageType {
* manager. */
char *reserved; /* reserved for future expansion */
};
-
+
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Additional definitions used to manage images of type "photo".
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
/*
@@ -1363,18 +1373,13 @@ struct Tk_PhotoImageFormat {
* currently known. Filled in by Tk, not by
* image format handler. */
};
-
-#ifdef USE_OLD_IMAGE
-#define Tk_CreateImageType Tk_CreateOldImageType
-#define Tk_CreatePhotoImageFormat Tk_CreateOldPhotoImageFormat
-#endif
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Procedure prototypes and structures used for managing styles:
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
/*
@@ -1438,13 +1443,13 @@ typedef struct Tk_ElementSpec {
#define TK_ELEMENT_STATE_PRESSED 1<<3
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* The definitions below provide backward compatibility for functions and
* types related to event handling that used to be in Tk but have moved to
* Tcl.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
#define TK_READABLE TCL_READABLE
@@ -1491,21 +1496,18 @@ EXTERN const char * Tk_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
const char *version, int exact));
#ifndef USE_TK_STUBS
-
#define Tk_InitStubs(interp, version, exact) \
Tk_PkgInitStubsCheck(interp, version, exact)
-
-#endif
+#endif /* USE_TK_STUBS */
#define Tk_InitImageArgs(interp, argc, argv) /**/
-
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Additional procedure types defined by Tk.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
typedef int (Tk_ErrorProc) _ANSI_ARGS_((ClientData clientData,
@@ -1523,18 +1525,27 @@ typedef Tk_RestrictAction (Tk_RestrictProc) _ANSI_ARGS_((
ClientData clientData, XEvent *eventPtr));
typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData,
int offset, char *buffer, int maxBytes));
-
+
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * Platform independant exported procedures and variables.
+ * Platform independent exported procedures and variables.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
#include "tkDecls.h"
+
+#ifdef USE_OLD_IMAGE
+#undef Tk_CreateImageType
+#define Tk_CreateImageType Tk_CreateOldImageType
+#undef Tk_CreatePhotoImageFormat
+#define Tk_CreatePhotoImageFormat Tk_CreateOldPhotoImageFormat
+#endif /* USE_OLD_IMAGE */
/*
+ *----------------------------------------------------------------------
+ *
* Allow users to say that they don't want to alter their source to add extra
* arguments to Tk_PhotoPutBlock() et al; DO NOT DEFINE THIS WHEN BUILDING TK.
*
@@ -1574,11 +1585,7 @@ typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData,
# endif
# define Tk_PhotoSetSize Tk_PhotoSetSize_Panic
#endif /* USE_PANIC_ON_PHOTO_ALLOC_FAILURE */
-
-/*
- * Tcl commands exported by Tk:
- */
-
+
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
diff --git a/generic/tkBind.c b/generic/tkBind.c
index 21bfb5c..8d20fa9 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -4595,7 +4595,7 @@ TkKeysymToString(
*
* TkCopyAndGlobalEval --
*
- * This function makes a copy of a script then calls Tcl_GlobalEval to
+ * This function makes a copy of a script then calls Tcl_EvalEx to
* evaluate it. It's used in situations where the execution of a command
* may cause the original command string to be reallocated.
*
diff --git a/generic/tkCmds.c b/generic/tkCmds.c
index a86ef84..ebf6444 100644
--- a/generic/tkCmds.c
+++ b/generic/tkCmds.c
@@ -22,6 +22,10 @@
#include "tkUnixInt.h"
#endif
+#if (TCL_MAJOR_VERSION==8) && (TCL_MINOR_VERSION<6)
+# define Tcl_Canceled(interp, flags) (TCL_OK)
+#endif
+
/*
* Forward declarations for functions defined later in this file:
*/
@@ -232,7 +236,7 @@ TkBindEventProc(
ClientData objects[MAX_OBJS], *objPtr;
TkWindow *topLevPtr;
int i, count;
- char *p;
+ const char *p;
Tcl_HashEntry *hPtr;
if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
@@ -251,7 +255,7 @@ TkBindEventProc(
(winPtr->numTags * sizeof(ClientData)));
}
for (i = 0; i < winPtr->numTags; i++) {
- p = (char *) winPtr->tagPtr[i];
+ p = winPtr->tagPtr[i];
if (*p == '.') {
hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
if (hPtr != NULL) {
@@ -327,7 +331,6 @@ Tk_BindtagsObjCmd(
}
if (objc == 2) {
listPtr = Tcl_NewObj();
- Tcl_IncrRefCount(listPtr);
if (winPtr->numTags == 0) {
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(winPtr->pathName, -1));
@@ -350,7 +353,6 @@ Tk_BindtagsObjCmd(
}
}
Tcl_SetObjResult(interp, listPtr);
- Tcl_DecrRefCount(listPtr);
return TCL_OK;
}
if (winPtr->tagPtr != NULL) {
@@ -411,17 +413,17 @@ TkFreeBindingTags(
TkWindow *winPtr) /* Window whose tags are to be released. */
{
int i;
- char *p;
+ const char *p;
for (i = 0; i < winPtr->numTags; i++) {
- p = (char *) (winPtr->tagPtr[i]);
+ p = winPtr->tagPtr[i];
if (*p == '.') {
/*
* Names starting with "." are malloced rather than Uids, so they
* have to be freed.
*/
- ckfree(p);
+ ckfree((char *)p);
}
}
ckfree((char *) winPtr->tagPtr);
@@ -913,6 +915,7 @@ Tk_TkwaitObjCmd(
{
Tk_Window tkwin = (Tk_Window) clientData;
int done, index;
+ int code = TCL_OK;
static const char *optionStrings[] = {
"variable", "visibility", "window", NULL
};
@@ -939,6 +942,10 @@ Tk_TkwaitObjCmd(
}
done = 0;
while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
Tcl_DoOneEvent(0);
}
Tcl_UntraceVar(interp, Tcl_GetString(objv[2]),
@@ -958,9 +965,13 @@ Tk_TkwaitObjCmd(
WaitVisibilityProc, (ClientData) &done);
done = 0;
while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
Tcl_DoOneEvent(0);
}
- if (done != 1) {
+ if ((done != 0) && (done != 1)) {
/*
* Note that we do not delete the event handler because it was
* deleted automatically when the window was destroyed.
@@ -988,25 +999,37 @@ Tk_TkwaitObjCmd(
WaitWindowProc, (ClientData) &done);
done = 0;
while (!done) {
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
Tcl_DoOneEvent(0);
}
/*
- * Note: there's no need to delete the event handler. It was deleted
- * automatically when the window was destroyed.
+ * Note: normally there's no need to delete the event handler. It was
+ * deleted automatically when the window was destroyed; however, if
+ * the wait operation was canceled, we need to delete it.
*/
+ if (done == 0) {
+ Tk_DeleteEventHandler(window, StructureNotifyMask,
+ WaitWindowProc, &done);
+ }
break;
}
}
/*
* Clear out the interpreter's result, since it may have been set by event
- * handlers.
+ * handlers. This is skipped if an error occurred above, such as the wait
+ * operation being canceled.
*/
+ if (code == TCL_OK)
Tcl_ResetResult(interp);
- return TCL_OK;
+
+ return code;
}
/* ARGSUSED */
@@ -1034,8 +1057,7 @@ WaitVisibilityProc(
if (eventPtr->type == VisibilityNotify) {
*donePtr = 1;
- }
- if (eventPtr->type == DestroyNotify) {
+ } else if (eventPtr->type == DestroyNotify) {
*donePtr = 2;
}
}
@@ -1080,6 +1102,7 @@ Tk_UpdateObjCmd(
static const char *updateOptions[] = {"idletasks", NULL};
int flags, index;
TkDisplay *dispPtr;
+ int code = TCL_OK;
if (objc == 1) {
flags = TCL_DONT_WAIT;
@@ -1104,12 +1127,35 @@ Tk_UpdateObjCmd(
while (1) {
while (Tcl_DoOneEvent(flags) != 0) {
- /* Empty loop body */
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
}
+
+ /*
+ * If event processing was canceled proceed no further.
+ */
+
+ if (code == TCL_ERROR)
+ break;
+
for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
dispPtr = dispPtr->nextPtr) {
XSync(dispPtr->display, False);
}
+
+ /*
+ * Check again if event processing has been canceled because the inner
+ * loop (above) may not have checked (i.e. no events were processed and
+ * the loop body was skipped).
+ */
+
+ if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
+ code = TCL_ERROR;
+ break;
+ }
+
if (Tcl_DoOneEvent(flags) == 0) {
break;
}
@@ -1117,11 +1163,14 @@ Tk_UpdateObjCmd(
/*
* Must clear the interpreter's result because event handlers could have
- * executed commands.
+ * executed commands. This is skipped if an error occurred above, such as
+ * the wait operation being canceled.
*/
+ if (code == TCL_OK)
Tcl_ResetResult(interp);
- return TCL_OK;
+
+ return code;
}
/*
@@ -1503,9 +1552,7 @@ Tk_WinfoObjCmd(
Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
}
break;
- case WIN_INTERPS: {
- int result;
-
+ case WIN_INTERPS:
skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
if (skip < 0) {
return TCL_ERROR;
@@ -1514,9 +1561,7 @@ Tk_WinfoObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
return TCL_ERROR;
}
- result = TkGetInterpNames(interp, tkwin);
- return result;
- }
+ return TkGetInterpNames(interp, tkwin);
case WIN_PATHNAME: {
Window id;
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
index b10aaaf..2cd2632 100644
--- a/generic/tkConsole.c
+++ b/generic/tkConsole.c
@@ -220,11 +220,10 @@ Tk_InitConsoleChannels(
Tcl_Channel consoleChannel;
/*
- * Ensure that we are getting the matching version of Tcl. This is really
- * only an issue when Tk is loaded dynamically.
+ * Ensure that we are getting a compatible version of Tcl.
*/
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) {
return;
}
@@ -436,7 +435,8 @@ Tk_CreateConsoleWindow(
}
Tcl_Preserve((ClientData) consoleInterp);
- result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
+ result = Tcl_EvalEx(consoleInterp, "source $tk_library/console.tcl",
+ -1, TCL_EVAL_GLOBAL);
if (result == TCL_ERROR) {
Tcl_SetReturnOptions(interp,
Tcl_GetReturnOptions(consoleInterp, result));
@@ -528,7 +528,7 @@ ConsoleOutput(
Tcl_DStringFree(&ds);
Tcl_IncrRefCount(cmd);
- Tcl_GlobalEvalObj(consoleInterp, cmd);
+ Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(cmd);
}
}
@@ -732,7 +732,7 @@ ConsoleObjCmd(
Tcl_IncrRefCount(cmd);
if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
Tcl_Preserve((ClientData) consoleInterp);
- result = Tcl_GlobalEvalObj(consoleInterp, cmd);
+ result = Tcl_EvalObjEx(consoleInterp, cmd, TCL_EVAL_GLOBAL);
Tcl_SetReturnOptions(interp,
Tcl_GetReturnOptions(consoleInterp, result));
Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
@@ -794,7 +794,7 @@ InterpreterObjCmd(
Tcl_Preserve((ClientData) otherInterp);
switch ((enum option) index) {
case OTHER_EVAL:
- result = Tcl_GlobalEvalObj(otherInterp, objv[2]);
+ result = Tcl_EvalObjEx(otherInterp, objv[2], TCL_EVAL_GLOBAL);
/*
* TODO: Should exceptions be filtered here?
*/
@@ -929,7 +929,7 @@ ConsoleEventProc(
Tcl_Interp *consoleInterp = info->consoleInterp;
if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
- Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
+ Tcl_EvalEx(consoleInterp, "tk::ConsoleExit", -1, TCL_EVAL_GLOBAL);
}
if (--info->refCount <= 0) {
diff --git a/generic/tkDecls.h b/generic/tkDecls.h
index d06df4b..6a2cca0 100644
--- a/generic/tkDecls.h
+++ b/generic/tkDecls.h
@@ -1674,6 +1674,12 @@ EXTERN void Tk_CreateOldImageType(Tk_ImageType *typePtr);
EXTERN void Tk_CreateOldPhotoImageFormat(
Tk_PhotoImageFormat *formatPtr);
#endif
+/* Slot 274 is reserved */
+#ifndef TkUnusedStubEntry_TCL_DECLARED
+#define TkUnusedStubEntry_TCL_DECLARED
+/* 275 */
+EXTERN void TkUnusedStubEntry(void);
+#endif
typedef struct TkStubHooks {
struct TkPlatStubs *tkPlatStubs;
@@ -1960,6 +1966,8 @@ typedef struct TkStubs {
Tcl_Interp * (*tk_Interp) (Tk_Window tkwin); /* 271 */
void (*tk_CreateOldImageType) (Tk_ImageType *typePtr); /* 272 */
void (*tk_CreateOldPhotoImageFormat) (Tk_PhotoImageFormat *formatPtr); /* 273 */
+ VOID *reserved274;
+ void (*tkUnusedStubEntry) (void); /* 275 */
} TkStubs;
#ifdef __cplusplus
@@ -3066,6 +3074,11 @@ extern TkStubs *tkStubsPtr;
#define Tk_CreateOldPhotoImageFormat \
(tkStubsPtr->tk_CreateOldPhotoImageFormat) /* 273 */
#endif
+/* Slot 274 is reserved */
+#ifndef TkUnusedStubEntry
+#define TkUnusedStubEntry \
+ (tkStubsPtr->tkUnusedStubEntry) /* 275 */
+#endif
#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
@@ -3074,5 +3087,7 @@ extern TkStubs *tkStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#undef TkUnusedStubEntry
+
#endif /* _TKDECLS */
diff --git a/generic/tkInt.decls b/generic/tkInt.decls
index 6794edb..17f39ba 100644
--- a/generic/tkInt.decls
+++ b/generic/tkInt.decls
@@ -568,6 +568,9 @@ declare 180 {
char *TkSmoothPrintProc(ClientData clientData, Tk_Window tkwin,
char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
}
+declare 184 {
+ void TkUnusedStubEntry(void)
+}
##############################################################################
diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h
index 5fcce30..063301d 100644
--- a/generic/tkIntDecls.h
+++ b/generic/tkIntDecls.h
@@ -962,6 +962,14 @@ EXTERN char * TkSmoothPrintProc(ClientData clientData,
Tk_Window tkwin, char *widgRec, int offset,
Tcl_FreeProc **freeProcPtr);
#endif
+/* Slot 181 is reserved */
+/* Slot 182 is reserved */
+/* Slot 183 is reserved */
+#ifndef TkUnusedStubEntry_TCL_DECLARED
+#define TkUnusedStubEntry_TCL_DECLARED
+/* 184 */
+EXTERN void TkUnusedStubEntry(void);
+#endif
typedef struct TkIntStubs {
int magic;
@@ -1175,6 +1183,10 @@ typedef struct TkIntStubs {
char * (*tkOrientPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 178 */
int (*tkSmoothParseProc) (ClientData clientData, Tcl_Interp *interp, Tk_Window tkwin, CONST char *value, char *widgRec, int offset); /* 179 */
char * (*tkSmoothPrintProc) (ClientData clientData, Tk_Window tkwin, char *widgRec, int offset, Tcl_FreeProc **freeProcPtr); /* 180 */
+ VOID *reserved181;
+ VOID *reserved182;
+ VOID *reserved183;
+ void (*tkUnusedStubEntry) (void); /* 184 */
} TkIntStubs;
#ifdef __cplusplus
@@ -1846,6 +1858,13 @@ extern TkIntStubs *tkIntStubsPtr;
#define TkSmoothPrintProc \
(tkIntStubsPtr->tkSmoothPrintProc) /* 180 */
#endif
+/* Slot 181 is reserved */
+/* Slot 182 is reserved */
+/* Slot 183 is reserved */
+#ifndef TkUnusedStubEntry
+#define TkUnusedStubEntry \
+ (tkIntStubsPtr->tkUnusedStubEntry) /* 184 */
+#endif
#endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */
@@ -1881,6 +1900,7 @@ extern TkIntStubs *tkIntStubsPtr;
(Region) (src), (Region) (ret))
#endif /* !__CYGWIN__*/
+#undef TkUnusedStubEntry
#if defined(__CYGWIN__) && defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS)
# undef TkBindDeadWindow
# define TkBindDeadWindow(winPtr) /* Removed from Cygwins stub table, just do nothing */
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index d803d7b..248dd7b 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -1630,9 +1630,6 @@ ConfigureListbox(
if (Tcl_SetVar2Ex(interp, listPtr->listVarName, NULL,
listVarObj, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG)
== NULL) {
- if (oldListObj == NULL) {
- Tcl_DecrRefCount(listVarObj);
- }
continue;
}
}
diff --git a/generic/tkMain.c b/generic/tkMain.c
index 3be7189..8bebb3d 100644
--- a/generic/tkMain.c
+++ b/generic/tkMain.c
@@ -132,12 +132,15 @@ Tk_MainEx(
Tcl_DString appName;
/*
- * Ensure that we are getting the matching version of Tcl. This is really
- * only an issue when Tk is loaded dynamically.
+ * Ensure that we are getting a compatible version of Tcl.
*/
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
- abort();
+ if (Tcl_InitStubs(interp, TCL_VERSION ".0", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ abort();
+ } else {
+ Tcl_Panic("%s", Tcl_GetStringResult(interp));
+ }
}
#if defined(__WIN32__) && !defined(__WIN64__) && !defined(STATIC_BUILD)
@@ -168,6 +171,12 @@ Tk_MainEx(
tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+#if !defined(STATIC_BUILD)
+# undef Tcl_FindExecutable
+# define Tcl_FindExecutable \
+ (tclStubsPtr->tcl_FindExecutable) /* 144 */
+#endif
+
Tcl_FindExecutable(argv[0]);
tsdPtr->interp = interp;
Tcl_Preserve((ClientData) interp);
diff --git a/generic/tkObj.c b/generic/tkObj.c
index 7672240..f30742b 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.c
@@ -189,7 +189,7 @@ GetPixelsFromObjEx(
int *intPtr,
double *dblPtr) /* Places to store resulting pixels. */
{
- int result,fresh;
+ int result, fresh;
double d;
PixelRep *pixelPtr;
static double bias[] = {
@@ -204,16 +204,16 @@ GetPixelsFromObjEx(
*/
if (objPtr->typePtr != &pixelObjType) {
- ThreadSpecificData *tsdPtr = GetTypeCache();
+ ThreadSpecificData *typeCache = GetTypeCache();
- if (objPtr->typePtr == tsdPtr->doubleTypePtr) {
+ if (objPtr->typePtr == typeCache->doubleTypePtr) {
(void) Tcl_GetDoubleFromObj(interp, objPtr, &d);
if (dblPtr != NULL) {
*dblPtr = d;
}
*intPtr = (int) (d<0 ? d-0.5 : d+0.5);
return TCL_OK;
- } else if (objPtr->typePtr == tsdPtr->intTypePtr) {
+ } else if (objPtr->typePtr == typeCache->intTypePtr) {
(void) Tcl_GetIntFromObj(interp, objPtr, intPtr);
if (dblPtr) {
*dblPtr = (double) (*intPtr);
@@ -223,14 +223,12 @@ GetPixelsFromObjEx(
}
retry:
- if (objPtr->typePtr != &pixelObjType) {
+ fresh = (objPtr->typePtr != &pixelObjType);
+ if (fresh) {
result = SetPixelFromAny(interp, objPtr);
if (result != TCL_OK) {
return result;
}
- fresh = 1;
- } else {
- fresh = 0;
}
if (SIMPLE_PIXELREP(objPtr)) {
@@ -242,14 +240,14 @@ GetPixelsFromObjEx(
pixelPtr = GET_COMPLEXPIXEL(objPtr);
if ((!fresh) && (pixelPtr->tkwin != tkwin)) {
/*
- * In case of exo-screen conversions of non-pixels we force a
+ * In the case of exo-screen conversions of non-pixels, we force a
* recomputation from the string.
*/
FreePixelInternalRep(objPtr);
goto retry;
}
- if ((pixelPtr->tkwin != tkwin)||dblPtr) {
+ if ((pixelPtr->tkwin != tkwin) || dblPtr) {
d = pixelPtr->value;
if (pixelPtr->units >= 0) {
d *= bias[pixelPtr->units] * WidthOfScreen(Tk_Screen(tkwin));
@@ -294,7 +292,7 @@ Tk_GetPixelsFromObj(
Tcl_Obj *objPtr, /* The object from which to get pixels. */
int *intPtr) /* Place to store resulting pixels. */
{
- return GetPixelsFromObjEx(interp,tkwin,objPtr,intPtr,NULL);
+ return GetPixelsFromObjEx(interp, tkwin, objPtr, intPtr, NULL);
}
/*
@@ -326,7 +324,7 @@ Tk_GetDoublePixelsFromObj(
double *doublePtr) /* Place to store resulting pixels. */
{
double d;
- int result,val;
+ int result, val;
result = GetPixelsFromObjEx(interp, tkwin, objPtr, &val, &d);
if (result != TCL_OK) {
@@ -448,7 +446,7 @@ SetPixelFromAny(
double d;
int i, units;
- string = Tcl_GetStringFromObj(objPtr, NULL);
+ string = Tcl_GetString(objPtr);
d = strtod(string, &rest);
if (rest == string) {
@@ -561,7 +559,7 @@ Tk_GetMMFromObj(
}
}
- mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
+ mmPtr = (MMRep *) objPtr->internalRep.twoPtrValue.ptr1;
if (mmPtr->tkwin != tkwin) {
d = mmPtr->value;
if (mmPtr->units == -1) {
@@ -600,8 +598,8 @@ static void
FreeMMInternalRep(
Tcl_Obj *objPtr) /* MM object with internal rep to free. */
{
- ckfree((char *) objPtr->internalRep.otherValuePtr);
- objPtr->internalRep.otherValuePtr = NULL;
+ ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1);
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->typePtr = NULL;
}
@@ -631,13 +629,13 @@ DupMMInternalRep(
MMRep *oldPtr, *newPtr;
copyPtr->typePtr = srcPtr->typePtr;
- oldPtr = (MMRep *) srcPtr->internalRep.otherValuePtr;
+ oldPtr = (MMRep *) srcPtr->internalRep.twoPtrValue.ptr1;
newPtr = (MMRep *) ckalloc(sizeof(MMRep));
newPtr->value = oldPtr->value;
newPtr->units = oldPtr->units;
newPtr->tkwin = oldPtr->tkwin;
newPtr->returnValue = oldPtr->returnValue;
- copyPtr->internalRep.otherValuePtr = (VOID *) newPtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) newPtr;
}
/*
@@ -667,7 +665,7 @@ UpdateStringOfMM(
char buffer[TCL_DOUBLE_SPACE];
register int len;
- mmPtr = (MMRep *) objPtr->internalRep.otherValuePtr;
+ mmPtr = (MMRep *) objPtr->internalRep.twoPtrValue.ptr1;
/* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */
if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) {
Tcl_Panic("UpdateStringOfMM: false precondition");
@@ -705,17 +703,17 @@ SetMMFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr) /* The object to convert. */
{
- ThreadSpecificData *tsdPtr = GetTypeCache();
+ ThreadSpecificData *typeCache = GetTypeCache();
const Tcl_ObjType *typePtr;
char *string, *rest;
double d;
int units;
MMRep *mmPtr;
- if (objPtr->typePtr == tsdPtr->doubleTypePtr) {
+ if (objPtr->typePtr == typeCache->doubleTypePtr) {
Tcl_GetDoubleFromObj(interp, objPtr, &d);
units = -1;
- } else if (objPtr->typePtr == tsdPtr->intTypePtr) {
+ } else if (objPtr->typePtr == typeCache->intTypePtr) {
Tcl_GetIntFromObj(interp, objPtr, &units);
d = (double) units;
units = -1;
@@ -726,13 +724,13 @@ SetMMFromAny(
* ints again from mm obj types.
*/
- (void) Tcl_GetStringFromObj(objPtr, NULL);
+ (void) Tcl_GetString(objPtr);
} else {
/*
* It wasn't a known int or double, so parse it.
*/
- string = Tcl_GetStringFromObj(objPtr, NULL);
+ string = Tcl_GetString(objPtr);
d = strtod(string, &rest);
if (rest == string) {
@@ -780,15 +778,15 @@ SetMMFromAny(
(*typePtr->freeIntRepProc)(objPtr);
}
- objPtr->typePtr = &mmObjType;
+ objPtr->typePtr = &mmObjType;
- mmPtr = (MMRep *) ckalloc(sizeof(MMRep));
- mmPtr->value = d;
- mmPtr->units = units;
- mmPtr->tkwin = NULL;
+ mmPtr = (MMRep *) ckalloc(sizeof(MMRep));
+ mmPtr->value = d;
+ mmPtr->units = units;
+ mmPtr->tkwin = NULL;
mmPtr->returnValue = d;
- objPtr->internalRep.otherValuePtr = (VOID *) mmPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) mmPtr;
return TCL_OK;
}
@@ -821,7 +819,7 @@ TkGetWindowFromObj(
Tcl_Obj *objPtr, /* The object from which to get window. */
Tk_Window *windowPtr) /* Place to store resulting window. */
{
- TkMainInfo *mainPtr = ((TkWindow *)tkwin)->mainPtr;
+ TkMainInfo *mainPtr = ((TkWindow *) tkwin)->mainPtr;
register WindowRep *winPtr;
int result;
@@ -830,28 +828,28 @@ TkGetWindowFromObj(
return result;
}
- winPtr = (WindowRep *) objPtr->internalRep.otherValuePtr;
- if ( winPtr->tkwin == NULL
- || winPtr->mainPtr == NULL
- || winPtr->mainPtr != mainPtr
- || winPtr->epoch != mainPtr->deletionEpoch)
+ winPtr = (WindowRep *) objPtr->internalRep.twoPtrValue.ptr1;
+ if (winPtr->tkwin == NULL
+ || winPtr->mainPtr == NULL
+ || winPtr->mainPtr != mainPtr
+ || winPtr->epoch != mainPtr->deletionEpoch)
{
/*
* Cache is invalid.
*/
winPtr->tkwin = Tk_NameToWindow(interp,
- Tcl_GetStringFromObj(objPtr, NULL), tkwin);
+ Tcl_GetString(objPtr), tkwin);
+ if (winPtr->tkwin == NULL) {
+ /* ASSERT: Tk_NameToWindow has left error message in interp */
+ return TCL_ERROR;
+ }
+
winPtr->mainPtr = mainPtr;
winPtr->epoch = mainPtr ? mainPtr->deletionEpoch : 0;
}
*windowPtr = winPtr->tkwin;
-
- if (winPtr->tkwin == NULL) {
- /* ASSERT: Tk_NameToWindow has left error message in interp */
- return TCL_ERROR;
- }
return TCL_OK;
}
@@ -887,7 +885,7 @@ SetWindowFromAny(
* Free the old internalRep before setting the new one.
*/
- Tcl_GetStringFromObj(objPtr, NULL);
+ (void)Tcl_GetString(objPtr);
typePtr = objPtr->typePtr;
if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
(*typePtr->freeIntRepProc)(objPtr);
@@ -898,7 +896,7 @@ SetWindowFromAny(
winPtr->mainPtr = NULL;
winPtr->epoch = 0;
- objPtr->internalRep.otherValuePtr = (VOID*)winPtr;
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID*)winPtr;
objPtr->typePtr = &windowObjType;
return TCL_OK;
@@ -929,12 +927,12 @@ DupWindowInternalRep(
{
register WindowRep *oldPtr, *newPtr;
- oldPtr = srcPtr->internalRep.otherValuePtr;
+ oldPtr = srcPtr->internalRep.twoPtrValue.ptr1;
newPtr = (WindowRep *) ckalloc(sizeof(WindowRep));
newPtr->tkwin = oldPtr->tkwin;
newPtr->mainPtr = oldPtr->mainPtr;
newPtr->epoch = oldPtr->epoch;
- copyPtr->internalRep.otherValuePtr = (VOID *)newPtr;
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *)newPtr;
copyPtr->typePtr = srcPtr->typePtr;
}
@@ -960,13 +958,13 @@ static void
FreeWindowInternalRep(
Tcl_Obj *objPtr) /* Window object with internal rep to free. */
{
- ckfree((char *) objPtr->internalRep.otherValuePtr);
- objPtr->internalRep.otherValuePtr = NULL;
+ ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1);
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->typePtr = NULL;
}
/*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* TkParsePadAmount --
*
@@ -984,7 +982,7 @@ FreeWindowInternalRep(
* An error message is written to the interpreter if something is not
* right.
*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c
index c2ef290..79edc4d 100644
--- a/generic/tkStubInit.c
+++ b/generic/tkStubInit.c
@@ -30,6 +30,8 @@
#include "tkPlatDecls.h"
#include "tkIntXlibDecls.h"
+#define TkUnusedStubEntry NULL
+
#ifdef __WIN32__
static int
@@ -476,6 +478,10 @@ TkIntStubs tkIntStubs = {
TkOrientPrintProc, /* 178 */
TkSmoothParseProc, /* 179 */
TkSmoothPrintProc, /* 180 */
+ NULL, /* 181 */
+ NULL, /* 182 */
+ NULL, /* 183 */
+ TkUnusedStubEntry, /* 184 */
};
TkIntPlatStubs tkIntPlatStubs = {
@@ -1130,6 +1136,8 @@ TkStubs tkStubs = {
Tk_Interp, /* 271 */
Tk_CreateOldImageType, /* 272 */
Tk_CreateOldPhotoImageFormat, /* 273 */
+ NULL, /* 274 */
+ TkUnusedStubEntry, /* 275 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tkStubLib.c b/generic/tkStubLib.c
index 5349a0b..f605b5d 100644
--- a/generic/tkStubLib.c
+++ b/generic/tkStubLib.c
@@ -1,33 +1,16 @@
/*
* tkStubLib.c --
*
- * Stub object that will be statically linked into extensions that wish
+ * Stub object that will be statically linked into extensions that want
* to access Tk.
*
- * Copyright (c) 1998 Paul Duffin.
* 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.
*/
-/*
- * 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.
- */
-
-#ifndef USE_TCL_STUBS
-#define USE_TCL_STUBS
-#endif
-#undef USE_TCL_STUB_PROCS
-
-#ifndef USE_TK_STUBS
-#define USE_TK_STUBS
-#endif
-#undef USE_TK_STUB_PROCS
-
#include "tkInt.h"
#ifdef __WIN32__
@@ -56,7 +39,8 @@ TkIntXlibStubs *tkIntXlibStubsPtr = NULL;
* Use our own isdigit to avoid linking to libc on windows
*/
-static int isDigit(const int c)
+static int
+isDigit(const int c)
{
return (c >= '0' && c <= '9');
}
@@ -78,66 +62,73 @@ static int isDigit(const int c)
*
*----------------------------------------------------------------------
*/
-
-#ifdef Tk_InitStubs
#undef Tk_InitStubs
-#endif
-
CONST char *
Tk_InitStubs(
Tcl_Interp *interp,
CONST char *version,
int exact)
{
- CONST char *actualVersion;
- TkStubs **stubsPtrPtr = &tkStubsPtr; /* squelch warning */
-
- actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0,
- (ClientData *) stubsPtrPtr);
- if (!actualVersion) {
+ const char *packageName = "Tk";
+ const char *errMsg = NULL;
+ ClientData clientData = NULL;
+ CONST char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
+ packageName, version, 0, &clientData);
+ TkStubs *stubsPtr = (TkStubs *)clientData;
+
+ if (actualVersion == NULL) {
return NULL;
}
+
if (exact) {
- CONST char *p = version;
- int count = 0;
+ CONST char *p = version;
+ int count = 0;
- while (*p) {
- count += !isDigit(*p++);
- }
- if (count == 1) {
+ while (*p) {
+ count += !isDigit(*p++);
+ }
+ if (count == 1) {
CONST char *q = actualVersion;
p = version;
while (*p && (*p == *q)) {
p++; q++;
}
- if (*p) {
+ if (*p || isDigit(*q)) {
/* 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;
- }
- }
+ tclStubsPtr->tcl_PkgRequireEx(interp, "Tk", version, 1, NULL);
+ return NULL;
+ }
+ } else {
+ actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, "Tk",
+ version, 1, NULL);
+ if (actualVersion == NULL) {
+ return NULL;
+ }
+ }
}
-
- if (!tkStubsPtr) {
- Tcl_SetResult(interp,
- "This implementation of Tk does not support stubs",
- TCL_STATIC);
- 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;
}
-
- tkPlatStubsPtr = tkStubsPtr->hooks->tkPlatStubs;
- tkIntStubsPtr = tkStubsPtr->hooks->tkIntStubs;
- tkIntPlatStubsPtr = tkStubsPtr->hooks->tkIntPlatStubs;
- tkIntXlibStubsPtr = tkStubsPtr->hooks->tkIntXlibStubs;
-
- return actualVersion;
+ tclStubsPtr->tcl_ResetResult(interp);
+ tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
+ " (requested version ", version, ", actual version ",
+ actualVersion, "): ", errMsg, NULL);
+ return NULL;
}
/*
diff --git a/generic/tkStyle.c b/generic/tkStyle.c
index dd3b2e8..c2eed8f 100644
--- a/generic/tkStyle.c
+++ b/generic/tkStyle.c
@@ -62,7 +62,7 @@ typedef struct StyleEngine {
StyledElement *elements; /* Table of widget element descriptors. Each
* element is indexed by a unique system-wide
* ID. Table grows dynamically as new elements
- * are registered. Malloc'd*/
+ * are registered. Malloc'd. */
struct StyleEngine *parentPtr;
/* Parent engine. Engines may be layered to
* form a fallback chain, terminated by the
@@ -146,7 +146,7 @@ static int SetStyleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
/*
* The following structure defines the implementation of the "style" Tcl
- * object, used for drawing. The internalRep.otherValuePtr field of each style
+ * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of each style
* object points to the Style structure for the stylefont, or NULL.
*/
@@ -375,14 +375,12 @@ InitStyleEngine(
*/
enginePtr->parentPtr = NULL;
-
} else if (parentPtr == NULL) {
/*
* The default style engine is the parent.
*/
enginePtr->parentPtr = tsdPtr->defaultEnginePtr;
-
} else {
enginePtr->parentPtr = parentPtr;
}
@@ -602,17 +600,16 @@ FreeStyledElement(
static int
CreateElement(
- const char *name, /* Name of the element. */
- int create) /* Boolean, whether the element is being created
- * explicitly (being registered) or implicitly (by a
- * derived element). */
+ const char *name, /* Name of the element. */
+ int create) /* Boolean, whether the element is being
+ * created explicitly (being registered) or
+ * implicitly (by a derived element). */
{
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr, *engineEntryPtr;
Tcl_HashSearch search;
- int newEntry;
- int elementId, genericId = -1;
+ int newEntry, elementId, genericId = -1;
char *dot;
StyleEngine *enginePtr;
@@ -1261,8 +1258,7 @@ Tk_CreateStyle(
stylePtr = (Style *) ckalloc(sizeof(Style));
InitStyle(stylePtr, Tcl_GetHashKey(&tsdPtr->styleTable, entryPtr),
- (engine != NULL ? (StyleEngine *) engine :
- tsdPtr->defaultEnginePtr),
+ (engine!=NULL ? (StyleEngine *) engine : tsdPtr->defaultEnginePtr),
clientData);
Tcl_SetHashValue(entryPtr, (ClientData) stylePtr);
@@ -1415,10 +1411,8 @@ Tk_AllocStyleFromObj(
if (objPtr->typePtr != &styleObjType) {
SetStyleFromAny(interp, objPtr);
- stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
- } else {
- stylePtr = (Style *) objPtr->internalRep.otherValuePtr;
}
+ stylePtr = (Style *) objPtr->internalRep.twoPtrValue.ptr1;
return (Tk_Style) stylePtr;
}
@@ -1450,7 +1444,7 @@ Tk_GetStyleFromObj(
SetStyleFromAny(NULL, objPtr);
}
- return (Tk_Style) objPtr->internalRep.otherValuePtr;
+ return (Tk_Style) objPtr->internalRep.twoPtrValue.ptr1;
}
/*
@@ -1505,7 +1499,7 @@ SetStyleFromAny(
}
objPtr->typePtr = &styleObjType;
- objPtr->internalRep.otherValuePtr = (VOID *) Tk_GetStyle(interp, name);
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) Tk_GetStyle(interp, name);
return TCL_OK;
}
@@ -1528,7 +1522,7 @@ static void
FreeStyleObjProc(
Tcl_Obj *objPtr) /* The object we are releasing. */
{
- objPtr->internalRep.otherValuePtr = NULL;
+ objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->typePtr = NULL;
}
@@ -1549,7 +1543,8 @@ DupStyleObjProc(
Tcl_Obj *dupObjPtr) /* The object we are copying to. */
{
dupObjPtr->typePtr = srcObjPtr->typePtr;
- dupObjPtr->internalRep.otherValuePtr=srcObjPtr->internalRep.otherValuePtr;
+ dupObjPtr->internalRep.twoPtrValue.ptr1 =
+ srcObjPtr->internalRep.twoPtrValue.ptr1;
}
/*
diff --git a/generic/tkTest.c b/generic/tkTest.c
index 307ca34..9fe2222 100644
--- a/generic/tkTest.c
+++ b/generic/tkTest.c
@@ -400,7 +400,7 @@ CBindingEvalProc(
cbindPtr = (CBinding *) clientData;
- return Tcl_GlobalEval(interp, cbindPtr->command);
+ return Tcl_EvalEx(interp, cbindPtr->command, -1, TCL_EVAL_GLOBAL);
}
static void
@@ -410,7 +410,7 @@ CBindingFreeProc(
CBinding *cbindPtr = (CBinding *) clientData;
if (cbindPtr->delete != NULL) {
- Tcl_GlobalEval(cbindPtr->interp, cbindPtr->delete);
+ Tcl_EvalEx(cbindPtr->interp, cbindPtr->delete, -1, TCL_EVAL_GLOBAL);
ckfree((char *) cbindPtr->delete);
}
ckfree((char *) cbindPtr->command);
diff --git a/generic/tkTextImage.c b/generic/tkTextImage.c
index 771347d..bc2b7c4 100644
--- a/generic/tkTextImage.c
+++ b/generic/tkTextImage.c
@@ -779,6 +779,10 @@ TkTextImageIndex(
Tcl_HashEntry *hPtr;
TkTextSegment *eiPtr;
+ if (textPtr == NULL) {
+ return 0;
+ }
+
hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->imageTable, name);
if (hPtr == NULL) {
return 0;
diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c
index a9b0bed..70c94db 100644
--- a/generic/tkTextIndex.c
+++ b/generic/tkTextIndex.c
@@ -758,9 +758,11 @@ GetIndex(
/*
*---------------------------------------------------------------------
- * Stage 1: check to see if the index consists of nothing but a mark name.
- * We do this check now even though it's also done later, in order to
- * allow mark names that include funny characters such as spaces or "+1c".
+ * Stage 1: check to see if the index consists of nothing but a mark
+ * name, an embedded window or an embedded image. We do this check
+ * now even though it's also done later, in order to allow mark names,
+ * embedded window names or image names that include funny characters
+ * such as spaces or "+1c".
*---------------------------------------------------------------------
*/
@@ -768,6 +770,14 @@ GetIndex(
goto done;
}
+ if (TkTextWindowIndex(textPtr, string, indexPtr) != 0) {
+ return TCL_OK;
+ }
+
+ if (TkTextImageIndex(textPtr, string, indexPtr) != 0) {
+ return TCL_OK;
+ }
+
/*
*------------------------------------------------
* Stage 2: start again by parsing the base index.
diff --git a/generic/tkTextWind.c b/generic/tkTextWind.c
index ecafd4e..8d1f850 100644
--- a/generic/tkTextWind.c
+++ b/generic/tkTextWind.c
@@ -902,10 +902,10 @@ EmbWinLayoutProc(
if (dsPtr != NULL) {
Tcl_DStringAppend(dsPtr, before, (int) (string-before));
- code = Tcl_GlobalEval(textPtr->interp, Tcl_DStringValue(dsPtr));
+ code = Tcl_EvalEx(textPtr->interp, Tcl_DStringValue(dsPtr), -1, TCL_EVAL_GLOBAL);
Tcl_DStringFree(dsPtr);
} else {
- code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create);
+ code = Tcl_EvalEx(textPtr->interp, ewPtr->body.ew.create, -1, TCL_EVAL_GLOBAL);
}
if (code != TCL_OK) {
createError:
@@ -1329,6 +1329,10 @@ TkTextWindowIndex(
Tcl_HashEntry *hPtr;
TkTextSegment *ewPtr;
+ if (textPtr == NULL) {
+ return 0;
+ }
+
hPtr = Tcl_FindHashEntry(&textPtr->sharedTextPtr->windowTable, name);
if (hPtr == NULL) {
return 0;
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 2a8240b..bfa5d5c 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -976,89 +976,6 @@ TkFindStateNumObj(
}
/*
- * ----------------------------------------------------------------------
- *
- * TkBackgroundEvalObjv --
- *
- * Evaluate a command while ensuring that we do not affect the
- * interpreters state. This is important when evaluating script
- * during background tasks.
- *
- * Results:
- * A standard Tcl result code.
- *
- * Side Effects:
- * The interpreters variables and code may be modified by the script
- * but the result will not be modified.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TkBackgroundEvalObjv(
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const *objv,
- int flags)
-{
- Tcl_DString errorInfo, errorCode;
- Tcl_SavedResult state;
- int n, r = TCL_OK;
-
- Tcl_DStringInit(&errorInfo);
- Tcl_DStringInit(&errorCode);
-
- Tcl_Preserve(interp);
-
- /*
- * Record the state of the interpreter
- */
-
- Tcl_SaveResult(interp, &state);
- Tcl_DStringAppend(&errorInfo,
- Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY), -1);
- Tcl_DStringAppend(&errorCode,
- Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY), -1);
-
- /*
- * Evaluate the command and handle any error.
- */
-
- for (n = 0; n < objc; ++n) {
- Tcl_IncrRefCount(objv[n]);
- }
- r = Tcl_EvalObjv(interp, objc, objv, flags);
- for (n = 0; n < objc; ++n) {
- Tcl_DecrRefCount(objv[n]);
- }
- if (r == TCL_ERROR) {
- Tcl_AddErrorInfo(interp, "\n (background event handler)");
- Tcl_BackgroundError(interp);
- }
-
- Tcl_Release(interp);
-
- /*
- * Restore the state of the interpreter
- */
-
- Tcl_SetVar(interp, "errorInfo",
- Tcl_DStringValue(&errorInfo), TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "errorCode",
- Tcl_DStringValue(&errorCode), TCL_GLOBAL_ONLY);
- Tcl_RestoreResult(interp, &state);
-
- /*
- * Clean up references.
- */
-
- Tcl_DStringFree(&errorInfo);
- Tcl_DStringFree(&errorCode);
-
- return r;
-}
-
-/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 995f71f..d40e7de 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -3021,11 +3021,10 @@ Initialize(
ThreadSpecificData *tsdPtr;
/*
- * Ensure that we are getting the matching version of Tcl. This is really
- * only an issue when Tk is loaded dynamically.
+ * Ensure that we are getting a compatible version of Tcl.
*/
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, TCL_VERSION ".0", 0) == NULL) {
return TCL_ERROR;
}
@@ -3257,11 +3256,6 @@ Initialize(
geometry = NULL;
}
- if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
- code = TCL_ERROR;
- goto done;
- }
-
/*
* Provide Tk and its stub table.
*/
@@ -3281,10 +3275,6 @@ Initialize(
Tcl_SetMainLoop(Tk_MainLoop);
-#undef Tk_InitStubs
-
- Tk_InitStubs(interp, TK_VERSION, 1);
-
/*
* Initialized the themed widget set
*/
diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c
index ba9e5c0..2fcb190 100644
--- a/generic/ttk/ttkManager.c
+++ b/generic/ttk/ttkManager.c
@@ -237,7 +237,7 @@ void Ttk_DeleteManager(Ttk_Manager *mgr)
ckfree((ClientData)mgr->slaves);
}
- Tk_CancelIdleCall(ManagerIdleProc, mgr);
+ Tcl_CancelIdleCall(ManagerIdleProc, mgr);
ckfree((ClientData)mgr);
}
diff --git a/generic/ttk/ttkScroll.c b/generic/ttk/ttkScroll.c
index defe05a..b670540 100644
--- a/generic/ttk/ttkScroll.c
+++ b/generic/ttk/ttkScroll.c
@@ -78,6 +78,7 @@ static int UpdateScrollbar(Tcl_Interp *interp, ScrollHandle h)
char arg1[TCL_DOUBLE_SPACE + 2];
char arg2[TCL_DOUBLE_SPACE + 2];
int code;
+ Tcl_DString buf;
h->flags &= ~SCROLL_UPDATE_REQUIRED;
@@ -88,9 +89,14 @@ static int UpdateScrollbar(Tcl_Interp *interp, ScrollHandle h)
arg1[0] = arg2[0] = ' ';
Tcl_PrintDouble(interp, (double)s->first / s->total, arg1+1);
Tcl_PrintDouble(interp, (double)s->last / s->total, arg2+1);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, s->scrollCmd, -1);
+ Tcl_DStringAppend(&buf, arg1, -1);
+ Tcl_DStringAppend(&buf, arg2, -1);
Tcl_Preserve(corePtr);
- code = Tcl_VarEval(interp, s->scrollCmd, arg1, arg2, NULL);
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, TCL_EVAL_GLOBAL);
+ Tcl_DStringFree(&buf);
if (WidgetDestroyed(corePtr)) {
Tcl_Release(corePtr);
return TCL_ERROR;
diff --git a/generic/ttk/ttkTheme.c b/generic/ttk/ttkTheme.c
index 5095487..a2c51c0 100644
--- a/generic/ttk/ttkTheme.c
+++ b/generic/ttk/ttkTheme.c
@@ -509,7 +509,7 @@ static void ThemeChangedProc(ClientData clientData)
static char ThemeChangedScript[] = "ttk::ThemeChanged";
StylePackageData *pkgPtr = clientData;
- if (Tcl_GlobalEval(pkgPtr->interp, ThemeChangedScript) != TCL_OK) {
+ if (Tcl_EvalEx(pkgPtr->interp, ThemeChangedScript, -1, TCL_EVAL_GLOBAL) != TCL_OK) {
Tcl_BackgroundError(pkgPtr->interp);
}
pkgPtr->themeChangePending = 0;
diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c
index 862c7f6..f0a3003 100644
--- a/generic/ttk/ttkTreeview.c
+++ b/generic/ttk/ttkTreeview.c
@@ -3169,6 +3169,8 @@ static int TreeviewTagAddCommand(
AddTag(items[i], tag);
}
+ TtkRedisplayWidget(&tv->core);
+
return TCL_OK;
}
@@ -3213,6 +3215,9 @@ static int TreeviewTagRemoveCommand(
item=NextPreorder(item);
}
}
+
+ TtkRedisplayWidget(&tv->core);
+
return TCL_OK;
}
generated by cgit v0.12 at 2024-11-03 09:12:25 (GMT)