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