diff options
Diffstat (limited to 'tk8.6/generic/tkWindow.c')
-rw-r--r-- | tk8.6/generic/tkWindow.c | 3395 |
1 files changed, 3395 insertions, 0 deletions
diff --git a/tk8.6/generic/tkWindow.c b/tk8.6/generic/tkWindow.c new file mode 100644 index 0000000..0c60321 --- /dev/null +++ b/tk8.6/generic/tkWindow.c @@ -0,0 +1,3395 @@ +/* + * tkWindow.c -- + * + * This file provides basic window-manipulation functions, which are + * equivalent to functions in Xlib (and even invoke them) but also + * maintain the local Tk_Window structure. + * + * Copyright (c) 1989-1994 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tkInt.h" + +#ifdef _WIN32 +#include "tkWinInt.h" +#elif !defined(MAC_OSX_TK) +#include "tkUnixInt.h" +#endif + +/* + * Type used to keep track of Window objects that were only partially + * deallocated by Tk_DestroyWindow. + */ + +#define HD_CLEANUP 1 +#define HD_FOCUS 2 +#define HD_MAIN_WIN 4 +#define HD_DESTROY_COUNT 8 +#define HD_DESTROY_EVENT 0x10 + +typedef struct TkHalfdeadWindow { + int flags; + struct TkWindow *winPtr; + struct TkHalfdeadWindow *nextPtr; +} TkHalfdeadWindow; + +typedef struct ThreadSpecificData { + int numMainWindows; /* Count of numver of main windows currently + * open in this thread. */ + TkMainInfo *mainWindowList; + /* First in list of all main windows managed + * by this thread. */ + TkHalfdeadWindow *halfdeadWindowList; + /* First in list of partially deallocated + * windows. */ + TkDisplay *displayList; /* List of all displays currently in use by + * the current thread. */ + int initialized; /* 0 means the structures above need + * initializing. */ +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* + * Default values for "changes" and "atts" fields of TkWindows. Note that Tk + * always requests all events for all windows, except StructureNotify events + * on internal windows: these events are generated internally. + */ + +static const XWindowChanges defChanges = { + 0, 0, 1, 1, 0, 0, Above +}; +#define ALL_EVENTS_MASK \ + KeyPressMask|KeyReleaseMask|ButtonPressMask|ButtonReleaseMask| \ + EnterWindowMask|LeaveWindowMask|PointerMotionMask|ExposureMask| \ + VisibilityChangeMask|PropertyChangeMask|ColormapChangeMask +static const XSetWindowAttributes defAtts= { + None, /* background_pixmap */ + 0, /* background_pixel */ + CopyFromParent, /* border_pixmap */ + 0, /* border_pixel */ + NorthWestGravity, /* bit_gravity */ + NorthWestGravity, /* win_gravity */ + NotUseful, /* backing_store */ + (unsigned) ~0, /* backing_planes */ + 0, /* backing_pixel */ + False, /* save_under */ + ALL_EVENTS_MASK, /* event_mask */ + 0, /* do_not_propagate_mask */ + False, /* override_redirect */ + CopyFromParent, /* colormap */ + None /* cursor */ +}; + +/* + * The following structure defines all of the commands supported by Tk, and + * the C functions that execute them. + */ + +#define ISSAFE 1 +#define PASSMAINWINDOW 2 +#define WINMACONLY 4 +#define USEINITPROC 8 + +typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData); +typedef struct { + const char *name; /* Name of command. */ + Tcl_ObjCmdProc *objProc; /* Command's object- (or string-) based + * function, or initProc. */ + int flags; +} TkCmd; + +static const TkCmd commands[] = { + /* + * Commands that are part of the intrinsics: + */ + + {"bell", Tk_BellObjCmd, PASSMAINWINDOW}, + {"bind", Tk_BindObjCmd, PASSMAINWINDOW|ISSAFE}, + {"bindtags", Tk_BindtagsObjCmd, PASSMAINWINDOW|ISSAFE}, + {"clipboard", Tk_ClipboardObjCmd, PASSMAINWINDOW}, + {"destroy", Tk_DestroyObjCmd, PASSMAINWINDOW|ISSAFE}, + {"event", Tk_EventObjCmd, PASSMAINWINDOW|ISSAFE}, + {"focus", Tk_FocusObjCmd, PASSMAINWINDOW|ISSAFE}, + {"font", Tk_FontObjCmd, PASSMAINWINDOW|ISSAFE}, + {"grab", Tk_GrabObjCmd, PASSMAINWINDOW}, + {"grid", Tk_GridObjCmd, PASSMAINWINDOW|ISSAFE}, + {"image", Tk_ImageObjCmd, PASSMAINWINDOW|ISSAFE}, + {"lower", Tk_LowerObjCmd, PASSMAINWINDOW|ISSAFE}, + {"option", Tk_OptionObjCmd, PASSMAINWINDOW|ISSAFE}, + {"pack", Tk_PackObjCmd, PASSMAINWINDOW|ISSAFE}, + {"place", Tk_PlaceObjCmd, PASSMAINWINDOW|ISSAFE}, + {"raise", Tk_RaiseObjCmd, PASSMAINWINDOW|ISSAFE}, + {"selection", Tk_SelectionObjCmd, PASSMAINWINDOW}, + {"tk", (Tcl_ObjCmdProc *) TkInitTkCmd, USEINITPROC|PASSMAINWINDOW|ISSAFE}, + {"tkwait", Tk_TkwaitObjCmd, PASSMAINWINDOW|ISSAFE}, + {"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE}, + {"winfo", Tk_WinfoObjCmd, PASSMAINWINDOW|ISSAFE}, + {"wm", Tk_WmObjCmd, PASSMAINWINDOW}, + + /* + * Default widget class commands. + */ + + {"button", Tk_ButtonObjCmd, ISSAFE}, + {"canvas", Tk_CanvasObjCmd, PASSMAINWINDOW|ISSAFE}, + {"checkbutton", Tk_CheckbuttonObjCmd, ISSAFE}, + {"entry", Tk_EntryObjCmd, ISSAFE}, + {"frame", Tk_FrameObjCmd, ISSAFE}, + {"label", Tk_LabelObjCmd, ISSAFE}, + {"labelframe", Tk_LabelframeObjCmd, ISSAFE}, + {"listbox", Tk_ListboxObjCmd, ISSAFE}, + {"menu", Tk_MenuObjCmd, PASSMAINWINDOW}, + {"menubutton", Tk_MenubuttonObjCmd, ISSAFE}, + {"message", Tk_MessageObjCmd, ISSAFE}, + {"panedwindow", Tk_PanedWindowObjCmd, ISSAFE}, + {"radiobutton", Tk_RadiobuttonObjCmd, ISSAFE}, + {"scale", Tk_ScaleObjCmd, ISSAFE}, + {"scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE}, + {"spinbox", Tk_SpinboxObjCmd, ISSAFE}, + {"text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, + {"toplevel", Tk_ToplevelObjCmd, 0}, + + /* + * Classic widget class commands. + */ + + {"::tk::button", Tk_ButtonObjCmd, ISSAFE}, + {"::tk::canvas", Tk_CanvasObjCmd, PASSMAINWINDOW|ISSAFE}, + {"::tk::checkbutton",Tk_CheckbuttonObjCmd, ISSAFE}, + {"::tk::entry", Tk_EntryObjCmd, ISSAFE}, + {"::tk::frame", Tk_FrameObjCmd, ISSAFE}, + {"::tk::label", Tk_LabelObjCmd, ISSAFE}, + {"::tk::labelframe",Tk_LabelframeObjCmd, ISSAFE}, + {"::tk::listbox", Tk_ListboxObjCmd, ISSAFE}, + {"::tk::menubutton",Tk_MenubuttonObjCmd, ISSAFE}, + {"::tk::message", Tk_MessageObjCmd, ISSAFE}, + {"::tk::panedwindow",Tk_PanedWindowObjCmd, ISSAFE}, + {"::tk::radiobutton",Tk_RadiobuttonObjCmd, ISSAFE}, + {"::tk::scale", Tk_ScaleObjCmd, ISSAFE}, + {"::tk::scrollbar", Tk_ScrollbarObjCmd, PASSMAINWINDOW|ISSAFE}, + {"::tk::spinbox", Tk_SpinboxObjCmd, ISSAFE}, + {"::tk::text", Tk_TextObjCmd, PASSMAINWINDOW|ISSAFE}, + {"::tk::toplevel", Tk_ToplevelObjCmd, 0}, + + /* + * Standard dialog support. Note that the Unix/X11 platform implements + * these commands differently (via the script library). + */ + +#if defined(_WIN32) || defined(MAC_OSX_TK) + {"tk_chooseColor", Tk_ChooseColorObjCmd, PASSMAINWINDOW}, + {"tk_chooseDirectory", Tk_ChooseDirectoryObjCmd,WINMACONLY|PASSMAINWINDOW}, + {"tk_getOpenFile", Tk_GetOpenFileObjCmd, WINMACONLY|PASSMAINWINDOW}, + {"tk_getSaveFile", Tk_GetSaveFileObjCmd, WINMACONLY|PASSMAINWINDOW}, + {"tk_messageBox", Tk_MessageBoxObjCmd, PASSMAINWINDOW}, +#endif + + /* + * Misc. + */ + +#ifdef MAC_OSX_TK + {"::tk::unsupported::MacWindowStyle", + TkUnsupported1ObjCmd, PASSMAINWINDOW|ISSAFE}, +#endif + {NULL, NULL, 0} +}; + +/* + * Forward declarations to functions defined later in this file: + */ + +static Tk_Window CreateTopLevelWindow(Tcl_Interp *interp, + Tk_Window parent, const char *name, + const char *screenName, unsigned int flags); +static void DeleteWindowsExitProc(ClientData clientData); +static TkDisplay * GetScreen(Tcl_Interp *interp, const char *screenName, + int *screenPtr); +static int Initialize(Tcl_Interp *interp); +static int NameWindow(Tcl_Interp *interp, TkWindow *winPtr, + TkWindow *parentPtr, const char *name); +static void UnlinkWindow(TkWindow *winPtr); + +/* + *---------------------------------------------------------------------- + * + * TkCloseDisplay -- + * + * Closing the display can lead to order of deletion problems. We defer + * it until exit handling for Mac/Win, but since Unix can use many + * displays, try and clean it up as best as possible. + * + * Results: + * None. + * + * Side effects: + * Resources associated with the display will be free. The display may + * not be referenced at all after this. + * + *---------------------------------------------------------------------- + */ + +static void +TkCloseDisplay( + TkDisplay *dispPtr) +{ + TkClipCleanup(dispPtr); + + if (dispPtr->name != NULL) { + ckfree(dispPtr->name); + } + + if (dispPtr->atomInit) { + Tcl_DeleteHashTable(&dispPtr->nameTable); + Tcl_DeleteHashTable(&dispPtr->atomTable); + dispPtr->atomInit = 0; + } + + if (dispPtr->errorPtr != NULL) { + TkErrorHandler *errorPtr; + + for (errorPtr = dispPtr->errorPtr; + errorPtr != NULL; + errorPtr = dispPtr->errorPtr) { + dispPtr->errorPtr = errorPtr->nextPtr; + ckfree(errorPtr); + } + } + + TkGCCleanup(dispPtr); + + TkpCloseDisplay(dispPtr); + + /* + * Delete winTable after TkpCloseDisplay since special windows may need + * call Tk_DestroyWindow and it checks the winTable. + */ + + Tcl_DeleteHashTable(&dispPtr->winTable); + + ckfree(dispPtr); + + /* + * There is more to clean up, we leave it at this for the time being. + */ +} + +/* + *---------------------------------------------------------------------- + * + * CreateTopLevelWindow -- + * + * Make a new window that will be at top-level (its parent will be the + * root window of a screen). + * + * Results: + * The return value is a token for the new window, or NULL if an error + * prevented the new window from being created. If NULL is returned, an + * error message will be left in the interp's result. + * + * Side effects: + * A new window structure is allocated locally. An X window is NOT + * initially created, but will be created the first time the window is + * mapped. + * + *---------------------------------------------------------------------- + */ + +static Tk_Window +CreateTopLevelWindow( + Tcl_Interp *interp, /* Interpreter to use for error reporting. */ + Tk_Window parent, /* Token for logical parent of new window + * (used for naming, options, etc.). May be + * NULL. */ + const char *name, /* Name for new window; if parent is non-NULL, + * must be unique among parent's children. */ + const char *screenName, /* Name of screen on which to create window. + * NULL means use DISPLAY environment variable + * to determine. Empty string means use + * parent's screen, or DISPLAY if no + * parent. */ + unsigned int flags) /* Additional flags to set on the window. */ +{ + register TkWindow *winPtr; + register TkDisplay *dispPtr; + int screenId; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (!tsdPtr->initialized) { + tsdPtr->initialized = 1; + + /* + * Create built-in image types. + */ + + Tk_CreateImageType(&tkBitmapImageType); + Tk_CreateImageType(&tkPhotoImageType); + + /* + * Create built-in photo image formats. + */ + + Tk_CreatePhotoImageFormat(&tkImgFmtGIF); + Tk_CreatePhotoImageFormat(&tkImgFmtPNG); + Tk_CreatePhotoImageFormat(&tkImgFmtPPM); + } + + if ((parent != NULL) && (screenName != NULL) && (screenName[0] == '\0')) { + dispPtr = ((TkWindow *) parent)->dispPtr; + screenId = Tk_ScreenNumber(parent); + } else { + dispPtr = GetScreen(interp, screenName, &screenId); + if (dispPtr == NULL) { + return NULL; + } + } + + winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent); + + /* + * Set the flags specified in the call. + */ + + winPtr->flags |= flags; + + /* + * Force the window to use a border pixel instead of border pixmap. This + * is needed for the case where the window doesn't use the default visual. + * In this case, the default border is a pixmap inherited from the root + * window, which won't work because it will have the wrong visual. + */ + + winPtr->dirtyAtts |= CWBorderPixel; + + /* + * (Need to set the TK_TOP_HIERARCHY flag immediately here; otherwise + * Tk_DestroyWindow will core dump if it is called before the flag has + * been set.) + */ + + winPtr->flags |= + TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED; + + if (parent != NULL) { + if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) { + Tk_DestroyWindow((Tk_Window) winPtr); + return NULL; + } + } + TkWmNewWindow(winPtr); + + return (Tk_Window) winPtr; +} + +/* + *---------------------------------------------------------------------- + * + * GetScreen -- + * + * Given a string name for a display-plus-screen, find the TkDisplay + * structure for the display and return the screen number too. + * + * Results: + * The return value is a pointer to information about the display, or + * NULL if the display couldn't be opened. In this case, an error message + * is left in the interp's result. The location at *screenPtr is + * overwritten with the screen number parsed from screenName. + * + * Side effects: + * A new connection is opened to the display if there is no connection + * already. A new TkDisplay data structure is also setup, if necessary. + * + *---------------------------------------------------------------------- + */ + +static TkDisplay * +GetScreen( + Tcl_Interp *interp, /* Place to leave error message. */ + const char *screenName, /* Name for screen. NULL or empty means use + * DISPLAY envariable. */ + int *screenPtr) /* Where to store screen number. */ +{ + register TkDisplay *dispPtr; + const char *p; + int screenId; + size_t length; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * Separate the screen number from the rest of the display name. + * ScreenName is assumed to have the syntax <display>.<screen> with the + * dot and the screen being optional. + */ + + screenName = TkGetDefaultScreenName(interp, screenName); + if (screenName == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no display name and no $DISPLAY environment variable", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_DISPLAY", NULL); + return NULL; + } + length = strlen(screenName); + screenId = 0; + p = screenName+length-1; + while (isdigit(UCHAR(*p)) && (p != screenName)) { + p--; + } + if ((*p == '.') && (p[1] != '\0')) { + length = p - screenName; + screenId = strtoul(p+1, NULL, 10); + } + + /* + * See if we already have a connection to this display. If not, then open + * a new connection. + */ + + for (dispPtr = tsdPtr->displayList; ; dispPtr = dispPtr->nextPtr) { + if (dispPtr == NULL) { + /* + * The private function zeros out dispPtr when it is created, so + * we only need to initialize the non-zero items. + */ + + dispPtr = TkpOpenDisplay(screenName); + if (dispPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't connect to display \"%s\"", screenName)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "CONNECT", NULL); + return NULL; + } + dispPtr->nextPtr = tsdPtr->displayList; /* TkGetDisplayList(); */ + tsdPtr->displayList = dispPtr; + + dispPtr->lastEventTime = CurrentTime; + dispPtr->bindInfoStale = 1; + dispPtr->cursorFont = None; + dispPtr->warpWindow = NULL; + dispPtr->multipleAtom = None; + + /* + * By default we do want to collapse motion events in + * Tk_QueueWindowEvent. + */ + + dispPtr->flags |= TK_DISPLAY_COLLAPSE_MOTION_EVENTS; + + Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS); + + dispPtr->name = ckalloc(length + 1); + strncpy(dispPtr->name, screenName, length); + dispPtr->name[length] = '\0'; + break; + } + if ((strncmp(dispPtr->name, screenName, length) == 0) + && (dispPtr->name[length] == '\0')) { + break; + } + } + if (screenId >= ScreenCount(dispPtr->display)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad screen number \"%d\"", screenId)); + Tcl_SetErrorCode(interp, "TK", "DISPLAY", "SCREEN_NUMBER", NULL); + return NULL; + } + *screenPtr = screenId; + return dispPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TkGetDisplay -- + * + * Given an X display, TkGetDisplay returns the TkDisplay structure for + * the display. + * + * Results: + * The return value is a pointer to information about the display, or + * NULL if the display did not have a TkDisplay structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +TkDisplay * +TkGetDisplay( + Display *display) /* X's display pointer */ +{ + TkDisplay *dispPtr; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + for (dispPtr = tsdPtr->displayList; dispPtr != NULL; + dispPtr = dispPtr->nextPtr) { + if (dispPtr->display == display) { + break; + } + } + return dispPtr; +} + +/* + *-------------------------------------------------------------- + * + * TkGetDisplayList -- + * + * This function returns a pointer to the thread-local list of TkDisplays + * corresponding to the open displays. + * + * Results: + * The return value is a pointer to the first TkDisplay structure in + * thread-local-storage. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +TkDisplay * +TkGetDisplayList(void) +{ + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->displayList; +} + +/* + *-------------------------------------------------------------- + * + * TkGetMainInfoList -- + * + * This function returns a pointer to the list of structures containing + * information about all main windows for the current thread. + * + * Results: + * The return value is a pointer to the first TkMainInfo structure in + * thread local storage. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +TkMainInfo * +TkGetMainInfoList(void) +{ + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->mainWindowList; +} +/* + *-------------------------------------------------------------- + * + * TkAllocWindow -- + * + * This function creates and initializes a TkWindow structure. + * + * Results: + * The return value is a pointer to the new window. + * + * Side effects: + * A new window structure is allocated and all its fields are + * initialized. + * + *-------------------------------------------------------------- + */ + +TkWindow * +TkAllocWindow( + TkDisplay *dispPtr, /* Display associated with new window. */ + int screenNum, /* Index of screen for new window. */ + TkWindow *parentPtr) /* Parent from which this window should + * inherit visual information. NULL means use + * screen defaults instead of inheriting. */ +{ + register TkWindow *winPtr = ckalloc(sizeof(TkWindow)); + + winPtr->display = dispPtr->display; + winPtr->dispPtr = dispPtr; + winPtr->screenNum = screenNum; + if ((parentPtr != NULL) && (parentPtr->display == winPtr->display) + && (parentPtr->screenNum == winPtr->screenNum)) { + winPtr->visual = parentPtr->visual; + winPtr->depth = parentPtr->depth; + } else { + winPtr->visual = DefaultVisual(dispPtr->display, screenNum); + winPtr->depth = DefaultDepth(dispPtr->display, screenNum); + } + winPtr->window = None; + winPtr->childList = NULL; + winPtr->lastChildPtr = NULL; + winPtr->parentPtr = NULL; + winPtr->nextPtr = NULL; + winPtr->mainPtr = NULL; + winPtr->pathName = NULL; + winPtr->nameUid = NULL; + winPtr->classUid = NULL; + winPtr->changes = defChanges; + winPtr->dirtyChanges = CWX|CWY|CWWidth|CWHeight|CWBorderWidth; + winPtr->atts = defAtts; + if ((parentPtr != NULL) && (parentPtr->display == winPtr->display) + && (parentPtr->screenNum == winPtr->screenNum)) { + winPtr->atts.colormap = parentPtr->atts.colormap; + } else { + winPtr->atts.colormap = DefaultColormap(dispPtr->display, screenNum); + } + winPtr->dirtyAtts = CWEventMask|CWColormap|CWBitGravity; + winPtr->flags = 0; + winPtr->handlerList = NULL; +#ifdef TK_USE_INPUT_METHODS + winPtr->inputContext = NULL; +#endif /* TK_USE_INPUT_METHODS */ + winPtr->tagPtr = NULL; + winPtr->numTags = 0; + winPtr->optionLevel = -1; + winPtr->selHandlerList = NULL; + winPtr->geomMgrPtr = NULL; + winPtr->geomData = NULL; + winPtr->reqWidth = winPtr->reqHeight = 1; + winPtr->internalBorderLeft = 0; + winPtr->wmInfoPtr = NULL; + winPtr->classProcsPtr = NULL; + winPtr->instanceData = NULL; + winPtr->privatePtr = NULL; + winPtr->internalBorderRight = 0; + winPtr->internalBorderTop = 0; + winPtr->internalBorderBottom = 0; + winPtr->minReqWidth = 0; + winPtr->minReqHeight = 0; + winPtr->geometryMaster = NULL; + + return winPtr; +} + +/* + *---------------------------------------------------------------------- + * + * NameWindow -- + * + * This function is invoked to give a window a name and insert the window + * into the hierarchy associated with a particular application. + * + * Results: + * A standard Tcl return value. + * + * Side effects: + * See above. + * + *---------------------------------------------------------------------- + */ + +static int +NameWindow( + Tcl_Interp *interp, /* Interpreter to use for error reporting. */ + register TkWindow *winPtr, /* Window that is to be named and inserted. */ + TkWindow *parentPtr, /* Pointer to logical parent for winPtr (used + * for naming, options, etc.). */ + const char *name) /* Name for winPtr; must be unique among + * parentPtr's children. */ +{ +#define FIXED_SIZE 200 + char staticSpace[FIXED_SIZE]; + char *pathName; + int isNew; + Tcl_HashEntry *hPtr; + size_t length1, length2; + + /* + * Setup all the stuff except name right away, then do the name stuff + * last. This is so that if the name stuff fails, everything else will be + * properly initialized (needed to destroy the window cleanly after the + * naming failure). + */ + + winPtr->parentPtr = parentPtr; + winPtr->nextPtr = NULL; + if (parentPtr->childList == NULL) { + parentPtr->childList = winPtr; + } else { + parentPtr->lastChildPtr->nextPtr = winPtr; + } + parentPtr->lastChildPtr = winPtr; + winPtr->mainPtr = parentPtr->mainPtr; + winPtr->mainPtr->refCount++; + + /* + * If this is an anonymous window (ie, it has no name), just return OK + * now. + */ + + if (winPtr->flags & TK_ANONYMOUS_WINDOW) { + return TCL_OK; + } + + /* + * Don't permit names that start with an upper-case letter: this will just + * cause confusion with class names in the option database. + */ + + if (isupper(UCHAR(name[0]))) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name starts with an upper-case letter: \"%s\"", + name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "NOTCLASS", NULL); + return TCL_ERROR; + } + + /* + * For non-anonymous windows, set up the window name. + */ + + winPtr->nameUid = Tk_GetUid(name); + + /* + * To permit names of arbitrary length, must be prepared to malloc a + * buffer to hold the new path name. To run fast in the common case where + * names are short, use a fixed-size buffer on the stack. + */ + + length1 = strlen(parentPtr->pathName); + length2 = strlen(name); + if ((length1 + length2 + 2) <= FIXED_SIZE) { + pathName = staticSpace; + } else { + pathName = ckalloc(length1 + length2 + 2); + } + if (length1 == 1) { + pathName[0] = '.'; + strcpy(pathName+1, name); + } else { + strcpy(pathName, parentPtr->pathName); + pathName[length1] = '.'; + strcpy(pathName+length1+1, name); + } + hPtr = Tcl_CreateHashEntry(&parentPtr->mainPtr->nameTable, pathName, + &isNew); + if (pathName != staticSpace) { + ckfree(pathName); + } + if (!isNew) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "window name \"%s\" already exists in parent", name)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW", "EXISTS", NULL); + return TCL_ERROR; + } + Tcl_SetHashValue(hPtr, winPtr); + winPtr->pathName = Tcl_GetHashKey(&parentPtr->mainPtr->nameTable, hPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TkCreateMainWindow -- + * + * Make a new main window. A main window is a special kind of top-level + * window used as the outermost window in an application. + * + * Results: + * The return value is a token for the new window, or NULL if an error + * prevented the new window from being created. If NULL is returned, an + * error message will be left in the interp's result. + * + * Side effects: + * A new window structure is allocated locally; "interp" is associated + * with the window and registered for "send" commands under "baseName". + * BaseName may be extended with an instance number in the form "#2" if + * necessary to make it globally unique. Tk-related commands are bound + * into interp. + * + *---------------------------------------------------------------------- + */ + +Tk_Window +TkCreateMainWindow( + Tcl_Interp *interp, /* Interpreter to use for error reporting. */ + const char *screenName, /* Name of screen on which to create window. + * Empty or NULL string means use DISPLAY + * environment variable. */ + const char *baseName) /* Base name for application; usually of the + * form "prog instance". */ +{ + Tk_Window tkwin; + int dummy, isSafe; + Tcl_HashEntry *hPtr; + register TkMainInfo *mainPtr; + register TkWindow *winPtr; + register const TkCmd *cmdPtr; + ClientData clientData; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * Panic if someone updated the TkWindow structure without also updating + * the Tk_FakeWin structure (or vice versa). + */ + + if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) { + Tcl_Panic("TkWindow and Tk_FakeWin are not the same size"); + } + + /* + * Create the basic TkWindow structure. + */ + + tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName, + screenName, /* flags */ 0); + if (tkwin == NULL) { + return NULL; + } + + /* + * Create the TkMainInfo structure for this application, and set up + * name-related information for the new window. + */ + + winPtr = (TkWindow *) tkwin; + mainPtr = ckalloc(sizeof(TkMainInfo)); + mainPtr->winPtr = winPtr; + mainPtr->refCount = 1; + mainPtr->interp = interp; + Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS); + mainPtr->deletionEpoch = 0l; + TkEventInit(); + TkBindInit(mainPtr); + TkFontPkgInit(mainPtr); + TkStylePkgInit(mainPtr); + mainPtr->tlFocusPtr = NULL; + mainPtr->displayFocusPtr = NULL; + mainPtr->optionRootPtr = NULL; + Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS); + mainPtr->strictMotif = 0; + mainPtr->alwaysShowSelection = 0; + if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif, + TCL_LINK_BOOLEAN) != TCL_OK) { + Tcl_ResetResult(interp); + } + if (Tcl_CreateNamespace(interp, "::tk", NULL, NULL) == NULL) { + Tcl_ResetResult(interp); + } + if (Tcl_LinkVar(interp, "::tk::AlwaysShowSelection", + (char *) &mainPtr->alwaysShowSelection, + TCL_LINK_BOOLEAN) != TCL_OK) { + Tcl_ResetResult(interp); + } + mainPtr->nextPtr = tsdPtr->mainWindowList; + tsdPtr->mainWindowList = mainPtr; + winPtr->mainPtr = mainPtr; + hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy); + Tcl_SetHashValue(hPtr, winPtr); + winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr); + Tcl_InitHashTable(&mainPtr->busyTable, TCL_ONE_WORD_KEYS); + + /* + * We have just created another Tk application; increment the refcount on + * the display pointer. + */ + + winPtr->dispPtr->refCount++; + + /* + * Register the interpreter for "send" purposes. + */ + + winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, baseName)); + + /* + * Bind in Tk's commands. + */ + + isSafe = Tcl_IsSafe(interp); + for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { + if (cmdPtr->objProc == NULL) { + Tcl_Panic("TkCreateMainWindow: builtin command with NULL string and object procs"); + } + +#if defined(_WIN32) && !defined(STATIC_BUILD) + if ((cmdPtr->flags & WINMACONLY) && tclStubsPtr->reserved9) { + /* + * We are running on Cygwin, so don't use the win32 dialogs. + */ + + continue; + } +#endif /* _WIN32 && !STATIC_BUILD */ + + if (cmdPtr->flags & PASSMAINWINDOW) { + clientData = tkwin; + } else { + clientData = NULL; + } + if (cmdPtr->flags & USEINITPROC) { + ((TkInitProc *) cmdPtr->objProc)(interp, clientData); + } else { + Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc, + clientData, NULL); + } + if (isSafe && !(cmdPtr->flags & ISSAFE)) { + Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name); + } + } + + /* + * Set variables for the intepreter. + */ + + Tcl_SetVar2(interp, "tk_patchLevel", NULL, TK_PATCH_LEVEL, TCL_GLOBAL_ONLY); + Tcl_SetVar2(interp, "tk_version", NULL, TK_VERSION, TCL_GLOBAL_ONLY); + + tsdPtr->numMainWindows++; + return tkwin; +} + +/* + *-------------------------------------------------------------- + * + * Tk_CreateWindow -- + * + * Create a new internal or top-level window as a child of an existing + * window. + * + * Results: + * The return value is a token for the new window. This is not the same + * as X's token for the window. If an error occurred in creating the + * window (e.g. no such display or screen), then an error message is left + * in the interp's result and NULL is returned. + * + * Side effects: + * A new window structure is allocated locally. An X window is not + * initially created, but will be created the first time the window is + * mapped. + * + *-------------------------------------------------------------- + */ + +Tk_Window +Tk_CreateWindow( + Tcl_Interp *interp, /* Interpreter to use for error reporting. + * the interp's result is assumed to be + * initialized by the caller. */ + Tk_Window parent, /* Token for parent of new window. */ + const char *name, /* Name for new window. Must be unique among + * parent's children. */ + const char *screenName) /* If NULL, new window will be internal on + * same screen as its parent. If non-NULL, + * gives name of screen on which to create new + * window; window will be a top-level + * window. */ +{ + TkWindow *parentPtr = (TkWindow *) parent; + + if (parentPtr) { + if (parentPtr->flags & TK_ALREADY_DEAD) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); + return NULL; + } else if (parentPtr->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); + return NULL; + } else if (screenName == NULL) { + TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, + parentPtr->screenNum, parentPtr); + + if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) { + Tk_DestroyWindow((Tk_Window) winPtr); + return NULL; + } + return (Tk_Window) winPtr; + } + } + return CreateTopLevelWindow(interp, parent, name, screenName, + /* flags */ 0); +} + +/* + *-------------------------------------------------------------- + * + * Tk_CreateAnonymousWindow -- + * + * Create a new internal or top-level window as a child of an existing + * window; this window will be anonymous (unnamed), so it will not be + * visible at the Tcl level. + * + * Results: + * The return value is a token for the new window. This is not the same + * as X's token for the window. If an error occurred in creating the + * window (e.g. no such display or screen), then an error message is left + * in the interp's result and NULL is returned. + * + * Side effects: + * A new window structure is allocated locally. An X window is not + * initially created, but will be created the first time the window is + * mapped. + * + *-------------------------------------------------------------- + */ + +Tk_Window +Tk_CreateAnonymousWindow( + Tcl_Interp *interp, /* Interpreter to use for error reporting. + * the interp's result is assumed to be + * initialized by the caller. */ + Tk_Window parent, /* Token for parent of new window. */ + const char *screenName) /* If NULL, new window will be internal on + * same screen as its parent. If non-NULL, + * gives name of screen on which to create new + * window; window will be a top-level + * window. */ +{ + TkWindow *parentPtr = (TkWindow *) parent; + + if (parentPtr) { + if (parentPtr->flags & TK_ALREADY_DEAD) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); + return NULL; + } else if (parentPtr->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", + -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); + return NULL; + } else if (screenName == NULL) { + TkWindow *winPtr = TkAllocWindow(parentPtr->dispPtr, + parentPtr->screenNum, parentPtr); + /* + * Add the anonymous window flag now, so that NameWindow will + * behave correctly. + */ + + winPtr->flags |= TK_ANONYMOUS_WINDOW; + if (NameWindow(interp, winPtr, parentPtr, NULL) != TCL_OK) { + Tk_DestroyWindow((Tk_Window) winPtr); + return NULL; + } + return (Tk_Window) winPtr; + } + } + return CreateTopLevelWindow(interp, parent, NULL, screenName, + TK_ANONYMOUS_WINDOW); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_CreateWindowFromPath -- + * + * This function is similar to Tk_CreateWindow except that it uses a path + * name to create the window, rather than a parent and a child name. + * + * Results: + * The return value is a token for the new window. This is not the same + * as X's token for the window. If an error occurred in creating the + * window (e.g. no such display or screen), then an error message is left + * in the interp's result and NULL is returned. + * + * Side effects: + * A new window structure is allocated locally. An X window is not + * initially created, but will be created the first time the window is + * mapped. + * + *---------------------------------------------------------------------- + */ + +Tk_Window +Tk_CreateWindowFromPath( + Tcl_Interp *interp, /* Interpreter to use for error reporting. + * the interp's result is assumed to be + * initialized by the caller. */ + Tk_Window tkwin, /* Token for any window in application that is + * to contain new window. */ + const char *pathName, /* Path name for new window within the + * application of tkwin. The parent of this + * window must already exist, but the window + * itself must not exist. */ + const char *screenName) /* If NULL, new window will be on same screen + * as its parent. If non-NULL, gives name of + * screen on which to create new window; + * window will be a top-level window. */ +{ +#define FIXED_SPACE 5 + char fixedSpace[FIXED_SPACE+1]; + char *p; + Tk_Window parent; + int numChars; + + /* + * Strip the parent's name out of pathName (it's everything up to the last + * dot). There are two tricky parts: (a) must copy the parent's name + * somewhere else to avoid modifying the pathName string (for large names, + * space for the copy will have to be malloc'ed); (b) must special-case + * the situation where the parent is ".". + */ + + p = strrchr(pathName, '.'); + if (p == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "VALUE", "WINDOW_PATH", NULL); + return NULL; + } + numChars = (int) (p-pathName); + if (numChars > FIXED_SPACE) { + p = ckalloc(numChars + 1); + } else { + p = fixedSpace; + } + if (numChars == 0) { + *p = '.'; + p[1] = '\0'; + } else { + strncpy(p, pathName, (size_t) numChars); + p[numChars] = '\0'; + } + + /* + * Find the parent window. + */ + + parent = Tk_NameToWindow(interp, p, tkwin); + if (p != fixedSpace) { + ckfree(p); + } + if (parent == NULL) { + return NULL; + } + if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: parent has been destroyed", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "DEAD_PARENT", NULL); + return NULL; + } else if (((TkWindow *) parent)->flags & TK_CONTAINER) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't create window: its parent has -container = yes", -1)); + Tcl_SetErrorCode(interp, "TK", "CREATE", "CONTAINER", NULL); + return NULL; + } + + /* + * Create the window. + */ + + if (screenName == NULL) { + TkWindow *parentPtr = (TkWindow *) parent; + TkWindow *winPtr; + + winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum, + parentPtr); + if (NameWindow(interp, winPtr, parentPtr, pathName+numChars+1) + != TCL_OK) { + Tk_DestroyWindow((Tk_Window) winPtr); + return NULL; + } + return (Tk_Window) winPtr; + } + + return CreateTopLevelWindow(interp, parent, pathName+numChars+1, + screenName, /* flags */ 0); +} + +/* + *-------------------------------------------------------------- + * + * Tk_DestroyWindow -- + * + * Destroy an existing window. After this call, the caller should never + * again use the token. Note that this function can be reentered to + * destroy a window that was only partially destroyed before a call to + * exit. + * + * Results: + * None. + * + * Side effects: + * The window is deleted, along with all of its children. Relevant + * callback functions are invoked. + * + *-------------------------------------------------------------- + */ + +void +Tk_DestroyWindow( + Tk_Window tkwin) /* Window to destroy. */ +{ + TkWindow *winPtr = (TkWindow *) tkwin; + TkDisplay *dispPtr = winPtr->dispPtr; + XEvent event; + TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr; + ThreadSpecificData *tsdPtr = + Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + if (winPtr->flags & TK_ALREADY_DEAD) { + /* + * A destroy event binding caused the window to be destroyed again. + * Ignore the request. + */ + + return; + } + winPtr->flags |= TK_ALREADY_DEAD; + + /* + * Unless we are cleaning up a half dead window from + * DeleteWindowsExitProc, add this window to the half dead list. + */ + + if (tsdPtr->halfdeadWindowList && + (tsdPtr->halfdeadWindowList->flags & HD_CLEANUP) && + (tsdPtr->halfdeadWindowList->winPtr == winPtr)) { + halfdeadPtr = tsdPtr->halfdeadWindowList; + } else { + halfdeadPtr = ckalloc(sizeof(TkHalfdeadWindow)); + halfdeadPtr->flags = 0; + halfdeadPtr->winPtr = winPtr; + halfdeadPtr->nextPtr = tsdPtr->halfdeadWindowList; + tsdPtr->halfdeadWindowList = halfdeadPtr; + } + + /* + * Some cleanup needs to be done immediately, rather than later, because + * it needs information that will be destoyed before we get to the main + * cleanup point. For example, TkFocusDeadWindow needs to access the + * parentPtr field from a window, but if a Destroy event handler deletes + * the window's parent this field will be NULL before the main cleanup + * point is reached. + */ + + if (!(halfdeadPtr->flags & HD_FOCUS)) { + halfdeadPtr->flags |= HD_FOCUS; + TkFocusDeadWindow(winPtr); + } + + /* + * If this is a main window, remove it from the list of main windows. + * This needs to be done now (rather than later with all the other main + * window cleanup) to handle situations where a destroy binding for a + * window calls "exit". In this case the child window cleanup isn't + * complete when exit is called. This situation is dealt with using the + * half dead window list. Windows that are half dead gets cleaned up + * during exit. + * + * Also decrement the display refcount so that if this is the last Tk + * application in this process on this display, the display can be closed + * and its data structures deleted. + */ + + if (!(halfdeadPtr->flags & HD_MAIN_WIN) && + winPtr->mainPtr != NULL && winPtr->mainPtr->winPtr == winPtr) { + halfdeadPtr->flags |= HD_MAIN_WIN; + dispPtr->refCount--; + if (tsdPtr->mainWindowList == winPtr->mainPtr) { + tsdPtr->mainWindowList = winPtr->mainPtr->nextPtr; + } else { + TkMainInfo *prevPtr; + + for (prevPtr = tsdPtr->mainWindowList; + prevPtr->nextPtr != winPtr->mainPtr; + prevPtr = prevPtr->nextPtr) { + /* Empty loop body. */ + } + prevPtr->nextPtr = winPtr->mainPtr->nextPtr; + } + tsdPtr->numMainWindows--; + } + + /* + * Recursively destroy children. Note that this child window block may + * need to be run multiple times in the case where a child window has a + * Destroy binding that calls exit. + */ + + if (!(halfdeadPtr->flags & HD_DESTROY_COUNT)) { + halfdeadPtr->flags |= HD_DESTROY_COUNT; + } + + while (winPtr->childList != NULL) { + TkWindow *childPtr = winPtr->childList; + + childPtr->flags |= TK_DONT_DESTROY_WINDOW; + Tk_DestroyWindow((Tk_Window) childPtr); + if (winPtr->childList == childPtr) { + /* + * The child didn't remove itself from the child list, so let's + * remove it here. This can happen in some strange conditions, + * such as when a Destroy event handler for a window destroys the + * window's parent. + */ + + winPtr->childList = childPtr->nextPtr; + childPtr->parentPtr = NULL; + } + } + if ((winPtr->flags & (TK_CONTAINER|TK_BOTH_HALVES)) + == (TK_CONTAINER|TK_BOTH_HALVES)) { + /* + * This is the container for an embedded application, and the embedded + * application is also in this process. Delete the embedded window + * in-line here, for the same reasons we delete children in-line + * (otherwise, for example, the Tk window may appear to exist even + * though its X window is gone; this could cause errors). Special + * note: it's possible that the embedded window has already been + * deleted, in which case TkpGetOtherWindow will return NULL. + */ + + TkWindow *childPtr = TkpGetOtherWindow(winPtr); + + if (childPtr != NULL) { + childPtr->flags |= TK_DONT_DESTROY_WINDOW; + Tk_DestroyWindow((Tk_Window) childPtr); + } + } + + /* + * Generate a DestroyNotify event. In order for the DestroyNotify event to + * be processed correctly, need to make sure the window exists. This is a + * bit of a kludge, and may be unnecessarily expensive, but without it no + * event handlers will get called for windows that don't exist yet. + * + * Note: if the window's pathName is NULL and the window is not an + * anonymous window, it means that the window was not successfully + * initialized in the first place, so we should not make the window exist + * or generate the event. + */ + + if (!(halfdeadPtr->flags & HD_DESTROY_EVENT) && + winPtr->pathName != NULL && + !(winPtr->flags & TK_ANONYMOUS_WINDOW)) { + halfdeadPtr->flags |= HD_DESTROY_EVENT; + if (winPtr->window == None) { + Tk_MakeWindowExist(tkwin); + } + event.type = DestroyNotify; + event.xdestroywindow.serial = + LastKnownRequestProcessed(winPtr->display); + event.xdestroywindow.send_event = False; + event.xdestroywindow.display = winPtr->display; + event.xdestroywindow.event = winPtr->window; + event.xdestroywindow.window = winPtr->window; + Tk_HandleEvent(&event); + } + + /* + * No additional bindings that could call exit should be invoked from this + * point on, so it is safe to remove this window from the half dead list. + */ + + for (prev_halfdeadPtr = NULL, + halfdeadPtr = tsdPtr->halfdeadWindowList; + halfdeadPtr != NULL; ) { + if (halfdeadPtr->winPtr == winPtr) { + if (prev_halfdeadPtr == NULL) { + tsdPtr->halfdeadWindowList = halfdeadPtr->nextPtr; + } else { + prev_halfdeadPtr->nextPtr = halfdeadPtr->nextPtr; + } + ckfree(halfdeadPtr); + break; + } + prev_halfdeadPtr = halfdeadPtr; + halfdeadPtr = halfdeadPtr->nextPtr; + } + if (halfdeadPtr == NULL) { + Tcl_Panic("window not found on half dead list"); + } + + /* + * Cleanup the data structures associated with this window. + */ + + if (winPtr->flags & TK_WIN_MANAGED) { + TkWmDeadWindow(winPtr); + } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) { + TkWmRemoveFromColormapWindows(winPtr); + } + if (winPtr->window != None) { +#if defined(MAC_OSX_TK) || defined(_WIN32) + XDestroyWindow(winPtr->display, winPtr->window); +#else + if ((winPtr->flags & TK_TOP_HIERARCHY) + || !(winPtr->flags & TK_DONT_DESTROY_WINDOW)) { + /* + * The parent has already been destroyed and this isn't a + * top-level window, so this window will be destroyed implicitly + * when the parent's X window is destroyed; it's much faster not + * to do an explicit destroy of this X window. + */ + + XDestroyWindow(winPtr->display, winPtr->window); + } +#endif + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable, + (char *) winPtr->window)); + winPtr->window = None; + } + UnlinkWindow(winPtr); + TkEventDeadWindow(winPtr); +#ifdef TK_USE_INPUT_METHODS + if (winPtr->inputContext != NULL) { + XDestroyIC(winPtr->inputContext); + winPtr->inputContext = NULL; + } +#endif /* TK_USE_INPUT_METHODS */ + if (winPtr->tagPtr != NULL) { + TkFreeBindingTags(winPtr); + } + TkOptionDeadWindow(winPtr); + TkSelDeadWindow(winPtr); + TkGrabDeadWindow(winPtr); + if (winPtr->geometryMaster != NULL) { + ckfree(winPtr->geometryMaster); + winPtr->geometryMaster = NULL; + } + if (winPtr->mainPtr != NULL) { + if (winPtr->pathName != NULL) { + Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable, + winPtr->pathName); + Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, + winPtr->pathName)); + + /* + * The memory pointed to by pathName has been deallocated. Keep + * users from accessing it after the window has been destroyed by + * setting it to NULL. + */ + + winPtr->pathName = NULL; + + /* + * Invalidate all objects referring to windows with the same main + * window. + */ + + winPtr->mainPtr->deletionEpoch++; + } + winPtr->mainPtr->refCount--; + if (winPtr->mainPtr->refCount == 0) { + register const TkCmd *cmdPtr; + + /* + * We just deleted the last window in the application. Delete the + * TkMainInfo structure too and replace all of Tk's commands with + * dummy commands that return errors. Also delete the "send" + * command to unregister the interpreter. + * + * NOTE: Only replace the commands it if the interpreter is not + * being deleted. If it *is*, the interpreter cleanup will do all + * the needed work. + */ + + if ((winPtr->mainPtr->interp != NULL) && + !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { + for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { + Tcl_CreateObjCommand(winPtr->mainPtr->interp, cmdPtr->name, + TkDeadAppObjCmd, NULL, NULL); + } + Tcl_CreateObjCommand(winPtr->mainPtr->interp, "send", + TkDeadAppObjCmd, NULL, NULL); + Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif"); + Tcl_UnlinkVar(winPtr->mainPtr->interp, + "::tk::AlwaysShowSelection"); + } + + Tcl_DeleteHashTable(&winPtr->mainPtr->busyTable); + Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable); + TkBindFree(winPtr->mainPtr); + TkDeleteAllImages(winPtr->mainPtr); + TkFontPkgFree(winPtr->mainPtr); + TkFocusFree(winPtr->mainPtr); + TkStylePkgFree(winPtr->mainPtr); + + /* + * When embedding Tk into other applications, make sure that all + * destroy events reach the server. Otherwise the embedding + * application may also attempt to destroy the windows, resulting + * in an X error + */ + + if (winPtr->flags & TK_EMBEDDED) { + XSync(winPtr->display, False); + } + ckfree(winPtr->mainPtr); + + /* + * If no other applications are using the display, close the + * display now and relinquish its data structures. + */ + +#if !defined(_WIN32) && defined(NOT_YET) + if (dispPtr->refCount <= 0) { + /* + * I have disabled this code because on Windows there are + * still order dependencies in close-down. All displays and + * resources will get closed down properly anyway at exit, + * through the exit handler. -- jyl + * + * Ideally this should be enabled, as unix Tk can use multiple + * displays. However, there are order issues still, as well as + * the handling of queued events and such that must be + * addressed before this can be enabled. The current cleanup + * works except for send event issues. -- hobbs 04/2002 + */ + + TkDisplay *theDispPtr, *backDispPtr; + + /* + * Splice this display out of the list of displays. + */ + + for (theDispPtr = tsdPtr->displayList, backDispPtr = NULL; + (theDispPtr!=winPtr->dispPtr) && (theDispPtr!=NULL); + theDispPtr = theDispPtr->nextPtr) { + backDispPtr = theDispPtr; + } + if (theDispPtr == NULL) { + Tcl_Panic("could not find display to close!"); + } + if (backDispPtr == NULL) { + tsdPtr->displayList = theDispPtr->nextPtr; + } else { + backDispPtr->nextPtr = theDispPtr->nextPtr; + } + + /* + * Calling XSync creates X server traffic, but addresses a + * focus issue on close (but not the send issue). -- hobbs + * + * XSync(dispPtr->display, True); + */ + + /* + * Found and spliced it out, now actually do the cleanup. + */ + + TkCloseDisplay(dispPtr); + } +#endif /* !_WIN32 && NOT_YET */ + } + } + Tcl_EventuallyFree(winPtr, TCL_DYNAMIC); +} + +/* + *-------------------------------------------------------------- + * + * Tk_MapWindow -- + * + * Map a window within its parent. This may require the window and/or its + * parents to actually be created. + * + * Results: + * None. + * + * Side effects: + * The given window will be mapped. Windows may also be created. + * + *-------------------------------------------------------------- + */ + +void +Tk_MapWindow( + Tk_Window tkwin) /* Token for window to map. */ +{ + TkWindow *winPtr = (TkWindow *) tkwin; + XEvent event; + + if (winPtr->flags & TK_MAPPED) { + return; + } + if (winPtr->window == None) { + Tk_MakeWindowExist(tkwin); + } + /* + * [Bug 2645457]: the previous call permits events to be processed and can + * lead to the destruction of the window under some conditions. + */ + if (winPtr->flags & TK_ALREADY_DEAD) { + return; + } + if (winPtr->flags & TK_WIN_MANAGED) { + /* + * Lots of special processing has to be done for top-level windows. + * Let tkWm.c handle everything itself. + */ + + TkWmMapWindow(winPtr); + return; + } + winPtr->flags |= TK_MAPPED; + XMapWindow(winPtr->display, winPtr->window); + event.type = MapNotify; + event.xmap.serial = LastKnownRequestProcessed(winPtr->display); + event.xmap.send_event = False; + event.xmap.display = winPtr->display; + event.xmap.event = winPtr->window; + event.xmap.window = winPtr->window; + event.xmap.override_redirect = winPtr->atts.override_redirect; + Tk_HandleEvent(&event); +} + +/* + *-------------------------------------------------------------- + * + * Tk_MakeWindowExist -- + * + * Ensure that a particular window actually exists. This function should + * not normally need to be invoked from outside the Tk package, but may + * be needed if someone wants to manipulate a window before mapping it. + * + * Results: + * None. + * + * Side effects: + * When the function returns, the X window associated with tkwin is + * guaranteed to exist. This may require the window's ancestors to be + * created also. + * + *-------------------------------------------------------------- + */ + +void +Tk_MakeWindowExist( + Tk_Window tkwin) /* Token for window. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *winPtr2; + Window parent; + Tcl_HashEntry *hPtr; + Tk_ClassCreateProc *createProc; + int isNew; + + if (winPtr->window != None) { + return; + } + + if ((winPtr->parentPtr == NULL) || (winPtr->flags & TK_TOP_HIERARCHY)) { + parent = XRootWindow(winPtr->display, winPtr->screenNum); + } else { + if (winPtr->parentPtr->window == None) { + Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr); + } + parent = winPtr->parentPtr->window; + } + + createProc = Tk_GetClassProc(winPtr->classProcsPtr, createProc); + if (createProc != NULL && parent != None) { + winPtr->window = createProc(tkwin, parent, winPtr->instanceData); + } else { + winPtr->window = TkpMakeWindow(winPtr, parent); + } + + hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable, + (char *) winPtr->window, &isNew); + Tcl_SetHashValue(hPtr, winPtr); + winPtr->dirtyAtts = 0; + winPtr->dirtyChanges = 0; + + if (!(winPtr->flags & TK_TOP_HIERARCHY)) { + /* + * If any siblings higher up in the stacking order have already been + * created then move this window to its rightful position in the + * stacking order. + * + * NOTE: this code ignores any changes anyone might have made to the + * sibling and stack_mode field of the window's attributes, so it + * really isn't safe for these to be manipulated except by calling + * Tk_RestackWindow. + */ + + for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL; + winPtr2 = winPtr2->nextPtr) { + if ((winPtr2->window != None) + && !(winPtr2->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))) { + XWindowChanges changes; + + changes.sibling = winPtr2->window; + changes.stack_mode = Below; + XConfigureWindow(winPtr->display, winPtr->window, + CWSibling|CWStackMode, &changes); + break; + } + } + + /* + * If this window has a different colormap than its parent, add the + * window to the WM_COLORMAP_WINDOWS property for its top-level. + */ + + if ((winPtr->parentPtr != NULL) && + (winPtr->atts.colormap != winPtr->parentPtr->atts.colormap)) { + TkWmAddToColormapWindows(winPtr); + winPtr->flags |= TK_WM_COLORMAP_WINDOW; + } + } + + /* + * Issue a ConfigureNotify event if there were deferred configuration + * changes (but skip it if the window is being deleted; the + * ConfigureNotify event could cause problems if we're being called from + * Tk_DestroyWindow under some conditions). + */ + + if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY) + && !(winPtr->flags & TK_ALREADY_DEAD)) { + winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY; + TkDoConfigureNotify(winPtr); + } +} + +/* + *-------------------------------------------------------------- + * + * Tk_UnmapWindow, etc. -- + * + * There are several functions under here, each of which mirrors an + * existing X function. In addition to performing the functions of the + * corresponding function, each function also updates the local window + * structure and synthesizes an X event (if the window's structure is + * being managed internally). + * + * Results: + * See the manual entries. + * + * Side effects: + * See the manual entries. + * + *-------------------------------------------------------------- + */ + +void +Tk_UnmapWindow( + Tk_Window tkwin) /* Token for window to unmap. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + if (!(winPtr->flags & TK_MAPPED) || (winPtr->flags & TK_ALREADY_DEAD)) { + return; + } + if (winPtr->flags & TK_WIN_MANAGED) { + /* + * Special processing has to be done for top-level windows. Let tkWm.c + * handle everything itself. + */ + + TkWmUnmapWindow(winPtr); + return; + } + winPtr->flags &= ~TK_MAPPED; + XUnmapWindow(winPtr->display, winPtr->window); + if (!(winPtr->flags & TK_TOP_HIERARCHY)) { + XEvent event; + + event.type = UnmapNotify; + event.xunmap.serial = LastKnownRequestProcessed(winPtr->display); + event.xunmap.send_event = False; + event.xunmap.display = winPtr->display; + event.xunmap.event = winPtr->window; + event.xunmap.window = winPtr->window; + event.xunmap.from_configure = False; + Tk_HandleEvent(&event); + } +} + +void +Tk_ConfigureWindow( + Tk_Window tkwin, /* Window to re-configure. */ + unsigned int valueMask, /* Mask indicating which parts of *valuePtr + * are to be used. */ + XWindowChanges *valuePtr) /* New values. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + if (valueMask & CWX) { + winPtr->changes.x = valuePtr->x; + } + if (valueMask & CWY) { + winPtr->changes.y = valuePtr->y; + } + if (valueMask & CWWidth) { + winPtr->changes.width = valuePtr->width; + } + if (valueMask & CWHeight) { + winPtr->changes.height = valuePtr->height; + } + if (valueMask & CWBorderWidth) { + winPtr->changes.border_width = valuePtr->border_width; + } + if (valueMask & (CWSibling|CWStackMode)) { + Tcl_Panic("Can't set sibling or stack mode from Tk_ConfigureWindow"); + } + + if (winPtr->window != None) { + XConfigureWindow(winPtr->display, winPtr->window, + valueMask, valuePtr); + TkDoConfigureNotify(winPtr); + } else { + winPtr->dirtyChanges |= valueMask; + winPtr->flags |= TK_NEED_CONFIG_NOTIFY; + } +} + +void +Tk_MoveWindow( + Tk_Window tkwin, /* Window to move. */ + int x, int y) /* New location for window (within parent). */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->changes.x = x; + winPtr->changes.y = y; + if (winPtr->window != None) { + XMoveWindow(winPtr->display, winPtr->window, x, y); + TkDoConfigureNotify(winPtr); + } else { + winPtr->dirtyChanges |= CWX|CWY; + winPtr->flags |= TK_NEED_CONFIG_NOTIFY; + } +} + +void +Tk_ResizeWindow( + Tk_Window tkwin, /* Window to resize. */ + int width, int height) /* New dimensions for window. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->changes.width = (unsigned) width; + winPtr->changes.height = (unsigned) height; + if (winPtr->window != None) { + XResizeWindow(winPtr->display, winPtr->window, (unsigned) width, + (unsigned) height); + TkDoConfigureNotify(winPtr); + } else { + winPtr->dirtyChanges |= CWWidth|CWHeight; + winPtr->flags |= TK_NEED_CONFIG_NOTIFY; + } +} + +void +Tk_MoveResizeWindow( + Tk_Window tkwin, /* Window to move and resize. */ + int x, int y, /* New location for window (within parent). */ + int width, int height) /* New dimensions for window. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->changes.x = x; + winPtr->changes.y = y; + winPtr->changes.width = (unsigned) width; + winPtr->changes.height = (unsigned) height; + if (winPtr->window != None) { + XMoveResizeWindow(winPtr->display, winPtr->window, x, y, + (unsigned) width, (unsigned) height); + TkDoConfigureNotify(winPtr); + } else { + winPtr->dirtyChanges |= CWX|CWY|CWWidth|CWHeight; + winPtr->flags |= TK_NEED_CONFIG_NOTIFY; + } +} + +void +Tk_SetWindowBorderWidth( + Tk_Window tkwin, /* Window to modify. */ + int width) /* New border width for window. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->changes.border_width = width; + if (winPtr->window != None) { + XSetWindowBorderWidth(winPtr->display, winPtr->window, + (unsigned) width); + TkDoConfigureNotify(winPtr); + } else { + winPtr->dirtyChanges |= CWBorderWidth; + winPtr->flags |= TK_NEED_CONFIG_NOTIFY; + } +} + +void +Tk_ChangeWindowAttributes( + Tk_Window tkwin, /* Window to manipulate. */ + unsigned long valueMask, /* OR'ed combination of bits, indicating which + * fields of *attsPtr are to be used. */ + register XSetWindowAttributes *attsPtr) + /* New values for some attributes. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + if (valueMask & CWBackPixmap) { + winPtr->atts.background_pixmap = attsPtr->background_pixmap; + } + if (valueMask & CWBackPixel) { + winPtr->atts.background_pixel = attsPtr->background_pixel; + } + if (valueMask & CWBorderPixmap) { + winPtr->atts.border_pixmap = attsPtr->border_pixmap; + } + if (valueMask & CWBorderPixel) { + winPtr->atts.border_pixel = attsPtr->border_pixel; + } + if (valueMask & CWBitGravity) { + winPtr->atts.bit_gravity = attsPtr->bit_gravity; + } + if (valueMask & CWWinGravity) { + winPtr->atts.win_gravity = attsPtr->win_gravity; + } + if (valueMask & CWBackingStore) { + winPtr->atts.backing_store = attsPtr->backing_store; + } + if (valueMask & CWBackingPlanes) { + winPtr->atts.backing_planes = attsPtr->backing_planes; + } + if (valueMask & CWBackingPixel) { + winPtr->atts.backing_pixel = attsPtr->backing_pixel; + } + if (valueMask & CWOverrideRedirect) { + winPtr->atts.override_redirect = attsPtr->override_redirect; + } + if (valueMask & CWSaveUnder) { + winPtr->atts.save_under = attsPtr->save_under; + } + if (valueMask & CWEventMask) { + winPtr->atts.event_mask = attsPtr->event_mask; + } + if (valueMask & CWDontPropagate) { + winPtr->atts.do_not_propagate_mask + = attsPtr->do_not_propagate_mask; + } + if (valueMask & CWColormap) { + winPtr->atts.colormap = attsPtr->colormap; + } + if (valueMask & CWCursor) { + winPtr->atts.cursor = attsPtr->cursor; + } + + if (winPtr->window != None) { + XChangeWindowAttributes(winPtr->display, winPtr->window, + valueMask, attsPtr); + } else { + winPtr->dirtyAtts |= valueMask; + } +} + +void +Tk_SetWindowBackground( + Tk_Window tkwin, /* Window to manipulate. */ + unsigned long pixel) /* Pixel value to use for window's + * background. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->atts.background_pixel = pixel; + + if (winPtr->window != None) { + XSetWindowBackground(winPtr->display, winPtr->window, pixel); + } else { + winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixmap) + | CWBackPixel; + } +} + +void +Tk_SetWindowBackgroundPixmap( + Tk_Window tkwin, /* Window to manipulate. */ + Pixmap pixmap) /* Pixmap to use for window's background. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->atts.background_pixmap = pixmap; + + if (winPtr->window != None) { + XSetWindowBackgroundPixmap(winPtr->display, + winPtr->window, pixmap); + } else { + winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixel) + | CWBackPixmap; + } +} + +void +Tk_SetWindowBorder( + Tk_Window tkwin, /* Window to manipulate. */ + unsigned long pixel) /* Pixel value to use for window's border. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->atts.border_pixel = pixel; + + if (winPtr->window != None) { + XSetWindowBorder(winPtr->display, winPtr->window, pixel); + } else { + winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixmap) + | CWBorderPixel; + } +} + +void +Tk_SetWindowBorderPixmap( + Tk_Window tkwin, /* Window to manipulate. */ + Pixmap pixmap) /* Pixmap to use for window's border. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->atts.border_pixmap = pixmap; + + if (winPtr->window != None) { + XSetWindowBorderPixmap(winPtr->display, + winPtr->window, pixmap); + } else { + winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixel) + | CWBorderPixmap; + } +} + +void +Tk_DefineCursor( + Tk_Window tkwin, /* Window to manipulate. */ + Tk_Cursor cursor) /* Cursor to use for window (may be None). */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + +#if defined(MAC_OSX_TK) + winPtr->atts.cursor = (XCursor) cursor; +#else + winPtr->atts.cursor = (Cursor) cursor; +#endif + + if (winPtr->window != None) { + XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor); + } else { + winPtr->dirtyAtts = winPtr->dirtyAtts | CWCursor; + } +} + +void +Tk_UndefineCursor( + Tk_Window tkwin) /* Window to manipulate. */ +{ + Tk_DefineCursor(tkwin, None); +} + +void +Tk_SetWindowColormap( + Tk_Window tkwin, /* Window to manipulate. */ + Colormap colormap) /* Colormap to use for window. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->atts.colormap = colormap; + + if (winPtr->window != None) { + XSetWindowColormap(winPtr->display, winPtr->window, colormap); + if (!(winPtr->flags & TK_WIN_MANAGED)) { + TkWmAddToColormapWindows(winPtr); + winPtr->flags |= TK_WM_COLORMAP_WINDOW; + } + } else { + winPtr->dirtyAtts |= CWColormap; + } +} + +/* + *---------------------------------------------------------------------- + * + * Tk_SetWindowVisual -- + * + * This function is called to specify a visual to be used for a Tk window + * when it is created. This function, if called at all, must be called + * before the X window is created (i.e. before Tk_MakeWindowExist is + * called). + * + * Results: + * The return value is 1 if successful, or 0 if the X window has been + * already created. + * + * Side effects: + * The information given is stored for when the window is created. + * + *---------------------------------------------------------------------- + */ + +int +Tk_SetWindowVisual( + Tk_Window tkwin, /* Window to manipulate. */ + Visual *visual, /* New visual for window. */ + int depth, /* New depth for window. */ + Colormap colormap) /* An appropriate colormap for the visual. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + if (winPtr->window != None) { + /* Too late! */ + return 0; + } + + winPtr->visual = visual; + winPtr->depth = depth; + winPtr->atts.colormap = colormap; + winPtr->dirtyAtts |= CWColormap; + + /* + * The following code is needed to make sure that the window doesn't + * inherit the parent's border pixmap, which would result in a BadMatch + * error. + */ + + if (!(winPtr->dirtyAtts & CWBorderPixmap)) { + winPtr->dirtyAtts |= CWBorderPixel; + } + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * TkDoConfigureNotify -- + * + * Generate a ConfigureNotify event describing the current configuration + * of a window. + * + * Results: + * None. + * + * Side effects: + * An event is generated and processed by Tk_HandleEvent. + * + *---------------------------------------------------------------------- + */ + +void +TkDoConfigureNotify( + register TkWindow *winPtr) /* Window whose configuration was just + * changed. */ +{ + XEvent event; + + event.type = ConfigureNotify; + event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display); + event.xconfigure.send_event = False; + event.xconfigure.display = winPtr->display; + event.xconfigure.event = winPtr->window; + event.xconfigure.window = winPtr->window; + event.xconfigure.x = winPtr->changes.x; + event.xconfigure.y = winPtr->changes.y; + event.xconfigure.width = winPtr->changes.width; + event.xconfigure.height = winPtr->changes.height; + event.xconfigure.border_width = winPtr->changes.border_width; + if (winPtr->changes.stack_mode == Above) { + event.xconfigure.above = winPtr->changes.sibling; + } else { + event.xconfigure.above = None; + } + event.xconfigure.override_redirect = winPtr->atts.override_redirect; + Tk_HandleEvent(&event); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_SetClass -- + * + * This function is used to give a window a class. + * + * Results: + * None. + * + * Side effects: + * A new class is stored for tkwin, replacing any existing class for it. + * + *---------------------------------------------------------------------- + */ + +void +Tk_SetClass( + Tk_Window tkwin, /* Token for window to assign class. */ + const char *className) /* New class for tkwin. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->classUid = Tk_GetUid(className); + if (winPtr->flags & TK_WIN_MANAGED) { + TkWmSetClass(winPtr); + } + TkOptionClassChanged(winPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_SetClassProcs -- + * + * This function is used to set the class functions and instance data for + * a window. + * + * Results: + * None. + * + * Side effects: + * A new set of class functions and instance data is stored for tkwin, + * replacing any existing values. + * + *---------------------------------------------------------------------- + */ + +void +Tk_SetClassProcs( + Tk_Window tkwin, /* Token for window to modify. */ + const Tk_ClassProcs *procs, /* Class procs structure. */ + ClientData instanceData) /* Data to be passed to class functions. */ +{ + register TkWindow *winPtr = (TkWindow *) tkwin; + + winPtr->classProcsPtr = procs; + winPtr->instanceData = instanceData; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_NameToWindow -- + * + * Given a string name for a window, this function returns the token for + * the window, if there exists a window corresponding to the given name. + * + * Results: + * The return result is either a token for the window corresponding to + * "name", or else NULL to indicate that there is no such window. In this + * case, an error message is left in the interp's result, unless interp + * is NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tk_Window +Tk_NameToWindow( + Tcl_Interp *interp, /* Where to report errors. */ + const char *pathName, /* Path name of window. */ + Tk_Window tkwin) /* Token for window: name is assumed to belong + * to the same main window as tkwin. */ +{ + Tcl_HashEntry *hPtr; + + if (tkwin == NULL) { + /* + * Either we're not really in Tk, or the main window was destroyed and + * we're on our way out of the application. + */ + + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("NULL main window",-1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); + } + return NULL; + } + + hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable, + pathName); + if (hPtr == NULL) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad window path name \"%s\"", pathName)); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "WINDOW", pathName, + NULL); + } + return NULL; + } + return Tcl_GetHashValue(hPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_IdToWindow -- + * + * Given an X display and window ID, this function returns the Tk token + * for the window, if there exists a Tk window corresponding to the given + * ID. + * + * Results: + * The return result is either a token for the window corresponding to + * the given X id, or else NULL to indicate that there is no such window. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tk_Window +Tk_IdToWindow( + Display *display, /* X display containing the window. */ + Window window) /* X window window id. */ +{ + TkDisplay *dispPtr; + Tcl_HashEntry *hPtr; + + for (dispPtr = TkGetDisplayList(); ; dispPtr = dispPtr->nextPtr) { + if (dispPtr == NULL) { + return NULL; + } + if (dispPtr->display == display) { + break; + } + } + if (window == None) { + return NULL; + } + + hPtr = Tcl_FindHashEntry(&dispPtr->winTable, (char *) window); + if (hPtr == NULL) { + return NULL; + } + return Tcl_GetHashValue(hPtr); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_DisplayName -- + * + * Return the textual name of a window's display. + * + * Results: + * The return value is the string name of the display associated with + * tkwin. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +const char * +Tk_DisplayName( + Tk_Window tkwin) /* Window whose display name is desired. */ +{ + return ((TkWindow *) tkwin)->dispPtr->name; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_Interp -- + * + * Get the Tcl interpreter from a Tk window. + * + * Results: + * A pointer to the interpreter or NULL. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Interp * +Tk_Interp( + Tk_Window tkwin) +{ + if (tkwin != NULL && ((TkWindow *) tkwin)->mainPtr != NULL) { + return ((TkWindow *) tkwin)->mainPtr->interp; + } + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * UnlinkWindow -- + * + * This function removes a window from the childList of its parent. + * + * Results: + * None. + * + * Side effects: + * The window is unlinked from its childList. + * + *---------------------------------------------------------------------- + */ + +static void +UnlinkWindow( + TkWindow *winPtr) /* Child window to be unlinked. */ +{ + TkWindow *prevPtr; + + if (winPtr->parentPtr == NULL) { + return; + } + prevPtr = winPtr->parentPtr->childList; + if (prevPtr == winPtr) { + winPtr->parentPtr->childList = winPtr->nextPtr; + if (winPtr->nextPtr == NULL) { + winPtr->parentPtr->lastChildPtr = NULL; + } + } else { + while (prevPtr->nextPtr != winPtr) { + prevPtr = prevPtr->nextPtr; + if (prevPtr == NULL) { + Tcl_Panic("UnlinkWindow couldn't find child in parent"); + } + } + prevPtr->nextPtr = winPtr->nextPtr; + if (winPtr->nextPtr == NULL) { + winPtr->parentPtr->lastChildPtr = prevPtr; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * Tk_RestackWindow -- + * + * Change a window's position in the stacking order. + * + * Results: + * TCL_OK is normally returned. If other is not a descendant of tkwin's + * parent then TCL_ERROR is returned and tkwin is not repositioned. + * + * Side effects: + * Tkwin is repositioned in the stacking order. + * + *---------------------------------------------------------------------- + */ + +int +Tk_RestackWindow( + Tk_Window tkwin, /* Token for window whose position in the + * stacking order is to change. */ + int aboveBelow, /* Indicates new position of tkwin relative to + * other; must be Above or Below. */ + Tk_Window other) /* Tkwin will be moved to a position that puts + * it just above or below this window. If NULL + * then tkwin goes above or below all windows + * in the same parent. */ +{ + TkWindow *winPtr = (TkWindow *) tkwin; + TkWindow *otherPtr = (TkWindow *) other; + + /* + * Special case: if winPtr is a top-level window then just find the + * top-level ancestor of otherPtr and restack winPtr above otherPtr + * without changing any of Tk's childLists. + */ + + if (winPtr->flags & TK_WIN_MANAGED) { + while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_HIERARCHY)) { + otherPtr = otherPtr->parentPtr; + } + TkWmRestackToplevel(winPtr, aboveBelow, otherPtr); + return TCL_OK; + } + + /* + * Find an ancestor of otherPtr that is a sibling of winPtr. + */ + + if (winPtr->parentPtr == NULL) { + /* + * Window is going to be deleted shortly; don't do anything. + */ + + return TCL_OK; + } + if (otherPtr == NULL) { + if (aboveBelow == Above) { + otherPtr = winPtr->parentPtr->lastChildPtr; + } else { + otherPtr = winPtr->parentPtr->childList; + } + } else { + while (winPtr->parentPtr != otherPtr->parentPtr) { + if ((otherPtr == NULL) || (otherPtr->flags & TK_TOP_HIERARCHY)) { + return TCL_ERROR; + } + otherPtr = otherPtr->parentPtr; + } + } + if (otherPtr == winPtr) { + return TCL_OK; + } + + /* + * Reposition winPtr in the stacking order. + */ + + UnlinkWindow(winPtr); + if (aboveBelow == Above) { + winPtr->nextPtr = otherPtr->nextPtr; + if (winPtr->nextPtr == NULL) { + winPtr->parentPtr->lastChildPtr = winPtr; + } + otherPtr->nextPtr = winPtr; + } else { + TkWindow *prevPtr; + + prevPtr = winPtr->parentPtr->childList; + if (prevPtr == otherPtr) { + winPtr->parentPtr->childList = winPtr; + } else { + while (prevPtr->nextPtr != otherPtr) { + prevPtr = prevPtr->nextPtr; + } + prevPtr->nextPtr = winPtr; + } + winPtr->nextPtr = otherPtr; + } + + /* + * Notify the X server of the change. If winPtr hasn't yet been created + * then there's no need to tell the X server now, since the stacking order + * will be handled properly when the window is finally created. + */ + + if (winPtr->window != None) { + XWindowChanges changes; + unsigned int mask = CWStackMode; + + changes.stack_mode = Above; + for (otherPtr = winPtr->nextPtr; otherPtr != NULL; + otherPtr = otherPtr->nextPtr) { + if ((otherPtr->window != None) + && !(otherPtr->flags & (TK_TOP_HIERARCHY|TK_REPARENTED))){ + changes.sibling = otherPtr->window; + changes.stack_mode = Below; + mask = CWStackMode|CWSibling; + break; + } + } + XConfigureWindow(winPtr->display, winPtr->window, mask, &changes); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_MainWindow -- + * + * Returns the main window for an application. + * + * Results: + * If interp has a Tk application associated with it, the main window for + * the application is returned. Otherwise NULL is returned and an error + * message is left in the interp's result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tk_Window +Tk_MainWindow( + Tcl_Interp *interp) /* Interpreter that embodies the application. + * Used for error reporting also. */ +{ + TkMainInfo *mainPtr; + ThreadSpecificData *tsdPtr; + + if (interp == NULL) { + return NULL; + } +#ifdef USE_TCL_STUBS + if (tclStubsPtr == NULL) { + return NULL; + } +#endif + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + for (mainPtr = tsdPtr->mainWindowList; mainPtr != NULL; + mainPtr = mainPtr->nextPtr) { + if (mainPtr->interp == interp) { + return (Tk_Window) mainPtr->winPtr; + } + } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "this isn't a Tk application", -1)); + Tcl_SetErrorCode(interp, "TK", "NO_MAIN_WINDOW", NULL); + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_StrictMotif -- + * + * Indicates whether strict Motif compliance has been specified for the + * given window. + * + * Results: + * The return value is 1 if strict Motif compliance has been requested + * for tkwin's application by setting the tk_strictMotif variable in its + * interpreter to a true value. 0 is returned if tk_strictMotif has a + * false value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tk_StrictMotif( + Tk_Window tkwin) /* Window whose application is to be + * checked. */ +{ + return ((TkWindow *) tkwin)->mainPtr->strictMotif; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_GetNumMainWindows -- + * + * This function returns the number of main windows currently open in + * this process. + * + * Results: + * The number of main windows open in this process. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +Tk_GetNumMainWindows(void) +{ + ThreadSpecificData *tsdPtr; + +#ifdef USE_TCL_STUBS + if (tclStubsPtr == NULL) { + return 0; + } +#endif + + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + return tsdPtr->numMainWindows; +} + +/* + *---------------------------------------------------------------------- + * + * TkpAlwaysShowSelection -- + * + * Indicates whether text/entry widgets should always display + * their selection, regardless of window focus. + * + * Results: + * The return value is 1 if always showing the selection has been + * requested for tkwin's application by setting the + * ::tk::AlwaysShowSelection variable in its interpreter to a true value. + * 0 is returned if it has a false value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TkpAlwaysShowSelection( + Tk_Window tkwin) /* Window whose application is to be + * checked. */ +{ + return ((TkWindow *) tkwin)->mainPtr->alwaysShowSelection; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteWindowsExitProc -- + * + * This function is invoked as an exit handler. It deletes all of the + * main windows in the current thread. We really should be using a thread + * local exit handler to delete windows and a process exit handler to + * close the display but Tcl does not provide support for this usage. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteWindowsExitProc( + ClientData clientData) /* tsdPtr when handler was created. */ +{ + TkDisplay *dispPtr, *nextPtr; + Tcl_Interp *interp; + ThreadSpecificData *tsdPtr = clientData; + + if (tsdPtr == NULL) { + return; + } + + /* + * Finish destroying any windows that are in a half-dead state. We must + * protect the interpreter while destroying the window, because of + * <Destroy> bindings which could destroy the interpreter while the window + * is being deleted. This would leave frames on the call stack pointing at + * deleted memory, causing core dumps. + */ + + while (tsdPtr->halfdeadWindowList != NULL) { + interp = tsdPtr->halfdeadWindowList->winPtr->mainPtr->interp; + Tcl_Preserve(interp); + tsdPtr->halfdeadWindowList->flags |= HD_CLEANUP; + tsdPtr->halfdeadWindowList->winPtr->flags &= ~TK_ALREADY_DEAD; + Tk_DestroyWindow((Tk_Window) tsdPtr->halfdeadWindowList->winPtr); + Tcl_Release(interp); + } + + /* + * Destroy any remaining main windows. + */ + + while (tsdPtr->mainWindowList != NULL) { + interp = tsdPtr->mainWindowList->interp; + Tcl_Preserve(interp); + Tk_DestroyWindow((Tk_Window) tsdPtr->mainWindowList->winPtr); + Tcl_Release(interp); + } + + /* + * Iterate destroying the displays until no more displays remain. It is + * possible for displays to get recreated during exit by any code that + * calls GetScreen, so we must destroy these new displays as well as the + * old ones. + */ + + for (dispPtr = tsdPtr->displayList; dispPtr != NULL; + dispPtr = tsdPtr->displayList) { + /* + * Now iterate over the current list of open displays, and first set + * the global pointer to NULL so we will be able to notice if any new + * displays got created during deletion of the current set. We must + * also do this to ensure that Tk_IdToWindow does not find the old + * display as it is being destroyed, when it wants to see if it needs + * to dispatch a message. + */ + + for (tsdPtr->displayList = NULL; dispPtr != NULL; dispPtr = nextPtr) { + nextPtr = dispPtr->nextPtr; + TkCloseDisplay(dispPtr); + } + } + + tsdPtr->numMainWindows = 0; + tsdPtr->mainWindowList = NULL; + tsdPtr->initialized = 0; +} + +#if defined(_WIN32) + +static HMODULE tkcygwindll = NULL; + +/* + * Run Tk_MainEx from libtk8.?.dll + * + * This function is only ever called from wish8.4.exe, the cygwin port of Tcl. + * This means that the system encoding is utf-8, so we don't have to do any + * encoding conversions. + */ + +int +TkCygwinMainEx( + int argc, /* Number of arguments. */ + char **argv, /* Array of argument strings. */ + Tcl_AppInitProc *appInitProc, + /* Application-specific initialization + * procedure to call after most initialization + * but before starting to execute commands. */ + Tcl_Interp *interp) +{ + TCHAR name[MAX_PATH]; + int len; + void (*tkmainex)(int, char **, Tcl_AppInitProc *, Tcl_Interp *); + + /* construct "<path>/libtk8.?.dll", from "<path>/tk8?.dll" */ + len = GetModuleFileNameW(Tk_GetHINSTANCE(), name, MAX_PATH); + name[len-2] = TEXT('.'); + name[len-1] = name[len-5]; + _tcscpy(name+len, TEXT(".dll")); + memcpy(name+len-8, TEXT("libtk8"), 6 * sizeof(TCHAR)); + + tkcygwindll = LoadLibrary(name); + if (!tkcygwindll) { + /* dll is not present */ + return 0; + } + tkmainex = (void (*)(int, char **, Tcl_AppInitProc *, Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_MainEx"); + if (!tkmainex) { + return 0; + } + tkmainex(argc, argv, appInitProc, interp); + return 1; +} +#endif /* _WIN32 */ + +/* + *---------------------------------------------------------------------- + * + * Tk_Init -- + * + * This function is invoked to add Tk to an interpreter. It incorporates + * all of Tk's commands into the interpreter and creates the main window + * for a new Tk application. If the interpreter contains a variable + * "argv", this function extracts several arguments from that variable, + * uses them to configure the main window, and modifies argv to exclude + * the arguments (see the "wish" documentation for a list of the + * arguments that are extracted). + * + * Results: + * Returns a standard Tcl completion code and sets the interp's result if + * there is an error. + * + * Side effects: + * Depends on various initialization scripts that get invoked. + * + *---------------------------------------------------------------------- + */ + +int +Tk_Init( + Tcl_Interp *interp) /* Interpreter to initialize. */ +{ +#if defined(_WIN32) + if (tkcygwindll) { + int (*tkinit)(Tcl_Interp *); + + tkinit = (int(*)(Tcl_Interp *)) GetProcAddress(tkcygwindll,"Tk_Init"); + if (tkinit) { + return tkinit(interp); + } + } +#endif /* _WIN32 */ + return Initialize(interp); +} + +/* + *---------------------------------------------------------------------- + * + * Tk_SafeInit -- + * + * This function is invoked to add Tk to a safe interpreter. It invokes + * the internal function that does the real work. + * + * Results: + * Returns a standard Tcl completion code and sets the interp's result if + * there is an error. + * + * Side effects: + * Depends on various initialization scripts that are invoked. + * + *---------------------------------------------------------------------- + */ + +int +Tk_SafeInit( + Tcl_Interp *interp) /* Interpreter to initialize. */ +{ + /* + * Initialize the interpreter with Tk, safely. This removes all the Tk + * commands that are unsafe. + * + * Rationale: + * + * - Toplevel and menu are unsafe because they can be used to cover the + * entire screen and to steal input from the user. + * - Continuous ringing of the bell is a nuisance. + * - Cannot allow access to the clipboard because a malicious script can + * replace the contents with the string "rm -r *" and lead to surprises + * when the contents of the clipboard are pasted. Similarly, the + * selection command is blocked. + * - Cannot allow send because it can be used to cause unsafe interpreters + * to execute commands. The tk command recreates the send command, so + * that too must be hidden. + * - Focus can be used to grab the focus away from another window, in + * effect stealing user input. Cannot allow that. + * NOTE: We currently do *not* hide focus as it would make it impossible + * to provide keyboard input to Tk in a safe interpreter. + * - Grab can be used to block the user from using any other apps on the + * screen. + * - Tkwait can block the containing process forever. Use bindings, + * fileevents and split the protocol into before-the-wait and + * after-the-wait parts. More work but necessary. + * - Wm is unsafe because (if toplevels are allowed, in the future) it can + * be used to remove decorations, move windows around, cover the entire + * screen etc etc. + * + * Current risks: + * + * - No CPU time limit, no memory allocation limits, no color limits. + * CPU time limits can be imposed by an unsafe master interpreter. + * + * The actual code called is the same as Tk_Init but Tcl_IsSafe() is + * checked at several places to differentiate the two initialisations. + */ + +#if defined(_WIN32) + if (tkcygwindll) { + int (*tksafeinit)(Tcl_Interp *); + + tksafeinit = (int (*)(Tcl_Interp *)) + GetProcAddress(tkcygwindll, "Tk_SafeInit"); + if (tksafeinit) { + return tksafeinit(interp); + } + } +#endif /* _WIN32 */ + return Initialize(interp); +} + +MODULE_SCOPE const TkStubs tkStubs; + +/* + *---------------------------------------------------------------------- + * + * Initialize -- + * + * The core of the initialization code for Tk, called from Tk_Init and + * Tk_SafeInit. + * + * Results: + * A standard Tcl result. Also leaves an error message in the interp's + * result if there was an error. + * + * Side effects: + * Depends on the initialization scripts that are invoked. + * + *---------------------------------------------------------------------- + */ + +static int +CopyValue( + ClientData dummy, + Tcl_Obj *objPtr, + void *dstPtr) +{ + *(Tcl_Obj **)dstPtr = objPtr; + return 1; +} + +static int +Initialize( + Tcl_Interp *interp) /* Interpreter to initialize. */ +{ + int code = TCL_OK; + ThreadSpecificData *tsdPtr; + Tcl_Obj *value = NULL; + Tcl_Obj *cmd; + + Tcl_Obj *nameObj = NULL; + Tcl_Obj *classObj = NULL; + Tcl_Obj *displayObj = NULL; + Tcl_Obj *colorMapObj = NULL; + Tcl_Obj *useObj = NULL; + Tcl_Obj *visualObj = NULL; + Tcl_Obj *geometryObj = NULL; + + int sync = 0; + + const Tcl_ArgvInfo table[] = { + {TCL_ARGV_CONSTANT, "-sync", INT2PTR(1), &sync, + "Use synchronous mode for display server", NULL}, + {TCL_ARGV_FUNC, "-colormap", CopyValue, &colorMapObj, + "Colormap for main window", NULL}, + {TCL_ARGV_FUNC, "-display", CopyValue, &displayObj, + "Display to use", NULL}, + {TCL_ARGV_FUNC, "-geometry", CopyValue, &geometryObj, + "Initial geometry for window", NULL}, + {TCL_ARGV_FUNC, "-name", CopyValue, &nameObj, + "Name to use for application", NULL}, + {TCL_ARGV_FUNC, "-visual", CopyValue, &visualObj, + "Visual for main window", NULL}, + {TCL_ARGV_FUNC, "-use", CopyValue, &useObj, + "Id of window in which to embed application", NULL}, + TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END + }; + + /* + * Ensure that we are getting a compatible version of Tcl. + */ + + if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + return TCL_ERROR; + } + + /* + * Ensure that our obj-types are registered with the Tcl runtime. + */ + + TkRegisterObjTypes(); + + tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + + /* + * We start by resetting the result because it might not be clean. + */ + + Tcl_ResetResult(interp); + + if (Tcl_IsSafe(interp)) { + /* + * Get the clearance to start Tk and the "argv" parameters from the + * master. + */ + + /* + * Step 1 : find the master and construct the interp name (could be a + * function if new APIs were ok). We could also construct the path + * while walking, but there is no API to get the name of an interp + * either. + */ + + Tcl_Interp *master = interp; + + while (Tcl_IsSafe(master)) { + master = Tcl_GetMaster(master); + if (master == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no controlling master interpreter", -1)); + Tcl_SetErrorCode(interp, "TK", "SAFE", "NO_MASTER", NULL); + return TCL_ERROR; + } + } + + /* + * Construct the name (rewalk...) + */ + + code = Tcl_GetInterpPath(master, interp); + if (code != TCL_OK) { + Tcl_Panic("Tcl_GetInterpPath broken!"); + } + + /* + * Build the command to eval in trusted master. + */ + + cmd = Tcl_NewListObj(2, NULL); + Tcl_ListObjAppendElement(NULL, cmd, + Tcl_NewStringObj("::safe::TkInit", -1)); + Tcl_ListObjAppendElement(NULL, cmd, Tcl_GetObjResult(master)); + + /* + * Step 2 : Eval in the master. The argument is the *reversed* interp + * path of the slave. + */ + + Tcl_IncrRefCount(cmd); + code = Tcl_EvalObjEx(master, cmd, 0); + Tcl_DecrRefCount(cmd); + Tcl_TransferResult(master, code, interp); + if (code != TCL_OK) { + return code; + } + + /* + * Use the master's result as argv. Note: We don't use the Obj + * interfaces to avoid dealing with cross interp refcounting and + * changing the code below. + */ + + value = Tcl_GetObjResult(interp); + } else { + /* + * If there is an "argv" variable, get its value, extract out relevant + * arguments from it, and rewrite the variable without the arguments + * that we used. + */ + + value = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); + } + + if (value) { + int objc; + Tcl_Obj **objv, **rest; + Tcl_Obj *parseList = Tcl_NewListObj(1, NULL); + + Tcl_ListObjAppendElement(NULL, parseList, Tcl_NewObj()); + + Tcl_IncrRefCount(value); + if (TCL_OK != Tcl_ListObjAppendList(interp, parseList, value) || + TCL_OK != Tcl_ListObjGetElements(NULL, parseList, &objc, &objv) || + TCL_OK != Tcl_ParseArgsObjv(interp, table, &objc, objv, &rest)) { + Tcl_AddErrorInfo(interp, + "\n (processing arguments in argv variable)"); + code = TCL_ERROR; + } + if (code == TCL_OK) { + Tcl_SetVar2Ex(interp, "argv", NULL, + Tcl_NewListObj(objc-1, rest+1), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "argc", NULL, + Tcl_NewIntObj(objc-1), TCL_GLOBAL_ONLY); + ckfree(rest); + } + Tcl_DecrRefCount(parseList); + if (code != TCL_OK) { + goto done; + } + } + + /* + * Figure out the application's name and class. + */ + + /* + * If we got no -name argument, fetch from TkpGetAppName(). + */ + + if (nameObj == NULL) { + Tcl_DString nameDS; + + Tcl_DStringInit(&nameDS); + TkpGetAppName(interp, &nameDS); + nameObj = Tcl_NewStringObj(Tcl_DStringValue(&nameDS), + Tcl_DStringLength(&nameDS)); + Tcl_DStringFree(&nameDS); + } + + /* + * The -class argument is always the ToTitle of the -name + */ + + { + int numBytes; + const char *bytes = Tcl_GetStringFromObj(nameObj, &numBytes); + + classObj = Tcl_NewStringObj(bytes, numBytes); + + numBytes = Tcl_UtfToTitle(Tcl_GetString(classObj)); + Tcl_SetObjLength(classObj, numBytes); + } + + /* + * Create an argument list for creating the top-level window, using the + * information parsed from argv, if any. + */ + + cmd = Tcl_NewStringObj("toplevel . -class", -1); + + Tcl_ListObjAppendElement(NULL, cmd, classObj); + classObj = NULL; + + if (displayObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-screen", -1)); + Tcl_ListObjAppendElement(NULL, cmd, displayObj); + + /* + * If this is the first application for this process, save the display + * name in the DISPLAY environment variable so that it will be + * available to subprocesses created by us. + */ + + if (tsdPtr->numMainWindows == 0) { + Tcl_SetVar2Ex(interp, "env", "DISPLAY", displayObj, TCL_GLOBAL_ONLY); + } + displayObj = NULL; + } + if (colorMapObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-colormap", -1)); + Tcl_ListObjAppendElement(NULL, cmd, colorMapObj); + colorMapObj = NULL; + } + if (useObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-use", -1)); + Tcl_ListObjAppendElement(NULL, cmd, useObj); + useObj = NULL; + } + if (visualObj) { + Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj("-visual", -1)); + Tcl_ListObjAppendElement(NULL, cmd, visualObj); + visualObj = NULL; + } + + code = TkListCreateFrame(NULL, interp, cmd, 1, nameObj); + + Tcl_DecrRefCount(cmd); + + if (code != TCL_OK) { + goto done; + } + Tcl_ResetResult(interp); + if (sync) { + XSynchronize(Tk_Display(Tk_MainWindow(interp)), True); + } + + /* + * Set the geometry of the main window, if requested. Put the requested + * geometry into the "geometry" variable. + */ + + if (geometryObj) { + + Tcl_SetVar2Ex(interp, "geometry", NULL, geometryObj, TCL_GLOBAL_ONLY); + + cmd = Tcl_NewStringObj("wm geometry .", -1); + Tcl_ListObjAppendElement(NULL, cmd, geometryObj); + Tcl_IncrRefCount(cmd); + code = Tcl_EvalObjEx(interp, cmd, 0); + Tcl_DecrRefCount(cmd); + geometryObj = NULL; + if (code != TCL_OK) { + goto done; + } + } + + /* + * Provide Tk and its stub table. + */ + + code = Tcl_PkgProvideEx(interp, "Tk", TK_PATCH_LEVEL, + (ClientData) &tkStubs); + if (code != TCL_OK) { + goto done; + } + + /* + * If we were able to provide ourselves as a package, then set the main + * loop function in Tcl to our main loop proc. This will cause tclsh to be + * event-aware when Tk is dynamically loaded. This will have no effect in + * wish, which already is prepared to run the event loop. + */ + + Tcl_SetMainLoop(Tk_MainLoop); + + /* + * Initialized the themed widget set + */ + + code = Ttk_Init(interp); + if (code != TCL_OK) { + goto done; + } + + /* + * Invoke platform-specific initialization. Unlock mutex before entering + * TkpInit, as that may run through the Tk_Init routine again for the + * console window interpreter. + */ + + code = TkpInit(interp); + if (code == TCL_OK) { + + /* + * In order to find tk.tcl during initialization, we evaluate the + * following script. It calls on the Tcl command [tcl_findLibrary] + * to perform the search. See the docs for that command for details + * on where it looks. + * + * Note that this entire search mechanism can be bypassed by defining + * an alternate [tkInit] command before calling Tk_Init(). + */ + + code = Tcl_EvalEx(interp, +"if {[namespace which -command tkInit] eq \"\"} {\n\ + proc tkInit {} {\n\ + global tk_library tk_version tk_patchLevel\n\ + rename tkInit {}\n\ + tcl_findLibrary tk $tk_version $tk_patchLevel tk.tcl TK_LIBRARY tk_library\n\ + }\n\ +}\n\ +tkInit", -1, 0); + } + if (code == TCL_OK) { + /* + * Create exit handlers to delete all windows when the application or + * thread exits. The handler need to be invoked before other platform + * specific cleanups take place to avoid panics in finalization. + */ + + TkCreateThreadExitHandler(DeleteWindowsExitProc, tsdPtr); + } + done: + if (value) { + Tcl_DecrRefCount(value); + value = NULL; + } + return code; +} + +/* + *---------------------------------------------------------------------- + * + * Tk_PkgInitStubsCheck -- + * + * This is a replacement routine for Tk_InitStubs() that is called + * from code where -DUSE_TK_STUBS has not been enabled. + * + * Results: + * Returns the version of a conforming Tk stubs table, or NULL, if + * the table version doesn't satisfy the requested requirements, + * according to historical practice. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +const char * +Tk_PkgInitStubsCheck( + Tcl_Interp *interp, + const char * version, + int exact) +{ + const char *actualVersion = Tcl_PkgRequireEx(interp, "Tk", version, 0, NULL); + + if (exact && actualVersion) { + const char *p = version; + int count = 0; + + while (*p) { + count += !isdigit(UCHAR(*p++)); + } + if (count == 1) { + if (0 != strncmp(version, actualVersion, strlen(version))) { + /* Construct error message */ + Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL); + return NULL; + } + } else { + return Tcl_PkgPresentEx(interp, "Tk", version, 1, NULL); + } + } + return actualVersion; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |