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