/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkwindow.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkwindow.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25