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