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