tkWindow.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:93k
源码类别:

通讯编程

开发平台:

Visual C++

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