summaryrefslogtreecommitdiffstats
path: root/generic/tkWindow.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkWindow.c')
-rw-r--r--generic/tkWindow.c548
1 files changed, 286 insertions, 262 deletions
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index f2e98e8..b5cbbab 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -14,7 +14,7 @@
#include "tkInt.h"
-#ifdef __WIN32__
+#ifdef _WIN32
#include "tkWinInt.h"
#elif !defined(MAC_OSX_TK)
#include "tkUnixInt.h"
@@ -97,12 +97,14 @@ static const XSetWindowAttributes defAtts= {
#define ISSAFE 1
#define PASSMAINWINDOW 2
-#define NOOBJPROC 4
-#define WINMACONLY 8
+#define WINMACONLY 4
+#define USEINITPROC 8
+typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData);
typedef struct {
- const char *name; /* Name of command. */
- Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based function. */
+ const char *name; /* Name of command. */
+ Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based
+ * function, or initProc. */
int flags;
} TkCmd;
@@ -125,10 +127,10 @@ static const TkCmd commands[] = {
{"lower", Tk_LowerObjCmd, PASSMAINWINDOW|ISSAFE},
{"option", Tk_OptionObjCmd, PASSMAINWINDOW|ISSAFE},
{"pack", Tk_PackObjCmd, PASSMAINWINDOW|ISSAFE},
- {"place", Tk_PlaceObjCmd, ISSAFE},
+ {"place", Tk_PlaceObjCmd, PASSMAINWINDOW|ISSAFE},
{"raise", Tk_RaiseObjCmd, PASSMAINWINDOW|ISSAFE},
{"selection", Tk_SelectionObjCmd, PASSMAINWINDOW},
- {"tk", Tk_TkObjCmd, PASSMAINWINDOW|ISSAFE},
+ {"tk", (Tcl_ObjCmdProc *) TkInitTkCmd, USEINITPROC|PASSMAINWINDOW|ISSAFE},
{"tkwait", Tk_TkwaitObjCmd, PASSMAINWINDOW|ISSAFE},
{"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE},
{"winfo", Tk_WinfoObjCmd, PASSMAINWINDOW|ISSAFE},
@@ -146,12 +148,13 @@ static const TkCmd commands[] = {
{"label", Tk_LabelObjCmd, ISSAFE},
{"labelframe", Tk_LabelframeObjCmd, ISSAFE},
{"listbox", Tk_ListboxObjCmd, ISSAFE},
+ {"menu", Tk_MenuObjCmd, PASSMAINWINDOW},
{"menubutton", Tk_MenubuttonObjCmd, ISSAFE},
{"message", Tk_MessageObjCmd, ISSAFE},
{"panedwindow", Tk_PanedWindowObjCmd, ISSAFE},
{"radiobutton", Tk_RadiobuttonObjCmd, ISSAFE},
{"scale", Tk_ScaleObjCmd, ISSAFE},
- {"scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE},
+ {"scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE},
{"spinbox", Tk_SpinboxObjCmd, ISSAFE},
{"text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE},
{"toplevel", Tk_ToplevelObjCmd, 0},
@@ -173,7 +176,7 @@ static const TkCmd commands[] = {
{"::tk::panedwindow",Tk_PanedWindowObjCmd, ISSAFE},
{"::tk::radiobutton",Tk_RadiobuttonObjCmd, ISSAFE},
{"::tk::scale", Tk_ScaleObjCmd, ISSAFE},
- {"::tk::scrollbar", (Tcl_ObjCmdProc *) Tk_ScrollbarCmd, NOOBJPROC|PASSMAINWINDOW|ISSAFE},
+ {"::tk::scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE},
{"::tk::spinbox", Tk_SpinboxObjCmd, ISSAFE},
{"::tk::text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE},
{"::tk::toplevel", Tk_ToplevelObjCmd, 0},
@@ -183,7 +186,7 @@ static const TkCmd commands[] = {
* these commands differently (via the script library).
*/
-#if defined(__WIN32__) || defined(MAC_OSX_TK)
+#if defined(_WIN32) || defined(MAC_OSX_TK)
{"tk_chooseColor", Tk_ChooseColorObjCmd, PASSMAINWINDOW},
{"tk_chooseDirectory", Tk_ChooseDirectoryObjCmd,WINMACONLY|PASSMAINWINDOW},
{"tk_getOpenFile", Tk_GetOpenFileObjCmd, WINMACONLY|PASSMAINWINDOW},
@@ -195,7 +198,7 @@ static const TkCmd commands[] = {
* Misc.
*/
-#if defined(MAC_OSX_TK)
+#ifdef MAC_OSX_TK
{"::tk::unsupported::MacWindowStyle",
TkUnsupported1ObjCmd, PASSMAINWINDOW|ISSAFE},
#endif
@@ -216,7 +219,7 @@ static char *use = NULL;
static char *visual = NULL;
static int rest = 0;
-static Tk_ArgvInfo argTable[] = {
+static const Tk_ArgvInfo argTable[] = {
{"-colormap", TK_ARGV_STRING, NULL, (char *) &colormap,
"Colormap for main window"},
{"-display", TK_ARGV_STRING, NULL, (char *) &display,
@@ -241,14 +244,14 @@ static Tk_ArgvInfo argTable[] = {
*/
static Tk_Window CreateTopLevelWindow(Tcl_Interp *interp,
- Tk_Window parent, CONST char *name,
- CONST char *screenName, unsigned int flags);
+ Tk_Window parent, const char *name,
+ const char *screenName, unsigned int flags);
static void DeleteWindowsExitProc(ClientData clientData);
-static TkDisplay * GetScreen(Tcl_Interp *interp, CONST char *screenName,
+static TkDisplay * GetScreen(Tcl_Interp *interp, const char *screenName,
int *screenPtr);
static int Initialize(Tcl_Interp *interp);
static int NameWindow(Tcl_Interp *interp, TkWindow *winPtr,
- TkWindow *parentPtr, CONST char *name);
+ TkWindow *parentPtr, const char *name);
static void UnlinkWindow(TkWindow *winPtr);
/*
@@ -288,11 +291,12 @@ TkCloseDisplay(
if (dispPtr->errorPtr != NULL) {
TkErrorHandler *errorPtr;
+
for (errorPtr = dispPtr->errorPtr;
errorPtr != NULL;
errorPtr = dispPtr->errorPtr) {
dispPtr->errorPtr = errorPtr->nextPtr;
- ckfree((char *) errorPtr);
+ ckfree(errorPtr);
}
}
@@ -307,7 +311,7 @@ TkCloseDisplay(
Tcl_DeleteHashTable(&dispPtr->winTable);
- ckfree((char *) dispPtr);
+ ckfree(dispPtr);
/*
* There is more to clean up, we leave it at this for the time being.
@@ -341,9 +345,9 @@ CreateTopLevelWindow(
Tk_Window parent, /* Token for logical parent of new window
* (used for naming, options, etc.). May be
* NULL. */
- CONST char *name, /* Name for new window; if parent is non-NULL,
+ const char *name, /* Name for new window; if parent is non-NULL,
* must be unique among parent's children. */
- CONST char *screenName, /* Name of screen on which to create window.
+ const char *screenName, /* Name of screen on which to create window.
* NULL means use DISPLAY environment variable
* to determine. Empty string means use
* parent's screen, or DISPLAY if no
@@ -353,7 +357,7 @@ CreateTopLevelWindow(
register TkWindow *winPtr;
register TkDisplay *dispPtr;
int screenId;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (!tsdPtr->initialized) {
@@ -371,6 +375,7 @@ CreateTopLevelWindow(
*/
Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
+ Tk_CreatePhotoImageFormat(&tkImgFmtPNG);
Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
}
@@ -380,7 +385,7 @@ CreateTopLevelWindow(
} else {
dispPtr = GetScreen(interp, screenName, &screenId);
if (dispPtr == NULL) {
- return (Tk_Window) NULL;
+ return NULL;
}
}
@@ -413,7 +418,7 @@ CreateTopLevelWindow(
if (parent != NULL) {
if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) {
Tk_DestroyWindow((Tk_Window) winPtr);
- return (Tk_Window) NULL;
+ return NULL;
}
}
TkWmNewWindow(winPtr);
@@ -445,15 +450,15 @@ CreateTopLevelWindow(
static TkDisplay *
GetScreen(
Tcl_Interp *interp, /* Place to leave error message. */
- CONST char *screenName, /* Name for screen. NULL or empty means use
+ const char *screenName, /* Name for screen. NULL or empty means use
* DISPLAY envariable. */
int *screenPtr) /* Where to store screen number. */
{
register TkDisplay *dispPtr;
- CONST char *p;
+ const char *p;
int screenId;
size_t length;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
@@ -464,9 +469,9 @@ GetScreen(
screenName = TkGetDefaultScreenName(interp, screenName);
if (screenName == NULL) {
- Tcl_SetResult(interp,
- "no display name and no $DISPLAY environment variable",
- TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no display name and no $DISPLAY environment variable", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL);
return NULL;
}
length = strlen(screenName);
@@ -494,9 +499,9 @@ GetScreen(
dispPtr = TkpOpenDisplay(screenName);
if (dispPtr == NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't connect to display \"",
- screenName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't connect to display \"%s\"", screenName));
+ Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL);
return NULL;
}
dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */
@@ -505,7 +510,7 @@ GetScreen(
dispPtr->lastEventTime = CurrentTime;
dispPtr->bindInfoStale = 1;
dispPtr->cursorFont = None;
- dispPtr->warpWindow = None;
+ dispPtr->warpWindow = NULL;
dispPtr->multipleAtom = None;
/*
@@ -517,11 +522,9 @@ GetScreen(
Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);
- dispPtr->name = (char *) ckalloc((unsigned) (length+1));
+ dispPtr->name = ckalloc(length + 1);
strncpy(dispPtr->name, screenName, length);
dispPtr->name[length] = '\0';
-
- TkInitXId(dispPtr);
break;
}
if ((strncmp(dispPtr->name, screenName, length) == 0)
@@ -530,10 +533,9 @@ GetScreen(
}
}
if (screenId >= ScreenCount(dispPtr->display)) {
- char buf[32 + TCL_INTEGER_SPACE];
-
- sprintf(buf, "bad screen number \"%d\"", screenId);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad screen number \"%d\"", screenId));
+ Tcl_SetErrorCode(interp, "TK", "DISPLAY", "SCREEN_NUMBER", NULL);
return NULL;
}
*screenPtr = screenId;
@@ -563,7 +565,7 @@ TkGetDisplay(
Display *display) /* X's display pointer */
{
TkDisplay *dispPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
@@ -596,7 +598,7 @@ TkGetDisplay(
TkDisplay *
TkGetDisplayList(void)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
return tsdPtr->displayList;
@@ -623,7 +625,7 @@ TkGetDisplayList(void)
TkMainInfo *
TkGetMainInfoList(void)
{
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
return tsdPtr->mainWindowList;
@@ -653,9 +655,8 @@ TkAllocWindow(
* inherit visual information. NULL means use
* screen defaults instead of inheriting. */
{
- register TkWindow *winPtr;
+ register TkWindow *winPtr = ckalloc(sizeof(TkWindow));
- winPtr = (TkWindow *) ckalloc(sizeof(TkWindow));
winPtr->display = dispPtr->display;
winPtr->dispPtr = dispPtr;
winPtr->screenNum = screenNum;
@@ -708,6 +709,7 @@ TkAllocWindow(
winPtr->internalBorderBottom = 0;
winPtr->minReqWidth = 0;
winPtr->minReqHeight = 0;
+ winPtr->geometryMaster = NULL;
return winPtr;
}
@@ -735,7 +737,7 @@ NameWindow(
register TkWindow *winPtr, /* Window that is to be named and inserted. */
TkWindow *parentPtr, /* Pointer to logical parent for winPtr (used
* for naming, options, etc.). */
- CONST char *name) /* Name for winPtr; must be unique among
+ const char *name) /* Name for winPtr; must be unique among
* parentPtr's children. */
{
#define FIXED_SIZE 200
@@ -773,24 +775,25 @@ NameWindow(
}
/*
- * For non-anonymous windows, set up the window name.
- */
-
- winPtr->nameUid = Tk_GetUid(name);
-
- /*
* Don't permit names that start with an upper-case letter: this will just
* cause confusion with class names in the option database.
*/
if (isupper(UCHAR(name[0]))) {
- Tcl_AppendResult(interp,
- "window name starts with an upper-case letter: \"",
- name, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window name starts with an upper-case letter: \"%s\"",
+ name));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL);
return TCL_ERROR;
}
/*
+ * For non-anonymous windows, set up the window name.
+ */
+
+ winPtr->nameUid = Tk_GetUid(name);
+
+ /*
* To permit names of arbitrary length, must be prepared to malloc a
* buffer to hold the new path name. To run fast in the common case where
* names are short, use a fixed-size buffer on the stack.
@@ -798,10 +801,10 @@ NameWindow(
length1 = strlen(parentPtr->pathName);
length2 = strlen(name);
- if ((length1+length2+2) <= FIXED_SIZE) {
+ if ((length1 + length2 + 2) <= FIXED_SIZE) {
pathName = staticSpace;
} else {
- pathName = (char *) ckalloc((unsigned) (length1+length2+2));
+ pathName = ckalloc(length1 + length2 + 2);
}
if (length1 == 1) {
pathName[0] = '.';
@@ -817,8 +820,9 @@ NameWindow(
ckfree(pathName);
}
if (!isNew) {
- Tcl_AppendResult(interp, "window name \"", name,
- "\" already exists in parent", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "window name \"%s\" already exists in parent", name));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL);
return TCL_ERROR;
}
Tcl_SetHashValue(hPtr, winPtr);
@@ -852,10 +856,10 @@ NameWindow(
Tk_Window
TkCreateMainWindow(
Tcl_Interp *interp, /* Interpreter to use for error reporting. */
- CONST char *screenName, /* Name of screen on which to create window.
+ const char *screenName, /* Name of screen on which to create window.
* Empty or NULL string means use DISPLAY
* environment variable. */
- char *baseName) /* Base name for application; usually of the
+ const char *baseName) /* Base name for application; usually of the
* form "prog instance". */
{
Tk_Window tkwin;
@@ -865,7 +869,7 @@ TkCreateMainWindow(
register TkWindow *winPtr;
register const TkCmd *cmdPtr;
ClientData clientData;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
@@ -893,7 +897,7 @@ TkCreateMainWindow(
*/
winPtr = (TkWindow *) tkwin;
- mainPtr = (TkMainInfo *) ckalloc(sizeof(TkMainInfo));
+ mainPtr = ckalloc(sizeof(TkMainInfo));
mainPtr->winPtr = winPtr;
mainPtr->refCount = 1;
mainPtr->interp = interp;
@@ -927,6 +931,7 @@ TkCreateMainWindow(
hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
Tcl_SetHashValue(hPtr, winPtr);
winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);
+ Tcl_InitHashTable(&mainPtr->busyTable, TCL_ONE_WORD_KEYS);
/*
* We have just created another Tk application; increment the refcount on
@@ -950,39 +955,39 @@ TkCreateMainWindow(
if (cmdPtr->objProc == NULL) {
Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs");
}
-#if defined(__WIN32__) && !defined(STATIC_BUILD)
+
+#if defined(_WIN32) && !defined(STATIC_BUILD)
if ((cmdPtr->flags & WINMACONLY) && tclStubsPtr->reserved9) {
- /* We are running on Cygwin, so don't use the win32 dialogs */
+ /*
+ * We are running on Cygwin, so don't use the win32 dialogs.
+ */
+
continue;
}
-#endif
+#endif /* _WIN32 && !STATIC_BUILD */
+
if (cmdPtr->flags & PASSMAINWINDOW) {
- clientData = (ClientData) tkwin;
+ clientData = tkwin;
} else {
- clientData = (ClientData) NULL;
+ clientData = NULL;
}
- if (cmdPtr->flags & NOOBJPROC) {
- Tcl_CreateCommand(interp, cmdPtr->name,
- (Tcl_CmdProc *) cmdPtr->objProc, clientData, NULL);
+ if (cmdPtr->flags & USEINITPROC) {
+ ((TkInitProc *) cmdPtr->objProc)(interp, clientData);
} else {
Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
clientData, NULL);
}
- if (isSafe) {
- if (!(cmdPtr->flags & ISSAFE)) {
- Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
- }
+ if (isSafe && !(cmdPtr->flags & ISSAFE)) {
+ Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
}
}
- TkCreateMenuCmd(interp);
-
/*
* Set variables for the intepreter.
*/
- Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tk_patchLevel", NULL, TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tk_version", NULL, TK_VERSION, TCL_GLOBAL_ONLY);
tsdPtr->numMainWindows++;
return tkwin;
@@ -1016,36 +1021,38 @@ Tk_CreateWindow(
* the interp's result is assumed to be
* initialized by the caller. */
Tk_Window parent, /* Token for parent of new window. */
- CONST char *name, /* Name for new window. Must be unique among
+ const char *name, /* Name for new window. Must be unique among
* parent's children. */
- CONST char *screenName) /* If NULL, new window will be internal on
+ const char *screenName) /* If NULL, new window will be internal on
* same screen as its parent. If non-NULL,
* gives name of screen on which to create new
* window; window will be a top-level
* window. */
{
TkWindow *parentPtr = (TkWindow *) parent;
- TkWindow *winPtr;
-
- if ((parentPtr != NULL) && (parentPtr->flags & TK_ALREADY_DEAD)) {
- Tcl_AppendResult(interp,
- "can't create window: parent has been destroyed", NULL);
- return NULL;
- } else if ((parentPtr != NULL) &&
- (parentPtr->flags & TK_CONTAINER)) {
- Tcl_AppendResult(interp,
- "can't create window: its parent has -container = yes", NULL);
- return NULL;
- }
- if (screenName == NULL) {
- winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
- parentPtr);
- if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) {
- Tk_DestroyWindow((Tk_Window) winPtr);
+ if (parentPtr) {
+ if (parentPtr->flags & TK_ALREADY_DEAD) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: parent has been destroyed", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
return NULL;
+ } else if (parentPtr->flags & TK_CONTAINER) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: its parent has -container = yes",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
+ return NULL;
+ } else if (screenName == NULL) {
+ TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
+ parentPtr->screenNum, parentPtr);
+
+ if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ }
+ return (Tk_Window) winPtr;
}
- return (Tk_Window) winPtr;
}
return CreateTopLevelWindow(interp, parent, name, screenName,
/* flags */ 0);
@@ -1080,39 +1087,41 @@ Tk_CreateAnonymousWindow(
* the interp's result is assumed to be
* initialized by the caller. */
Tk_Window parent, /* Token for parent of new window. */
- CONST char *screenName) /* If NULL, new window will be internal on
+ const char *screenName) /* If NULL, new window will be internal on
* same screen as its parent. If non-NULL,
* gives name of screen on which to create new
* window; window will be a top-level
* window. */
{
TkWindow *parentPtr = (TkWindow *) parent;
- TkWindow *winPtr;
- if ((parentPtr != NULL) && (parentPtr->flags & TK_ALREADY_DEAD)) {
- Tcl_AppendResult(interp,
- "can't create window: parent has been destroyed", NULL);
- return NULL;
- } else if ((parentPtr != NULL) &&
- (parentPtr->flags & TK_CONTAINER)) {
- Tcl_AppendResult(interp,
- "can't create window: its parent has -container = yes", NULL);
- return NULL;
- }
- if (screenName == NULL) {
- winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
- parentPtr);
- /*
- * Add the anonymous window flag now, so that NameWindow will behave
- * correctly.
- */
-
- winPtr->flags |= TK_ANONYMOUS_WINDOW;
- if (NameWindow(interp, winPtr, parentPtr, NULL) != TCL_OK) {
- Tk_DestroyWindow((Tk_Window) winPtr);
+ if (parentPtr) {
+ if (parentPtr->flags & TK_ALREADY_DEAD) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: parent has been destroyed", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
return NULL;
+ } else if (parentPtr->flags & TK_CONTAINER) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: its parent has -container = yes",
+ -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
+ return NULL;
+ } else if (screenName == NULL) {
+ TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
+ parentPtr->screenNum, parentPtr);
+ /*
+ * Add the anonymous window flag now, so that NameWindow will
+ * behave correctly.
+ */
+
+ winPtr->flags |= TK_ANONYMOUS_WINDOW;
+ if (NameWindow(interp, winPtr, parentPtr, NULL) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ }
+ return (Tk_Window) winPtr;
}
- return (Tk_Window) winPtr;
}
return CreateTopLevelWindow(interp, parent, NULL, screenName,
TK_ANONYMOUS_WINDOW);
@@ -1147,11 +1156,11 @@ Tk_CreateWindowFromPath(
* initialized by the caller. */
Tk_Window tkwin, /* Token for any window in application that is
* to contain new window. */
- CONST char *pathName, /* Path name for new window within the
+ const char *pathName, /* Path name for new window within the
* application of tkwin. The parent of this
* window must already exist, but the window
* itself must not exist. */
- CONST char *screenName) /* If NULL, new window will be on same screen
+ const char *screenName) /* If NULL, new window will be on same screen
* as its parent. If non-NULL, gives name of
* screen on which to create new window;
* window will be a top-level window. */
@@ -1172,13 +1181,14 @@ Tk_CreateWindowFromPath(
p = strrchr(pathName, '.');
if (p == NULL) {
- Tcl_AppendResult(interp, "bad window path name \"", pathName,
- "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad window path name \"%s\"", pathName));
+ Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL);
return NULL;
}
numChars = (int) (p-pathName);
if (numChars > FIXED_SPACE) {
- p = (char *) ckalloc((unsigned) (numChars+1));
+ p = ckalloc(numChars + 1);
} else {
p = fixedSpace;
}
@@ -1202,13 +1212,14 @@ Tk_CreateWindowFromPath(
return NULL;
}
if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
- Tcl_AppendResult(interp,
- "can't create window: parent has been destroyed", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: parent has been destroyed", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
return NULL;
- }
- if (((TkWindow *) parent)->flags & TK_CONTAINER) {
- Tcl_AppendResult(interp,
- "can't create window: its parent has -container = yes", NULL);
+ } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "can't create window: its parent has -container = yes", -1));
+ Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
return NULL;
}
@@ -1262,7 +1273,7 @@ Tk_DestroyWindow(
TkDisplay *dispPtr = winPtr->dispPtr;
XEvent event;
TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ ThreadSpecificData *tsdPtr =
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
if (winPtr->flags & TK_ALREADY_DEAD) {
@@ -1285,7 +1296,7 @@ Tk_DestroyWindow(
(tsdPtr->halfdeadWindowList->winPtr == winPtr)) {
halfdeadPtr = tsdPtr->halfdeadWindowList;
} else {
- halfdeadPtr = (TkHalfdeadWindow *) ckalloc(sizeof(TkHalfdeadWindow));
+ halfdeadPtr = ckalloc(sizeof(TkHalfdeadWindow));
halfdeadPtr->flags = 0;
halfdeadPtr->winPtr = winPtr;
halfdeadPtr->nextPtr = tsdPtr->halfdeadWindowList;
@@ -1347,12 +1358,11 @@ Tk_DestroyWindow(
if (!(halfdeadPtr->flags & HD_DESTROY_COUNT)) {
halfdeadPtr->flags |= HD_DESTROY_COUNT;
- dispPtr->destroyCount++;
}
while (winPtr->childList != NULL) {
- TkWindow *childPtr;
- childPtr = winPtr->childList;
+ TkWindow *childPtr = winPtr->childList;
+
childPtr->flags |= TK_DONT_DESTROY_WINDOW;
Tk_DestroyWindow((Tk_Window) childPtr);
if (winPtr->childList == childPtr) {
@@ -1379,8 +1389,8 @@ Tk_DestroyWindow(
* deleted, in which case TkpGetOtherWindow will return NULL.
*/
- TkWindow *childPtr;
- childPtr = TkpGetOtherWindow(winPtr);
+ TkWindow *childPtr = TkpGetOtherWindow(winPtr);
+
if (childPtr != NULL) {
childPtr->flags |= TK_DONT_DESTROY_WINDOW;
Tk_DestroyWindow((Tk_Window) childPtr);
@@ -1430,7 +1440,7 @@ Tk_DestroyWindow(
} else {
prev_halfdeadPtr->nextPtr = halfdeadPtr->nextPtr;
}
- ckfree((char *) halfdeadPtr);
+ ckfree(halfdeadPtr);
break;
}
prev_halfdeadPtr = halfdeadPtr;
@@ -1450,7 +1460,7 @@ Tk_DestroyWindow(
TkWmRemoveFromColormapWindows(winPtr);
}
if (winPtr->window != None) {
-#if defined(MAC_OSX_TK) || defined(__WIN32__)
+#if defined(MAC_OSX_TK) || defined(_WIN32)
XDestroyWindow(winPtr->display, winPtr->window);
#else
if ((winPtr->flags & TK_TOP_HIERARCHY)
@@ -1462,19 +1472,15 @@ Tk_DestroyWindow(
* to do an explicit destroy of this X window.
*/
- dispPtr->lastDestroyRequest = NextRequest(winPtr->display);
XDestroyWindow(winPtr->display, winPtr->window);
}
#endif
- TkFreeWindowId(dispPtr, winPtr->window);
Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable,
(char *) winPtr->window));
winPtr->window = None;
}
- dispPtr->destroyCount--;
UnlinkWindow(winPtr);
TkEventDeadWindow(winPtr);
- TkBindDeadWindow(winPtr);
#ifdef TK_USE_INPUT_METHODS
if (winPtr->inputContext != NULL) {
XDestroyIC(winPtr->inputContext);
@@ -1487,10 +1493,14 @@ Tk_DestroyWindow(
TkOptionDeadWindow(winPtr);
TkSelDeadWindow(winPtr);
TkGrabDeadWindow(winPtr);
+ if (winPtr->geometryMaster != NULL) {
+ ckfree(winPtr->geometryMaster);
+ winPtr->geometryMaster = NULL;
+ }
if (winPtr->mainPtr != NULL) {
if (winPtr->pathName != NULL) {
Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable,
- (ClientData) winPtr->pathName);
+ winPtr->pathName);
Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable,
winPtr->pathName));
@@ -1525,18 +1535,19 @@ Tk_DestroyWindow(
*/
if ((winPtr->mainPtr->interp != NULL) &&
- (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) {
+ !Tcl_InterpDeleted(winPtr->mainPtr->interp)) {
for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
- Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name,
- TkDeadAppCmd, NULL, NULL);
+ Tcl_CreateObjCommand(winPtr->mainPtr->interp, cmdPtr->name,
+ TkDeadAppObjCmd, NULL, NULL);
}
- Tcl_CreateCommand(winPtr->mainPtr->interp, "send",
- TkDeadAppCmd, NULL, NULL);
+ Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send",
+ TkDeadAppObjCmd, NULL, NULL);
Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
- Tcl_UnlinkVar(winPtr->mainPtr->interp,
+ Tcl_UnlinkVar(winPtr->mainPtr->interp,
"::tk::AlwaysShowSelection");
}
+ Tcl_DeleteHashTable(&winPtr->mainPtr->busyTable);
Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
TkBindFree(winPtr->mainPtr);
TkDeleteAllImages(winPtr->mainPtr);
@@ -1554,14 +1565,14 @@ Tk_DestroyWindow(
if (winPtr->flags & TK_EMBEDDED) {
XSync(winPtr->display, False);
}
- ckfree((char *) winPtr->mainPtr);
+ ckfree(winPtr->mainPtr);
/*
* If no other applications are using the display, close the
* display now and relinquish its data structures.
*/
-#if !defined(WIN32) && defined(NOT_YET)
+#if !defined(_WIN32) && defined(NOT_YET)
if (dispPtr->refCount <= 0) {
/*
* I have disabled this code because on Windows there are
@@ -1609,10 +1620,10 @@ Tk_DestroyWindow(
TkCloseDisplay(dispPtr);
}
-#endif
+#endif /* !_WIN32 && NOT_YET */
}
}
- Tcl_EventuallyFree((ClientData) winPtr, TCL_DYNAMIC);
+ Tcl_EventuallyFree(winPtr, TCL_DYNAMIC);
}
/*
@@ -1719,7 +1730,7 @@ Tk_MakeWindowExist(
createProc = Tk_GetClassProc(winPtr->classProcsPtr, createProc);
if (createProc != NULL && parent != None) {
- winPtr->window = (*createProc)(tkwin, parent, winPtr->instanceData);
+ winPtr->window = createProc(tkwin, parent, winPtr->instanceData);
} else {
winPtr->window = TkpMakeWindow(winPtr, parent);
}
@@ -1747,6 +1758,7 @@ Tk_MakeWindowExist(
if ((winPtr2->window != None)
&& !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) {
XWindowChanges changes;
+
changes.sibling = winPtr2->window;
changes.stack_mode = Below;
XConfigureWindow(winPtr->display, winPtr->window,
@@ -1860,7 +1872,7 @@ Tk_ConfigureWindow(
winPtr->changes.border_width = valuePtr->border_width;
}
if (valueMask & (CWSibling|CWStackMode)) {
- Tcl_Panic("Can't set sibling or stack mode from Tk_ConfigureWindow.");
+ Tcl_Panic("Can't set sibling or stack mode from Tk_ConfigureWindow");
}
if (winPtr->window != None) {
@@ -2247,7 +2259,7 @@ TkDoConfigureNotify(
void
Tk_SetClass(
Tk_Window tkwin, /* Token for window to assign class. */
- CONST char *className) /* New class for tkwin. */
+ const char *className) /* New class for tkwin. */
{
register TkWindow *winPtr = (TkWindow *) tkwin;
@@ -2279,7 +2291,7 @@ Tk_SetClass(
void
Tk_SetClassProcs(
Tk_Window tkwin, /* Token for window to modify. */
- Tk_ClassProcs *procs, /* Class procs structure. */
+ const Tk_ClassProcs *procs, /* Class procs structure. */
ClientData instanceData) /* Data to be passed to class functions. */
{
register TkWindow *winPtr = (TkWindow *) tkwin;
@@ -2311,7 +2323,7 @@ Tk_SetClassProcs(
Tk_Window
Tk_NameToWindow(
Tcl_Interp *interp, /* Where to report errors. */
- CONST char *pathName, /* Path name of window. */
+ const char *pathName, /* Path name of window. */
Tk_Window tkwin) /* Token for window: name is assumed to belong
* to the same main window as tkwin. */
{
@@ -2324,7 +2336,8 @@ Tk_NameToWindow(
*/
if (interp != NULL) {
- Tcl_AppendResult(interp, "NULL main window", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1));
+ Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL);
}
return NULL;
}
@@ -2333,12 +2346,14 @@ Tk_NameToWindow(
pathName);
if (hPtr == NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "bad window path name \"",
- pathName, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad window path name \"%s\"", pathName));
+ Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", pathName,
+ NULL);
}
return NULL;
}
- return (Tk_Window) Tcl_GetHashValue(hPtr);
+ return Tcl_GetHashValue(hPtr);
}
/*
@@ -2381,7 +2396,7 @@ Tk_IdToWindow(
if (hPtr == NULL) {
return NULL;
}
- return (Tk_Window) Tcl_GetHashValue(hPtr);
+ return Tcl_GetHashValue(hPtr);
}
/*
@@ -2401,7 +2416,7 @@ Tk_IdToWindow(
*----------------------------------------------------------------------
*/
-CONST char *
+const char *
Tk_DisplayName(
Tk_Window tkwin) /* Window whose display name is desired. */
{
@@ -2428,8 +2443,8 @@ Tcl_Interp *
Tk_Interp(
Tk_Window tkwin)
{
- if (tkwin != NULL && ((TkWindow *)tkwin)->mainPtr != NULL) {
- return ((TkWindow *)tkwin)->mainPtr->interp;
+ if (tkwin != NULL && ((TkWindow *) tkwin)->mainPtr != NULL) {
+ return ((TkWindow *) tkwin)->mainPtr->interp;
}
return NULL;
}
@@ -2587,9 +2602,8 @@ Tk_RestackWindow(
if (winPtr->window != None) {
XWindowChanges changes;
- unsigned int mask;
+ unsigned int mask = CWStackMode;
- mask = CWStackMode;
changes.stack_mode = Above;
for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
otherPtr = otherPtr->nextPtr) {
@@ -2640,8 +2654,7 @@ Tk_MainWindow(
return NULL;
}
#endif
- tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
mainPtr = mainPtr->nextPtr) {
@@ -2649,7 +2662,9 @@ Tk_MainWindow(
return (Tk_Window) mainPtr->winPtr;
}
}
- Tcl_SetResult(interp, "this isn't a Tk application", TCL_STATIC);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "this isn't a Tk application", -1));
+ Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL);
return NULL;
}
@@ -2709,8 +2724,7 @@ Tk_GetNumMainWindows(void)
}
#endif
- tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
return tsdPtr->numMainWindows;
}
@@ -2768,7 +2782,7 @@ DeleteWindowsExitProc(
{
TkDisplay *dispPtr, *nextPtr;
Tcl_Interp *interp;
- ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
+ ThreadSpecificData *tsdPtr = clientData;
if (tsdPtr == NULL) {
return;
@@ -2784,11 +2798,11 @@ DeleteWindowsExitProc(
while (tsdPtr->halfdeadWindowList != NULL) {
interp = tsdPtr->halfdeadWindowList->winPtr->mainPtr->interp;
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(interp);
tsdPtr->halfdeadWindowList->flags |= HD_CLEANUP;
tsdPtr->halfdeadWindowList->winPtr->flags &= ~TK_ALREADY_DEAD;
Tk_DestroyWindow((Tk_Window) tsdPtr->halfdeadWindowList->winPtr);
- Tcl_Release((ClientData) interp);
+ Tcl_Release(interp);
}
/*
@@ -2797,9 +2811,9 @@ DeleteWindowsExitProc(
while (tsdPtr->mainWindowList != NULL) {
interp = tsdPtr->mainWindowList->interp;
- Tcl_Preserve((ClientData) interp);
+ Tcl_Preserve(interp);
Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
- Tcl_Release((ClientData) interp);
+ Tcl_Release(interp);
}
/*
@@ -2831,51 +2845,54 @@ DeleteWindowsExitProc(
tsdPtr->initialized = 0;
}
-#if defined(__WIN32__)
+#if defined(_WIN32)
static HMODULE tkcygwindll = NULL;
/*
* Run Tk_MainEx from libtk8.?.dll
*
- * This function is only ever called from wish8.4.exe, the cygwin
- * port of Tcl. This means that the system encoding is utf-8,
- * so we don't have to do any encoding conversions.
+ * This function is only ever called from wish8.4.exe, the cygwin port of Tcl.
+ * This means that the system encoding is utf-8, so we don't have to do any
+ * encoding conversions.
*/
+
int
-TkCygwinMainEx(argc, argv, appInitProc, interp)
- int argc; /* Number of arguments. */
- char **argv; /* Array of argument strings. */
- Tcl_AppInitProc *appInitProc; /* Application-specific initialization
- * procedure to call after most
- * initialization but before starting
- * to execute commands. */
- Tcl_Interp *interp;
+TkCygwinMainEx(
+ int argc, /* Number of arguments. */
+ char **argv, /* Array of argument strings. */
+ Tcl_AppInitProc *appInitProc,
+ /* Application-specific initialization
+ * procedure to call after most initialization
+ * but before starting to execute commands. */
+ Tcl_Interp *interp)
{
- char name[MAX_PATH];
+ TCHAR name[MAX_PATH];
int len;
- void (*sym)(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
+ void (*tkmainex)(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
/* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */
- len = GetModuleFileName(Tk_GetHINSTANCE(), name, MAX_PATH);
- name[len-2] = '.';
- name[len-1] = name[len-5];
- strcpy(name+len, ".dll");
- memcpy(name+len-8, "libtk8", 6);
-
- tkcygwindll = LoadLibrary(name);
- if (!tkcygwindll) {
- /* dll is not present */
- return 0;
- }
- sym = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_MainEx");
- if (!sym) {
- return 0;
- }
- sym(argc, argv, appInitProc, interp);
+ len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH);
+ name[len-2] = TEXT('.');
+ name[len-1] = name[len-5];
+ _tcscpy(name+len, TEXT(".dll"));
+ memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR));
+
+ tkcygwindll = LoadLibrary(name);
+ if (!tkcygwindll) {
+ /* dll is not present */
+ return 0;
+ }
+ tkmainex = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *))
+ GetProcAddress(tkcygwindll, "Tk_MainEx");
+ if (!tkmainex) {
+ return 0;
+ }
+ tkmainex(argc, argv, appInitProc, interp);
return 1;
}
-#endif
+#endif /* _WIN32 */
+
/*
*----------------------------------------------------------------------
*
@@ -2903,16 +2920,16 @@ int
Tk_Init(
Tcl_Interp *interp) /* Interpreter to initialize. */
{
-#if defined(__WIN32__)
+#if defined(_WIN32)
if (tkcygwindll) {
- int (*sym)(Tcl_Interp *);
+ int (*tkinit)(Tcl_Interp *);
- sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_Init");
- if (sym) {
- return sym(interp);
+ tkinit = (int(*)(Tcl_Interp *)) GetProcAddress(tkcygwindll,"Tk_Init");
+ if (tkinit) {
+ return tkinit(interp);
}
}
-#endif
+#endif /* _WIN32 */
return Initialize(interp);
}
@@ -2976,27 +2993,29 @@ Tk_SafeInit(
* checked at several places to differentiate the two initialisations.
*/
-#if defined(__WIN32__)
+#if defined(_WIN32)
if (tkcygwindll) {
- int (*sym)(Tcl_Interp *);
+ int (*tksafeinit)(Tcl_Interp *);
- sym = (int (*)(Tcl_Interp *)) GetProcAddress(tkcygwindll, "Tk_SafeInit");
- if (sym) {
- return sym(interp);
+ tksafeinit = (int (*)(Tcl_Interp *))
+ GetProcAddress(tkcygwindll, "Tk_SafeInit");
+ if (tksafeinit) {
+ return tksafeinit(interp);
}
}
-#endif
+#endif /* _WIN32 */
return Initialize(interp);
}
-extern TkStubs tkStubs;
+MODULE_SCOPE const TkStubs tkStubs;
/*
*----------------------------------------------------------------------
*
* Initialize --
*
- * ???TODO???
+ * The core of the initialization code for Tk, called from Tk_Init and
+ * Tk_SafeInit.
*
* Results:
* A standard Tcl result. Also leaves an error message in the interp's
@@ -3014,9 +3033,9 @@ Initialize(
{
char *p;
int argc, code;
- CONST char **argv;
- char *args[20];
- CONST char *argString = NULL;
+ const char **argv;
+ const char *args[20];
+ const char *argString = NULL;
Tcl_DString class;
ThreadSpecificData *tsdPtr;
@@ -3024,7 +3043,7 @@ Initialize(
* Ensure that we are getting a compatible version of Tcl.
*/
- if (Tcl_InitStubs(interp, "8.5.0", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
return TCL_ERROR;
}
@@ -3034,8 +3053,7 @@ Initialize(
TkRegisterObjTypes();
- tsdPtr = (ThreadSpecificData *)
- Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+ tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
/*
* Start by initializing all the static variables to default acceptable
@@ -3055,7 +3073,7 @@ Initialize(
argv = NULL;
/*
- * We start by resetting the result because it might not be clean
+ * We start by resetting the result because it might not be clean.
*/
Tcl_ResetResult(interp);
@@ -3080,7 +3098,9 @@ Initialize(
while (1) {
master = Tcl_GetMaster(master);
if (master == NULL) {
- Tcl_AppendResult(interp, "NULL master", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no controlling master interpreter", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL);
code = TCL_ERROR;
goto done;
}
@@ -3096,7 +3116,9 @@ Initialize(
code = Tcl_GetInterpPath(master, interp);
if (code != TCL_OK) {
- Tcl_AppendResult(interp, "error in Tcl_GetInterpPath", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "error in Tcl_GetInterpPath", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL);
goto done;
}
@@ -3106,14 +3128,14 @@ Initialize(
Tcl_DStringInit(&ds);
Tcl_DStringAppendElement(&ds, "::safe::TkInit");
- Tcl_DStringAppendElement(&ds, Tcl_GetStringResult(master));
+ Tcl_DStringAppendElement(&ds, Tcl_GetString(Tcl_GetObjResult(master)));
/*
* Step 2 : Eval in the master. The argument is the *reversed* interp
* path of the slave.
*/
- code = Tcl_Eval(master, Tcl_DStringValue(&ds));
+ code = Tcl_EvalEx(master, Tcl_DStringValue(&ds), -1, 0);
if (code != TCL_OK) {
/*
* We might want to transfer the error message or not. We don't.
@@ -3121,8 +3143,9 @@ Initialize(
*/
Tcl_DStringFree(&ds);
- Tcl_AppendResult(interp,
- "not allowed to start Tk by master's safe::TkInit", NULL);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "not allowed to start Tk by master's safe::TkInit", -1));
+ Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL);
goto done;
}
Tcl_DStringFree(&ds);
@@ -3133,7 +3156,7 @@ Initialize(
* changing the code below.
*/
- argString = Tcl_GetStringResult(master);
+ argString = Tcl_GetString(Tcl_GetObjResult(master));
} else {
/*
* If there is an "argv" variable, get its value, extract out relevant
@@ -3231,7 +3254,7 @@ Initialize(
visual = NULL;
}
args[argc] = NULL;
- code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name);
+ code = TkCreateFrame(NULL, interp, argc, args, 1, name);
Tcl_DStringFree(&class);
if (code != TCL_OK) {
@@ -3248,8 +3271,14 @@ Initialize(
*/
if (geometry != NULL) {
- Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
- code = Tcl_VarEval(interp, "wm geometry . ", geometry, NULL);
+ Tcl_DString buf;
+
+ Tcl_SetVar2(interp, "geometry", NULL, geometry, TCL_GLOBAL_ONLY);
+ Tcl_DStringInit(&buf);
+ Tcl_DStringAppend(&buf, "wm geometry . ", -1);
+ Tcl_DStringAppend(&buf, geometry, -1);
+ code = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
+ Tcl_DStringFree(&buf);
if (code != TCL_OK) {
goto done;
}
@@ -3275,12 +3304,6 @@ Initialize(
Tcl_SetMainLoop(Tk_MainLoop);
-#ifndef _WIN32
- /* On Windows, this has no added value. */
-# undef Tk_InitStubs
- Tk_InitStubs(interp, TK_VERSION, 1);
-#endif
-
/*
* Initialized the themed widget set
*/
@@ -3298,7 +3321,7 @@ Initialize(
Tcl_MutexUnlock(&windowMutex);
if (argv != NULL) {
- ckfree((char *) argv);
+ ckfree(argv);
}
code = TkpInit(interp);
if (code == TCL_OK) {
@@ -3313,7 +3336,7 @@ Initialize(
* an alternate [tkInit] command before calling Tk_Init().
*/
- code = Tcl_Eval(interp,
+ code = Tcl_EvalEx(interp,
"if {[namespace which -command tkInit] eq \"\"} {\n\
proc tkInit {} {\n\
global tk_library tk_version tk_patchLevel\n\
@@ -3321,7 +3344,7 @@ Initialize(
tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\
}\n\
}\n\
-tkInit");
+tkInit", -1, 0);
}
if (code == TCL_OK) {
/*
@@ -3330,14 +3353,14 @@ tkInit");
* specific cleanups take place to avoid panics in finalization.
*/
- TkCreateThreadExitHandler(DeleteWindowsExitProc, (ClientData) tsdPtr);
+ TkCreateThreadExitHandler(DeleteWindowsExitProc, tsdPtr);
}
return code;
done:
Tcl_MutexUnlock(&windowMutex);
if (argv != NULL) {
- ckfree((char *) argv);
+ ckfree(argv);
}
return code;
}
@@ -3361,16 +3384,16 @@ tkInit");
*----------------------------------------------------------------------
*/
-CONST char *
+const char *
Tk_PkgInitStubsCheck(
Tcl_Interp *interp,
- CONST char * version,
+ const char * version,
int exact)
{
- CONST char *actualVersion = Tcl_PkgRequire(interp, "Tk", version, 0);
+ const char *actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0, NULL);
if (exact && actualVersion) {
- CONST char *p = version;
+ const char *p = version;
int count = 0;
while (*p) {
@@ -3379,15 +3402,16 @@ Tk_PkgInitStubsCheck(
if (count == 1) {
if (0 != strncmp(version, actualVersion, strlen(version))) {
/* Construct error message */
- Tcl_PkgPresent(interp, "Tk", version, 1);
+ Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL);
return NULL;
}
} else {
- return Tcl_PkgPresent(interp, "Tk", version, 1);
+ return Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL);
}
}
return actualVersion;
}
+
/*
* Local Variables:
* mode: c
generated by cgit v0.12 at 2024-07-22 04:50:23 (GMT)