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