diff options
Diffstat (limited to 'tk8.6/generic/tkWindow.c')
| -rw-r--r-- | tk8.6/generic/tkWindow.c | 3401 |
1 files changed, 0 insertions, 3401 deletions
diff --git a/tk8.6/generic/tkWindow.c b/tk8.6/generic/tkWindow.c deleted file mode 100644 index 2848ff5..0000000 --- a/tk8.6/generic/tkWindow.c +++ /dev/null @@ -1,3401 +0,0 @@ -/* - * 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); - - TkpCancelWarp(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. - */ - -#ifdef TK_USE_INPUT_METHODS - winPtr->ximGeneration = 0; -#endif /*TK_USE_INPUT_METHODS*/ - 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->ximGeneration = 0; - 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 && - winPtr->ximGeneration == winPtr->dispPtr->ximGeneration) { - 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++; - } - if (winPtr->mainPtr->refCount-- <= 1) { - 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: - */ |