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

Annotation of /projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tkwindow.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 98 - (hide annotations) (download)
Sun Dec 18 00:57:31 2016 UTC (7 years, 5 months ago) by dashley
File MIME type: text/plain
File size: 87498 byte(s)
Reorganization.
1 dashley 71 /* $Header$ */
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     /* End of tkwindow.c */

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25