summaryrefslogtreecommitdiffstats
path: root/generic/tkWindow.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tkWindow.c')
-rw-r--r--generic/tkWindow.c2763
1 files changed, 2763 insertions, 0 deletions
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
new file mode 100644
index 0000000..fc9060a
--- /dev/null
+++ b/generic/tkWindow.c
@@ -0,0 +1,2763 @@
+/*
+ * tkWindow.c --
+ *
+ * This file provides basic window-manipulation procedures,
+ * which are equivalent to procedures 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.
+ *
+ * SCCS: @(#) tkWindow.c 1.233 97/10/31 09:55:23
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * Count of number of main windows currently open in this process.
+ */
+
+static int numMainWindows;
+
+/*
+ * First in list of all main windows managed by this process.
+ */
+
+TkMainInfo *tkMainWindowList = NULL;
+
+/*
+ * List of all displays currently in use.
+ */
+
+TkDisplay *tkDisplayList = NULL;
+
+/*
+ * Have statics in this module been initialized?
+ */
+
+static int initialized = 0;
+
+/*
+ * The variables below hold several uid's that are used in many places
+ * in the toolkit.
+ */
+
+Tk_Uid tkDisabledUid = NULL;
+Tk_Uid tkActiveUid = NULL;
+Tk_Uid tkNormalUid = NULL;
+
+/*
+ * 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 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 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 procedures that execute them.
+ */
+
+typedef struct {
+ char *name; /* Name of command. */
+ Tcl_CmdProc *cmdProc; /* Command's string-based procedure. */
+ Tcl_ObjCmdProc *objProc; /* Command's object-based procedure. */
+ int isSafe; /* If !0, this command will be exposed in
+ * a safe interpreter. Otherwise it will be
+ * hidden in a safe interpreter. */
+} TkCmd;
+
+static TkCmd commands[] = {
+ /*
+ * Commands that are part of the intrinsics:
+ */
+
+ {"bell", Tk_BellCmd, NULL, 0},
+ {"bind", Tk_BindCmd, NULL, 1},
+ {"bindtags", Tk_BindtagsCmd, NULL, 1},
+ {"clipboard", Tk_ClipboardCmd, NULL, 0},
+ {"destroy", Tk_DestroyCmd, NULL, 1},
+ {"event", Tk_EventCmd, NULL, 1},
+ {"focus", Tk_FocusCmd, NULL, 1},
+ {"font", NULL, Tk_FontObjCmd, 1},
+ {"grab", Tk_GrabCmd, NULL, 0},
+ {"grid", Tk_GridCmd, NULL, 1},
+ {"image", Tk_ImageCmd, NULL, 1},
+ {"lower", Tk_LowerCmd, NULL, 1},
+ {"option", Tk_OptionCmd, NULL, 1},
+ {"pack", Tk_PackCmd, NULL, 1},
+ {"place", Tk_PlaceCmd, NULL, 1},
+ {"raise", Tk_RaiseCmd, NULL, 1},
+ {"selection", Tk_SelectionCmd, NULL, 0},
+ {"tk", NULL, Tk_TkObjCmd, 0},
+ {"tkwait", Tk_TkwaitCmd, NULL, 1},
+ {"tk_chooseColor", Tk_ChooseColorCmd, NULL, 0},
+ {"tk_getOpenFile", Tk_GetOpenFileCmd, NULL, 0},
+ {"tk_getSaveFile", Tk_GetSaveFileCmd, NULL, 0},
+ {"tk_messageBox", Tk_MessageBoxCmd, NULL, 0},
+ {"update", Tk_UpdateCmd, NULL, 1},
+ {"winfo", NULL, Tk_WinfoObjCmd, 1},
+ {"wm", Tk_WmCmd, NULL, 0},
+
+ /*
+ * Widget class commands.
+ */
+ {"button", Tk_ButtonCmd, NULL, 1},
+ {"canvas", Tk_CanvasCmd, NULL, 1},
+ {"checkbutton", Tk_CheckbuttonCmd, NULL, 1},
+ {"entry", Tk_EntryCmd, NULL, 1},
+ {"frame", Tk_FrameCmd, NULL, 1},
+ {"label", Tk_LabelCmd, NULL, 1},
+ {"listbox", Tk_ListboxCmd, NULL, 1},
+ {"menu", Tk_MenuCmd, NULL, 0},
+ {"menubutton", Tk_MenubuttonCmd, NULL, 1},
+ {"message", Tk_MessageCmd, NULL, 1},
+ {"radiobutton", Tk_RadiobuttonCmd, NULL, 1},
+ {"scale", Tk_ScaleCmd, NULL, 1},
+ {"scrollbar", Tk_ScrollbarCmd, NULL, 1},
+ {"text", Tk_TextCmd, NULL, 1},
+ {"toplevel", Tk_ToplevelCmd, NULL, 0},
+
+ /*
+ * Misc.
+ */
+
+#ifdef MAC_TCL
+ {"unsupported1", TkUnsupported1Cmd, NULL, 1},
+#endif
+ {(char *) NULL, (int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **))) NULL, NULL, 0}
+};
+
+/*
+ * The variables and table below are used to parse arguments from
+ * the "argv" variable in Tk_Init.
+ */
+
+static int synchronize = 0;
+static char *name = NULL;
+static char *display = NULL;
+static char *geometry = NULL;
+static char *colormap = NULL;
+static char *use = NULL;
+static char *visual = NULL;
+static int rest = 0;
+
+static Tk_ArgvInfo argTable[] = {
+ {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap,
+ "Colormap for main window"},
+ {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
+ "Display to use"},
+ {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
+ "Initial geometry for window"},
+ {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
+ "Name to use for application"},
+ {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
+ "Use synchronous mode for display server"},
+ {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual,
+ "Visual for main window"},
+ {"-use", TK_ARGV_STRING, (char *) NULL, (char *) &use,
+ "Id of window in which to embed application"},
+ {"--", TK_ARGV_REST, (char *) 1, (char *) &rest,
+ "Pass all remaining arguments through to script"},
+ {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+/*
+ * Forward declarations to procedures defined later in this file:
+ */
+
+static Tk_Window CreateTopLevelWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window parent, char *name, char *screenName));
+static void DeleteWindowsExitProc _ANSI_ARGS_((
+ ClientData clientData));
+static TkDisplay * GetScreen _ANSI_ARGS_((Tcl_Interp *interp,
+ char *screenName, int *screenPtr));
+static int Initialize _ANSI_ARGS_((Tcl_Interp *interp));
+static int NameWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr, TkWindow *parentPtr,
+ char *name));
+static void OpenIM _ANSI_ARGS_((TkDisplay *dispPtr));
+static void UnlinkWindow _ANSI_ARGS_((TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ * interp->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(interp, parent, name, screenName)
+ 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. */
+ char *name; /* Name for new window; if parent is
+ * non-NULL, must be unique among parent's
+ * children. */
+ 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. */
+{
+ register TkWindow *winPtr;
+ register TkDisplay *dispPtr;
+ int screenId;
+
+ if (!initialized) {
+ initialized = 1;
+ tkActiveUid = Tk_GetUid("active");
+ tkDisabledUid = Tk_GetUid("disabled");
+ tkNormalUid = Tk_GetUid("normal");
+
+ /*
+ * Create built-in image types.
+ */
+
+ Tk_CreateImageType(&tkBitmapImageType);
+ Tk_CreateImageType(&tkPhotoImageType);
+
+ /*
+ * Create built-in photo image formats.
+ */
+
+ Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
+ Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
+
+ /*
+ * Create exit handler to delete all windows when the application
+ * exits.
+ */
+
+ Tcl_CreateExitHandler(DeleteWindowsExitProc, (ClientData) NULL);
+ }
+
+ 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 (Tk_Window) NULL;
+ }
+ }
+
+ winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent);
+
+ /*
+ * 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_LEVEL flag immediately here; otherwise
+ * Tk_DestroyWindow will core dump if it is called before the flag
+ * has been set.)
+ */
+
+ winPtr->flags |= TK_TOP_LEVEL;
+
+ if (parent != NULL) {
+ if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return (Tk_Window) 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 interp->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(interp, screenName, screenPtr)
+ Tcl_Interp *interp; /* Place to leave error message. */
+ char *screenName; /* Name for screen. NULL or empty means
+ * use DISPLAY envariable. */
+ int *screenPtr; /* Where to store screen number. */
+{
+ register TkDisplay *dispPtr;
+ char *p;
+ int screenId;
+ size_t length;
+
+ /*
+ * 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) {
+ interp->result =
+ "no display name and no $DISPLAY environment variable";
+ return (TkDisplay *) 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, (char **) NULL, 10);
+ }
+
+ /*
+ * See if we already have a connection to this display. If not,
+ * then open a new connection.
+ */
+
+ for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ dispPtr = TkpOpenDisplay(screenName);
+ if (dispPtr == NULL) {
+ Tcl_AppendResult(interp, "couldn't connect to display \"",
+ screenName, "\"", (char *) NULL);
+ return (TkDisplay *) NULL;
+ }
+ dispPtr->nextPtr = tkDisplayList;
+ dispPtr->name = (char *) ckalloc((unsigned) (length+1));
+ dispPtr->lastEventTime = CurrentTime;
+ strncpy(dispPtr->name, screenName, length);
+ dispPtr->name[length] = '\0';
+ dispPtr->bindInfoStale = 1;
+ dispPtr->modeModMask = 0;
+ dispPtr->metaModMask = 0;
+ dispPtr->altModMask = 0;
+ dispPtr->numModKeyCodes = 0;
+ dispPtr->modKeyCodes = NULL;
+ OpenIM(dispPtr);
+ dispPtr->errorPtr = NULL;
+ dispPtr->deleteCount = 0;
+ dispPtr->commTkwin = NULL;
+ dispPtr->selectionInfoPtr = NULL;
+ dispPtr->multipleAtom = None;
+ dispPtr->clipWindow = NULL;
+ dispPtr->clipboardActive = 0;
+ dispPtr->clipboardAppPtr = NULL;
+ dispPtr->clipTargetPtr = NULL;
+ dispPtr->atomInit = 0;
+ dispPtr->cursorFont = None;
+ dispPtr->grabWinPtr = NULL;
+ dispPtr->eventualGrabWinPtr = NULL;
+ dispPtr->buttonWinPtr = NULL;
+ dispPtr->serverWinPtr = NULL;
+ dispPtr->firstGrabEventPtr = NULL;
+ dispPtr->lastGrabEventPtr = NULL;
+ dispPtr->grabFlags = 0;
+ TkInitXId(dispPtr);
+ dispPtr->destroyCount = 0;
+ dispPtr->lastDestroyRequest = 0;
+ dispPtr->cmapPtr = NULL;
+ dispPtr->implicitWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ dispPtr->stressPtr = NULL;
+ dispPtr->delayedMotionPtr = NULL;
+ Tcl_InitHashTable(&dispPtr->winTable, TCL_ONE_WORD_KEYS);
+ dispPtr->refCount = 0;
+
+ tkDisplayList = dispPtr;
+ break;
+ }
+ if ((strncmp(dispPtr->name, screenName, length) == 0)
+ && (dispPtr->name[length] == '\0')) {
+ break;
+ }
+ }
+ if (screenId >= ScreenCount(dispPtr->display)) {
+ sprintf(interp->result, "bad screen number \"%d\"", screenId);
+ return (TkDisplay *) 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 *display; /* X's display pointer */
+{
+ TkDisplay *dispPtr;
+
+ for (dispPtr = tkDisplayList; dispPtr != NULL;
+ dispPtr = dispPtr->nextPtr) {
+ if (dispPtr->display == display) {
+ break;
+ }
+ }
+ return dispPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkAllocWindow --
+ *
+ * This procedure 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(dispPtr, screenNum, parentPtr)
+ 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;
+
+ winPtr = (TkWindow *) ckalloc(sizeof(TkWindow));
+ winPtr->display = dispPtr->display;
+ winPtr->dispPtr = dispPtr;
+ winPtr->screenNum = screenNum;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->visual = parentPtr->visual;
+ winPtr->depth = parentPtr->depth;
+ } else {
+ winPtr->visual = DefaultVisual(dispPtr->display, screenNum);
+ winPtr->depth = DefaultDepth(dispPtr->display, screenNum);
+ }
+ winPtr->window = None;
+ winPtr->childList = NULL;
+ winPtr->lastChildPtr = NULL;
+ winPtr->parentPtr = NULL;
+ winPtr->nextPtr = NULL;
+ winPtr->mainPtr = NULL;
+ winPtr->pathName = NULL;
+ winPtr->nameUid = NULL;
+ winPtr->classUid = NULL;
+ winPtr->changes = defChanges;
+ winPtr->dirtyChanges = CWX|CWY|CWWidth|CWHeight|CWBorderWidth;
+ winPtr->atts = defAtts;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->atts.colormap = parentPtr->atts.colormap;
+ } else {
+ winPtr->atts.colormap = DefaultColormap(dispPtr->display, screenNum);
+ }
+ winPtr->dirtyAtts = CWEventMask|CWColormap|CWBitGravity;
+ winPtr->flags = 0;
+ winPtr->handlerList = NULL;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+ winPtr->tagPtr = NULL;
+ winPtr->numTags = 0;
+ winPtr->optionLevel = -1;
+ winPtr->selHandlerList = NULL;
+ winPtr->geomMgrPtr = NULL;
+ winPtr->geomData = NULL;
+ winPtr->reqWidth = winPtr->reqHeight = 1;
+ winPtr->internalBorderWidth = 0;
+ winPtr->wmInfoPtr = NULL;
+ winPtr->classProcsPtr = NULL;
+ winPtr->instanceData = NULL;
+ winPtr->privatePtr = NULL;
+
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NameWindow --
+ *
+ * This procedure 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(interp, winPtr, parentPtr, name)
+ 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.). */
+ char *name; /* Name for winPtr; must be unique among
+ * parentPtr's children. */
+{
+#define FIXED_SIZE 200
+ char staticSpace[FIXED_SIZE];
+ char *pathName;
+ int new;
+ Tcl_HashEntry *hPtr;
+ int 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++;
+ winPtr->nameUid = Tk_GetUid(name);
+
+ /*
+ * 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_AppendResult(interp,
+ "window name starts with an upper-case letter: \"",
+ name, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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 = (char *) ckalloc((unsigned) (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, &new);
+ if (pathName != staticSpace) {
+ ckfree(pathName);
+ }
+ if (!new) {
+ Tcl_AppendResult(interp, "window name \"", name,
+ "\" already exists in parent", (char *) 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
+ * interp->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(interp, screenName, baseName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ char *screenName; /* Name of screen on which to create
+ * window. Empty or NULL string means
+ * use DISPLAY environment variable. */
+ char *baseName; /* Base name for application; usually of the
+ * form "prog instance". */
+{
+ Tk_Window tkwin;
+ int dummy;
+ int isSafe;
+ Tcl_HashEntry *hPtr;
+ register TkMainInfo *mainPtr;
+ register TkWindow *winPtr;
+ register TkCmd *cmdPtr;
+
+ /*
+ * Panic if someone updated the TkWindow structure without
+ * also updating the Tk_FakeWin structure (or vice versa).
+ */
+
+ if (sizeof(TkWindow) != sizeof(Tk_FakeWin)) {
+ panic("TkWindow and Tk_FakeWin are not the same size");
+ }
+
+ /*
+ * Create the basic TkWindow structure.
+ */
+
+ tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName,
+ screenName);
+ 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 = (TkMainInfo *) ckalloc(sizeof(TkMainInfo));
+ mainPtr->winPtr = winPtr;
+ mainPtr->refCount = 1;
+ mainPtr->interp = interp;
+ Tcl_InitHashTable(&mainPtr->nameTable, TCL_STRING_KEYS);
+ TkBindInit(mainPtr);
+ TkFontPkgInit(mainPtr);
+ mainPtr->tlFocusPtr = NULL;
+ mainPtr->displayFocusPtr = NULL;
+ mainPtr->optionRootPtr = NULL;
+ Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS);
+ mainPtr->strictMotif = 0;
+ if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif,
+ TCL_LINK_BOOLEAN) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+ mainPtr->nextPtr = tkMainWindowList;
+ tkMainWindowList = mainPtr;
+ winPtr->mainPtr = mainPtr;
+ hPtr = Tcl_CreateHashEntry(&mainPtr->nameTable, ".", &dummy);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->pathName = Tcl_GetHashKey(&mainPtr->nameTable, hPtr);
+
+ /*
+ * 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->cmdProc == NULL) && (cmdPtr->objProc == NULL)) {
+ panic("TkCreateMainWindow: builtin command with NULL string and object procs");
+ }
+ if (cmdPtr->cmdProc != NULL) {
+ Tcl_CreateCommand(interp, cmdPtr->name, cmdPtr->cmdProc,
+ (ClientData) tkwin, (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ } else {
+ Tcl_CreateObjCommand(interp, cmdPtr->name, cmdPtr->objProc,
+ (ClientData) tkwin, NULL);
+ }
+ if (isSafe) {
+ if (!(cmdPtr->isSafe)) {
+ Tcl_HideCommand(interp, cmdPtr->name, cmdPtr->name);
+ }
+ }
+ }
+
+ /*
+ * Set variables for the intepreter.
+ */
+
+ Tcl_SetVar(interp, "tk_patchLevel", TK_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tk_version", TK_VERSION, TCL_GLOBAL_ONLY);
+
+ 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 interp->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(interp, parent, name, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * Interp->result is assumed to be
+ * initialized by the caller. */
+ Tk_Window parent; /* Token for parent of new window. */
+ char *name; /* Name for new window. Must be unique
+ * among parent's children. */
+ 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;
+ TkWindow *winPtr;
+
+ if ((parentPtr != NULL) && (parentPtr->flags & TK_ALREADY_DEAD)) {
+ Tcl_AppendResult(interp,
+ "can't create window: parent has been destroyed",
+ (char *) NULL);
+ return NULL;
+ } else if ((parentPtr != NULL) &&
+ (parentPtr->flags & TK_CONTAINER)) {
+ Tcl_AppendResult(interp,
+ "can't create window: its parent has -container = yes",
+ (char *) NULL);
+ return NULL;
+ }
+ if (screenName == NULL) {
+ winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
+ parentPtr);
+ if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ } else {
+ return (Tk_Window) winPtr;
+ }
+ } else {
+ return CreateTopLevelWindow(interp, parent, name, screenName);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateWindowFromPath --
+ *
+ * This procedure 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 interp->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(interp, tkwin, pathName, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting.
+ * Interp->result is assumed to be
+ * initialized by the caller. */
+ Tk_Window tkwin; /* Token for any window in application
+ * that is to contain new window. */
+ 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. */
+ 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_AppendResult(interp, "bad window path name \"", pathName,
+ "\"", (char *) NULL);
+ return NULL;
+ }
+ numChars = p-pathName;
+ if (numChars > FIXED_SPACE) {
+ p = (char *) ckalloc((unsigned) (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_AppendResult(interp,
+ "can't create window: parent has been destroyed", (char *) NULL);
+ return NULL;
+ } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
+ Tcl_AppendResult(interp,
+ "can't create window: its parent has -container = yes",
+ (char *) 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;
+ } else {
+ return (Tk_Window) winPtr;
+ }
+ } else {
+ return CreateTopLevelWindow(interp, parent, pathName+numChars+1,
+ screenName);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DestroyWindow --
+ *
+ * Destroy an existing window. After this call, the caller
+ * should never again use the token.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is deleted, along with all of its children.
+ * Relevant callback procedures are invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DestroyWindow(tkwin)
+ Tk_Window tkwin; /* Window to destroy. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ XEvent event;
+
+ 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;
+
+ /*
+ * 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.
+ */
+
+ 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,
+ * so the reference count of its application doesn't go to zero
+ * when exit calls Tk_DestroyWindow on ".", so the main window
+ * doesn't get removed from the list and exit loops infinitely.
+ * Even worse, if "destroy ." is called by the destroy binding
+ * before calling "exit", "exit" will attempt to destroy
+ * mainPtr->winPtr, which no longer exists, and there may be a
+ * core dump.
+ *
+ * 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 (winPtr->mainPtr->winPtr == winPtr) {
+ dispPtr->refCount--;
+ if (tkMainWindowList == winPtr->mainPtr) {
+ tkMainWindowList = winPtr->mainPtr->nextPtr;
+ } else {
+ TkMainInfo *prevPtr;
+
+ for (prevPtr = tkMainWindowList;
+ prevPtr->nextPtr != winPtr->mainPtr;
+ prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = winPtr->mainPtr->nextPtr;
+ }
+ numMainWindows--;
+ }
+
+ /*
+ * Recursively destroy children.
+ */
+
+ dispPtr->destroyCount++;
+ while (winPtr->childList != NULL) {
+ TkWindow *childPtr;
+ 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 Delete event handler for a
+ * window deletes 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;
+ 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 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 (winPtr->pathName != NULL) {
+ 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);
+ }
+
+ /*
+ * Cleanup the data structures associated with this window.
+ */
+
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWmDeadWindow(winPtr);
+ } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) {
+ TkWmRemoveFromColormapWindows(winPtr);
+ }
+ if (winPtr->window != None) {
+#if defined(MAC_TCL) || defined(__WIN32__)
+ XDestroyWindow(winPtr->display, winPtr->window);
+#else
+ if ((winPtr->flags & TK_TOP_LEVEL)
+ || !(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.
+ */
+
+ dispPtr->lastDestroyRequest = NextRequest(winPtr->display);
+ XDestroyWindow(winPtr->display, winPtr->window);
+ }
+#endif
+ TkFreeWindowId(dispPtr, winPtr->window);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable,
+ (char *) winPtr->window));
+ winPtr->window = None;
+ }
+ dispPtr->destroyCount--;
+ UnlinkWindow(winPtr);
+ TkEventDeadWindow(winPtr);
+ TkBindDeadWindow(winPtr);
+#ifdef TK_USE_INPUT_METHODS
+ if (winPtr->inputContext != NULL) {
+ XDestroyIC(winPtr->inputContext);
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ TkOptionDeadWindow(winPtr);
+ TkSelDeadWindow(winPtr);
+ TkGrabDeadWindow(winPtr);
+ if (winPtr->mainPtr != NULL) {
+ if (winPtr->pathName != NULL) {
+ Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable,
+ (ClientData) winPtr->pathName);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable,
+ winPtr->pathName));
+ }
+ winPtr->mainPtr->refCount--;
+ if (winPtr->mainPtr->refCount == 0) {
+ register 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_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name,
+ TkDeadAppCmd, (ClientData) NULL,
+ (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ }
+ Tcl_CreateCommand(winPtr->mainPtr->interp, "send",
+ TkDeadAppCmd, (ClientData) NULL,
+ (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ Tcl_UnlinkVar(winPtr->mainPtr->interp, "tk_strictMotif");
+ }
+
+ Tcl_DeleteHashTable(&winPtr->mainPtr->nameTable);
+ TkBindFree(winPtr->mainPtr);
+ TkFontPkgFree(winPtr->mainPtr);
+ TkDeleteAllImages(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((char *) winPtr->mainPtr);
+
+ /*
+ * If no other applications are using the display, close the
+ * display now and relinquish its data structures.
+ */
+
+ if (dispPtr->refCount <= 0) {
+#ifdef NOT_YET
+ /*
+ * 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.
+ */
+
+ TkDisplay *theDispPtr, *backDispPtr;
+
+ /*
+ * Splice this display out of the list of displays.
+ */
+
+ for (theDispPtr = tkDisplayList, backDispPtr = NULL;
+ (theDispPtr != winPtr->dispPtr) &&
+ (theDispPtr != NULL);
+ theDispPtr = theDispPtr->nextPtr) {
+ backDispPtr = theDispPtr;
+ }
+ if (theDispPtr == NULL) {
+ panic("could not find display to close!");
+ }
+ if (backDispPtr == NULL) {
+ tkDisplayList = theDispPtr->nextPtr;
+ } else {
+ backDispPtr->nextPtr = theDispPtr->nextPtr;
+ }
+
+ /*
+ * Found and spliced it out, now actually do the cleanup.
+ */
+
+ if (dispPtr->name != NULL) {
+ ckfree(dispPtr->name);
+ }
+
+ Tcl_DeleteHashTable(&(dispPtr->winTable));
+
+ /*
+ * Cannot yet close the display because we still have
+ * order of deletion problems. Defer until exit handling
+ * instead. At that time, the display will cleanly shut
+ * down (hopefully..). (JYL)
+ */
+
+ TkpCloseDisplay(dispPtr);
+
+ /*
+ * There is lots more to clean up, we leave it at this for
+ * the time being.
+ */
+#endif
+ }
+ }
+ }
+ ckfree((char *) winPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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(tkwin)
+ Tk_Window tkwin; /* Token for window to map. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ XEvent event;
+
+ if (winPtr->flags & TK_MAPPED) {
+ return;
+ }
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ /*
+ * 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
+ * procedure shouldn't 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 procedure 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(tkwin)
+ Tk_Window tkwin; /* Token for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *winPtr2;
+ Window parent;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ if (winPtr->window != None) {
+ return;
+ }
+
+ if ((winPtr->parentPtr == NULL) || (winPtr->flags & TK_TOP_LEVEL)) {
+ parent = XRootWindow(winPtr->display, winPtr->screenNum);
+ } else {
+ if (winPtr->parentPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr);
+ }
+ parent = winPtr->parentPtr->window;
+ }
+
+ if (winPtr->classProcsPtr != NULL
+ && winPtr->classProcsPtr->createProc != NULL) {
+ winPtr->window = (*winPtr->classProcsPtr->createProc)(tkwin, parent,
+ winPtr->instanceData);
+ } else {
+ winPtr->window = TkpMakeWindow(winPtr, parent);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable,
+ (char *) winPtr->window, &new);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->dirtyAtts = 0;
+ winPtr->dirtyChanges = 0;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ /*
+ * 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_LEVEL|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 procedures under here, each of which
+ * mirrors an existing X procedure. In addition to performing
+ * the functions of the corresponding procedure, each
+ * procedure 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(tkwin)
+ 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_TOP_LEVEL) {
+ /*
+ * 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_LEVEL)) {
+ 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(tkwin, valueMask, valuePtr)
+ 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)) {
+ 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(tkwin, x, y)
+ Tk_Window tkwin; /* Window to move. */
+ int x, 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(tkwin, width, height)
+ Tk_Window tkwin; /* Window to resize. */
+ int width, 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(tkwin, x, y, width, height)
+ Tk_Window tkwin; /* Window to move and resize. */
+ int x, y; /* New location for window (within
+ * parent). */
+ int width, 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(tkwin, width)
+ 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(tkwin, valueMask, attsPtr)
+ 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(tkwin, pixel)
+ 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(tkwin, pixmap)
+ 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(tkwin, pixel)
+ 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(tkwin, pixmap)
+ 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(tkwin, cursor)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Tk_Cursor cursor; /* Cursor to use for window (may be None). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+#ifdef MAC_TCL
+ 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(tkwin)
+ Tk_Window tkwin; /* Window to manipulate. */
+{
+ Tk_DefineCursor(tkwin, None);
+}
+
+void
+Tk_SetWindowColormap(tkwin, colormap)
+ 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_TOP_LEVEL)) {
+ TkWmAddToColormapWindows(winPtr);
+ winPtr->flags |= TK_WM_COLORMAP_WINDOW;
+ }
+ } else {
+ winPtr->dirtyAtts |= CWColormap;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetWindowVisual --
+ *
+ * This procedure is called to specify a visual to be used
+ * for a Tk window when it is created. This procedure, 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(tkwin, visual, depth, colormap)
+ 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(winPtr)
+ 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 procedure 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(tkwin, className)
+ Tk_Window tkwin; /* Token for window to assign class. */
+ char *className; /* New class for tkwin. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classUid = Tk_GetUid(className);
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWmSetClass(winPtr);
+ }
+ TkOptionClassChanged(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetClassProcs --
+ *
+ * This procedure is used to set the class procedures and
+ * instance data for a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new set of class procedures and instance data is stored
+ * for tkwin, replacing any existing values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetClassProcs(tkwin, procs, instanceData)
+ Tk_Window tkwin; /* Token for window to modify. */
+ TkClassProcs *procs; /* Class procs structure. */
+ ClientData instanceData; /* Data to be passed to class procedures. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classProcsPtr = procs;
+ winPtr->instanceData = instanceData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameToWindow --
+ *
+ * Given a string name for a window, this procedure
+ * 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 interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_NameToWindow(interp, pathName, tkwin)
+ Tcl_Interp *interp; /* Where to report errors. */
+ 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;
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable,
+ pathName);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "bad window path name \"",
+ pathName, "\"", (char *) NULL);
+ return NULL;
+ }
+ return (Tk_Window) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_IdToWindow --
+ *
+ * Given an X display and window ID, this procedure 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, window)
+ Display *display; /* X display containing the window. */
+ Window window; /* X window window id. */
+{
+ TkDisplay *dispPtr;
+ Tcl_HashEntry *hPtr;
+
+ for (dispPtr = tkDisplayList; ; dispPtr = dispPtr->nextPtr) {
+ if (dispPtr == NULL) {
+ return NULL;
+ }
+ if (dispPtr->display == display) {
+ break;
+ }
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->winTable, (char *) window);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return (Tk_Window) 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tk_DisplayName(tkwin)
+ Tk_Window tkwin; /* Window whose display name is desired. */
+{
+ return ((TkWindow *) tkwin)->dispPtr->name;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkWindow --
+ *
+ * This procedure removes a window from the childList of its
+ * parent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is unlinked from its childList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkWindow(winPtr)
+ 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) {
+ 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(tkwin, aboveBelow, other)
+ 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;
+ XWindowChanges changes;
+ unsigned int mask;
+
+
+ /*
+ * 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.
+ */
+
+ changes.stack_mode = aboveBelow;
+ mask = CWStackMode;
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_LEVEL)) {
+ 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_LEVEL)) {
+ 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) {
+ changes.stack_mode = Above;
+ for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
+ otherPtr = otherPtr->nextPtr) {
+ if ((otherPtr->window != None)
+ && !(otherPtr->flags & (TK_TOP_LEVEL|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 interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_MainWindow(interp)
+ Tcl_Interp *interp; /* Interpreter that embodies the
+ * application. Used for error
+ * reporting also. */
+{
+ TkMainInfo *mainPtr;
+
+ for (mainPtr = tkMainWindowList; mainPtr != NULL;
+ mainPtr = mainPtr->nextPtr) {
+ if (mainPtr->interp == interp) {
+ return (Tk_Window) mainPtr->winPtr;
+ }
+ }
+ interp->result = "this isn't a Tk application";
+ 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(tkwin)
+ Tk_Window tkwin; /* Window whose application is
+ * to be checked. */
+{
+ return ((TkWindow *) tkwin)->mainPtr->strictMotif;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OpenIM --
+ *
+ * Tries to open an X input method, associated with the
+ * given display. Right now we can only deal with a bare-bones
+ * input style: no preedit, and no status.
+ *
+ * Results:
+ * Stores the input method in dispPtr->inputMethod; if there isn't
+ * a suitable input method, then NULL is stored in dispPtr->inputMethod.
+ *
+ * Side effects:
+ * An input method gets opened.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OpenIM(dispPtr)
+ TkDisplay *dispPtr; /* Tk's structure for the display. */
+{
+#ifndef TK_USE_INPUT_METHODS
+ return;
+#else
+ unsigned short i;
+ XIMStyles *stylePtr;
+
+ dispPtr->inputMethod = XOpenIM(dispPtr->display, NULL, NULL, NULL);
+ if (dispPtr->inputMethod == NULL) {
+ return;
+ }
+
+ if ((XGetIMValues(dispPtr->inputMethod, XNQueryInputStyle, &stylePtr,
+ NULL) != NULL) || (stylePtr == NULL)) {
+ goto error;
+ }
+ for (i = 0; i < stylePtr->count_styles; i++) {
+ if (stylePtr->supported_styles[i]
+ == (XIMPreeditNothing|XIMStatusNothing)) {
+ XFree(stylePtr);
+ return;
+ }
+ }
+ XFree(stylePtr);
+
+ error:
+
+ /*
+ * Should close the input method, but this causes core dumps on some
+ * systems (e.g. Solaris 2.3 as of 1/6/95).
+ * XCloseIM(dispPtr->inputMethod);
+ */
+ dispPtr->inputMethod = NULL;
+ return;
+#endif /* TK_USE_INPUT_METHODS */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetNumMainWindows --
+ *
+ * This procedure 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()
+{
+ return numMainWindows;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteWindowsExitProc --
+ *
+ * This procedure is invoked as an exit handler. It deletes all
+ * of the main windows in the process.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteWindowsExitProc(clientData)
+ ClientData clientData; /* Not used. */
+{
+ TkDisplay *displayPtr, *nextPtr;
+ Tcl_Interp *interp;
+
+ while (tkMainWindowList != NULL) {
+ /*
+ * We must protect the interpreter while deleting 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.
+ */
+
+ interp = tkMainWindowList->winPtr->mainPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ Tk_DestroyWindow((Tk_Window) tkMainWindowList->winPtr);
+ Tcl_Release((ClientData) interp);
+ }
+
+ displayPtr = tkDisplayList;
+ tkDisplayList = NULL;
+
+ /*
+ * 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 (displayPtr = tkDisplayList;
+ displayPtr != NULL;
+ displayPtr = tkDisplayList) {
+
+ /*
+ * 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 (tkDisplayList = NULL; displayPtr != NULL; displayPtr = nextPtr) {
+ nextPtr = displayPtr->nextPtr;
+ if (displayPtr->name != (char *) NULL) {
+ ckfree(displayPtr->name);
+ }
+ Tcl_DeleteHashTable(&(displayPtr->winTable));
+ TkpCloseDisplay(displayPtr);
+ }
+ }
+
+ numMainWindows = 0;
+ tkMainWindowList = NULL;
+ initialized = 0;
+ tkDisabledUid = NULL;
+ tkActiveUid = NULL;
+ tkNormalUid = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Init --
+ *
+ * This procedure 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 procedure
+ * 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 interp->result
+ * if there is an error.
+ *
+ * Side effects:
+ * Depends on various initialization scripts that get invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ return Initialize(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SafeInit --
+ *
+ * This procedure is invoked to add Tk to a safe interpreter. It
+ * invokes the internal procedure that does the real work.
+ *
+ * Results:
+ * Returns a standard Tcl completion code and sets interp->result
+ * if there is an error.
+ *
+ * Side effects:
+ * Depends on various initialization scripts that are invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_SafeInit(interp)
+ 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. We do
+ * not currently hide the selection command.. Should we?
+ * - 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.
+ *
+ * The actual code called is the same as Tk_Init but Tcl_IsSafe()
+ * is checked at several places to differentiate the two initialisations.
+ */
+
+ return Initialize(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Initialize --
+ *
+ *
+ * Results:
+ * A standard Tcl result. Also leaves an error message in interp->result
+ * if there was an error.
+ *
+ * Side effects:
+ * Depends on the initialization scripts that are invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Initialize(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ char *p;
+ int argc, code;
+ char **argv, *args[20];
+ Tcl_DString class;
+ char buffer[30];
+
+ /*
+ * Start by initializing all the static variables to default acceptable
+ * values so that no information is leaked from a previous run of this
+ * code.
+ */
+
+ synchronize = 0;
+ name = NULL;
+ display = NULL;
+ geometry = NULL;
+ colormap = NULL;
+ use = NULL;
+ visual = NULL;
+ rest = 0;
+
+ /*
+ * 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.
+ */
+
+ p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);
+ argv = NULL;
+ if (p != NULL) {
+ if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) {
+ argError:
+ Tcl_AddErrorInfo(interp,
+ "\n (processing arguments in argv variable)");
+ return TCL_ERROR;
+ }
+ if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
+ argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS)
+ != TCL_OK) {
+ ckfree((char *) argv);
+ goto argError;
+ }
+ p = Tcl_Merge(argc, argv);
+ Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY);
+ sprintf(buffer, "%d", argc);
+ Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY);
+ ckfree(p);
+ }
+
+ /*
+ * Figure out the application's name and class.
+ */
+
+ Tcl_DStringInit(&class);
+ if (name == NULL) {
+ int offset;
+ TkpGetAppName(interp, &class);
+ offset = Tcl_DStringLength(&class)+1;
+ Tcl_DStringSetLength(&class, offset);
+ Tcl_DStringAppend(&class, Tcl_DStringValue(&class), offset-1);
+ name = Tcl_DStringValue(&class) + offset;
+ } else {
+ Tcl_DStringAppend(&class, name, -1);
+ }
+
+ p = Tcl_DStringValue(&class);
+ if (islower(UCHAR(*p))) {
+ *p = toupper(UCHAR(*p));
+ }
+
+ /*
+ * Create an argument list for creating the top-level window,
+ * using the information parsed from argv, if any.
+ */
+
+ args[0] = "toplevel";
+ args[1] = ".";
+ args[2] = "-class";
+ args[3] = Tcl_DStringValue(&class);
+ argc = 4;
+ if (display != NULL) {
+ args[argc] = "-screen";
+ args[argc+1] = display;
+ argc += 2;
+
+ /*
+ * 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 (numMainWindows == 0) {
+ Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
+ }
+ }
+ if (colormap != NULL) {
+ args[argc] = "-colormap";
+ args[argc+1] = colormap;
+ argc += 2;
+ colormap = NULL;
+ }
+ if (use != NULL) {
+ args[argc] = "-use";
+ args[argc+1] = use;
+ argc += 2;
+ use = NULL;
+ }
+ if (visual != NULL) {
+ args[argc] = "-visual";
+ args[argc+1] = visual;
+ argc += 2;
+ visual = NULL;
+ }
+ args[argc] = NULL;
+ code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name);
+
+ Tcl_DStringFree(&class);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ Tcl_ResetResult(interp);
+ if (synchronize) {
+ 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 (geometry != NULL) {
+ Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
+ code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ geometry = NULL;
+ }
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ code = Tcl_PkgProvide(interp, "Tk", TK_VERSION);
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * Invoke platform-specific initialization.
+ */
+
+ code = TkpInit(interp);
+
+ done:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return code;
+}