1 /*
2  * tkWindow.c --
3  *
4  *	This file provides basic window-manipulation functions, which are
5  *	equivalent to functions in Xlib (and even invoke them) but also
6  *	maintain the local Tk_Window structure.
7  *
8  * Copyright (c) 1989-1994 The Regents of the University of California.
9  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
10  *
11  * See the file "license.terms" for information on usage and redistribution of
12  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
13  */
14 
15 #include "tkInt.h"
16 #include "tkPort.h"
17 #ifdef _WIN32
18 #include "tkWinInt.h"
19 #elif !defined(MAC_OSX_TK)
20 #include "tkUnixInt.h"
21 #endif
22 
23 /*
24  * Type used to keep track of Window objects that were only partially
25  * deallocated by Tk_DestroyWindow.
26  */
27 
28 #define HD_CLEANUP		1
29 #define HD_FOCUS		2
30 #define HD_MAIN_WIN		4
31 #define HD_DESTROY_COUNT	8
32 #define HD_DESTROY_EVENT	0x10
33 
34 typedef struct TkHalfdeadWindow {
35     int flags;
36     struct TkWindow *winPtr;
37     struct TkHalfdeadWindow *nextPtr;
38 } TkHalfdeadWindow;
39 
40 typedef struct {
41     int numMainWindows;		/* Count of numver of main windows currently
42 				 * open in this thread. */
43     TkMainInfo *mainWindowList;
44 				/* First in list of all main windows managed
45 				 * by this thread. */
46     TkHalfdeadWindow *halfdeadWindowList;
47 				/* First in list of partially deallocated
48 				 * windows. */
49     TkDisplay *displayList;	/* List of all displays currently in use by
50 				 * the current thread. */
51     int initialized;		/* 0 means the structures above need
52 				 * initializing. */
53 } ThreadSpecificData;
54 static Tcl_ThreadDataKey dataKey;
55 
56 /*
57  * Default values for "changes" and "atts" fields of TkWindows. Note that Tk
58  * always requests all events for all windows, except StructureNotify events
59  * on internal windows: these events are generated internally.
60  */
61 
62 static const XWindowChanges defChanges = {
63     0, 0, 1, 1, 0, 0, Above
64 };
65 #define ALL_EVENTS_MASK \
66     KeyPressMask|KeyReleaseMask|ButtonPressMask|ButtonReleaseMask| \
67     EnterWindowMask|LeaveWindowMask|PointerMotionMask|ExposureMask| \
68     VisibilityChangeMask|PropertyChangeMask|ColormapChangeMask
69 static const XSetWindowAttributes defAtts= {
70     None,			/* background_pixmap */
71     0,				/* background_pixel */
72     CopyFromParent,		/* border_pixmap */
73     0,				/* border_pixel */
74     NorthWestGravity,		/* bit_gravity */
75     NorthWestGravity,		/* win_gravity */
76     NotUseful,			/* backing_store */
77     (unsigned) ~0,		/* backing_planes */
78     0,				/* backing_pixel */
79     False,			/* save_under */
80     ALL_EVENTS_MASK,		/* event_mask */
81     0,				/* do_not_propagate_mask */
82     False,			/* override_redirect */
83     CopyFromParent,		/* colormap */
84     None			/* cursor */
85 };
86 
87 /*
88  * The following structure defines all of the commands supported by Tk, and
89  * the C functions that execute them.
90  */
91 
92 #define ISSAFE 1
93 #define PASSMAINWINDOW 2
94 #define WINMACONLY 4
95 #define USEINITPROC 8
96 #define SAVEUPDATECMD 16 /* better only be one of these! */
97 
98 typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData);
99 typedef struct {
100     const char *name;		/* Name of command. */
101     Tcl_ObjCmdProc *objProc;	/* Command's object- (or string-) based
102 				 * function, or initProc. */
103     int flags;
104 } TkCmd;
105 
106 static const TkCmd commands[] = {
107     /*
108      * Commands that are part of the intrinsics:
109      */
110 
111     {"bell",		Tk_BellObjCmd,		PASSMAINWINDOW},
112     {"bind",		Tk_BindObjCmd,		PASSMAINWINDOW|ISSAFE},
113     {"bindtags",	Tk_BindtagsObjCmd,	PASSMAINWINDOW|ISSAFE},
114     {"clipboard",	Tk_ClipboardObjCmd,	PASSMAINWINDOW},
115     {"destroy",		Tk_DestroyObjCmd,	PASSMAINWINDOW|ISSAFE},
116     {"event",		Tk_EventObjCmd,		PASSMAINWINDOW|ISSAFE},
117     {"focus",		Tk_FocusObjCmd,		PASSMAINWINDOW|ISSAFE},
118     {"font",		Tk_FontObjCmd,		PASSMAINWINDOW|ISSAFE},
119     {"grab",		Tk_GrabObjCmd,		PASSMAINWINDOW},
120     {"grid",		Tk_GridObjCmd,		PASSMAINWINDOW|ISSAFE},
121     {"image",		Tk_ImageObjCmd,		PASSMAINWINDOW|ISSAFE},
122     {"lower",		Tk_LowerObjCmd,		PASSMAINWINDOW|ISSAFE},
123     {"option",		Tk_OptionObjCmd,	PASSMAINWINDOW|ISSAFE},
124     {"pack",		Tk_PackObjCmd,		PASSMAINWINDOW|ISSAFE},
125     {"place",		Tk_PlaceObjCmd,		PASSMAINWINDOW|ISSAFE},
126     {"raise",		Tk_RaiseObjCmd,		PASSMAINWINDOW|ISSAFE},
127     {"selection",	Tk_SelectionObjCmd,	PASSMAINWINDOW},
128     {"tk",		(Tcl_ObjCmdProc *)(void *)TkInitTkCmd,  USEINITPROC|PASSMAINWINDOW|ISSAFE},
129     {"tkwait",		Tk_TkwaitObjCmd,	PASSMAINWINDOW|ISSAFE},
130     {"update",		Tk_UpdateObjCmd,	PASSMAINWINDOW|ISSAFE|SAVEUPDATECMD},
131     {"winfo",		Tk_WinfoObjCmd,		PASSMAINWINDOW|ISSAFE},
132     {"wm",		Tk_WmObjCmd,		PASSMAINWINDOW},
133 
134     /*
135      * Default widget class commands.
136      */
137 
138     {"button",		Tk_ButtonObjCmd,	ISSAFE},
139     {"canvas",		Tk_CanvasObjCmd,	PASSMAINWINDOW|ISSAFE},
140     {"checkbutton",	Tk_CheckbuttonObjCmd,	ISSAFE},
141     {"entry",		Tk_EntryObjCmd,		ISSAFE},
142     {"frame",		Tk_FrameObjCmd,		ISSAFE},
143     {"label",		Tk_LabelObjCmd,		ISSAFE},
144     {"labelframe",	Tk_LabelframeObjCmd,	ISSAFE},
145     {"listbox",		Tk_ListboxObjCmd,	ISSAFE},
146     {"menu",		Tk_MenuObjCmd,	PASSMAINWINDOW},
147     {"menubutton",	Tk_MenubuttonObjCmd,	ISSAFE},
148     {"message",		Tk_MessageObjCmd,	ISSAFE},
149     {"panedwindow",	Tk_PanedWindowObjCmd,	ISSAFE},
150     {"radiobutton",	Tk_RadiobuttonObjCmd,	ISSAFE},
151     {"scale",		Tk_ScaleObjCmd,		ISSAFE},
152     {"scrollbar",	Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE},
153     {"spinbox",		Tk_SpinboxObjCmd,	ISSAFE},
154     {"text",		Tk_TextObjCmd,		PASSMAINWINDOW|ISSAFE},
155     {"toplevel",	Tk_ToplevelObjCmd,	0},
156 
157     /*
158      * Classic widget class commands.
159      */
160 
161     {"::tk::button",	Tk_ButtonObjCmd,	ISSAFE},
162     {"::tk::canvas",	Tk_CanvasObjCmd,	PASSMAINWINDOW|ISSAFE},
163     {"::tk::checkbutton",Tk_CheckbuttonObjCmd,	ISSAFE},
164     {"::tk::entry",	Tk_EntryObjCmd,		ISSAFE},
165     {"::tk::frame",	Tk_FrameObjCmd,		ISSAFE},
166     {"::tk::label",	Tk_LabelObjCmd,		ISSAFE},
167     {"::tk::labelframe",Tk_LabelframeObjCmd,	ISSAFE},
168     {"::tk::listbox",	Tk_ListboxObjCmd,	ISSAFE},
169     {"::tk::menubutton",Tk_MenubuttonObjCmd,	ISSAFE},
170     {"::tk::message",	Tk_MessageObjCmd,	ISSAFE},
171     {"::tk::panedwindow",Tk_PanedWindowObjCmd,	ISSAFE},
172     {"::tk::radiobutton",Tk_RadiobuttonObjCmd,	ISSAFE},
173     {"::tk::scale",	Tk_ScaleObjCmd,		ISSAFE},
174     {"::tk::scrollbar",	Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE},
175     {"::tk::spinbox",	Tk_SpinboxObjCmd,	ISSAFE},
176     {"::tk::text",	Tk_TextObjCmd,		PASSMAINWINDOW|ISSAFE},
177     {"::tk::toplevel",	Tk_ToplevelObjCmd,	0},
178 
179     /*
180      * Standard dialog support. Note that the Unix/X11 platform implements
181      * these commands differently (via the script library).
182      */
183 
184 #if defined(_WIN32) || defined(MAC_OSX_TK)
185     {"tk_chooseColor",	Tk_ChooseColorObjCmd,	PASSMAINWINDOW},
186     {"tk_chooseDirectory", Tk_ChooseDirectoryObjCmd,WINMACONLY|PASSMAINWINDOW},
187     {"tk_getOpenFile",	Tk_GetOpenFileObjCmd,	WINMACONLY|PASSMAINWINDOW},
188     {"tk_getSaveFile",	Tk_GetSaveFileObjCmd,	WINMACONLY|PASSMAINWINDOW},
189     {"tk_messageBox",	Tk_MessageBoxObjCmd,	PASSMAINWINDOW},
190 #endif
191 
192     /*
193      * Misc.
194      */
195 
196 #ifdef MAC_OSX_TK
197     {"::tk::unsupported::MacWindowStyle",
198 			TkUnsupported1ObjCmd,	PASSMAINWINDOW|ISSAFE},
199 #endif
200     {NULL,		NULL,			0}
201 };
202 
203 /*
204  * Forward declarations to functions defined later in this file:
205  */
206 
207 static Tk_Window	CreateTopLevelWindow(Tcl_Interp *interp,
208 			    Tk_Window parent, const char *name,
209 			    const char *screenName, unsigned int flags);
210 static void		DeleteWindowsExitProc(ClientData clientData);
211 static TkDisplay *	GetScreen(Tcl_Interp *interp, const char *screenName,
212 			    int *screenPtr);
213 static int		Initialize(Tcl_Interp *interp);
214 static int		NameWindow(Tcl_Interp *interp, TkWindow *winPtr,
215 			    TkWindow *parentPtr, const char *name);
216 static void		UnlinkWindow(TkWindow *winPtr);
217 
218 /*
219  *----------------------------------------------------------------------
220  *
221  * TkCloseDisplay --
222  *
223  *	Closing the display can lead to order of deletion problems. We defer
224  *	it until exit handling for Mac/Win, but since Unix can use many
225  *	displays, try and clean it up as best as possible.
226  *
227  * Results:
228  *	None.
229  *
230  * Side effects:
231  *	Resources associated with the display will be free. The display may
232  *	not be referenced at all after this.
233  *
234  *----------------------------------------------------------------------
235  */
236 
237 static void
TkCloseDisplay(TkDisplay * dispPtr)238 TkCloseDisplay(
239     TkDisplay *dispPtr)
240 {
241     TkClipCleanup(dispPtr);
242 
243     TkpCancelWarp(dispPtr);
244 
245     if (dispPtr->name != NULL) {
246 	ckfree(dispPtr->name);
247     }
248 
249     if (dispPtr->atomInit) {
250 	Tcl_DeleteHashTable(&dispPtr->nameTable);
251 	Tcl_DeleteHashTable(&dispPtr->atomTable);
252 	dispPtr->atomInit = 0;
253     }
254 
255     if (dispPtr->errorPtr != NULL) {
256 	TkErrorHandler *errorPtr;
257 
258 	for (errorPtr = dispPtr->errorPtr;
259 		errorPtr != NULL;
260 		errorPtr = dispPtr->errorPtr) {
261 	    dispPtr->errorPtr = errorPtr->nextPtr;
262 	    ckfree(errorPtr);
263 	}
264     }
265 
266     TkGCCleanup(dispPtr);
267 
268     TkpCloseDisplay(dispPtr);
269 
270     /*
271      * Delete winTable after TkpCloseDisplay since special windows may need
272      * call Tk_DestroyWindow and it checks the winTable.
273      */
274 
275     Tcl_DeleteHashTable(&dispPtr->winTable);
276 
277     ckfree(dispPtr);
278 
279     /*
280      * There is more to clean up, we leave it at this for the time being.
281      */
282 }
283 
284 /*
285  *----------------------------------------------------------------------
286  *
287  * CreateTopLevelWindow --
288  *
289  *	Make a new window that will be at top-level (its parent will be the
290  *	root window of a screen).
291  *
292  * Results:
293  *	The return value is a token for the new window, or NULL if an error
294  *	prevented the new window from being created. If NULL is returned, an
295  *	error message will be left in the interp's result.
296  *
297  * Side effects:
298  *	A new window structure is allocated locally. An X window is NOT
299  *	initially created, but will be created the first time the window is
300  *	mapped.
301  *
302  *----------------------------------------------------------------------
303  */
304 
305 static Tk_Window
CreateTopLevelWindow(Tcl_Interp * interp,Tk_Window parent,const char * name,const char * screenName,unsigned int flags)306 CreateTopLevelWindow(
307     Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
308     Tk_Window parent,		/* Token for logical parent of new window
309 				 * (used for naming, options, etc.). May be
310 				 * NULL. */
311     const char *name,		/* Name for new window; if parent is non-NULL,
312 				 * must be unique among parent's children. */
313     const char *screenName,	/* Name of screen on which to create window.
314 				 * NULL means use DISPLAY environment variable
315 				 * to determine. Empty string means use
316 				 * parent's screen, or DISPLAY if no
317 				 * parent. */
318     unsigned int flags)		/* Additional flags to set on the window. */
319 {
320     TkWindow *winPtr;
321     TkDisplay *dispPtr;
322     int screenId;
323     ThreadSpecificData *tsdPtr =
324 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
325 
326     if (!tsdPtr->initialized) {
327 	tsdPtr->initialized = 1;
328 
329 	/*
330 	 * Create built-in image types.
331 	 */
332 
333 	Tk_CreateImageType(&tkBitmapImageType);
334 	Tk_CreateImageType(&tkPhotoImageType);
335 
336 	/*
337 	 * Create built-in photo image formats.
338 	 */
339 
340 	Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
341 	Tk_CreatePhotoImageFormat(&tkImgFmtPNG);
342 	Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
343     }
344 
345     if ((parent != NULL) && (screenName != NULL) && (screenName[0] == '\0')) {
346 	dispPtr = ((TkWindow *) parent)->dispPtr;
347 	screenId = Tk_ScreenNumber(parent);
348     } else {
349 	dispPtr = GetScreen(interp, screenName, &screenId);
350 	if (dispPtr == NULL) {
351 	    return NULL;
352 	}
353     }
354 
355     winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent);
356 
357     /*
358      * Set the flags specified in the call.
359      */
360 
361 #ifdef TK_USE_INPUT_METHODS
362     winPtr->ximGeneration = 0;
363 #endif /*TK_USE_INPUT_METHODS*/
364     winPtr->flags |= flags;
365 
366     /*
367      * Force the window to use a border pixel instead of border pixmap. This
368      * is needed for the case where the window doesn't use the default visual.
369      * In this case, the default border is a pixmap inherited from the root
370      * window, which won't work because it will have the wrong visual.
371      */
372 
373     winPtr->dirtyAtts |= CWBorderPixel;
374 
375     /*
376      * (Need to set the TK_TOP_HIERARCHY flag immediately here; otherwise
377      * Tk_DestroyWindow will core dump if it is called before the flag has
378      * been set.)
379      */
380 
381     winPtr->flags |=
382 	    TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED;
383 
384     if (parent != NULL) {
385 	if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) {
386 	    Tk_DestroyWindow((Tk_Window) winPtr);
387 	    return NULL;
388 	}
389     }
390     TkWmNewWindow(winPtr);
391 
392     return (Tk_Window) winPtr;
393 }
394 
395 /*
396  *----------------------------------------------------------------------
397  *
398  * GetScreen --
399  *
400  *	Given a string name for a display-plus-screen, find the TkDisplay
401  *	structure for the display and return the screen number too.
402  *
403  * Results:
404  *	The return value is a pointer to information about the display, or
405  *	NULL if the display couldn't be opened. In this case, an error message
406  *	is left in the interp's result. The location at *screenPtr is
407  *	overwritten with the screen number parsed from screenName.
408  *
409  * Side effects:
410  *	A new connection is opened to the display if there is no connection
411  *	already. A new TkDisplay data structure is also setup, if necessary.
412  *
413  *----------------------------------------------------------------------
414  */
415 
416 static TkDisplay *
GetScreen(Tcl_Interp * interp,const char * screenName,int * screenPtr)417 GetScreen(
418     Tcl_Interp *interp,		/* Place to leave error message. */
419     const char *screenName,	/* Name for screen. NULL or empty means use
420 				 * DISPLAY envariable. */
421     int *screenPtr)		/* Where to store screen number. */
422 {
423     TkDisplay *dispPtr;
424     const char *p;
425     int screenId;
426     size_t length;
427     ThreadSpecificData *tsdPtr =
428 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
429 
430     /*
431      * Separate the screen number from the rest of the display name.
432      * ScreenName is assumed to have the syntax <display>.<screen> with the
433      * dot and the screen being optional.
434      */
435 
436     screenName = TkGetDefaultScreenName(interp, screenName);
437     if (screenName == NULL) {
438 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
439 		"no display name and no $DISPLAY environment variable", -1));
440 	Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL);
441 	return NULL;
442     }
443     length = strlen(screenName);
444     screenId = 0;
445     p = screenName+length-1;
446     while (isdigit(UCHAR(*p)) && (p != screenName)) {
447 	p--;
448     }
449     if ((*p == '.') && (p[1] != '\0')) {
450 	length = p - screenName;
451 	screenId = strtoul(p+1, NULL, 10);
452     }
453 
454     /*
455      * See if we already have a connection to this display. If not, then open
456      * a new connection.
457      */
458 
459     for (dispPtr = tsdPtr->displayList; ; dispPtr = dispPtr->nextPtr) {
460 	if (dispPtr == NULL) {
461 	    /*
462 	     * The private function zeros out dispPtr when it is created, so
463 	     * we only need to initialize the non-zero items.
464 	     */
465 
466 	    dispPtr = TkpOpenDisplay(screenName);
467 	    if (dispPtr == NULL) {
468 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
469 			"couldn't connect to display \"%s\"", screenName));
470 		Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL);
471 		return NULL;
472 	    }
473 	    dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */
474 	    tsdPtr->displayList = dispPtr;
475 
476 	    dispPtr->lastEventTime = CurrentTime;
477 	    dispPtr->bindInfoStale = 1;
478 	    dispPtr->cursorFont = None;
479 	    dispPtr->warpWindow = NULL;
480 	    dispPtr->multipleAtom = None;
481 
482 	    /*
483 	     * By default we do want to collapse motion events in
484 	     * Tk_QueueWindowEvent.
485 	     */
486 
487 	    dispPtr->flags |= TK_DISPLAY_COLLAPSE_MOTION_EVENTS;
488 
489 	    Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);
490 
491 	    dispPtr->name = ckalloc(length + 1);
492 	    strncpy(dispPtr->name, screenName, length);
493 	    dispPtr->name[length] = '\0';
494 	    break;
495 	}
496 	if ((strncmp(dispPtr->name, screenName, length) == 0)
497 		&& (dispPtr->name[length] == '\0')) {
498 	    break;
499 	}
500     }
501     if (screenId >= ScreenCount(dispPtr->display)) {
502 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
503 		"bad screen number \"%d\"", screenId));
504 	Tcl_SetErrorCode(interp, "TK", "DISPLAY", "SCREEN_NUMBER", NULL);
505 	return NULL;
506     }
507     *screenPtr = screenId;
508     return dispPtr;
509 }
510 
511 /*
512  *----------------------------------------------------------------------
513  *
514  * TkGetDisplay --
515  *
516  *	Given an X display, TkGetDisplay returns the TkDisplay structure for
517  *	the display.
518  *
519  * Results:
520  *	The return value is a pointer to information about the display, or
521  *	NULL if the display did not have a TkDisplay structure.
522  *
523  * Side effects:
524  *	None.
525  *
526  *----------------------------------------------------------------------
527  */
528 
529 TkDisplay *
TkGetDisplay(Display * display)530 TkGetDisplay(
531     Display *display)		/* X's display pointer */
532 {
533     TkDisplay *dispPtr;
534     ThreadSpecificData *tsdPtr =
535 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
536 
537     for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
538 	    dispPtr = dispPtr->nextPtr) {
539 	if (dispPtr->display == display) {
540 	    break;
541 	}
542     }
543     return dispPtr;
544 }
545 
546 /*
547  *--------------------------------------------------------------
548  *
549  * TkGetDisplayList --
550  *
551  *	This function returns a pointer to the thread-local list of TkDisplays
552  *	corresponding to the open displays.
553  *
554  * Results:
555  *	The return value is a pointer to the first TkDisplay structure in
556  *	thread-local-storage.
557  *
558  * Side effects:
559  *	None.
560  *
561  *--------------------------------------------------------------
562  */
563 
564 TkDisplay *
TkGetDisplayList(void)565 TkGetDisplayList(void)
566 {
567     ThreadSpecificData *tsdPtr =
568 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
569 
570     return tsdPtr->displayList;
571 }
572 
573 /*
574  *--------------------------------------------------------------
575  *
576  * TkGetMainInfoList --
577  *
578  *	This function returns a pointer to the list of structures containing
579  *	information about all main windows for the current thread.
580  *
581  * Results:
582  *	The return value is a pointer to the first TkMainInfo structure in
583  *	thread local storage.
584  *
585  * Side effects:
586  *	None.
587  *
588  *--------------------------------------------------------------
589  */
590 
591 TkMainInfo *
TkGetMainInfoList(void)592 TkGetMainInfoList(void)
593 {
594     ThreadSpecificData *tsdPtr =
595 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
596 
597     return tsdPtr->mainWindowList;
598 }
599 /*
600  *--------------------------------------------------------------
601  *
602  * TkAllocWindow --
603  *
604  *	This function creates and initializes a TkWindow structure.
605  *
606  * Results:
607  *	The return value is a pointer to the new window.
608  *
609  * Side effects:
610  *	A new window structure is allocated and all its fields are
611  *	initialized.
612  *
613  *--------------------------------------------------------------
614  */
615 
616 TkWindow *
TkAllocWindow(TkDisplay * dispPtr,int screenNum,TkWindow * parentPtr)617 TkAllocWindow(
618     TkDisplay *dispPtr,		/* Display associated with new window. */
619     int screenNum,		/* Index of screen for new window. */
620     TkWindow *parentPtr)	/* Parent from which this window should
621 				 * inherit visual information. NULL means use
622 				 * screen defaults instead of inheriting. */
623 {
624     TkWindow *winPtr = ckalloc(sizeof(TkWindow));
625 
626     winPtr->display = dispPtr->display;
627     winPtr->dispPtr = dispPtr;
628     winPtr->screenNum = screenNum;
629     if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
630 	    && (parentPtr->screenNum == winPtr->screenNum)) {
631 	winPtr->visual = parentPtr->visual;
632 	winPtr->depth = parentPtr->depth;
633     } else {
634 	winPtr->visual = DefaultVisual(dispPtr->display, screenNum);
635 	winPtr->depth = DefaultDepth(dispPtr->display, screenNum);
636     }
637     winPtr->window = None;
638     winPtr->childList = NULL;
639     winPtr->lastChildPtr = NULL;
640     winPtr->parentPtr = NULL;
641     winPtr->nextPtr = NULL;
642     winPtr->mainPtr = NULL;
643     winPtr->pathName = NULL;
644     winPtr->nameUid = NULL;
645     winPtr->classUid = NULL;
646     winPtr->changes = defChanges;
647     winPtr->dirtyChanges = CWX|CWY|CWWidth|CWHeight|CWBorderWidth;
648     winPtr->atts = defAtts;
649     if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
650 	    && (parentPtr->screenNum == winPtr->screenNum)) {
651 	winPtr->atts.colormap = parentPtr->atts.colormap;
652     } else {
653 	winPtr->atts.colormap = DefaultColormap(dispPtr->display, screenNum);
654     }
655     winPtr->dirtyAtts = CWEventMask|CWColormap|CWBitGravity;
656     winPtr->flags = 0;
657     winPtr->handlerList = NULL;
658 #ifdef TK_USE_INPUT_METHODS
659     winPtr->ximGeneration = 0;
660     winPtr->inputContext = NULL;
661 #endif /* TK_USE_INPUT_METHODS */
662     winPtr->tagPtr = NULL;
663     winPtr->numTags = 0;
664     winPtr->optionLevel = -1;
665     winPtr->selHandlerList = NULL;
666     winPtr->geomMgrPtr = NULL;
667     winPtr->geomData = NULL;
668     winPtr->geomMgrName = NULL;
669     winPtr->maintainerPtr = NULL;
670     winPtr->reqWidth = winPtr->reqHeight = 1;
671     winPtr->internalBorderLeft = 0;
672     winPtr->wmInfoPtr = NULL;
673     winPtr->classProcsPtr = NULL;
674     winPtr->instanceData = NULL;
675     winPtr->privatePtr = NULL;
676     winPtr->internalBorderRight = 0;
677     winPtr->internalBorderTop = 0;
678     winPtr->internalBorderBottom = 0;
679     winPtr->minReqWidth = 0;
680     winPtr->minReqHeight = 0;
681 
682     return winPtr;
683 }
684 
685 /*
686  *----------------------------------------------------------------------
687  *
688  * NameWindow --
689  *
690  *	This function is invoked to give a window a name and insert the window
691  *	into the hierarchy associated with a particular application.
692  *
693  * Results:
694  *	A standard Tcl return value.
695  *
696  * Side effects:
697  *	See above.
698  *
699  *----------------------------------------------------------------------
700  */
701 
702 static int
NameWindow(Tcl_Interp * interp,TkWindow * winPtr,TkWindow * parentPtr,const char * name)703 NameWindow(
704     Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
705     TkWindow *winPtr,	/* Window that is to be named and inserted. */
706     TkWindow *parentPtr,	/* Pointer to logical parent for winPtr (used
707 				 * for naming, options, etc.). */
708     const char *name)		/* Name for winPtr; must be unique among
709 				 * parentPtr's children. */
710 {
711 #define FIXED_SIZE 200
712     char staticSpace[FIXED_SIZE];
713     char *pathName;
714     int isNew;
715     Tcl_HashEntry *hPtr;
716     size_t length1, length2;
717 
718     /*
719      * Setup all the stuff except name right away, then do the name stuff
720      * last. This is so that if the name stuff fails, everything else will be
721      * properly initialized (needed to destroy the window cleanly after the
722      * naming failure).
723      */
724 
725     winPtr->parentPtr = parentPtr;
726     winPtr->nextPtr = NULL;
727     if (parentPtr->childList == NULL) {
728 	parentPtr->childList = winPtr;
729     } else {
730 	parentPtr->lastChildPtr->nextPtr = winPtr;
731     }
732     parentPtr->lastChildPtr = winPtr;
733     winPtr->mainPtr = parentPtr->mainPtr;
734     winPtr->mainPtr->refCount++;
735 
736     /*
737      * If this is an anonymous window (ie, it has no name), just return OK
738      * now.
739      */
740 
741     if (winPtr->flags & TK_ANONYMOUS_WINDOW) {
742 	return TCL_OK;
743     }
744 
745     /*
746      * Don't permit names that start with an upper-case letter: this will just
747      * cause confusion with class names in the option database.
748      */
749 
750     if (isupper(UCHAR(name[0]))) {
751 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
752 		"window name starts with an upper-case letter: \"%s\"",
753 		name));
754 	Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL);
755 	return TCL_ERROR;
756     }
757 
758     /*
759      * For non-anonymous windows, set up the window name.
760      */
761 
762     winPtr->nameUid = Tk_GetUid(name);
763 
764     /*
765      * To permit names of arbitrary length, must be prepared to malloc a
766      * buffer to hold the new path name. To run fast in the common case where
767      * names are short, use a fixed-size buffer on the stack.
768      */
769 
770     length1 = strlen(parentPtr->pathName);
771     length2 = strlen(name);
772     if ((length1 + length2 + 2) <= FIXED_SIZE) {
773 	pathName = staticSpace;
774     } else {
775 	pathName = ckalloc(length1 + length2 + 2);
776     }
777     if (length1 == 1) {
778 	pathName[0] = '.';
779 	strcpy(pathName+1, name);
780     } else {
781 	strcpy(pathName, parentPtr->pathName);
782 	pathName[length1] = '.';
783 	strcpy(pathName+length1+1, name);
784     }
785     hPtr = Tcl_CreateHashEntry(&parentPtr->mainPtr->nameTable, pathName,
786 	    &isNew);
787     if (pathName != staticSpace) {
788 	ckfree(pathName);
789     }
790     if (!isNew) {
791 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
792 		"window name \"%s\" already exists in parent", name));
793 	Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL);
794 	return TCL_ERROR;
795     }
796     Tcl_SetHashValue(hPtr, winPtr);
797     winPtr->pathName = Tcl_GetHashKey(&parentPtr->mainPtr->nameTable, hPtr);
798     return TCL_OK;
799 }
800 
801 /*
802  *----------------------------------------------------------------------
803  *
804  * TkCreateMainWindow --
805  *
806  *	Make a new main window. A main window is a special kind of top-level
807  *	window used as the outermost window in an application.
808  *
809  * Results:
810  *	The return value is a token for the new window, or NULL if an error
811  *	prevented the new window from being created. If NULL is returned, an
812  *	error message will be left in the interp's result.
813  *
814  * Side effects:
815  *	A new window structure is allocated locally; "interp" is associated
816  *	with the window and registered for "send" commands under "baseName".
817  *	BaseName may be extended with an instance number in the form "#2" if
818  *	necessary to make it globally unique. Tk-related commands are bound
819  *	into interp.
820  *
821  *----------------------------------------------------------------------
822  */
823 
824 Tk_Window
TkCreateMainWindow(Tcl_Interp * interp,const char * screenName,const char * baseName)825 TkCreateMainWindow(
826     Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
827     const char *screenName,	/* Name of screen on which to create window.
828 				 * Empty or NULL string means use DISPLAY
829 				 * environment variable. */
830     const char *baseName)	/* Base name for application; usually of the
831 				 * form "prog instance". */
832 {
833     Tk_Window tkwin;
834     int dummy, isSafe;
835     Tcl_HashEntry *hPtr;
836     TkMainInfo *mainPtr;
837     TkWindow *winPtr;
838     const TkCmd *cmdPtr;
839     ClientData clientData;
840     ThreadSpecificData *tsdPtr =
841 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
842 
843     /*
844      * Panic if someone updated the TkWindow structure without also updating
845      * the Tk_FakeWin structure (or vice versa).
846      */
847 
848     if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
849 	Tcl_Panic("TkWindow and Tk_FakeWin are not the same size");
850     }
851 
852     /*
853      * Create the basic TkWindow structure.
854      */
855 
856     tkwin = CreateTopLevelWindow(interp, NULL, baseName,
857 	    screenName, /* flags */ 0);
858     if (tkwin == NULL) {
859 	return NULL;
860     }
861 
862     /*
863      * Create the TkMainInfo structure for this application, and set up
864      * name-related information for the new window.
865      */
866 
867     winPtr = (TkWindow *) tkwin;
868     mainPtr = ckalloc(sizeof(TkMainInfo));
869     mainPtr->winPtr = winPtr;
870     mainPtr->refCount = 1;
871     mainPtr->interp = interp;
872     Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS);
873     mainPtr->deletionEpoch = 0l;
874     TkEventInit();
875     TkBindInit(mainPtr);
876     TkFontPkgInit(mainPtr);
877     TkStylePkgInit(mainPtr);
878     mainPtr->tlFocusPtr = NULL;
879     mainPtr->displayFocusPtr = NULL;
880     mainPtr->optionRootPtr = NULL;
881     Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
882     mainPtr->strictMotif = 0;
883     mainPtr->alwaysShowSelection = 0;
884     mainPtr->tclUpdateObjProc = NULL;
885     if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
886 	    TCL_LINK_BOOLEAN) != TCL_OK) {
887 	Tcl_ResetResult(interp);
888     }
889     if (Tcl_CreateNamespace(interp, "::tk", NULL, NULL) == NULL) {
890 	Tcl_ResetResult(interp);
891     }
892     if (Tcl_LinkVar(interp, "::tk::AlwaysShowSelection",
893 	    (char *) &mainPtr->alwaysShowSelection,
894 	    TCL_LINK_BOOLEAN) != TCL_OK) {
895 	Tcl_ResetResult(interp);
896     }
897     mainPtr->nextPtr = tsdPtr->mainWindowList;
898     tsdPtr->mainWindowList = mainPtr;
899     winPtr->mainPtr = mainPtr;
900     hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
901     Tcl_SetHashValue(hPtr, winPtr);
902     winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);
903     Tcl_InitHashTable(&mainPtr->busyTable, TCL_ONE_WORD_KEYS);
904 
905     /*
906      * We have just created another Tk application; increment the refcount on
907      * the display pointer.
908      */
909 
910     winPtr->dispPtr->refCount++;
911 
912     /*
913      * Register the interpreter for "send" purposes.
914      */
915 
916     winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, baseName));
917 
918     /*
919      * Bind in Tk's commands.
920      */
921 
922     isSafe = Tcl_IsSafe(interp);
923     for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
924 	Tcl_CmdInfo cmdInfo;
925 
926 	if (cmdPtr->objProc == NULL) {
927 	    Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs");
928 	}
929 
930 #if defined(_WIN32) && !defined(STATIC_BUILD)
931 	if ((cmdPtr->flags & WINMACONLY) && tclStubsPtr->reserved9) {
932 	    /*
933 	     * We are running on Cygwin, so don't use the win32 dialogs.
934 	     */
935 
936 	    continue;
937 	}
938 #endif /* _WIN32 && !STATIC_BUILD */
939 
940 	if (cmdPtr->flags & PASSMAINWINDOW) {
941 	    clientData = tkwin;
942 	} else {
943 	    clientData = NULL;
944 	}
945 	if ((cmdPtr->flags & SAVEUPDATECMD) &&
946 	    Tcl_GetCommandInfo(interp, cmdPtr->name, &cmdInfo) &&
947 	    cmdInfo.isNativeObjectProc && !cmdInfo.objClientData && !cmdInfo.deleteProc) {
948 	    mainPtr->tclUpdateObjProc = cmdInfo.objProc;
949 	}
950 	if (cmdPtr->flags & USEINITPROC) {
951 	    ((TkInitProc *)(void *)cmdPtr->objProc)(interp, clientData);
952 	} else {
953 	    Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
954 		    clientData, NULL);
955 	}
956 	if (isSafe && !(cmdPtr->flags & ISSAFE)) {
957 	    Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
958 	}
959     }
960 
961     /*
962      * Set variables for the intepreter.
963      */
964 
965     Tcl_SetVar2(interp, "tk_patchLevel", NULL, TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
966     Tcl_SetVar2(interp, "tk_version",    NULL, TK_VERSION,     TCL_GLOBAL_ONLY);
967 
968     tsdPtr->numMainWindows++;
969     return tkwin;
970 }
971 
972 /*
973  *--------------------------------------------------------------
974  *
975  * Tk_CreateWindow --
976  *
977  *	Create a new internal or top-level window as a child of an existing
978  *	window.
979  *
980  * Results:
981  *	The return value is a token for the new window. This is not the same
982  *	as X's token for the window. If an error occurred in creating the
983  *	window (e.g. no such display or screen), then an error message is left
984  *	in the interp's result and NULL is returned.
985  *
986  * Side effects:
987  *	A new window structure is allocated locally. An X window is not
988  *	initially created, but will be created the first time the window is
989  *	mapped.
990  *
991  *--------------------------------------------------------------
992  */
993 
994 Tk_Window
Tk_CreateWindow(Tcl_Interp * interp,Tk_Window parent,const char * name,const char * screenName)995 Tk_CreateWindow(
996     Tcl_Interp *interp,		/* Interpreter to use for error reporting.
997 				 * the interp's result is assumed to be
998 				 * initialized by the caller. */
999     Tk_Window parent,		/* Token for parent of new window. */
1000     const char *name,		/* Name for new window. Must be unique among
1001 				 * parent's children. */
1002     const char *screenName)	/* If NULL, new window will be internal on
1003 				 * same screen as its parent. If non-NULL,
1004 				 * gives name of screen on which to create new
1005 				 * window; window will be a top-level
1006 				 * window. */
1007 {
1008     TkWindow *parentPtr = (TkWindow *) parent;
1009 
1010     if (parentPtr) {
1011 	if (parentPtr->flags & TK_ALREADY_DEAD) {
1012 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
1013 		    "can't create window: parent has been destroyed", -1));
1014 	    Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
1015 	    return NULL;
1016 	} else if (parentPtr->flags & TK_CONTAINER) {
1017 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
1018 		    "can't create window: its parent has -container = yes",
1019 		    -1));
1020 	    Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
1021 	    return NULL;
1022 	} else if (screenName == NULL) {
1023 	    TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
1024 		    parentPtr->screenNum, parentPtr);
1025 
1026 	    if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) {
1027 		Tk_DestroyWindow((Tk_Window) winPtr);
1028 		return NULL;
1029 	    }
1030 	    return (Tk_Window) winPtr;
1031 	}
1032     }
1033     return CreateTopLevelWindow(interp, parent, name, screenName,
1034 	    /* flags */ 0);
1035 }
1036 
1037 /*
1038  *--------------------------------------------------------------
1039  *
1040  * Tk_CreateAnonymousWindow --
1041  *
1042  *	Create a new internal or top-level window as a child of an existing
1043  *	window; this window will be anonymous (unnamed), so it will not be
1044  *	visible at the Tcl level.
1045  *
1046  * Results:
1047  *	The return value is a token for the new window. This is not the same
1048  *	as X's token for the window. If an error occurred in creating the
1049  *	window (e.g. no such display or screen), then an error message is left
1050  *	in the interp's result and NULL is returned.
1051  *
1052  * Side effects:
1053  *	A new window structure is allocated locally. An X window is not
1054  *	initially created, but will be created the first time the window is
1055  *	mapped.
1056  *
1057  *--------------------------------------------------------------
1058  */
1059 
1060 Tk_Window
Tk_CreateAnonymousWindow(Tcl_Interp * interp,Tk_Window parent,const char * screenName)1061 Tk_CreateAnonymousWindow(
1062     Tcl_Interp *interp,		/* Interpreter to use for error reporting.
1063 				 * the interp's result is assumed to be
1064 				 * initialized by the caller. */
1065     Tk_Window parent,		/* Token for parent of new window. */
1066     const char *screenName)	/* If NULL, new window will be internal on
1067 				 * same screen as its parent. If non-NULL,
1068 				 * gives name of screen on which to create new
1069 				 * window; window will be a top-level
1070 				 * window. */
1071 {
1072     TkWindow *parentPtr = (TkWindow *) parent;
1073 
1074     if (parentPtr) {
1075 	if (parentPtr->flags & TK_ALREADY_DEAD) {
1076 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
1077 		    "can't create window: parent has been destroyed", -1));
1078 	    Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
1079 	    return NULL;
1080 	} else if (parentPtr->flags & TK_CONTAINER) {
1081 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
1082 		    "can't create window: its parent has -container = yes",
1083 		    -1));
1084 	    Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
1085 	    return NULL;
1086 	} else if (screenName == NULL) {
1087 	    TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr,
1088 		    parentPtr->screenNum, parentPtr);
1089 	    /*
1090 	     * Add the anonymous window flag now, so that NameWindow will
1091 	     * behave correctly.
1092 	     */
1093 
1094 	    winPtr->flags |= TK_ANONYMOUS_WINDOW;
1095 	    if (NameWindow(interp, winPtr, parentPtr, NULL) != TCL_OK) {
1096 		Tk_DestroyWindow((Tk_Window) winPtr);
1097 		return NULL;
1098 	    }
1099 	    return (Tk_Window) winPtr;
1100 	}
1101     }
1102     return CreateTopLevelWindow(interp, parent, NULL, screenName,
1103 	    TK_ANONYMOUS_WINDOW);
1104 }
1105 
1106 /*
1107  *----------------------------------------------------------------------
1108  *
1109  * Tk_CreateWindowFromPath --
1110  *
1111  *	This function is similar to Tk_CreateWindow except that it uses a path
1112  *	name to create the window, rather than a parent and a child name.
1113  *
1114  * Results:
1115  *	The return value is a token for the new window. This is not the same
1116  *	as X's token for the window. If an error occurred in creating the
1117  *	window (e.g. no such display or screen), then an error message is left
1118  *	in the interp's result and NULL is returned.
1119  *
1120  * Side effects:
1121  *	A new window structure is allocated locally. An X window is not
1122  *	initially created, but will be created the first time the window is
1123  *	mapped.
1124  *
1125  *----------------------------------------------------------------------
1126  */
1127 
1128 Tk_Window
Tk_CreateWindowFromPath(Tcl_Interp * interp,Tk_Window tkwin,const char * pathName,const char * screenName)1129 Tk_CreateWindowFromPath(
1130     Tcl_Interp *interp,		/* Interpreter to use for error reporting.
1131 				 * the interp's result is assumed to be
1132 				 * initialized by the caller. */
1133     Tk_Window tkwin,		/* Token for any window in application that is
1134 				 * to contain new window. */
1135     const char *pathName,	/* Path name for new window within the
1136 				 * application of tkwin. The parent of this
1137 				 * window must already exist, but the window
1138 				 * itself must not exist. */
1139     const char *screenName)	/* If NULL, new window will be on same screen
1140 				 * as its parent. If non-NULL, gives name of
1141 				 * screen on which to create new window;
1142 				 * window will be a top-level window. */
1143 {
1144 #define FIXED_SPACE 5
1145     char fixedSpace[FIXED_SPACE+1];
1146     char *p;
1147     Tk_Window parent;
1148     int numChars;
1149 
1150     /*
1151      * Strip the parent's name out of pathName (it's everything up to the last
1152      * dot). There are two tricky parts: (a) must copy the parent's name
1153      * somewhere else to avoid modifying the pathName string (for large names,
1154      * space for the copy will have to be malloc'ed); (b) must special-case
1155      * the situation where the parent is ".".
1156      */
1157 
1158     p = strrchr(pathName, '.');
1159     if (p == NULL) {
1160 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
1161 		"bad window path name \"%s\"", pathName));
1162 	Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL);
1163 	return NULL;
1164     }
1165     numChars = (int) (p-pathName);
1166     if (numChars > FIXED_SPACE) {
1167 	p = ckalloc(numChars + 1);
1168     } else {
1169 	p = fixedSpace;
1170     }
1171     if (numChars == 0) {
1172 	*p = '.';
1173 	p[1] = '\0';
1174     } else {
1175 	strncpy(p, pathName, (size_t) numChars);
1176 	p[numChars] = '\0';
1177     }
1178 
1179     /*
1180      * Find the parent window.
1181      */
1182 
1183     parent = Tk_NameToWindow(interp, p, tkwin);
1184     if (p != fixedSpace) {
1185 	ckfree(p);
1186     }
1187     if (parent == NULL) {
1188 	return NULL;
1189     }
1190     if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
1191 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
1192 		"can't create window: parent has been destroyed", -1));
1193 	Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL);
1194 	return NULL;
1195     } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
1196 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
1197 		"can't create window: its parent has -container = yes", -1));
1198 	Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL);
1199 	return NULL;
1200     }
1201 
1202     /*
1203      * Create the window.
1204      */
1205 
1206     if (screenName == NULL) {
1207 	TkWindow *parentPtr = (TkWindow *) parent;
1208 	TkWindow *winPtr;
1209 
1210 	winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
1211 		parentPtr);
1212 	if (NameWindow(interp, winPtr, parentPtr, pathName+numChars+1)
1213 		!= TCL_OK) {
1214 	    Tk_DestroyWindow((Tk_Window) winPtr);
1215 	    return NULL;
1216 	}
1217 	return (Tk_Window) winPtr;
1218     }
1219 
1220     return CreateTopLevelWindow(interp, parent, pathName+numChars+1,
1221 	    screenName, /* flags */ 0);
1222 }
1223 
1224 /*
1225  *--------------------------------------------------------------
1226  *
1227  * Tk_DestroyWindow --
1228  *
1229  *	Destroy an existing window. After this call, the caller should never
1230  *	again use the token. Note that this function can be reentered to
1231  *	destroy a window that was only partially destroyed before a call to
1232  *	exit.
1233  *
1234  * Results:
1235  *	None.
1236  *
1237  * Side effects:
1238  *	The window is deleted, along with all of its children. Relevant
1239  *	callback functions are invoked.
1240  *
1241  *--------------------------------------------------------------
1242  */
1243 
1244 void
Tk_DestroyWindow(Tk_Window tkwin)1245 Tk_DestroyWindow(
1246     Tk_Window tkwin)		/* Window to destroy. */
1247 {
1248     TkWindow *winPtr = (TkWindow *) tkwin;
1249     TkDisplay *dispPtr = winPtr->dispPtr;
1250     XEvent event;
1251     TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr;
1252     ThreadSpecificData *tsdPtr =
1253 	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1254 
1255     if (winPtr->flags & TK_ALREADY_DEAD) {
1256 	/*
1257 	 * A destroy event binding caused the window to be destroyed again.
1258 	 * Ignore the request.
1259 	 */
1260 
1261 	return;
1262     }
1263     winPtr->flags |= TK_ALREADY_DEAD;
1264 
1265     /*
1266      * Unless we are cleaning up a half dead window from
1267      * DeleteWindowsExitProc, add this window to the half dead list.
1268      */
1269 
1270     if (tsdPtr->halfdeadWindowList &&
1271 	    (tsdPtr->halfdeadWindowList->flags & HD_CLEANUP) &&
1272 	    (tsdPtr->halfdeadWindowList->winPtr == winPtr)) {
1273 	halfdeadPtr = tsdPtr->halfdeadWindowList;
1274     } else {
1275 	halfdeadPtr = ckalloc(sizeof(TkHalfdeadWindow));
1276 	halfdeadPtr->flags = 0;
1277 	halfdeadPtr->winPtr = winPtr;
1278 	halfdeadPtr->nextPtr = tsdPtr->halfdeadWindowList;
1279 	tsdPtr->halfdeadWindowList = halfdeadPtr;
1280     }
1281 
1282     /*
1283      * Some cleanup needs to be done immediately, rather than later, because
1284      * it needs information that will be destroyed before we get to the main
1285      * cleanup point. For example, TkFocusDeadWindow needs to access the
1286      * parentPtr field from a window, but if a Destroy event handler deletes
1287      * the window's parent this field will be NULL before the main cleanup
1288      * point is reached.
1289      */
1290 
1291     if (!(halfdeadPtr->flags & HD_FOCUS)) {
1292 	halfdeadPtr->flags |= HD_FOCUS;
1293 	TkFocusDeadWindow(winPtr);
1294     }
1295 
1296     /*
1297      * If this is a main window, remove it from the list of main windows.
1298      * This needs to be done now (rather than later with all the other main
1299      * window cleanup) to handle situations where a destroy binding for a
1300      * window calls "exit". In this case the child window cleanup isn't
1301      * complete when exit is called. This situation is dealt with using the
1302      * half dead window list. Windows that are half dead gets cleaned up
1303      * during exit.
1304      *
1305      * Also decrement the display refcount so that if this is the last Tk
1306      * application in this process on this display, the display can be closed
1307      * and its data structures deleted.
1308      */
1309 
1310     if (!(halfdeadPtr->flags & HD_MAIN_WIN) &&
1311 	    winPtr->mainPtr != NULL && winPtr->mainPtr->winPtr == winPtr) {
1312 	halfdeadPtr->flags |= HD_MAIN_WIN;
1313 	dispPtr->refCount--;
1314 	if (tsdPtr->mainWindowList == winPtr->mainPtr) {
1315 	    tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr;
1316 	} else {
1317 	    TkMainInfo *prevPtr;
1318 
1319 	    for (prevPtr = tsdPtr->mainWindowList;
1320 		    prevPtr->nextPtr != winPtr->mainPtr;
1321 		    prevPtr = prevPtr->nextPtr) {
1322 		/* Empty loop body. */
1323 	    }
1324 	    prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
1325 	}
1326 	tsdPtr->numMainWindows--;
1327     }
1328 
1329     /*
1330      * Recursively destroy children. Note that this child window block may
1331      * need to be run multiple times in the case where a child window has a
1332      * Destroy binding that calls exit.
1333      */
1334 
1335     if (!(halfdeadPtr->flags & HD_DESTROY_COUNT)) {
1336 	halfdeadPtr->flags |= HD_DESTROY_COUNT;
1337     }
1338 
1339     while (winPtr->childList != NULL) {
1340 	TkWindow *childPtr = winPtr->childList;
1341 
1342 	childPtr->flags |= TK_DONT_DESTROY_WINDOW;
1343 	Tk_DestroyWindow((Tk_Window) childPtr);
1344 	if (winPtr->childList == childPtr) {
1345 	    /*
1346 	     * The child didn't remove itself from the child list, so let's
1347 	     * remove it here. This can happen in some strange conditions,
1348 	     * such as when a Destroy event handler for a window destroys the
1349 	     * window's parent.
1350 	     */
1351 
1352 	    winPtr->childList = childPtr->nextPtr;
1353 	    childPtr->parentPtr = NULL;
1354 	}
1355     }
1356     if ((winPtr->flags & (TK_CONTAINER|TK_BOTH_HALVES))
1357 	    == (TK_CONTAINER|TK_BOTH_HALVES)) {
1358 	/*
1359 	 * This is the container for an embedded application, and the embedded
1360 	 * application is also in this process. Delete the embedded window
1361 	 * in-line here, for the same reasons we delete children in-line
1362 	 * (otherwise, for example, the Tk window may appear to exist even
1363 	 * though its X window is gone; this could cause errors). Special
1364 	 * note: it's possible that the embedded window has already been
1365 	 * deleted, in which case TkpGetOtherWindow will return NULL.
1366 	 */
1367 
1368 	TkWindow *childPtr = TkpGetOtherWindow(winPtr);
1369 
1370 	if (childPtr != NULL) {
1371 	    childPtr->flags |= TK_DONT_DESTROY_WINDOW;
1372 	    Tk_DestroyWindow((Tk_Window) childPtr);
1373 	}
1374     }
1375 
1376     /*
1377      * Generate a DestroyNotify event. In order for the DestroyNotify event to
1378      * be processed correctly, need to make sure the window exists. This is a
1379      * bit of a kludge, and may be unnecessarily expensive, but without it no
1380      * event handlers will get called for windows that don't exist yet.
1381      *
1382      * Note: if the window's pathName is NULL and the window is not an
1383      * anonymous window, it means that the window was not successfully
1384      * initialized in the first place, so we should not make the window exist
1385      * or generate the event.
1386      */
1387 
1388     if (!(halfdeadPtr->flags & HD_DESTROY_EVENT) &&
1389 	    winPtr->pathName != NULL &&
1390 	    !(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
1391 	halfdeadPtr->flags |= HD_DESTROY_EVENT;
1392 	if (winPtr->window == None) {
1393 	    Tk_MakeWindowExist(tkwin);
1394 	}
1395 	event.type = DestroyNotify;
1396 	event.xdestroywindow.serial =
1397 		LastKnownRequestProcessed(winPtr->display);
1398 	event.xdestroywindow.send_event = False;
1399 	event.xdestroywindow.display = winPtr->display;
1400 	event.xdestroywindow.event = winPtr->window;
1401 	event.xdestroywindow.window = winPtr->window;
1402 	Tk_HandleEvent(&event);
1403     }
1404 
1405     /*
1406      * No additional bindings that could call exit should be invoked from this
1407      * point on, so it is safe to remove this window from the half dead list.
1408      */
1409 
1410     for (prev_halfdeadPtr = NULL,
1411 	    halfdeadPtr = tsdPtr->halfdeadWindowList;
1412 	    halfdeadPtr != NULL; ) {
1413 	if (halfdeadPtr->winPtr == winPtr) {
1414 	    if (prev_halfdeadPtr == NULL) {
1415 		tsdPtr->halfdeadWindowList = halfdeadPtr->nextPtr;
1416 	    } else {
1417 		prev_halfdeadPtr->nextPtr = halfdeadPtr->nextPtr;
1418 	    }
1419 	    ckfree(halfdeadPtr);
1420 	    break;
1421 	}
1422 	prev_halfdeadPtr = halfdeadPtr;
1423 	halfdeadPtr = halfdeadPtr->nextPtr;
1424     }
1425     if (halfdeadPtr == NULL) {
1426 	Tcl_Panic("window not found on half dead list");
1427     }
1428 
1429     /*
1430      * Cleanup the data structures associated with this window.
1431      */
1432 
1433     if (winPtr->flags & TK_WIN_MANAGED) {
1434 	TkWmDeadWindow(winPtr);
1435     } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) {
1436 	TkWmRemoveFromColormapWindows(winPtr);
1437     }
1438     if (winPtr->window != None) {
1439 #if defined(MAC_OSX_TK) || defined(_WIN32)
1440 	XDestroyWindow(winPtr->display, winPtr->window);
1441 #else
1442 	if ((winPtr->flags & TK_TOP_HIERARCHY)
1443 		|| !(winPtr->flags & TK_DONT_DESTROY_WINDOW)) {
1444 	    /*
1445 	     * The parent has already been destroyed and this isn't a
1446 	     * top-level window, so this window will be destroyed implicitly
1447 	     * when the parent's X window is destroyed; it's much faster not
1448 	     * to do an explicit destroy of this X window.
1449 	     */
1450 
1451 	    XDestroyWindow(winPtr->display, winPtr->window);
1452 	}
1453 #endif
1454 	Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable,
1455 		(char *) winPtr->window));
1456 	winPtr->window = None;
1457     }
1458     UnlinkWindow(winPtr);
1459     TkEventDeadWindow(winPtr);
1460 #ifdef TK_USE_INPUT_METHODS
1461     if (winPtr->inputContext != NULL &&
1462 	    winPtr->ximGeneration == winPtr->dispPtr->ximGeneration) {
1463 	XDestroyIC(winPtr->inputContext);
1464     }
1465     winPtr->inputContext = NULL;
1466 #endif /* TK_USE_INPUT_METHODS */
1467     if (winPtr->tagPtr != NULL) {
1468 	TkFreeBindingTags(winPtr);
1469     }
1470     TkOptionDeadWindow(winPtr);
1471     TkSelDeadWindow(winPtr);
1472     TkGrabDeadWindow(winPtr);
1473     if (winPtr->geomMgrName != NULL) {
1474 	ckfree(winPtr->geomMgrName);
1475 	winPtr->geomMgrName = NULL;
1476     }
1477     if (winPtr->mainPtr != NULL) {
1478 	if (winPtr->pathName != NULL) {
1479 	    Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable,
1480 		    winPtr->pathName);
1481 	    Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable,
1482 		    winPtr->pathName));
1483 
1484 	    /*
1485 	     * The memory pointed to by pathName has been deallocated. Keep
1486 	     * users from accessing it after the window has been destroyed by
1487 	     * setting it to NULL.
1488 	     */
1489 
1490 	    winPtr->pathName = NULL;
1491 
1492 	    /*
1493 	     * Invalidate all objects referring to windows with the same main
1494 	     * window.
1495 	     */
1496 
1497 	    winPtr->mainPtr->deletionEpoch++;
1498 	}
1499 	if (winPtr->mainPtr->refCount-- <= 1) {
1500 	    const TkCmd *cmdPtr;
1501 
1502 	    /*
1503 	     * We just deleted the last window in the application. Delete the
1504 	     * TkMainInfo structure too and replace all of Tk's commands with
1505 	     * dummy commands that return errors. Also delete the "send"
1506 	     * command to unregister the interpreter.
1507 	     *
1508 	     * NOTE: Only replace the commands it if the interpreter is not
1509 	     * being deleted. If it *is*, the interpreter cleanup will do all
1510 	     * the needed work.
1511 	     */
1512 
1513 	    if ((winPtr->mainPtr->interp != NULL) &&
1514 		!Tcl_InterpDeleted(winPtr->mainPtr->interp)) {
1515 		for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
1516 		    if ((cmdPtr->flags & SAVEUPDATECMD) &&
1517 			winPtr->mainPtr->tclUpdateObjProc != NULL) {
1518 			/* Restore Tcl's version of [update] */
1519 			Tcl_CreateObjCommand(winPtr->mainPtr->interp,
1520 					     cmdPtr->name,
1521 					     winPtr->mainPtr->tclUpdateObjProc,
1522 					     NULL, NULL);
1523 		    } else {
1524 			Tcl_CreateObjCommand(winPtr->mainPtr->interp,
1525 					     cmdPtr->name, TkDeadAppObjCmd,
1526 					     NULL, NULL);
1527 		    }
1528 		}
1529 		Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send",
1530 			TkDeadAppObjCmd, NULL, NULL);
1531 		Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
1532 		Tcl_UnlinkVar(winPtr->mainPtr->interp,
1533 			"::tk::AlwaysShowSelection");
1534 	    }
1535 
1536 	    Tcl_DeleteHashTable(&winPtr->mainPtr->busyTable);
1537 	    Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
1538 	    TkBindFree(winPtr->mainPtr);
1539 	    TkDeleteAllImages(winPtr->mainPtr);
1540 	    TkFontPkgFree(winPtr->mainPtr);
1541 	    TkFocusFree(winPtr->mainPtr);
1542 	    TkStylePkgFree(winPtr->mainPtr);
1543 
1544 	    /*
1545 	     * When embedding Tk into other applications, make sure that all
1546 	     * destroy events reach the server. Otherwise the embedding
1547 	     * application may also attempt to destroy the windows, resulting
1548 	     * in an X error
1549 	     */
1550 
1551 	    if (winPtr->flags & TK_EMBEDDED) {
1552 		XSync(winPtr->display, False);
1553 	    }
1554 	    ckfree(winPtr->mainPtr);
1555 
1556 	    /*
1557 	     * If no other applications are using the display, close the
1558 	     * display now and relinquish its data structures.
1559 	     */
1560 
1561 #if !defined(_WIN32) && defined(NOT_YET)
1562 	    if (dispPtr->refCount <= 0) {
1563 		/*
1564 		 * I have disabled this code because on Windows there are
1565 		 * still order dependencies in close-down. All displays and
1566 		 * resources will get closed down properly anyway at exit,
1567 		 * through the exit handler. -- jyl
1568 		 *
1569 		 * Ideally this should be enabled, as unix Tk can use multiple
1570 		 * displays. However, there are order issues still, as well as
1571 		 * the handling of queued events and such that must be
1572 		 * addressed before this can be enabled. The current cleanup
1573 		 * works except for send event issues. -- hobbs 04/2002
1574 		 */
1575 
1576 		TkDisplay *theDispPtr, *backDispPtr;
1577 
1578 		/*
1579 		 * Splice this display out of the list of displays.
1580 		 */
1581 
1582 		for (theDispPtr = tsdPtr->displayList, backDispPtr = NULL;
1583 			(theDispPtr!=winPtr->dispPtr) && (theDispPtr!=NULL);
1584 			theDispPtr = theDispPtr->nextPtr) {
1585 		    backDispPtr = theDispPtr;
1586 		}
1587 		if (theDispPtr == NULL) {
1588 		    Tcl_Panic("could not find display to close!");
1589 		}
1590 		if (backDispPtr == NULL) {
1591 		    tsdPtr->displayList = theDispPtr->nextPtr;
1592 		} else {
1593 		    backDispPtr->nextPtr = theDispPtr->nextPtr;
1594 		}
1595 
1596 		/*
1597 		 * Calling XSync creates X server traffic, but addresses a
1598 		 * focus issue on close (but not the send issue). -- hobbs
1599 		 *
1600 		 *	XSync(dispPtr->display, True);
1601 		 */
1602 
1603 		/*
1604 		 * Found and spliced it out, now actually do the cleanup.
1605 		 */
1606 
1607 		TkCloseDisplay(dispPtr);
1608 	    }
1609 #endif /* !_WIN32 && NOT_YET */
1610 	}
1611     }
1612     Tcl_EventuallyFree(winPtr, TCL_DYNAMIC);
1613 }
1614 
1615 /*
1616  *--------------------------------------------------------------
1617  *
1618  * Tk_MapWindow --
1619  *
1620  *	Map a window within its parent. This may require the window and/or its
1621  *	parents to actually be created.
1622  *
1623  * Results:
1624  *	None.
1625  *
1626  * Side effects:
1627  *	The given window will be mapped. Windows may also be created.
1628  *
1629  *--------------------------------------------------------------
1630  */
1631 
1632 void
Tk_MapWindow(Tk_Window tkwin)1633 Tk_MapWindow(
1634     Tk_Window tkwin)		/* Token for window to map. */
1635 {
1636     TkWindow *winPtr = (TkWindow *) tkwin;
1637     XEvent event;
1638 
1639     if (winPtr->flags & TK_MAPPED) {
1640 	return;
1641     }
1642     if (winPtr->window == None) {
1643 	Tk_MakeWindowExist(tkwin);
1644     }
1645     /*
1646      * [Bug 2645457]: the previous call permits events to be processed and can
1647      * lead to the destruction of the window under some conditions.
1648      */
1649     if (winPtr->flags & TK_ALREADY_DEAD) {
1650 	return;
1651     }
1652     if (winPtr->flags & TK_WIN_MANAGED) {
1653 	/*
1654 	 * Lots of special processing has to be done for top-level windows.
1655 	 * Let tkWm.c handle everything itself.
1656 	 */
1657 
1658 	TkWmMapWindow(winPtr);
1659 	return;
1660     }
1661     winPtr->flags |= TK_MAPPED;
1662     XMapWindow(winPtr->display, winPtr->window);
1663     event.type = MapNotify;
1664     event.xmap.serial = LastKnownRequestProcessed(winPtr->display);
1665     event.xmap.send_event = False;
1666     event.xmap.display = winPtr->display;
1667     event.xmap.event = winPtr->window;
1668     event.xmap.window = winPtr->window;
1669     event.xmap.override_redirect = winPtr->atts.override_redirect;
1670     TkpHandleMapOrUnmap((Tk_Window)winPtr, &event);
1671 }
1672 
1673 /*
1674  *--------------------------------------------------------------
1675  *
1676  * Tk_MakeWindowExist --
1677  *
1678  *	Ensure that a particular window actually exists. This function should
1679  *	not normally need to be invoked from outside the Tk package, but may
1680  *	be needed if someone wants to manipulate a window before mapping it.
1681  *
1682  * Results:
1683  *	None.
1684  *
1685  * Side effects:
1686  *	When the function returns, the X window associated with tkwin is
1687  *	guaranteed to exist. This may require the window's ancestors to be
1688  *	created also.
1689  *
1690  *--------------------------------------------------------------
1691  */
1692 
1693 void
Tk_MakeWindowExist(Tk_Window tkwin)1694 Tk_MakeWindowExist(
1695     Tk_Window tkwin)		/* Token for window. */
1696 {
1697     TkWindow *winPtr = (TkWindow *) tkwin;
1698     TkWindow *winPtr2;
1699     Window parent;
1700     Tcl_HashEntry *hPtr;
1701     Tk_ClassCreateProc *createProc;
1702     int isNew;
1703 
1704     if (winPtr->window != None) {
1705 	return;
1706     }
1707 
1708     if ((winPtr->parentPtr == NULL) || (winPtr->flags & TK_TOP_HIERARCHY)) {
1709 	parent = XRootWindow(winPtr->display, winPtr->screenNum);
1710     } else {
1711 	if (winPtr->parentPtr->window == None) {
1712 	    Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr);
1713 	}
1714 	parent = winPtr->parentPtr->window;
1715     }
1716 
1717     createProc = Tk_GetClassProc(winPtr->classProcsPtr, createProc);
1718     if (createProc != NULL && parent != None) {
1719 	winPtr->window = createProc(tkwin, parent, winPtr->instanceData);
1720     } else {
1721 	winPtr->window = TkpMakeWindow(winPtr, parent);
1722     }
1723 
1724     hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable,
1725 	    (char *) winPtr->window, &isNew);
1726     Tcl_SetHashValue(hPtr, winPtr);
1727     winPtr->dirtyAtts = 0;
1728     winPtr->dirtyChanges = 0;
1729 
1730     if (!(winPtr->flags & TK_TOP_HIERARCHY)) {
1731 	/*
1732 	 * If any siblings higher up in the stacking order have already been
1733 	 * created then move this window to its rightful position in the
1734 	 * stacking order.
1735 	 *
1736 	 * NOTE: this code ignores any changes anyone might have made to the
1737 	 * sibling and stack_mode field of the window's attributes, so it
1738 	 * really isn't safe for these to be manipulated except by calling
1739 	 * Tk_RestackWindow.
1740 	 */
1741 
1742 	for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL;
1743 		winPtr2 = winPtr2->nextPtr) {
1744 	    if ((winPtr2->window != None)
1745 		    && !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) {
1746 		XWindowChanges changes;
1747 
1748 		changes.sibling = winPtr2->window;
1749 		changes.stack_mode = Below;
1750 		XConfigureWindow(winPtr->display, winPtr->window,
1751 			CWSibling|CWStackMode, &changes);
1752 		break;
1753 	    }
1754 	}
1755 
1756 	/*
1757 	 * If this window has a different colormap than its parent, add the
1758 	 * window to the WM_COLORMAP_WINDOWS property for its top-level.
1759 	 */
1760 
1761 	if ((winPtr->parentPtr != NULL) &&
1762 		(winPtr->atts.colormap != winPtr->parentPtr->atts.colormap)) {
1763 	    TkWmAddToColormapWindows(winPtr);
1764 	    winPtr->flags |= TK_WM_COLORMAP_WINDOW;
1765 	}
1766     }
1767 
1768     /*
1769      * Issue a ConfigureNotify event if there were deferred configuration
1770      * changes (but skip it if the window is being deleted; the
1771      * ConfigureNotify event could cause problems if we're being called from
1772      * Tk_DestroyWindow under some conditions).
1773      */
1774 
1775     if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY)
1776 	    && !(winPtr->flags & TK_ALREADY_DEAD)) {
1777 	winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY;
1778 	TkDoConfigureNotify(winPtr);
1779     }
1780 }
1781 
1782 /*
1783  *--------------------------------------------------------------
1784  *
1785  * Tk_UnmapWindow, etc. --
1786  *
1787  *	There are several functions under here, each of which mirrors an
1788  *	existing X function. In addition to performing the functions of the
1789  *	corresponding function, each function also updates the local window
1790  *	structure and synthesizes an X event (if the window's structure is
1791  *	being managed internally).
1792  *
1793  * Results:
1794  *	See the manual entries.
1795  *
1796  * Side effects:
1797  *	See the manual entries.
1798  *
1799  *--------------------------------------------------------------
1800  */
1801 
1802 void
Tk_UnmapWindow(Tk_Window tkwin)1803 Tk_UnmapWindow(
1804     Tk_Window tkwin)		/* Token for window to unmap. */
1805 {
1806     TkWindow *winPtr = (TkWindow *) tkwin;
1807 
1808     if (!(winPtr->flags & TK_MAPPED) || (winPtr->flags & TK_ALREADY_DEAD)) {
1809 	return;
1810     }
1811     if (winPtr->flags & TK_WIN_MANAGED) {
1812 	/*
1813 	 * Special processing has to be done for top-level windows. Let tkWm.c
1814 	 * handle everything itself.
1815 	 */
1816 
1817 	TkWmUnmapWindow(winPtr);
1818 	return;
1819     }
1820     winPtr->flags &= ~TK_MAPPED;
1821     XUnmapWindow(winPtr->display, winPtr->window);
1822     if (!(winPtr->flags & TK_TOP_HIERARCHY)) {
1823 	XEvent event;
1824 
1825 	event.type = UnmapNotify;
1826 	event.xunmap.serial = LastKnownRequestProcessed(winPtr->display);
1827 	event.xunmap.send_event = False;
1828 	event.xunmap.display = winPtr->display;
1829 	event.xunmap.event = winPtr->window;
1830 	event.xunmap.window = winPtr->window;
1831 	event.xunmap.from_configure = False;
1832 	TkpHandleMapOrUnmap((Tk_Window)winPtr, &event);
1833     }
1834 }
1835 
1836 void
Tk_ConfigureWindow(Tk_Window tkwin,unsigned int valueMask,XWindowChanges * valuePtr)1837 Tk_ConfigureWindow(
1838     Tk_Window tkwin,		/* Window to re-configure. */
1839     unsigned int valueMask,	/* Mask indicating which parts of *valuePtr
1840 				 * are to be used. */
1841     XWindowChanges *valuePtr)	/* New values. */
1842 {
1843     TkWindow *winPtr = (TkWindow *) tkwin;
1844 
1845     if (valueMask & CWX) {
1846 	winPtr->changes.x = valuePtr->x;
1847     }
1848     if (valueMask & CWY) {
1849 	winPtr->changes.y = valuePtr->y;
1850     }
1851     if (valueMask & CWWidth) {
1852 	winPtr->changes.width = valuePtr->width;
1853     }
1854     if (valueMask & CWHeight) {
1855 	winPtr->changes.height = valuePtr->height;
1856     }
1857     if (valueMask & CWBorderWidth) {
1858 	winPtr->changes.border_width = valuePtr->border_width;
1859     }
1860     if (valueMask & (CWSibling|CWStackMode)) {
1861 	Tcl_Panic("Can't set sibling or stack mode from Tk_ConfigureWindow");
1862     }
1863 
1864     if (winPtr->window != None) {
1865 	XConfigureWindow(winPtr->display, winPtr->window,
1866 		valueMask, valuePtr);
1867 	TkDoConfigureNotify(winPtr);
1868     } else {
1869 	winPtr->dirtyChanges |= valueMask;
1870 	winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
1871     }
1872 }
1873 
1874 void
Tk_MoveWindow(Tk_Window tkwin,int x,int y)1875 Tk_MoveWindow(
1876     Tk_Window tkwin,		/* Window to move. */
1877     int x, int y)		/* New location for window (within parent). */
1878 {
1879     TkWindow *winPtr = (TkWindow *) tkwin;
1880 
1881     winPtr->changes.x = x;
1882     winPtr->changes.y = y;
1883     if (winPtr->window != None) {
1884 	XMoveWindow(winPtr->display, winPtr->window, x, y);
1885 	TkDoConfigureNotify(winPtr);
1886     } else {
1887 	winPtr->dirtyChanges |= CWX|CWY;
1888 	winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
1889     }
1890 }
1891 
1892 void
Tk_ResizeWindow(Tk_Window tkwin,int width,int height)1893 Tk_ResizeWindow(
1894     Tk_Window tkwin,		/* Window to resize. */
1895     int width, int height)	/* New dimensions for window. */
1896 {
1897     TkWindow *winPtr = (TkWindow *) tkwin;
1898 
1899     winPtr->changes.width = (unsigned) width;
1900     winPtr->changes.height = (unsigned) height;
1901     if (winPtr->window != None) {
1902 	XResizeWindow(winPtr->display, winPtr->window, (unsigned) width,
1903 		(unsigned) height);
1904 	TkDoConfigureNotify(winPtr);
1905     } else {
1906 	winPtr->dirtyChanges |= CWWidth|CWHeight;
1907 	winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
1908     }
1909 }
1910 
1911 void
Tk_MoveResizeWindow(Tk_Window tkwin,int x,int y,int width,int height)1912 Tk_MoveResizeWindow(
1913     Tk_Window tkwin,		/* Window to move and resize. */
1914     int x, int y,		/* New location for window (within parent). */
1915     int width, int height)	/* New dimensions for window. */
1916 {
1917     TkWindow *winPtr = (TkWindow *) tkwin;
1918 
1919     winPtr->changes.x = x;
1920     winPtr->changes.y = y;
1921     winPtr->changes.width = (unsigned) width;
1922     winPtr->changes.height = (unsigned) height;
1923     if (winPtr->window != None) {
1924 	XMoveResizeWindow(winPtr->display, winPtr->window, x, y,
1925 		(unsigned) width, (unsigned) height);
1926 	TkDoConfigureNotify(winPtr);
1927     } else {
1928 	winPtr->dirtyChanges |= CWX|CWY|CWWidth|CWHeight;
1929 	winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
1930     }
1931 }
1932 
1933 void
Tk_SetWindowBorderWidth(Tk_Window tkwin,int width)1934 Tk_SetWindowBorderWidth(
1935     Tk_Window tkwin,		/* Window to modify. */
1936     int width)			/* New border width for window. */
1937 {
1938     TkWindow *winPtr = (TkWindow *) tkwin;
1939 
1940     winPtr->changes.border_width = width;
1941     if (winPtr->window != None) {
1942 	XSetWindowBorderWidth(winPtr->display, winPtr->window,
1943 		(unsigned) width);
1944 	TkDoConfigureNotify(winPtr);
1945     } else {
1946 	winPtr->dirtyChanges |= CWBorderWidth;
1947 	winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
1948     }
1949 }
1950 
1951 void
Tk_ChangeWindowAttributes(Tk_Window tkwin,unsigned long valueMask,XSetWindowAttributes * attsPtr)1952 Tk_ChangeWindowAttributes(
1953     Tk_Window tkwin,		/* Window to manipulate. */
1954     unsigned long valueMask,	/* OR'ed combination of bits, indicating which
1955 				 * fields of *attsPtr are to be used. */
1956     XSetWindowAttributes *attsPtr)
1957 				/* New values for some attributes. */
1958 {
1959     TkWindow *winPtr = (TkWindow *) tkwin;
1960 
1961     if (valueMask & CWBackPixmap) {
1962 	winPtr->atts.background_pixmap = attsPtr->background_pixmap;
1963     }
1964     if (valueMask & CWBackPixel) {
1965 	winPtr->atts.background_pixel = attsPtr->background_pixel;
1966     }
1967     if (valueMask & CWBorderPixmap) {
1968 	winPtr->atts.border_pixmap = attsPtr->border_pixmap;
1969     }
1970     if (valueMask & CWBorderPixel) {
1971 	winPtr->atts.border_pixel = attsPtr->border_pixel;
1972     }
1973     if (valueMask & CWBitGravity) {
1974 	winPtr->atts.bit_gravity = attsPtr->bit_gravity;
1975     }
1976     if (valueMask & CWWinGravity) {
1977 	winPtr->atts.win_gravity = attsPtr->win_gravity;
1978     }
1979     if (valueMask & CWBackingStore) {
1980 	winPtr->atts.backing_store = attsPtr->backing_store;
1981     }
1982     if (valueMask & CWBackingPlanes) {
1983 	winPtr->atts.backing_planes = attsPtr->backing_planes;
1984     }
1985     if (valueMask & CWBackingPixel) {
1986 	winPtr->atts.backing_pixel = attsPtr->backing_pixel;
1987     }
1988     if (valueMask & CWOverrideRedirect) {
1989 	winPtr->atts.override_redirect = attsPtr->override_redirect;
1990     }
1991     if (valueMask & CWSaveUnder) {
1992 	winPtr->atts.save_under = attsPtr->save_under;
1993     }
1994     if (valueMask & CWEventMask) {
1995 	winPtr->atts.event_mask = attsPtr->event_mask;
1996     }
1997     if (valueMask & CWDontPropagate) {
1998 	winPtr->atts.do_not_propagate_mask
1999 		= attsPtr->do_not_propagate_mask;
2000     }
2001     if (valueMask & CWColormap) {
2002 	winPtr->atts.colormap = attsPtr->colormap;
2003     }
2004     if (valueMask & CWCursor) {
2005 	winPtr->atts.cursor = attsPtr->cursor;
2006     }
2007 
2008     if (winPtr->window != None) {
2009 	XChangeWindowAttributes(winPtr->display, winPtr->window,
2010 		valueMask, attsPtr);
2011     } else {
2012 	winPtr->dirtyAtts |= valueMask;
2013     }
2014 }
2015 
2016 void
Tk_SetWindowBackground(Tk_Window tkwin,unsigned long pixel)2017 Tk_SetWindowBackground(
2018     Tk_Window tkwin,		/* Window to manipulate. */
2019     unsigned long pixel)	/* Pixel value to use for window's
2020 				 * background. */
2021 {
2022     TkWindow *winPtr = (TkWindow *) tkwin;
2023 
2024     winPtr->atts.background_pixel = pixel;
2025 
2026     if (winPtr->window != None) {
2027 	XSetWindowBackground(winPtr->display, winPtr->window, pixel);
2028     } else {
2029 	winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixmap)
2030 		| CWBackPixel;
2031     }
2032 }
2033 
2034 void
Tk_SetWindowBackgroundPixmap(Tk_Window tkwin,Pixmap pixmap)2035 Tk_SetWindowBackgroundPixmap(
2036     Tk_Window tkwin,		/* Window to manipulate. */
2037     Pixmap pixmap)		/* Pixmap to use for window's background. */
2038 {
2039     TkWindow *winPtr = (TkWindow *) tkwin;
2040 
2041     winPtr->atts.background_pixmap = pixmap;
2042 
2043     if (winPtr->window != None) {
2044 	XSetWindowBackgroundPixmap(winPtr->display,
2045 		winPtr->window, pixmap);
2046     } else {
2047 	winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixel)
2048 		| CWBackPixmap;
2049     }
2050 }
2051 
2052 void
Tk_SetWindowBorder(Tk_Window tkwin,unsigned long pixel)2053 Tk_SetWindowBorder(
2054     Tk_Window tkwin,		/* Window to manipulate. */
2055     unsigned long pixel)	/* Pixel value to use for window's border. */
2056 {
2057     TkWindow *winPtr = (TkWindow *) tkwin;
2058 
2059     winPtr->atts.border_pixel = pixel;
2060 
2061     if (winPtr->window != None) {
2062 	XSetWindowBorder(winPtr->display, winPtr->window, pixel);
2063     } else {
2064 	winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixmap)
2065 		| CWBorderPixel;
2066     }
2067 }
2068 
2069 void
Tk_SetWindowBorderPixmap(Tk_Window tkwin,Pixmap pixmap)2070 Tk_SetWindowBorderPixmap(
2071     Tk_Window tkwin,		/* Window to manipulate. */
2072     Pixmap pixmap)		/* Pixmap to use for window's border. */
2073 {
2074     TkWindow *winPtr = (TkWindow *) tkwin;
2075 
2076     winPtr->atts.border_pixmap = pixmap;
2077 
2078     if (winPtr->window != None) {
2079 	XSetWindowBorderPixmap(winPtr->display,
2080 		winPtr->window, pixmap);
2081     } else {
2082 	winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixel)
2083 		| CWBorderPixmap;
2084     }
2085 }
2086 
2087 void
Tk_DefineCursor(Tk_Window tkwin,Tk_Cursor cursor)2088 Tk_DefineCursor(
2089     Tk_Window tkwin,		/* Window to manipulate. */
2090     Tk_Cursor cursor)		/* Cursor to use for window (may be None). */
2091 {
2092     TkWindow *winPtr = (TkWindow *) tkwin;
2093 
2094 #if defined(MAC_OSX_TK)
2095     winPtr->atts.cursor = (XCursor) cursor;
2096 #else
2097     winPtr->atts.cursor = (Cursor) cursor;
2098 #endif
2099 
2100     if (winPtr->window != None) {
2101 	XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor);
2102     } else {
2103 	winPtr->dirtyAtts = winPtr->dirtyAtts | CWCursor;
2104     }
2105 }
2106 
2107 void
Tk_UndefineCursor(Tk_Window tkwin)2108 Tk_UndefineCursor(
2109     Tk_Window tkwin)		/* Window to manipulate. */
2110 {
2111     Tk_DefineCursor(tkwin, NULL);
2112 }
2113 
2114 void
Tk_SetWindowColormap(Tk_Window tkwin,Colormap colormap)2115 Tk_SetWindowColormap(
2116     Tk_Window tkwin,		/* Window to manipulate. */
2117     Colormap colormap)		/* Colormap to use for window. */
2118 {
2119     TkWindow *winPtr = (TkWindow *) tkwin;
2120 
2121     winPtr->atts.colormap = colormap;
2122 
2123     if (winPtr->window != None) {
2124 	XSetWindowColormap(winPtr->display, winPtr->window, colormap);
2125 	if (!(winPtr->flags & TK_WIN_MANAGED)) {
2126 	    TkWmAddToColormapWindows(winPtr);
2127 	    winPtr->flags |= TK_WM_COLORMAP_WINDOW;
2128 	}
2129     } else {
2130 	winPtr->dirtyAtts |= CWColormap;
2131     }
2132 }
2133 
2134 /*
2135  *----------------------------------------------------------------------
2136  *
2137  * Tk_SetWindowVisual --
2138  *
2139  *	This function is called to specify a visual to be used for a Tk window
2140  *	when it is created. This function, if called at all, must be called
2141  *	before the X window is created (i.e. before Tk_MakeWindowExist is
2142  *	called).
2143  *
2144  * Results:
2145  *	The return value is 1 if successful, or 0 if the X window has been
2146  *	already created.
2147  *
2148  * Side effects:
2149  *	The information given is stored for when the window is created.
2150  *
2151  *----------------------------------------------------------------------
2152  */
2153 
2154 int
Tk_SetWindowVisual(Tk_Window tkwin,Visual * visual,int depth,Colormap colormap)2155 Tk_SetWindowVisual(
2156     Tk_Window tkwin,		/* Window to manipulate. */
2157     Visual *visual,		/* New visual for window. */
2158     int depth,			/* New depth for window. */
2159     Colormap colormap)		/* An appropriate colormap for the visual. */
2160 {
2161     TkWindow *winPtr = (TkWindow *) tkwin;
2162 
2163     if (winPtr->window != None) {
2164 	/* Too late! */
2165 	return 0;
2166     }
2167 
2168     winPtr->visual = visual;
2169     winPtr->depth = depth;
2170     winPtr->atts.colormap = colormap;
2171     winPtr->dirtyAtts |= CWColormap;
2172 
2173     /*
2174      * The following code is needed to make sure that the window doesn't
2175      * inherit the parent's border pixmap, which would result in a BadMatch
2176      * error.
2177      */
2178 
2179     if (!(winPtr->dirtyAtts & CWBorderPixmap)) {
2180 	winPtr->dirtyAtts |= CWBorderPixel;
2181     }
2182     return 1;
2183 }
2184 
2185 /*
2186  *----------------------------------------------------------------------
2187  *
2188  * TkDoConfigureNotify --
2189  *
2190  *	Generate a ConfigureNotify event describing the current configuration
2191  *	of a window.
2192  *
2193  * Results:
2194  *	None.
2195  *
2196  * Side effects:
2197  *	An event is generated and processed by Tk_HandleEvent.
2198  *
2199  *----------------------------------------------------------------------
2200  */
2201 
2202 void
TkDoConfigureNotify(TkWindow * winPtr)2203 TkDoConfigureNotify(
2204     TkWindow *winPtr)	/* Window whose configuration was just
2205 				 * changed. */
2206 {
2207     XEvent event;
2208 
2209     event.type = ConfigureNotify;
2210     event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display);
2211     event.xconfigure.send_event = False;
2212     event.xconfigure.display = winPtr->display;
2213     event.xconfigure.event = winPtr->window;
2214     event.xconfigure.window = winPtr->window;
2215     event.xconfigure.x = winPtr->changes.x;
2216     event.xconfigure.y = winPtr->changes.y;
2217     event.xconfigure.width = winPtr->changes.width;
2218     event.xconfigure.height = winPtr->changes.height;
2219     event.xconfigure.border_width = winPtr->changes.border_width;
2220     if (winPtr->changes.stack_mode == Above) {
2221 	event.xconfigure.above = winPtr->changes.sibling;
2222     } else {
2223 	event.xconfigure.above = None;
2224     }
2225     event.xconfigure.override_redirect = winPtr->atts.override_redirect;
2226     Tk_HandleEvent(&event);
2227 }
2228 
2229 /*
2230  *----------------------------------------------------------------------
2231  *
2232  * Tk_SetClass --
2233  *
2234  *	This function is used to give a window a class.
2235  *
2236  * Results:
2237  *	None.
2238  *
2239  * Side effects:
2240  *	A new class is stored for tkwin, replacing any existing class for it.
2241  *
2242  *----------------------------------------------------------------------
2243  */
2244 
2245 void
Tk_SetClass(Tk_Window tkwin,const char * className)2246 Tk_SetClass(
2247     Tk_Window tkwin,		/* Token for window to assign class. */
2248     const char *className)	/* New class for tkwin. */
2249 {
2250     TkWindow *winPtr = (TkWindow *) tkwin;
2251 
2252     winPtr->classUid = Tk_GetUid(className);
2253     if (winPtr->flags & TK_WIN_MANAGED) {
2254 	TkWmSetClass(winPtr);
2255     }
2256     TkOptionClassChanged(winPtr);
2257 }
2258 
2259 /*
2260  *----------------------------------------------------------------------
2261  *
2262  * Tk_SetClassProcs --
2263  *
2264  *	This function is used to set the class functions and instance data for
2265  *	a window.
2266  *
2267  * Results:
2268  *	None.
2269  *
2270  * Side effects:
2271  *	A new set of class functions and instance data is stored for tkwin,
2272  *	replacing any existing values.
2273  *
2274  *----------------------------------------------------------------------
2275  */
2276 
2277 void
Tk_SetClassProcs(Tk_Window tkwin,const Tk_ClassProcs * procs,ClientData instanceData)2278 Tk_SetClassProcs(
2279     Tk_Window tkwin,		/* Token for window to modify. */
2280     const Tk_ClassProcs *procs,	/* Class procs structure. */
2281     ClientData instanceData)	/* Data to be passed to class functions. */
2282 {
2283     TkWindow *winPtr = (TkWindow *) tkwin;
2284 
2285     winPtr->classProcsPtr = procs;
2286     winPtr->instanceData = instanceData;
2287 }
2288 
2289 /*
2290  *----------------------------------------------------------------------
2291  *
2292  * Tk_NameToWindow --
2293  *
2294  *	Given a string name for a window, this function returns the token for
2295  *	the window, if there exists a window corresponding to the given name.
2296  *
2297  * Results:
2298  *	The return result is either a token for the window corresponding to
2299  *	"name", or else NULL to indicate that there is no such window. In this
2300  *	case, an error message is left in the interp's result, unless interp
2301  *      is NULL.
2302  *
2303  * Side effects:
2304  *	None.
2305  *
2306  *----------------------------------------------------------------------
2307  */
2308 
2309 Tk_Window
Tk_NameToWindow(Tcl_Interp * interp,const char * pathName,Tk_Window tkwin)2310 Tk_NameToWindow(
2311     Tcl_Interp *interp,		/* Where to report errors. */
2312     const char *pathName,	/* Path name of window. */
2313     Tk_Window tkwin)		/* Token for window: name is assumed to belong
2314 				 * to the same main window as tkwin. */
2315 {
2316     Tcl_HashEntry *hPtr;
2317 
2318     if (tkwin == NULL) {
2319 	/*
2320 	 * Either we're not really in Tk, or the main window was destroyed and
2321 	 * we're on our way out of the application.
2322 	 */
2323 
2324 	if (interp != NULL) {
2325 	    Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1));
2326 	    Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL);
2327 	}
2328 	return NULL;
2329     }
2330 
2331     hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable,
2332 	    pathName);
2333     if (hPtr == NULL) {
2334 	if (interp != NULL) {
2335 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2336 		    "bad window path name \"%s\"", pathName));
2337 	    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", pathName,
2338 		    NULL);
2339 	}
2340 	return NULL;
2341     }
2342     return Tcl_GetHashValue(hPtr);
2343 }
2344 
2345 /*
2346  *----------------------------------------------------------------------
2347  *
2348  * Tk_IdToWindow --
2349  *
2350  *	Given an X display and window ID, this function returns the Tk token
2351  *	for the window, if there exists a Tk window corresponding to the given
2352  *	ID.
2353  *
2354  * Results:
2355  *	The return result is either a token for the window corresponding to
2356  *	the given X id, or else NULL to indicate that there is no such window.
2357  *
2358  * Side effects:
2359  *	None.
2360  *
2361  *----------------------------------------------------------------------
2362  */
2363 
2364 Tk_Window
Tk_IdToWindow(Display * display,Window window)2365 Tk_IdToWindow(
2366     Display *display,		/* X display containing the window. */
2367     Window window)		/* X window window id. */
2368 {
2369     TkDisplay *dispPtr;
2370     Tcl_HashEntry *hPtr;
2371 
2372     for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) {
2373 	if (dispPtr == NULL) {
2374 	    return NULL;
2375 	}
2376 	if (dispPtr->display == display) {
2377 	    break;
2378 	}
2379     }
2380     if (window == None) {
2381 	return NULL;
2382     }
2383 
2384     hPtr = Tcl_FindHashEntry(&dispPtr->winTable, (char *) window);
2385     if (hPtr == NULL) {
2386 	return NULL;
2387     }
2388     return Tcl_GetHashValue(hPtr);
2389 }
2390 
2391 /*
2392  *----------------------------------------------------------------------
2393  *
2394  * Tk_DisplayName --
2395  *
2396  *	Return the textual name of a window's display.
2397  *
2398  * Results:
2399  *	The return value is the string name of the display associated with
2400  *	tkwin.
2401  *
2402  * Side effects:
2403  *	None.
2404  *
2405  *----------------------------------------------------------------------
2406  */
2407 
2408 const char *
Tk_DisplayName(Tk_Window tkwin)2409 Tk_DisplayName(
2410     Tk_Window tkwin)		/* Window whose display name is desired. */
2411 {
2412     return ((TkWindow *) tkwin)->dispPtr->name;
2413 }
2414 
2415 /*
2416  *----------------------------------------------------------------------
2417  *
2418  * Tk_Interp --
2419  *
2420  *	Get the Tcl interpreter from a Tk window.
2421  *
2422  * Results:
2423  *	A pointer to the interpreter or NULL.
2424  *
2425  * Side effects:
2426  *	None.
2427  *
2428  *----------------------------------------------------------------------
2429  */
2430 
2431 Tcl_Interp *
Tk_Interp(Tk_Window tkwin)2432 Tk_Interp(
2433     Tk_Window tkwin)
2434 {
2435     if (tkwin != NULL && ((TkWindow *) tkwin)->mainPtr != NULL) {
2436 	return ((TkWindow *) tkwin)->mainPtr->interp;
2437     }
2438     return NULL;
2439 }
2440 
2441 /*
2442  *----------------------------------------------------------------------
2443  *
2444  * UnlinkWindow --
2445  *
2446  *	This function removes a window from the childList of its parent.
2447  *
2448  * Results:
2449  *	None.
2450  *
2451  * Side effects:
2452  *	The window is unlinked from its childList.
2453  *
2454  *----------------------------------------------------------------------
2455  */
2456 
2457 static void
UnlinkWindow(TkWindow * winPtr)2458 UnlinkWindow(
2459     TkWindow *winPtr)		/* Child window to be unlinked. */
2460 {
2461     TkWindow *prevPtr;
2462 
2463     if (winPtr->parentPtr == NULL) {
2464 	return;
2465     }
2466     prevPtr = winPtr->parentPtr->childList;
2467     if (prevPtr == winPtr) {
2468 	winPtr->parentPtr->childList = winPtr->nextPtr;
2469 	if (winPtr->nextPtr == NULL) {
2470 	    winPtr->parentPtr->lastChildPtr = NULL;
2471 	}
2472     } else {
2473 	while (prevPtr->nextPtr != winPtr) {
2474 	    prevPtr = prevPtr->nextPtr;
2475 	    if (prevPtr == NULL) {
2476 		Tcl_Panic("UnlinkWindow couldn't find child in parent");
2477 	    }
2478 	}
2479 	prevPtr->nextPtr = winPtr->nextPtr;
2480 	if (winPtr->nextPtr == NULL) {
2481 	    winPtr->parentPtr->lastChildPtr = prevPtr;
2482 	}
2483     }
2484 }
2485 
2486 /*
2487  *----------------------------------------------------------------------
2488  *
2489  * Tk_RestackWindow --
2490  *
2491  *	Change a window's position in the stacking order.
2492  *
2493  * Results:
2494  *	TCL_OK is normally returned. If other is not a descendant of tkwin's
2495  *	parent then TCL_ERROR is returned and tkwin is not repositioned.
2496  *
2497  * Side effects:
2498  *	Tkwin is repositioned in the stacking order.
2499  *
2500  *----------------------------------------------------------------------
2501  */
2502 
2503 int
Tk_RestackWindow(Tk_Window tkwin,int aboveBelow,Tk_Window other)2504 Tk_RestackWindow(
2505     Tk_Window tkwin,		/* Token for window whose position in the
2506 				 * stacking order is to change. */
2507     int aboveBelow,		/* Indicates new position of tkwin relative to
2508 				 * other; must be Above or Below. */
2509     Tk_Window other)		/* Tkwin will be moved to a position that puts
2510 				 * it just above or below this window. If NULL
2511 				 * then tkwin goes above or below all windows
2512 				 * in the same parent. */
2513 {
2514     TkWindow *winPtr = (TkWindow *) tkwin;
2515     TkWindow *otherPtr = (TkWindow *) other;
2516 
2517     /*
2518      * Special case: if winPtr is a top-level window then just find the
2519      * top-level ancestor of otherPtr and restack winPtr above otherPtr
2520      * without changing any of Tk's childLists.
2521      */
2522 
2523     if (winPtr->flags & TK_WIN_MANAGED) {
2524 	while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_HIERARCHY)) {
2525 	    otherPtr = otherPtr->parentPtr;
2526 	}
2527 	TkWmRestackToplevel(winPtr, aboveBelow, otherPtr);
2528 	return TCL_OK;
2529     }
2530 
2531     /*
2532      * Find an ancestor of otherPtr that is a sibling of winPtr.
2533      */
2534 
2535     if (winPtr->parentPtr == NULL) {
2536 	/*
2537 	 * Window is going to be deleted shortly; don't do anything.
2538 	 */
2539 
2540 	return TCL_OK;
2541     }
2542     if (otherPtr == NULL) {
2543 	if (aboveBelow == Above) {
2544 	    otherPtr = winPtr->parentPtr->lastChildPtr;
2545 	} else {
2546 	    otherPtr = winPtr->parentPtr->childList;
2547 	}
2548     } else {
2549 	while (winPtr->parentPtr != otherPtr->parentPtr) {
2550 	    if ((otherPtr == NULL) || (otherPtr->flags & TK_TOP_HIERARCHY)) {
2551 		return TCL_ERROR;
2552 	    }
2553 	    otherPtr = otherPtr->parentPtr;
2554 	}
2555     }
2556     if (otherPtr == winPtr) {
2557 	return TCL_OK;
2558     }
2559 
2560     /*
2561      * Reposition winPtr in the stacking order.
2562      */
2563 
2564     UnlinkWindow(winPtr);
2565     if (aboveBelow == Above) {
2566 	winPtr->nextPtr = otherPtr->nextPtr;
2567 	if (winPtr->nextPtr == NULL) {
2568 	    winPtr->parentPtr->lastChildPtr = winPtr;
2569 	}
2570 	otherPtr->nextPtr = winPtr;
2571     } else {
2572 	TkWindow *prevPtr;
2573 
2574 	prevPtr = winPtr->parentPtr->childList;
2575 	if (prevPtr == otherPtr) {
2576 	    winPtr->parentPtr->childList = winPtr;
2577 	} else {
2578 	    while (prevPtr->nextPtr != otherPtr) {
2579 		prevPtr = prevPtr->nextPtr;
2580 	    }
2581 	    prevPtr->nextPtr = winPtr;
2582 	}
2583 	winPtr->nextPtr = otherPtr;
2584     }
2585 
2586     /*
2587      * Notify the X server of the change. If winPtr hasn't yet been created
2588      * then there's no need to tell the X server now, since the stacking order
2589      * will be handled properly when the window is finally created.
2590      */
2591 
2592     if (winPtr->window != None) {
2593 	XWindowChanges changes;
2594 	unsigned int mask = CWStackMode;
2595 
2596 	changes.stack_mode = Above;
2597 	for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
2598 		otherPtr = otherPtr->nextPtr) {
2599 	    if ((otherPtr->window != None)
2600 		    && !(otherPtr->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))){
2601 		changes.sibling = otherPtr->window;
2602 		changes.stack_mode = Below;
2603 		mask = CWStackMode|CWSibling;
2604 		break;
2605 	    }
2606 	}
2607 	XConfigureWindow(winPtr->display, winPtr->window, mask, &changes);
2608     }
2609     return TCL_OK;
2610 }
2611 
2612 /*
2613  *----------------------------------------------------------------------
2614  *
2615  * Tk_MainWindow --
2616  *
2617  *	Returns the main window for an application.
2618  *
2619  * Results:
2620  *	If interp has a Tk application associated with it, the main window for
2621  *	the application is returned. Otherwise NULL is returned and an error
2622  *	message is left in the interp's result.
2623  *
2624  * Side effects:
2625  *	None.
2626  *
2627  *----------------------------------------------------------------------
2628  */
2629 
2630 Tk_Window
Tk_MainWindow(Tcl_Interp * interp)2631 Tk_MainWindow(
2632     Tcl_Interp *interp)		/* Interpreter that embodies the application.
2633 				 * Used for error reporting also. */
2634 {
2635     TkMainInfo *mainPtr;
2636     ThreadSpecificData *tsdPtr;
2637 
2638     if (interp == NULL) {
2639 	return NULL;
2640     }
2641 #ifdef USE_TCL_STUBS
2642     if (tclStubsPtr == NULL) {
2643 	return NULL;
2644     }
2645 #endif
2646     tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
2647 
2648     for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL;
2649 	    mainPtr = mainPtr->nextPtr) {
2650 	if (mainPtr->interp == interp) {
2651 	    return (Tk_Window) mainPtr->winPtr;
2652 	}
2653     }
2654     Tcl_SetObjResult(interp, Tcl_NewStringObj(
2655 	    "this isn't a Tk application", -1));
2656     Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL);
2657     return NULL;
2658 }
2659 
2660 /*
2661  *----------------------------------------------------------------------
2662  *
2663  * Tk_StrictMotif --
2664  *
2665  *	Indicates whether strict Motif compliance has been specified for the
2666  *	given window.
2667  *
2668  * Results:
2669  *	The return value is 1 if strict Motif compliance has been requested
2670  *	for tkwin's application by setting the tk_strictMotif variable in its
2671  *	interpreter to a true value. 0 is returned if tk_strictMotif has a
2672  *	false value.
2673  *
2674  * Side effects:
2675  *	None.
2676  *
2677  *----------------------------------------------------------------------
2678  */
2679 
2680 int
Tk_StrictMotif(Tk_Window tkwin)2681 Tk_StrictMotif(
2682     Tk_Window tkwin)		/* Window whose application is to be
2683 				 * checked. */
2684 {
2685     return ((TkWindow *) tkwin)->mainPtr->strictMotif;
2686 }
2687 
2688 /*
2689  *----------------------------------------------------------------------
2690  *
2691  * Tk_GetNumMainWindows --
2692  *
2693  *	This function returns the number of main windows currently open in
2694  *	this process.
2695  *
2696  * Results:
2697  *	The number of main windows open in this process.
2698  *
2699  * Side effects:
2700  *	None.
2701  *
2702  *----------------------------------------------------------------------
2703  */
2704 
2705 int
Tk_GetNumMainWindows(void)2706 Tk_GetNumMainWindows(void)
2707 {
2708     ThreadSpecificData *tsdPtr;
2709 
2710 #ifdef USE_TCL_STUBS
2711     if (tclStubsPtr == NULL) {
2712 	return 0;
2713     }
2714 #endif
2715 
2716     tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
2717 
2718     return tsdPtr->numMainWindows;
2719 }
2720 
2721 /*
2722  *----------------------------------------------------------------------
2723  *
2724  * TkpAlwaysShowSelection --
2725  *
2726  *	Indicates whether text/entry widgets should always display
2727  *	their selection, regardless of window focus.
2728  *
2729  * Results:
2730  *	The return value is 1 if always showing the selection has been
2731  *	requested for tkwin's application by setting the
2732  *	::tk::AlwaysShowSelection variable in its interpreter to a true value.
2733  *	0 is returned if it has a false value.
2734  *
2735  * Side effects:
2736  *	None.
2737  *
2738  *----------------------------------------------------------------------
2739  */
2740 
2741 int
TkpAlwaysShowSelection(Tk_Window tkwin)2742 TkpAlwaysShowSelection(
2743     Tk_Window tkwin)		/* Window whose application is to be
2744 				 * checked. */
2745 {
2746     return ((TkWindow *) tkwin)->mainPtr->alwaysShowSelection;
2747 }
2748 
2749 /*
2750  *----------------------------------------------------------------------
2751  *
2752  * DeleteWindowsExitProc --
2753  *
2754  *	This function is invoked as an exit handler. It deletes all of the
2755  *	main windows in the current thread. We really should be using a thread
2756  *	local exit handler to delete windows and a process exit handler to
2757  *	close the display but Tcl does not provide support for this usage.
2758  *
2759  * Results:
2760  *	None.
2761  *
2762  * Side effects:
2763  *	None.
2764  *
2765  *----------------------------------------------------------------------
2766  */
2767 
2768 static void
DeleteWindowsExitProc(ClientData clientData)2769 DeleteWindowsExitProc(
2770     ClientData clientData)	/* tsdPtr when handler was created. */
2771 {
2772     TkDisplay *dispPtr, *nextPtr;
2773     Tcl_Interp *interp;
2774     ThreadSpecificData *tsdPtr = clientData;
2775 
2776     if (tsdPtr == NULL) {
2777 	return;
2778     }
2779 
2780     /*
2781      * Finish destroying any windows that are in a half-dead state. We must
2782      * protect the interpreter while destroying the window, because of
2783      * <Destroy> bindings which could destroy the interpreter while the window
2784      * is being deleted. This would leave frames on the call stack pointing at
2785      * deleted memory, causing core dumps.
2786      */
2787 
2788     while (tsdPtr->halfdeadWindowList != NULL) {
2789 	interp = tsdPtr->halfdeadWindowList->winPtr->mainPtr->interp;
2790 	Tcl_Preserve(interp);
2791 	tsdPtr->halfdeadWindowList->flags |= HD_CLEANUP;
2792 	tsdPtr->halfdeadWindowList->winPtr->flags &= ~TK_ALREADY_DEAD;
2793 	Tk_DestroyWindow((Tk_Window) tsdPtr->halfdeadWindowList->winPtr);
2794 	Tcl_Release(interp);
2795     }
2796 
2797     /*
2798      * Destroy any remaining main windows.
2799      */
2800 
2801     while (tsdPtr->mainWindowList != NULL) {
2802 	interp = tsdPtr->mainWindowList->interp;
2803 	Tcl_Preserve(interp);
2804 	Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr);
2805 	Tcl_Release(interp);
2806     }
2807 
2808     /*
2809      * Let error handlers catch up before actual close of displays.
2810      * Must be done before tsdPtr->displayList is cleared, otherwise
2811      * ErrorProc() in tkError.c cannot associate the pending X errors
2812      * to the remaining error handlers.
2813      */
2814 
2815     for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
2816            dispPtr = dispPtr->nextPtr) {
2817        XSync(dispPtr->display, False);
2818     }
2819 
2820     /*
2821      * Iterate destroying the displays until no more displays remain. It is
2822      * possible for displays to get recreated during exit by any code that
2823      * calls GetScreen, so we must destroy these new displays as well as the
2824      * old ones.
2825      */
2826 
2827     for (dispPtr = tsdPtr->displayList; dispPtr != NULL;
2828 	    dispPtr = tsdPtr->displayList) {
2829 	/*
2830 	 * Now iterate over the current list of open displays, and first set
2831 	 * the global pointer to NULL so we will be able to notice if any new
2832 	 * displays got created during deletion of the current set. We must
2833 	 * also do this to ensure that Tk_IdToWindow does not find the old
2834 	 * display as it is being destroyed, when it wants to see if it needs
2835 	 * to dispatch a message.
2836 	 */
2837 
2838 	for (tsdPtr->displayList = NULL; dispPtr != NULL; dispPtr = nextPtr) {
2839 	    nextPtr = dispPtr->nextPtr;
2840 	    TkCloseDisplay(dispPtr);
2841 	}
2842     }
2843 
2844     tsdPtr->numMainWindows = 0;
2845     tsdPtr->mainWindowList = NULL;
2846     tsdPtr->initialized = 0;
2847 }
2848 
2849 #if defined(_WIN32)
2850 
2851 static HMODULE tkcygwindll = NULL;
2852 
2853 /*
2854  * Run Tk_MainEx from libtk8.?.dll
2855  *
2856  * This function is only ever called from wish8.4.exe, the cygwin port of Tcl.
2857  * This means that the system encoding is utf-8, so we don't have to do any
2858  * encoding conversions.
2859  */
2860 
2861 int
TkCygwinMainEx(int argc,char ** argv,Tcl_AppInitProc * appInitProc,Tcl_Interp * interp)2862 TkCygwinMainEx(
2863     int argc,			/* Number of arguments. */
2864     char **argv,		/* Array of argument strings. */
2865     Tcl_AppInitProc *appInitProc,
2866 				/* Application-specific initialization
2867 				 * procedure to call after most initialization
2868 				 * but before starting to execute commands. */
2869     Tcl_Interp *interp)
2870 {
2871     WCHAR name[MAX_PATH];
2872     int len;
2873     void (*tkmainex)(int, char **, Tcl_AppInitProc *, Tcl_Interp *);
2874 
2875     /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */
2876     len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH);
2877     name[len-2] = '.';
2878     name[len-1] = name[len-5];
2879     wcscpy(name+len, L".dll");
2880     memcpy(name+len-8, L"libtk8", 6 * sizeof(WCHAR));
2881 
2882     tkcygwindll = LoadLibraryW(name);
2883     if (!tkcygwindll) {
2884 	/* dll is not present */
2885 	return 0;
2886     }
2887     tkmainex = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *))
2888 	    (void *)GetProcAddress(tkcygwindll, "Tk_MainEx");
2889     if (!tkmainex) {
2890 	return 0;
2891     }
2892     tkmainex(argc, argv, appInitProc, interp);
2893     return 1;
2894 }
2895 #endif /* _WIN32 */
2896 
2897 /*
2898  *----------------------------------------------------------------------
2899  *
2900  * Tk_Init --
2901  *
2902  *	This function is invoked to add Tk to an interpreter. It incorporates
2903  *	all of Tk's commands into the interpreter and creates the main window
2904  *	for a new Tk application. If the interpreter contains a variable
2905  *	"argv", this function extracts several arguments from that variable,
2906  *	uses them to configure the main window, and modifies argv to exclude
2907  *	the arguments (see the "wish" documentation for a list of the
2908  *	arguments that are extracted).
2909  *
2910  * Results:
2911  *	Returns a standard Tcl completion code and sets the interp's result if
2912  *	there is an error.
2913  *
2914  * Side effects:
2915  *	Depends on various initialization scripts that get invoked.
2916  *
2917  *----------------------------------------------------------------------
2918  */
2919 
2920 int
Tk_Init(Tcl_Interp * interp)2921 Tk_Init(
2922     Tcl_Interp *interp)		/* Interpreter to initialize. */
2923 {
2924 #if defined(_WIN32)
2925     if (tkcygwindll) {
2926 	int (*tkinit)(Tcl_Interp *);
2927 
2928 	tkinit = (int(*)(Tcl_Interp *))(void *)GetProcAddress(tkcygwindll,"Tk_Init");
2929 	if (tkinit) {
2930 	    return tkinit(interp);
2931 	}
2932     }
2933 #endif /* _WIN32 */
2934     return Initialize(interp);
2935 }
2936 
2937 /*
2938  *----------------------------------------------------------------------
2939  *
2940  * Tk_SafeInit --
2941  *
2942  *	This function is invoked to add Tk to a safe interpreter. It invokes
2943  *	the internal function that does the real work.
2944  *
2945  * Results:
2946  *	Returns a standard Tcl completion code and sets the interp's result if
2947  *	there is an error.
2948  *
2949  * Side effects:
2950  *	Depends on various initialization scripts that are invoked.
2951  *
2952  *----------------------------------------------------------------------
2953  */
2954 
2955 int
Tk_SafeInit(Tcl_Interp * interp)2956 Tk_SafeInit(
2957     Tcl_Interp *interp)		/* Interpreter to initialize. */
2958 {
2959     /*
2960      * Initialize the interpreter with Tk, safely. This removes all the Tk
2961      * commands that are unsafe.
2962      *
2963      * Rationale:
2964      *
2965      * - Toplevel and menu are unsafe because they can be used to cover the
2966      *   entire screen and to steal input from the user.
2967      * - Continuous ringing of the bell is a nuisance.
2968      * - Cannot allow access to the clipboard because a malicious script can
2969      *   replace the contents with the string "rm -r *" and lead to surprises
2970      *   when the contents of the clipboard are pasted. Similarly, the
2971      *   selection command is blocked.
2972      * - Cannot allow send because it can be used to cause unsafe interpreters
2973      *   to execute commands. The tk command recreates the send command, so
2974      *   that too must be hidden.
2975      * - Focus can be used to grab the focus away from another window, in
2976      *   effect stealing user input. Cannot allow that.
2977      *   NOTE: We currently do *not* hide focus as it would make it impossible
2978      *   to provide keyboard input to Tk in a safe interpreter.
2979      * - Grab can be used to block the user from using any other apps on the
2980      *   screen.
2981      * - Tkwait can block the containing process forever. Use bindings,
2982      *   fileevents and split the protocol into before-the-wait and
2983      *   after-the-wait parts. More work but necessary.
2984      * - Wm is unsafe because (if toplevels are allowed, in the future) it can
2985      *   be used to remove decorations, move windows around, cover the entire
2986      *   screen etc etc.
2987      *
2988      * Current risks:
2989      *
2990      * - No CPU time limit, no memory allocation limits, no color limits.
2991      *   CPU time limits can be imposed by an unsafe parent interpreter.
2992      *
2993      * The actual code called is the same as Tk_Init but Tcl_IsSafe() is
2994      * checked at several places to differentiate the two initialisations.
2995      */
2996 
2997 #if defined(_WIN32)
2998     if (tkcygwindll) {
2999 	int (*tksafeinit)(Tcl_Interp *);
3000 
3001 	tksafeinit = (int (*)(Tcl_Interp *))
3002 		(void *)GetProcAddress(tkcygwindll, "Tk_SafeInit");
3003 	if (tksafeinit) {
3004 	    return tksafeinit(interp);
3005 	}
3006     }
3007 #endif /* _WIN32 */
3008     return Initialize(interp);
3009 }
3010 
3011 MODULE_SCOPE const TkStubs tkStubs;
3012 
3013 /*
3014  *----------------------------------------------------------------------
3015  *
3016  * Initialize --
3017  *
3018  *	The core of the initialization code for Tk, called from Tk_Init and
3019  *	Tk_SafeInit.
3020  *
3021  * Results:
3022  *	A standard Tcl result. Also leaves an error message in the interp's
3023  *	result if there was an error.
3024  *
3025  * Side effects:
3026  *	Depends on the initialization scripts that are invoked.
3027  *
3028  *----------------------------------------------------------------------
3029  */
3030 
3031 static int
CopyValue(ClientData dummy,Tcl_Obj * objPtr,void * dstPtr)3032 CopyValue(
3033     ClientData dummy,
3034     Tcl_Obj *objPtr,
3035     void *dstPtr)
3036 {
3037     *(Tcl_Obj **)dstPtr = objPtr;
3038     return 1;
3039 }
3040 
3041 static int
Initialize(Tcl_Interp * interp)3042 Initialize(
3043     Tcl_Interp *interp)		/* Interpreter to initialize. */
3044 {
3045     int code = TCL_OK;
3046     ThreadSpecificData *tsdPtr;
3047     Tcl_Obj *value = NULL;
3048     Tcl_Obj *cmd;
3049 
3050     Tcl_Obj *nameObj = NULL;
3051     Tcl_Obj *classObj = NULL;
3052     Tcl_Obj *displayObj = NULL;
3053     Tcl_Obj *colorMapObj = NULL;
3054     Tcl_Obj *useObj = NULL;
3055     Tcl_Obj *visualObj = NULL;
3056     Tcl_Obj *geometryObj = NULL;
3057 
3058     int sync = 0;
3059 
3060     const Tcl_ArgvInfo table[] = {
3061 	{TCL_ARGV_CONSTANT, "-sync", INT2PTR(1), &sync,
3062 		"Use synchronous mode for display server", NULL},
3063 	{TCL_ARGV_FUNC, "-colormap", CopyValue, &colorMapObj,
3064 		"Colormap for main window", NULL},
3065 	{TCL_ARGV_FUNC, "-display", CopyValue, &displayObj,
3066 		"Display to use", NULL},
3067 	{TCL_ARGV_FUNC, "-geometry", CopyValue, &geometryObj,
3068 		"Initial geometry for window", NULL},
3069 	{TCL_ARGV_FUNC, "-name", CopyValue, &nameObj,
3070 		"Name to use for application", NULL},
3071 	{TCL_ARGV_FUNC, "-visual", CopyValue, &visualObj,
3072 		"Visual for main window", NULL},
3073 	{TCL_ARGV_FUNC, "-use", CopyValue, &useObj,
3074 		"Id of window in which to embed application", NULL},
3075 	TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
3076     };
3077 
3078     /*
3079      * Ensure that we are getting a compatible version of Tcl.
3080      */
3081 
3082     if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
3083 	return TCL_ERROR;
3084     }
3085 
3086     /*
3087      * Ensure that our obj-types are registered with the Tcl runtime.
3088      */
3089 
3090     TkRegisterObjTypes();
3091 
3092     tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
3093 
3094     /*
3095      * We start by resetting the result because it might not be clean.
3096      */
3097 
3098     Tcl_ResetResult(interp);
3099 
3100     if (Tcl_IsSafe(interp)) {
3101 	/*
3102 	 * Get the clearance to start Tk and the "argv" parameters from the
3103 	 * parent.
3104 	 */
3105 
3106 	/*
3107 	 * Step 1 : find the parent and construct the interp name (could be a
3108 	 * function if new APIs were ok). We could also construct the path
3109 	 * while walking, but there is no API to get the name of an interp
3110 	 * either.
3111 	 */
3112 
3113 	Tcl_Interp *parent = interp;
3114 
3115 	while (Tcl_IsSafe(parent)) {
3116 	    parent = Tcl_GetParent(parent);
3117 	    if (parent == NULL) {
3118 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
3119 			"no controlling parent interpreter", -1));
3120 		Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL);
3121 		return TCL_ERROR;
3122 	    }
3123 	}
3124 
3125 	/*
3126 	 * Construct the name (rewalk...)
3127 	 */
3128 
3129 	code = Tcl_GetInterpPath(parent, interp);
3130 	if (code != TCL_OK) {
3131 	    Tcl_Panic("Tcl_GetInterpPath broken!");
3132 	}
3133 
3134 	/*
3135 	 * Build the command to eval in trusted parent.
3136 	 */
3137 
3138 	cmd = Tcl_NewListObj(2, NULL);
3139 	Tcl_ListObjAppendElement(NULL, cmd,
3140 		Tcl_NewStringObj("::safe::TkInit", -1));
3141 	Tcl_ListObjAppendElement(NULL, cmd, Tcl_GetObjResult(parent));
3142 
3143 	/*
3144 	 * Step 2 : Eval in the parent. The argument is the *reversed* interp
3145 	 * path of the child.
3146 	 */
3147 
3148 	Tcl_IncrRefCount(cmd);
3149 	code = Tcl_EvalObjEx(parent, cmd, 0);
3150 	Tcl_DecrRefCount(cmd);
3151 	Tcl_TransferResult(parent, code, interp);
3152 	if (code != TCL_OK) {
3153 	    return code;
3154 	}
3155 
3156 	/*
3157 	 * Use the parent's result as argv. Note: We don't use the Obj
3158 	 * interfaces to avoid dealing with cross interp refcounting and
3159 	 * changing the code below.
3160 	 */
3161 
3162 	value = Tcl_GetObjResult(interp);
3163     } else {
3164 	/*
3165 	 * If there is an "argv" variable, get its value, extract out relevant
3166 	 * arguments from it, and rewrite the variable without the arguments
3167 	 * that we used.
3168 	 */
3169 
3170 	value = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY);
3171     }
3172 
3173     if (value) {
3174 	int objc;
3175 	Tcl_Obj **objv, **rest;
3176 	Tcl_Obj *parseList = Tcl_NewListObj(1, NULL);
3177 
3178 	Tcl_ListObjAppendElement(NULL, parseList, Tcl_NewObj());
3179 
3180 	Tcl_IncrRefCount(value);
3181 	if (TCL_OK != Tcl_ListObjAppendList(interp, parseList, value) ||
3182 	    TCL_OK != Tcl_ListObjGetElements(NULL, parseList, &objc, &objv) ||
3183 	    TCL_OK != Tcl_ParseArgsObjv(interp, table, &objc, objv, &rest)) {
3184 	    Tcl_AddErrorInfo(interp,
3185 		    "\n    (processing arguments in argv variable)");
3186 	    code = TCL_ERROR;
3187 	}
3188 	if (code == TCL_OK) {
3189 	    Tcl_SetVar2Ex(interp, "argv", NULL,
3190 		    Tcl_NewListObj(objc-1, rest+1), TCL_GLOBAL_ONLY);
3191 	    Tcl_SetVar2Ex(interp, "argc", NULL,
3192 		    Tcl_NewIntObj(objc-1), TCL_GLOBAL_ONLY);
3193 	    ckfree(rest);
3194 	}
3195 	Tcl_DecrRefCount(parseList);
3196 	if (code != TCL_OK) {
3197 	    goto done;
3198 	}
3199     }
3200 
3201     /*
3202      * Figure out the application's name and class.
3203      */
3204 
3205     /*
3206      * If we got no -name argument, fetch from TkpGetAppName().
3207      */
3208 
3209     if (nameObj == NULL) {
3210 	Tcl_DString nameDS;
3211 
3212 	Tcl_DStringInit(&nameDS);
3213 	TkpGetAppName(interp, &nameDS);
3214 	nameObj = Tcl_NewStringObj(Tcl_DStringValue(&nameDS),
3215 		Tcl_DStringLength(&nameDS));
3216 	Tcl_DStringFree(&nameDS);
3217     }
3218 
3219     /*
3220      * The -class argument is always the ToTitle of the -name
3221      */
3222 
3223     {
3224 	int numBytes;
3225 	const char *bytes = Tcl_GetStringFromObj(nameObj, &numBytes);
3226 
3227 	classObj = Tcl_NewStringObj(bytes, numBytes);
3228 
3229 	numBytes = Tcl_UtfToTitle(Tcl_GetString(classObj));
3230 	Tcl_SetObjLength(classObj, numBytes);
3231     }
3232 
3233     /*
3234      * Create an argument list for creating the top-level window, using the
3235      * information parsed from argv, if any.
3236      */
3237 
3238     cmd = Tcl_NewStringObj("toplevel . -class", -1);
3239 
3240     Tcl_ListObjAppendElement(NULL, cmd, classObj);
3241     classObj = NULL;
3242 
3243     if (displayObj) {
3244 	Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-screen", -1));
3245 	Tcl_ListObjAppendElement(NULL, cmd, displayObj);
3246 
3247 	/*
3248 	 * If this is the first application for this process, save the display
3249 	 * name in the DISPLAY environment variable so that it will be
3250 	 * available to subprocesses created by us.
3251 	 */
3252 
3253 	if (tsdPtr->numMainWindows == 0) {
3254 	    Tcl_SetVar2Ex(interp, "env", "DISPLAY", displayObj, TCL_GLOBAL_ONLY);
3255 	}
3256 	displayObj = NULL;
3257     }
3258     if (colorMapObj) {
3259 	Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-colormap", -1));
3260 	Tcl_ListObjAppendElement(NULL, cmd, colorMapObj);
3261 	colorMapObj = NULL;
3262     }
3263     if (useObj) {
3264 	Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-use", -1));
3265 	Tcl_ListObjAppendElement(NULL, cmd, useObj);
3266 	useObj = NULL;
3267     }
3268     if (visualObj) {
3269 	Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-visual", -1));
3270 	Tcl_ListObjAppendElement(NULL, cmd, visualObj);
3271 	visualObj = NULL;
3272     }
3273 
3274     code = TkListCreateFrame(NULL, interp, cmd, 1, nameObj);
3275 
3276     Tcl_DecrRefCount(cmd);
3277 
3278     if (code != TCL_OK) {
3279 	goto done;
3280     }
3281     Tcl_ResetResult(interp);
3282     if (sync) {
3283 	(void)XSynchronize(Tk_Display(Tk_MainWindow(interp)), True);
3284     }
3285 
3286     /*
3287      * Set the geometry of the main window, if requested. Put the requested
3288      * geometry into the "geometry" variable.
3289      */
3290 
3291     if (geometryObj) {
3292 
3293 	Tcl_SetVar2Ex(interp, "geometry", NULL, geometryObj, TCL_GLOBAL_ONLY);
3294 
3295 	cmd = Tcl_NewStringObj("wm geometry .", -1);
3296 	Tcl_ListObjAppendElement(NULL, cmd, geometryObj);
3297 	Tcl_IncrRefCount(cmd);
3298 	code = Tcl_EvalObjEx(interp, cmd, 0);
3299 	Tcl_DecrRefCount(cmd);
3300 	geometryObj = NULL;
3301 	if (code != TCL_OK) {
3302 	    goto done;
3303 	}
3304     }
3305 
3306     /*
3307      * Provide Tk and its stub table.
3308      */
3309 
3310     code = Tcl_PkgProvideEx(interp, "Tk", TK_PATCH_LEVEL,
3311 	    (ClientData) &tkStubs);
3312     if (code != TCL_OK) {
3313 	goto done;
3314     }
3315 
3316     /*
3317      * If we were able to provide ourselves as a package, then set the main
3318      * loop function in Tcl to our main loop proc. This will cause tclsh to be
3319      * event-aware when Tk is dynamically loaded. This will have no effect in
3320      * wish, which already is prepared to run the event loop.
3321      */
3322 
3323     Tcl_SetMainLoop(Tk_MainLoop);
3324 
3325     /*
3326      * Initialized the themed widget set
3327      */
3328 
3329     code = Ttk_Init(interp);
3330     if (code != TCL_OK) {
3331 	goto done;
3332     }
3333 
3334     /*
3335      * Invoke platform-specific initialization. Unlock mutex before entering
3336      * TkpInit, as that may run through the Tk_Init routine again for the
3337      * console window interpreter.
3338      */
3339 
3340     code = TkpInit(interp);
3341     if (code == TCL_OK) {
3342 
3343 	/*
3344 	 * In order to find tk.tcl during initialization, we evaluate the
3345 	 * following script.  It calls on the Tcl command [tcl_findLibrary]
3346 	 * to perform the search.  See the docs for that command for details
3347 	 * on where it looks.
3348 	 *
3349 	 * Note that this entire search mechanism can be bypassed by defining
3350 	 * an alternate [tkInit] command before calling Tk_Init().
3351 	 */
3352 
3353 	code = Tcl_EvalEx(interp,
3354 "if {[namespace which -command tkInit] eq \"\"} {\n\
3355   proc tkInit {} {\n\
3356     global tk_library tk_version tk_patchLevel\n\
3357       rename tkInit {}\n\
3358     tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\
3359   }\n\
3360 }\n\
3361 tkInit", -1, TCL_EVAL_GLOBAL);
3362     }
3363     if (code == TCL_OK) {
3364 	/*
3365 	 * Create exit handlers to delete all windows when the application or
3366 	 * thread exits. The handler need to be invoked before other platform
3367 	 * specific cleanups take place to avoid panics in finalization.
3368 	 */
3369 
3370 	TkCreateThreadExitHandler(DeleteWindowsExitProc, tsdPtr);
3371     }
3372   done:
3373     if (value) {
3374 	Tcl_DecrRefCount(value);
3375 	value = NULL;
3376     }
3377     return code;
3378 }
3379 
3380 /*
3381  *----------------------------------------------------------------------
3382  *
3383  * Tk_PkgInitStubsCheck --
3384  *
3385  *	This is a replacement routine for Tk_InitStubs() that is called
3386  *	from code where -DUSE_TK_STUBS has not been enabled.
3387  *
3388  * Results:
3389  *	Returns the version of a conforming Tk stubs table, or NULL, if
3390  *	the table version doesn't satisfy the requested requirements,
3391  *	according to historical practice.
3392  *
3393  * Side effects:
3394  *	None.
3395  *
3396  *----------------------------------------------------------------------
3397  */
3398 
3399 const char *
Tk_PkgInitStubsCheck(Tcl_Interp * interp,const char * version,int exact)3400 Tk_PkgInitStubsCheck(
3401     Tcl_Interp *interp,
3402     const char * version,
3403     int exact)
3404 {
3405     const char *actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0, NULL);
3406 
3407     if (exact && actualVersion) {
3408 	const char *p = version;
3409 	int count = 0;
3410 
3411 	while (*p) {
3412 	    count += !isdigit(UCHAR(*p++));
3413 	}
3414 	if (count == 1) {
3415 	    if (0 != strncmp(version, actualVersion, strlen(version))) {
3416 		/* Construct error message */
3417 		Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL);
3418 		return NULL;
3419 	    }
3420 	} else {
3421 	    return Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL);
3422 	}
3423     }
3424     return actualVersion;
3425 }
3426 
3427 /*
3428  * Local Variables:
3429  * mode: c
3430  * c-basic-offset: 4
3431  * fill-column: 78
3432  * End:
3433  */
3434