tk/generic/tkCmds.c

   1 /*
   2  * tkCmds.c --
   3  *
   4  *      This file contains a collection of Tk-related Tcl commands
   5  *      that didn't fit in any particular file of the toolkit.
   6  *
   7  * Copyright (c) 1990-1994 The Regents of the University of California.
   8  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
   9  * Copyright (c) 2000 Scriptics Corporation.
  10  *
  11  * See the file "license.terms" for information on usage and redistribution
  12  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13  *
  14  * RCS: @(#) $Id$
  15  */
  16
  17 #include "tkPort.h"
  18 #include "tkInt.h"
  19 #include <errno.h>
  20
  21 #if defined(WIN32)
  22 #include "tkWinInt.h"
  23 #elif defined(MAC_TCL)
  24 #include "tkMacInt.h"
  25 #elif defined(MAC_OSX_TK)
  26 #include "tkMacOSXInt.h"
  27 #else
  28 #include "tkUnixInt.h"
  29 #endif
  30
  31 /*
  32  * Forward declarations for procedures defined later in this file:
  33  */
  34
  35 static TkWindow *       GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
  36 static char *           WaitVariableProc _ANSI_ARGS_((ClientData clientData,
  37                             Tcl_Interp *interp, CONST char *name1,
  38                             CONST char *name2, int flags));
  39 static void             WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
  40                             XEvent *eventPtr));
  41 static void             WaitWindowProc _ANSI_ARGS_((ClientData clientData,
  42                             XEvent *eventPtr));
  43 \f
  44 /*
  45  *----------------------------------------------------------------------
  46  *
  47  * Tk_BellObjCmd --
  48  *
  49  *      This procedure is invoked to process the "bell" Tcl command.
  50  *      See the user documentation for details on what it does.
  51  *
  52  * Results:
  53  *      A standard Tcl result.
  54  *
  55  * Side effects:
  56  *      See the user documentation.
  57  *
  58  *----------------------------------------------------------------------
  59  */
  60
  61 int
  62 Tk_BellObjCmd(clientData, interp, objc, objv)
  63     ClientData clientData;      /* Main window associated with interpreter. */
  64     Tcl_Interp *interp;         /* Current interpreter. */
  65     int objc;                   /* Number of arguments. */
  66     Tcl_Obj *CONST objv[];      /* Argument objects. */
  67 {
  68     static CONST char *bellOptions[] = {"-displayof", "-nice", (char *) NULL};
  69     enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE };
  70     Tk_Window tkwin = (Tk_Window) clientData;
  71     int i, index, nice = 0;
  72
  73     if (objc > 4) {
  74         Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?-nice?");
  75         return TCL_ERROR;
  76     }
  77
  78     for (i = 1; i < objc; i++) {
  79         if (Tcl_GetIndexFromObj(interp, objv[i], bellOptions, "option", 0,
  80                 &index) != TCL_OK) {
  81             return TCL_ERROR;
  82         }
  83         switch ((enum options) index) {
  84             case TK_BELL_DISPLAYOF:
  85                 if (++i >= objc) {
  86                     Tcl_WrongNumArgs(interp, 1, objv,
  87                             "?-displayof window? ?-nice?");
  88                     return TCL_ERROR;
  89                 }
  90                 tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
  91                 if (tkwin == NULL) {
  92                     return TCL_ERROR;
  93                 }
  94                 break;
  95             case TK_BELL_NICE:
  96                 nice = 1;
  97                 break;
  98         }
  99     }
 100     XBell(Tk_Display(tkwin), 0);
 101     if (!nice) {
 102         XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
 103     }
 104     XFlush(Tk_Display(tkwin));
 105     return TCL_OK;
 106 }
 107 \f
 108 /*
 109  *----------------------------------------------------------------------
 110  *
 111  * Tk_BindObjCmd --
 112  *
 113  *      This procedure is invoked to process the "bind" Tcl command.
 114  *      See the user documentation for details on what it does.
 115  *
 116  * Results:
 117  *      A standard Tcl result.
 118  *
 119  * Side effects:
 120  *      See the user documentation.
 121  *
 122  *----------------------------------------------------------------------
 123  */
 124
 125 int
 126 Tk_BindObjCmd(clientData, interp, objc, objv)
 127     ClientData clientData;      /* Main window associated with interpreter. */
 128     Tcl_Interp *interp;         /* Current interpreter. */
 129     int objc;                   /* Number of arguments. */
 130     Tcl_Obj *CONST objv[];      /* Argument objects. */
 131 {
 132     Tk_Window tkwin = (Tk_Window) clientData;
 133     TkWindow *winPtr;
 134     ClientData object;
 135     char *string;
 136
 137     if ((objc < 2) || (objc > 4)) {
 138         Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?");
 139         return TCL_ERROR;
 140     }
 141     string = Tcl_GetString(objv[1]);
 142
 143     /*
 144      * Bind tags either a window name or a tag name for the first argument.
 145      * If the argument starts with ".", assume it is a window; otherwise, it
 146      * is a tag.
 147      */
 148
 149     if (string[0] == '.') {
 150         winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
 151         if (winPtr == NULL) {
 152             return TCL_ERROR;
 153         }
 154         object = (ClientData) winPtr->pathName;
 155     } else {
 156         winPtr = (TkWindow *) clientData;
 157         object = (ClientData) Tk_GetUid(string);
 158     }
 159
 160     /*
 161      * If there are four arguments, the command is modifying a binding.  If
 162      * there are three arguments, the command is querying a binding.  If there
 163      * are only two arguments, the command is querying all the bindings for
 164      * the given tag/window.
 165      */
 166
 167     if (objc == 4) {
 168         int append = 0;
 169         unsigned long mask;
 170         char *sequence, *script;
 171         sequence        = Tcl_GetString(objv[2]);
 172         script          = Tcl_GetString(objv[3]);
 173
 174         /*
 175          * If the script is null, just delete the binding.
 176          */
 177
 178         if (script[0] == 0) {
 179             return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
 180                     object, sequence);
 181         }
 182
 183         /*
 184          * If the script begins with "+", append this script to the existing
 185          * binding.
 186          */
 187
 188         if (script[0] == '+') {
 189             script++;
 190             append = 1;
 191         }
 192         mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
 193                 object, sequence, script, append);
 194         if (mask == 0) {
 195             return TCL_ERROR;
 196         }
 197     } else if (objc == 3) {
 198         CONST char *command;
 199
 200         command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
 201                 object, Tcl_GetString(objv[2]));
 202         if (command == NULL) {
 203             Tcl_ResetResult(interp);
 204             return TCL_OK;
 205         }
 206         Tcl_SetResult(interp, (char *) command, TCL_STATIC);
 207     } else {
 208         Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
 209     }
 210     return TCL_OK;
 211 }
 212 \f
 213 /*
 214  *----------------------------------------------------------------------
 215  *
 216  * TkBindEventProc --
 217  *
 218  *      This procedure is invoked by Tk_HandleEvent for each event;  it
 219  *      causes any appropriate bindings for that event to be invoked.
 220  *
 221  * Results:
 222  *      None.
 223  *
 224  * Side effects:
 225  *      Depends on what bindings have been established with the "bind"
 226  *      command.
 227  *
 228  *----------------------------------------------------------------------
 229  */
 230
 231 void
 232 TkBindEventProc(winPtr, eventPtr)
 233     TkWindow *winPtr;                   /* Pointer to info about window. */
 234     XEvent *eventPtr;                   /* Information about event. */
 235 {
 236 #define MAX_OBJS 20
 237     ClientData objects[MAX_OBJS], *objPtr;
 238     TkWindow *topLevPtr;
 239     int i, count;
 240     char *p;
 241     Tcl_HashEntry *hPtr;
 242
 243     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
 244         return;
 245     }
 246
 247     objPtr = objects;
 248     if (winPtr->numTags != 0) {
 249         /*
 250          * Make a copy of the tags for the window, replacing window names
 251          * with pointers to the pathName from the appropriate window.
 252          */
 253
 254         if (winPtr->numTags > MAX_OBJS) {
 255             objPtr = (ClientData *) ckalloc((unsigned)
 256                     (winPtr->numTags * sizeof(ClientData)));
 257         }
 258         for (i = 0; i < winPtr->numTags; i++) {
 259             p = (char *) winPtr->tagPtr[i];
 260             if (*p == '.') {
 261                 hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
 262                 if (hPtr != NULL) {
 263                     p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
 264                 } else {
 265                     p = NULL;
 266                 }
 267             }
 268             objPtr[i] = (ClientData) p;
 269         }
 270         count = winPtr->numTags;
 271     } else {
 272         objPtr[0] = (ClientData) winPtr->pathName;
 273         objPtr[1] = (ClientData) winPtr->classUid;
 274         for (topLevPtr = winPtr;
 275                 (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_HIERARCHY);
 276                 topLevPtr = topLevPtr->parentPtr) {
 277             /* Empty loop body. */
 278         }
 279         if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
 280             count = 4;
 281             objPtr[2] = (ClientData) topLevPtr->pathName;
 282         } else {
 283             count = 3;
 284         }
 285         objPtr[count-1] = (ClientData) Tk_GetUid("all");
 286     }
 287     Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
 288             count, objPtr);
 289     if (objPtr != objects) {
 290         ckfree((char *) objPtr);
 291     }
 292 }
 293 \f
 294 /*
 295  *----------------------------------------------------------------------
 296  *
 297  * Tk_BindtagsObjCmd --
 298  *
 299  *      This procedure is invoked to process the "bindtags" Tcl command.
 300  *      See the user documentation for details on what it does.
 301  *
 302  * Results:
 303  *      A standard Tcl result.
 304  *
 305  * Side effects:
 306  *      See the user documentation.
 307  *
 308  *----------------------------------------------------------------------
 309  */
 310
 311 int
 312 Tk_BindtagsObjCmd(clientData, interp, objc, objv)
 313     ClientData clientData;      /* Main window associated with interpreter. */
 314     Tcl_Interp *interp;         /* Current interpreter. */
 315     int objc;                   /* Number of arguments. */
 316     Tcl_Obj *CONST objv[];      /* Argument objects. */
 317 {
 318     Tk_Window tkwin = (Tk_Window) clientData;
 319     TkWindow *winPtr, *winPtr2;
 320     int i, length;
 321     char *p;
 322     Tcl_Obj *listPtr, **tags;
 323
 324     if ((objc < 2) || (objc > 3)) {
 325         Tcl_WrongNumArgs(interp, 1, objv, "window ?taglist?");
 326         return TCL_ERROR;
 327     }
 328     winPtr = (TkWindow *) Tk_NameToWindow(interp, Tcl_GetString(objv[1]),
 329             tkwin);
 330     if (winPtr == NULL) {
 331         return TCL_ERROR;
 332     }
 333     if (objc == 2) {
 334         listPtr = Tcl_NewObj();
 335         Tcl_IncrRefCount(listPtr);
 336         if (winPtr->numTags == 0) {
 337             Tcl_ListObjAppendElement(interp, listPtr,
 338                     Tcl_NewStringObj(winPtr->pathName, -1));
 339             Tcl_ListObjAppendElement(interp, listPtr,
 340                     Tcl_NewStringObj(winPtr->classUid, -1));
 341             winPtr2 = winPtr;
 342             while ((winPtr2 != NULL) && !(Tk_TopWinHierarchy(winPtr2))) {
 343                 winPtr2 = winPtr2->parentPtr;
 344             }
 345             if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
 346                 Tcl_ListObjAppendElement(interp, listPtr,
 347                         Tcl_NewStringObj(winPtr2->pathName, -1));
 348             }
 349             Tcl_ListObjAppendElement(interp, listPtr,
 350                     Tcl_NewStringObj("all", -1));
 351         } else {
 352             for (i = 0; i < winPtr->numTags; i++) {
 353                 Tcl_ListObjAppendElement(interp, listPtr,
 354                         Tcl_NewStringObj((char *)winPtr->tagPtr[i], -1));
 355             }
 356         }
 357         Tcl_SetObjResult(interp, listPtr);
 358         Tcl_DecrRefCount(listPtr);
 359         return TCL_OK;
 360     }
 361     if (winPtr->tagPtr != NULL) {
 362         TkFreeBindingTags(winPtr);
 363     }
 364     if (Tcl_ListObjGetElements(interp, objv[2], &length, &tags) != TCL_OK) {
 365         return TCL_ERROR;
 366     }
 367     if (length == 0) {
 368         return TCL_OK;
 369     }
 370
 371     winPtr->numTags = length;
 372     winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
 373             (length * sizeof(ClientData)));
 374     for (i = 0; i < length; i++) {
 375         p = Tcl_GetString(tags[i]);
 376         if (p[0] == '.') {
 377             char *copy;
 378
 379             /*
 380              * Handle names starting with "." specially: store a malloc'ed
 381              * string, rather than a Uid;  at event time we'll look up the
 382              * name in the window table and use the corresponding window,
 383              * if there is one.
 384              */
 385
 386             copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
 387             strcpy(copy, p);
 388             winPtr->tagPtr[i] = (ClientData) copy;
 389         } else {
 390             winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
 391         }
 392     }
 393     return TCL_OK;
 394 }
 395 \f
 396 /*
 397  *----------------------------------------------------------------------
 398  *
 399  * TkFreeBindingTags --
 400  *
 401  *      This procedure is called to free all of the binding tags
 402  *      associated with a window;  typically it is only invoked where
 403  *      there are window-specific tags.
 404  *
 405  * Results:
 406  *      None.
 407  *
 408  * Side effects:
 409  *      Any binding tags for winPtr are freed.
 410  *
 411  *----------------------------------------------------------------------
 412  */
 413
 414 void
 415 TkFreeBindingTags(winPtr)
 416     TkWindow *winPtr;           /* Window whose tags are to be released. */
 417 {
 418     int i;
 419     char *p;
 420
 421     for (i = 0; i < winPtr->numTags; i++) {
 422         p = (char *) (winPtr->tagPtr[i]);
 423         if (*p == '.') {
 424             /*
 425              * Names starting with "." are malloced rather than Uids, so
 426              * they have to be freed.
 427              */
 428
 429             ckfree(p);
 430         }
 431     }
 432     ckfree((char *) winPtr->tagPtr);
 433     winPtr->numTags = 0;
 434     winPtr->tagPtr = NULL;
 435 }
 436 \f
 437 /*
 438  *----------------------------------------------------------------------
 439  *
 440  * Tk_DestroyObjCmd --
 441  *
 442  *      This procedure is invoked to process the "destroy" Tcl command.
 443  *      See the user documentation for details on what it does.
 444  *
 445  * Results:
 446  *      A standard Tcl result.
 447  *
 448  * Side effects:
 449  *      See the user documentation.
 450  *
 451  *----------------------------------------------------------------------
 452  */
 453
 454 int
 455 Tk_DestroyObjCmd(clientData, interp, objc, objv)
 456     ClientData clientData;              /* Main window associated with
 457                                  * interpreter. */
 458     Tcl_Interp *interp;         /* Current interpreter. */
 459     int objc;                   /* Number of arguments. */
 460     Tcl_Obj *CONST objv[];      /* Argument objects. */
 461 {
 462     Tk_Window window;
 463     Tk_Window tkwin = (Tk_Window) clientData;
 464     int i;
 465
 466     for (i = 1; i < objc; i++) {
 467         window = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
 468         if (window == NULL) {
 469             Tcl_ResetResult(interp);
 470             continue;
 471         }
 472         Tk_DestroyWindow(window);
 473         if (window == tkwin) {
 474             /*
 475              * We just deleted the main window for the application! This
 476              * makes it impossible to do anything more (tkwin isn't
 477              * valid anymore).
 478              */
 479
 480             break;
 481          }
 482     }
 483     return TCL_OK;
 484 }
 485 \f
 486 /*
 487  *----------------------------------------------------------------------
 488  *
 489  * Tk_LowerObjCmd --
 490  *
 491  *      This procedure is invoked to process the "lower" Tcl command.
 492  *      See the user documentation for details on what it does.
 493  *
 494  * Results:
 495  *      A standard Tcl result.
 496  *
 497  * Side effects:
 498  *      See the user documentation.
 499  *
 500  *----------------------------------------------------------------------
 501  */
 502
 503         /* ARGSUSED */
 504 int
 505 Tk_LowerObjCmd(clientData, interp, objc, objv)
 506     ClientData clientData;      /* Main window associated with
 507                                  * interpreter. */
 508     Tcl_Interp *interp;         /* Current interpreter. */
 509     int objc;                   /* Number of arguments. */
 510     Tcl_Obj *CONST objv[];      /* Argument objects. */
 511 {
 512     Tk_Window mainwin = (Tk_Window) clientData;
 513     Tk_Window tkwin, other;
 514
 515     if ((objc != 2) && (objc != 3)) {
 516         Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");
 517         return TCL_ERROR;
 518     }
 519
 520     tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
 521     if (tkwin == NULL) {
 522         return TCL_ERROR;
 523     }
 524     if (objc == 2) {
 525         other = NULL;
 526     } else {
 527         other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
 528         if (other == NULL) {
 529             return TCL_ERROR;
 530         }
 531     }
 532     if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
 533         Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),
 534                 "\" below \"", (other ? Tcl_GetString(objv[2]) : ""),
 535                 "\"", (char *) NULL);
 536         return TCL_ERROR;
 537     }
 538     return TCL_OK;
 539 }
 540 \f
 541 /*
 542  *----------------------------------------------------------------------
 543  *
 544  * Tk_RaiseObjCmd --
 545  *
 546  *      This procedure is invoked to process the "raise" Tcl command.
 547  *      See the user documentation for details on what it does.
 548  *
 549  * Results:
 550  *      A standard Tcl result.
 551  *
 552  * Side effects:
 553  *      See the user documentation.
 554  *
 555  *----------------------------------------------------------------------
 556  */
 557
 558         /* ARGSUSED */
 559 int
 560 Tk_RaiseObjCmd(clientData, interp, objc, objv)
 561     ClientData clientData;      /* Main window associated with
 562                                  * interpreter. */
 563     Tcl_Interp *interp;         /* Current interpreter. */
 564     int objc;                   /* Number of arguments. */
 565     Tcl_Obj *CONST objv[];      /* Argument objects. */
 566 {
 567     Tk_Window mainwin = (Tk_Window) clientData;
 568     Tk_Window tkwin, other;
 569
 570     if ((objc != 2) && (objc != 3)) {
 571         Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");
 572         return TCL_ERROR;
 573     }
 574
 575     tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
 576     if (tkwin == NULL) {
 577         return TCL_ERROR;
 578     }
 579     if (objc == 2) {
 580         other = NULL;
 581     } else {
 582         other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
 583         if (other == NULL) {
 584             return TCL_ERROR;
 585         }
 586     }
 587     if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
 588         Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),
 589                 "\" above \"", (other ? Tcl_GetString(objv[2]) : ""),
 590                 "\"", (char *) NULL);
 591         return TCL_ERROR;
 592     }
 593     return TCL_OK;
 594 }
 595 \f
 596 /*
 597  *----------------------------------------------------------------------
 598  *
 599  * Tk_TkObjCmd --
 600  *
 601  *      This procedure is invoked to process the "tk" Tcl command.
 602  *      See the user documentation for details on what it does.
 603  *
 604  * Results:
 605  *      A standard Tcl result.
 606  *
 607  * Side effects:
 608  *      See the user documentation.
 609  *
 610  *----------------------------------------------------------------------
 611  */
 612
 613 int
 614 Tk_TkObjCmd(clientData, interp, objc, objv)
 615     ClientData clientData;      /* Main window associated with interpreter. */
 616     Tcl_Interp *interp;         /* Current interpreter. */
 617     int objc;                   /* Number of arguments. */
 618     Tcl_Obj *CONST objv[];      /* Argument objects. */
 619 {
 620     int index;
 621     Tk_Window tkwin;
 622     static CONST char *optionStrings[] = {
 623         "appname",      "caret",        "scaling",      "useinputmethods",
 624         "windowingsystem",              NULL
 625     };
 626     enum options {
 627         TK_APPNAME,     TK_CARET,       TK_SCALING,     TK_USE_IM,
 628         TK_WINDOWINGSYSTEM
 629     };
 630
 631     tkwin = (Tk_Window) clientData;
 632
 633     if (objc < 2) {
 634         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
 635         return TCL_ERROR;
 636     }
 637     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
 638             &index) != TCL_OK) {
 639         return TCL_ERROR;
 640     }
 641
 642     switch ((enum options) index) {
 643         case TK_APPNAME: {
 644             TkWindow *winPtr;
 645             char *string;
 646
 647             if (Tcl_IsSafe(interp)) {
 648                 Tcl_SetResult(interp,
 649                         "appname not accessible in a safe interpreter",
 650                         TCL_STATIC);
 651                 return TCL_ERROR;
 652             }
 653
 654             winPtr = (TkWindow *) tkwin;
 655
 656             if (objc > 3) {
 657                 Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
 658                 return TCL_ERROR;
 659             }
 660             if (objc == 3) {
 661                 string = Tcl_GetStringFromObj(objv[2], NULL);
 662                 winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
 663             }
 664             Tcl_AppendResult(interp, winPtr->nameUid, NULL);
 665             break;
 666         }
 667         case TK_CARET: {
 668             Tcl_Obj *objPtr;
 669             TkCaret *caretPtr;
 670             Tk_Window window;
 671             static CONST char *caretStrings[]
 672                 = { "-x",       "-y", "-height", NULL };
 673             enum caretOptions
 674                 { TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT };
 675
 676             if ((objc < 3) || ((objc > 4) && !(objc & 1))) {
 677                 Tcl_WrongNumArgs(interp, 2, objv,
 678                         "window ?-x x? ?-y y? ?-height height?");
 679                 return TCL_ERROR;
 680             }
 681             window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
 682             if (window == NULL) {
 683                 return TCL_ERROR;
 684             }
 685             caretPtr = &(((TkWindow *) window)->dispPtr->caret);
 686             if (objc == 3) {
 687                 /*
 688                  * Return all the current values
 689                  */
 690                 objPtr = Tcl_NewObj();
 691                 Tcl_ListObjAppendElement(interp, objPtr,
 692                         Tcl_NewStringObj("-height", 7));
 693                 Tcl_ListObjAppendElement(interp, objPtr,
 694                         Tcl_NewIntObj(caretPtr->height));
 695                 Tcl_ListObjAppendElement(interp, objPtr,
 696                         Tcl_NewStringObj("-x", 2));
 697                 Tcl_ListObjAppendElement(interp, objPtr,
 698                         Tcl_NewIntObj(caretPtr->x));
 699                 Tcl_ListObjAppendElement(interp, objPtr,
 700                         Tcl_NewStringObj("-y", 2));
 701                 Tcl_ListObjAppendElement(interp, objPtr,
 702                         Tcl_NewIntObj(caretPtr->y));
 703                 Tcl_SetObjResult(interp, objPtr);
 704             } else if (objc == 4) {
 705                 int value;
 706                 /*
 707                  * Return the current value of the selected option
 708                  */
 709                 if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings,
 710                         "caret option", 0, &index) != TCL_OK) {
 711                     return TCL_ERROR;
 712                 }
 713                 if (index == TK_CARET_X) {
 714                     value = caretPtr->x;
 715                 } else if (index == TK_CARET_Y) {
 716                     value = caretPtr->y;
 717                 } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
 718                     value = caretPtr->height;
 719                 }
 720                 Tcl_SetIntObj(Tcl_GetObjResult(interp), value);
 721             } else {
 722                 int i, value, x = 0, y = 0, height = -1;
 723
 724                 for (i = 3; i < objc; i += 2) {
 725                     if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings,
 726                             "caret option", 0, &index) != TCL_OK) ||
 727                             (Tcl_GetIntFromObj(interp, objv[i+1], &value)
 728                                 != TCL_OK)) {
 729                         return TCL_ERROR;
 730                     }
 731                     if (index == TK_CARET_X) {
 732                         x = value;
 733                     } else if (index == TK_CARET_Y) {
 734                         y = value;
 735                     } else /* if (index == TK_CARET_HEIGHT) -- last case */ {
 736                         height = value;
 737                     }
 738                 }
 739                 if (height < 0) {
 740                     height = Tk_Height(window);
 741                 }
 742                 Tk_SetCaretPos(window, x, y, height);
 743             }
 744             break;
 745         }
 746         case TK_SCALING: {
 747             Screen *screenPtr;
 748             int skip, width, height;
 749             double d;
 750
 751             if (Tcl_IsSafe(interp)) {
 752                 Tcl_SetResult(interp,
 753                         "scaling not accessible in a safe interpreter",
 754                         TCL_STATIC);
 755                 return TCL_ERROR;
 756             }
 757
 758             screenPtr = Tk_Screen(tkwin);
 759
 760             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
 761             if (skip < 0) {
 762                 return TCL_ERROR;
 763             }
 764             if (objc - skip == 2) {
 765                 d = 25.4 / 72;
 766                 d *= WidthOfScreen(screenPtr);
 767                 d /= WidthMMOfScreen(screenPtr);
 768                 Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
 769             } else if (objc - skip == 3) {
 770                 if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {
 771                     return TCL_ERROR;
 772                 }
 773                 d = (25.4 / 72) / d;
 774                 width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
 775                 if (width <= 0) {
 776                     width = 1;
 777                 }
 778                 height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
 779                 if (height <= 0) {
 780                     height = 1;
 781                 }
 782                 WidthMMOfScreen(screenPtr) = width;
 783                 HeightMMOfScreen(screenPtr) = height;
 784             } else {
 785                 Tcl_WrongNumArgs(interp, 2, objv,
 786                         "?-displayof window? ?factor?");
 787                 return TCL_ERROR;
 788             }
 789             break;
 790         }
 791         case TK_USE_IM: {
 792             TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
 793             int skip;
 794
 795             if (Tcl_IsSafe(interp)) {
 796                 Tcl_SetResult(interp,
 797                         "useinputmethods not accessible in a safe interpreter",
 798                         TCL_STATIC);
 799                 return TCL_ERROR;
 800             }
 801
 802             skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);
 803             if (skip < 0) {
 804                 return TCL_ERROR;
 805             } else if (skip) {
 806                 dispPtr = ((TkWindow *) tkwin)->dispPtr;
 807             }
 808             if ((objc - skip) == 3) {
 809                 /*
 810                  * In the case where TK_USE_INPUT_METHODS is not defined,
 811                  * this will be ignored and we will always return 0.
 812                  * That will indicate to the user that input methods
 813                  * are just not available.
 814                  */
 815                 int boolVal;
 816                 if (Tcl_GetBooleanFromObj(interp, objv[2+skip], &boolVal)
 817                         != TCL_OK) {
 818                     return TCL_ERROR;
 819                 }
 820 #ifdef TK_USE_INPUT_METHODS
 821                 if (boolVal) {
 822                     dispPtr->flags |= TK_DISPLAY_USE_IM;
 823                 } else {
 824                     dispPtr->flags &= ~TK_DISPLAY_USE_IM;
 825                 }
 826 #endif /* TK_USE_INPUT_METHODS */
 827             } else if ((objc - skip) != 2) {
 828                 Tcl_WrongNumArgs(interp, 2, objv,
 829                         "?-displayof window? ?boolean?");
 830                 return TCL_ERROR;
 831             }
 832             Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
 833                     (int) (dispPtr->flags & TK_DISPLAY_USE_IM));
 834             break;
 835         }
 836         case TK_WINDOWINGSYSTEM: {
 837             CONST char *windowingsystem;
 838
 839             if (objc != 2) {
 840                 Tcl_WrongNumArgs(interp, 2, objv, NULL);
 841                 return TCL_ERROR;
 842             }
 843 #if defined(WIN32)
 844             windowingsystem = "win32";
 845 #elif defined(MAC_TCL)
 846             windowingsystem = "classic";
 847 #elif defined(MAC_OSX_TK)
 848             windowingsystem = "aqua";
 849 #else
 850             windowingsystem = "x11";
 851 #endif
 852             Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1);
 853             break;
 854         }
 855     }
 856     return TCL_OK;
 857 }
 858 \f
 859 /*
 860  *----------------------------------------------------------------------
 861  *
 862  * Tk_TkwaitObjCmd --
 863  *
 864  *      This procedure is invoked to process the "tkwait" Tcl command.
 865  *      See the user documentation for details on what it does.
 866  *
 867  * Results:
 868  *      A standard Tcl result.
 869  *
 870  * Side effects:
 871  *      See the user documentation.
 872  *
 873  *----------------------------------------------------------------------
 874  */
 875
 876         /* ARGSUSED */
 877 int
 878 Tk_TkwaitObjCmd(clientData, interp, objc, objv)
 879     ClientData clientData;      /* Main window associated with
 880                                  * interpreter. */
 881     Tcl_Interp *interp;         /* Current interpreter. */
 882     int objc;                   /* Number of arguments. */
 883     Tcl_Obj *CONST objv[];      /* Argument objects. */
 884 {
 885     Tk_Window tkwin = (Tk_Window) clientData;
 886     int done, index;
 887     static CONST char *optionStrings[] = { "variable", "visibility", "window",
 888                                          (char *) NULL };
 889     enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW };
 890
 891     if (objc != 3) {
 892         Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
 893         return TCL_ERROR;
 894     }
 895
 896     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
 897             &index) != TCL_OK) {
 898         return TCL_ERROR;
 899     }
 900
 901     switch ((enum options) index) {
 902         case TKWAIT_VARIABLE: {
 903             if (Tcl_TraceVar(interp, Tcl_GetString(objv[2]),
 904                     TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 905                     WaitVariableProc, (ClientData) &done) != TCL_OK) {
 906                 return TCL_ERROR;
 907             }
 908             done = 0;
 909             while (!done) {
 910                 Tcl_DoOneEvent(0);
 911             }
 912             Tcl_UntraceVar(interp, Tcl_GetString(objv[2]),
 913                     TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 914                     WaitVariableProc, (ClientData) &done);
 915             break;
 916         }
 917
 918         case TKWAIT_VISIBILITY: {
 919             Tk_Window window;
 920
 921             window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
 922             if (window == NULL) {
 923                 return TCL_ERROR;
 924             }
 925             Tk_CreateEventHandler(window,
 926                     VisibilityChangeMask|StructureNotifyMask,
 927                     WaitVisibilityProc, (ClientData) &done);
 928             done = 0;
 929             while (!done) {
 930                 Tcl_DoOneEvent(0);
 931             }
 932             if (done != 1) {
 933                 /*
 934                  * Note that we do not delete the event handler because it
 935                  * was deleted automatically when the window was destroyed.
 936                  */
 937
 938                 Tcl_ResetResult(interp);
 939                 Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]),
 940                         "\" was deleted before its visibility changed",
 941                         (char *) NULL);
 942                 return TCL_ERROR;
 943             }
 944             Tk_DeleteEventHandler(window,
 945                     VisibilityChangeMask|StructureNotifyMask,
 946                     WaitVisibilityProc, (ClientData) &done);
 947             break;
 948         }
 949
 950         case TKWAIT_WINDOW: {
 951             Tk_Window window;
 952
 953             window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin);
 954             if (window == NULL) {
 955                 return TCL_ERROR;
 956             }
 957             Tk_CreateEventHandler(window, StructureNotifyMask,
 958                     WaitWindowProc, (ClientData) &done);
 959             done = 0;
 960             while (!done) {
 961                 Tcl_DoOneEvent(0);
 962             }
 963             /*
 964              * Note:  there's no need to delete the event handler.  It was
 965              * deleted automatically when the window was destroyed.
 966              */
 967             break;
 968         }
 969     }
 970
 971     /*
 972      * Clear out the interpreter's result, since it may have been set
 973      * by event handlers.
 974      */
 975
 976     Tcl_ResetResult(interp);
 977     return TCL_OK;
 978 }
 979
 980         /* ARGSUSED */
 981 static char *
 982 WaitVariableProc(clientData, interp, name1, name2, flags)
 983     ClientData clientData;      /* Pointer to integer to set to 1. */
 984     Tcl_Interp *interp;         /* Interpreter containing variable. */
 985     CONST char *name1;          /* Name of variable. */
 986     CONST char *name2;          /* Second part of variable name. */
 987     int flags;                  /* Information about what happened. */
 988 {
 989     int *donePtr = (int *) clientData;
 990
 991     *donePtr = 1;
 992     return (char *) NULL;
 993 }
 994
 995         /*ARGSUSED*/
 996 static void
 997 WaitVisibilityProc(clientData, eventPtr)
 998     ClientData clientData;      /* Pointer to integer to set to 1. */
 999     XEvent *eventPtr;           /* Information about event (not used). */
1000 {
1001     int *donePtr = (int *) clientData;
1002
1003     if (eventPtr->type == VisibilityNotify) {
1004         *donePtr = 1;
1005     }
1006     if (eventPtr->type == DestroyNotify) {
1007         *donePtr = 2;
1008     }
1009 }
1010
1011 static void
1012 WaitWindowProc(clientData, eventPtr)
1013     ClientData clientData;      /* Pointer to integer to set to 1. */
1014     XEvent *eventPtr;           /* Information about event. */
1015 {
1016     int *donePtr = (int *) clientData;
1017
1018     if (eventPtr->type == DestroyNotify) {
1019         *donePtr = 1;
1020     }
1021 }
1022 \f
1023 /*
1024  *----------------------------------------------------------------------
1025  *
1026  * Tk_UpdateObjCmd --
1027  *
1028  *      This procedure is invoked to process the "update" Tcl command.
1029  *      See the user documentation for details on what it does.
1030  *
1031  * Results:
1032  *      A standard Tcl result.
1033  *
1034  * Side effects:
1035  *      See the user documentation.
1036  *
1037  *----------------------------------------------------------------------
1038  */
1039
1040         /* ARGSUSED */
1041 int
1042 Tk_UpdateObjCmd(clientData, interp, objc, objv)
1043     ClientData clientData;      /* Main window associated with
1044                                  * interpreter. */
1045     Tcl_Interp *interp;         /* Current interpreter. */
1046     int objc;                   /* Number of arguments. */
1047     Tcl_Obj *CONST objv[];      /* Argument objects. */
1048 {
1049     static CONST char *updateOptions[] = {"idletasks", (char *) NULL};
1050     int flags, index;
1051     TkDisplay *dispPtr;
1052
1053     if (objc == 1) {
1054         flags = TCL_DONT_WAIT;
1055     } else if (objc == 2) {
1056         if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,
1057                 &index) != TCL_OK) {
1058             return TCL_ERROR;
1059         }
1060         flags = TCL_IDLE_EVENTS;
1061     } else {
1062         Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
1063         return TCL_ERROR;
1064     }
1065
1066     /*
1067      * Handle all pending events, sync all displays, and repeat over
1068      * and over again until all pending events have been handled.
1069      * Special note:  it's possible that the entire application could
1070      * be destroyed by an event handler that occurs during the update.
1071      * Thus, don't use any information from tkwin after calling
1072      * Tcl_DoOneEvent.
1073      */
1074
1075     while (1) {
1076         while (Tcl_DoOneEvent(flags) != 0) {
1077             /* Empty loop body */
1078         }
1079         for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
1080                 dispPtr = dispPtr->nextPtr) {
1081             XSync(dispPtr->display, False);
1082         }
1083         if (Tcl_DoOneEvent(flags) == 0) {
1084             break;
1085         }
1086     }
1087
1088     /*
1089      * Must clear the interpreter's result because event handlers could
1090      * have executed commands.
1091      */
1092
1093     Tcl_ResetResult(interp);
1094     return TCL_OK;
1095 }
1096 \f
1097 /*
1098  *----------------------------------------------------------------------
1099  *
1100  * Tk_WinfoObjCmd --
1101  *
1102  *      This procedure is invoked to process the "winfo" Tcl command.
1103  *      See the user documentation for details on what it does.
1104  *
1105  * Results:
1106  *      A standard Tcl result.
1107  *
1108  * Side effects:
1109  *      See the user documentation.
1110  *
1111  *----------------------------------------------------------------------
1112  */
1113
1114 int
1115 Tk_WinfoObjCmd(clientData, interp, objc, objv)
1116     ClientData clientData;      /* Main window associated with
1117                                  * interpreter. */
1118     Tcl_Interp *interp;         /* Current interpreter. */
1119     int objc;                   /* Number of arguments. */
1120     Tcl_Obj *CONST objv[];      /* Argument objects. */
1121 {
1122     int index, x, y, width, height, useX, useY, class, skip;
1123     char *string;
1124     TkWindow *winPtr;
1125     Tk_Window tkwin;
1126     Tcl_Obj *resultPtr;
1127
1128     static TkStateMap visualMap[] = {
1129         {PseudoColor,   "pseudocolor"},
1130         {GrayScale,     "grayscale"},
1131         {DirectColor,   "directcolor"},
1132         {TrueColor,     "truecolor"},
1133         {StaticColor,   "staticcolor"},
1134         {StaticGray,    "staticgray"},
1135         {-1,            NULL}
1136     };
1137     static CONST char *optionStrings[] = {
1138         "cells",        "children",     "class",        "colormapfull",
1139         "depth",        "geometry",     "height",       "id",
1140         "ismapped",     "manager",      "name",         "parent",
1141         "pointerx",     "pointery",     "pointerxy",    "reqheight",
1142         "reqwidth",     "rootx",        "rooty",        "screen",
1143         "screencells",  "screendepth",  "screenheight", "screenwidth",
1144         "screenmmheight","screenmmwidth","screenvisual","server",
1145         "toplevel",     "viewable",     "visual",       "visualid",
1146         "vrootheight",  "vrootwidth",   "vrootx",       "vrooty",
1147         "width",        "x",            "y",
1148
1149         "atom",         "atomname",     "containing",   "interps",
1150         "pathname",
1151
1152         "exists",       "fpixels",      "pixels",       "rgb",
1153         "visualsavailable",
1154
1155         NULL
1156     };
1157     enum options {
1158         WIN_CELLS,      WIN_CHILDREN,   WIN_CLASS,      WIN_COLORMAPFULL,
1159         WIN_DEPTH,      WIN_GEOMETRY,   WIN_HEIGHT,     WIN_ID,
1160         WIN_ISMAPPED,   WIN_MANAGER,    WIN_NAME,       WIN_PARENT,
1161         WIN_POINTERX,   WIN_POINTERY,   WIN_POINTERXY,  WIN_REQHEIGHT,
1162         WIN_REQWIDTH,   WIN_ROOTX,      WIN_ROOTY,      WIN_SCREEN,
1163         WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
1164         WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
1165         WIN_TOPLEVEL,   WIN_VIEWABLE,   WIN_VISUAL,     WIN_VISUALID,
1166         WIN_VROOTHEIGHT,WIN_VROOTWIDTH, WIN_VROOTX,     WIN_VROOTY,
1167         WIN_WIDTH,      WIN_X,          WIN_Y,
1168
1169         WIN_ATOM,       WIN_ATOMNAME,   WIN_CONTAINING, WIN_INTERPS,
1170         WIN_PATHNAME,
1171
1172         WIN_EXISTS,     WIN_FPIXELS,    WIN_PIXELS,     WIN_RGB,
1173         WIN_VISUALSAVAILABLE
1174     };
1175
1176     tkwin = (Tk_Window) clientData;
1177
1178     if (objc < 2) {
1179         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
1180         return TCL_ERROR;
1181     }
1182     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
1183             &index) != TCL_OK) {
1184         return TCL_ERROR;
1185     }
1186
1187     if (index < WIN_ATOM) {
1188         if (objc != 3) {
1189             Tcl_WrongNumArgs(interp, 2, objv, "window");
1190             return TCL_ERROR;
1191         }
1192         string = Tcl_GetStringFromObj(objv[2], NULL);
1193         tkwin = Tk_NameToWindow(interp, string, tkwin);
1194         if (tkwin == NULL) {
1195             return TCL_ERROR;
1196         }
1197     }
1198     winPtr = (TkWindow *) tkwin;
1199     resultPtr = Tcl_GetObjResult(interp);
1200
1201     switch ((enum options) index) {
1202         case WIN_CELLS: {
1203             Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
1204             break;
1205         }
1206         case WIN_CHILDREN: {
1207             Tcl_Obj *strPtr;
1208
1209             winPtr = winPtr->childList;
1210             for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
1211                 if (!(winPtr->flags & TK_ANONYMOUS_WINDOW)) {
1212                     strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
1213                     Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
1214                 }
1215             }
1216             break;
1217         }
1218         case WIN_CLASS: {
1219             Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
1220             break;
1221         }
1222         case WIN_COLORMAPFULL: {
1223             Tcl_SetBooleanObj(resultPtr,
1224                     TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
1225             break;
1226         }
1227         case WIN_DEPTH: {
1228             Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
1229             break;
1230         }
1231         case WIN_GEOMETRY: {
1232             char buf[16 + TCL_INTEGER_SPACE * 4];
1233
1234             sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
1235                     Tk_X(tkwin), Tk_Y(tkwin));
1236             Tcl_SetStringObj(resultPtr, buf, -1);
1237             break;
1238         }
1239         case WIN_HEIGHT: {
1240             Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
1241             break;
1242         }
1243         case WIN_ID: {
1244             char buf[TCL_INTEGER_SPACE];
1245
1246             Tk_MakeWindowExist(tkwin);
1247             TkpPrintWindowId(buf, Tk_WindowId(tkwin));
1248             Tcl_SetStringObj(resultPtr, buf, -1);
1249             break;
1250         }
1251         case WIN_ISMAPPED: {
1252             Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
1253             break;
1254         }
1255         case WIN_MANAGER: {
1256             if (winPtr->geomMgrPtr != NULL) {
1257                 Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
1258             }
1259             break;
1260         }
1261         case WIN_NAME: {
1262             Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
1263             break;
1264         }
1265         case WIN_PARENT: {
1266             if (winPtr->parentPtr != NULL) {
1267                 Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
1268             }
1269             break;
1270         }
1271         case WIN_POINTERX: {
1272             useX = 1;
1273             useY = 0;
1274             goto pointerxy;
1275         }
1276         case WIN_POINTERY: {
1277             useX = 0;
1278             useY = 1;
1279             goto pointerxy;
1280         }
1281         case WIN_POINTERXY: {
1282             useX = 1;
1283             useY = 1;
1284
1285             pointerxy:
1286             winPtr = GetToplevel(tkwin);
1287             if (winPtr == NULL) {
1288                 x = -1;
1289                 y = -1;
1290             } else {
1291                 TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
1292             }
1293             if (useX & useY) {
1294                 char buf[TCL_INTEGER_SPACE * 2];
1295
1296                 sprintf(buf, "%d %d", x, y);
1297                 Tcl_SetStringObj(resultPtr, buf, -1);
1298             } else if (useX) {
1299                 Tcl_SetIntObj(resultPtr, x);
1300             } else {
1301                 Tcl_SetIntObj(resultPtr, y);
1302             }
1303             break;
1304         }
1305         case WIN_REQHEIGHT: {
1306             Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
1307             break;
1308         }
1309         case WIN_REQWIDTH: {
1310             Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
1311             break;
1312         }
1313         case WIN_ROOTX: {
1314             Tk_GetRootCoords(tkwin, &x, &y);
1315             Tcl_SetIntObj(resultPtr, x);
1316             break;
1317         }
1318         case WIN_ROOTY: {
1319             Tk_GetRootCoords(tkwin, &x, &y);
1320             Tcl_SetIntObj(resultPtr, y);
1321             break;
1322         }
1323         case WIN_SCREEN: {
1324             char buf[TCL_INTEGER_SPACE];
1325
1326             sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
1327             Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".",
1328                     buf, NULL);
1329             break;
1330         }
1331         case WIN_SCREENCELLS: {
1332             Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
1333             break;
1334         }
1335         case WIN_SCREENDEPTH: {
1336             Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
1337             break;
1338         }
1339         case WIN_SCREENHEIGHT: {
1340             Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
1341             break;
1342         }
1343         case WIN_SCREENWIDTH: {
1344             Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
1345             break;
1346         }
1347         case WIN_SCREENMMHEIGHT: {
1348             Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
1349             break;
1350         }
1351         case WIN_SCREENMMWIDTH: {
1352             Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
1353             break;
1354         }
1355         case WIN_SCREENVISUAL: {
1356             class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
1357             goto visual;
1358         }
1359         case WIN_SERVER: {
1360             TkGetServerInfo(interp, tkwin);
1361             break;
1362         }
1363         case WIN_TOPLEVEL: {
1364             winPtr = GetToplevel(tkwin);
1365             if (winPtr != NULL) {
1366                 Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
1367             }
1368             break;
1369         }
1370         case WIN_VIEWABLE: {
1371             int viewable = 0;
1372             for ( ; ; winPtr = winPtr->parentPtr) {
1373                 if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
1374                     break;
1375                 }
1376                 if (winPtr->flags & TK_TOP_HIERARCHY) {
1377                     viewable = 1;
1378                     break;
1379                 }
1380             }
1381
1382             Tcl_SetBooleanObj(resultPtr, viewable);
1383             break;
1384         }
1385         case WIN_VISUAL: {
1386             class = Tk_Visual(tkwin)->class;
1387
1388             visual:
1389             string = TkFindStateString(visualMap, class);
1390             if (string == NULL) {
1391                 string = "unknown";
1392             }
1393             Tcl_SetStringObj(resultPtr, string, -1);
1394             break;
1395         }
1396         case WIN_VISUALID: {
1397             char buf[TCL_INTEGER_SPACE];
1398
1399             sprintf(buf, "0x%x",
1400                     (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
1401             Tcl_SetStringObj(resultPtr, buf, -1);
1402             break;
1403         }
1404         case WIN_VROOTHEIGHT: {
1405             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1406             Tcl_SetIntObj(resultPtr, height);
1407             break;
1408         }
1409         case WIN_VROOTWIDTH: {
1410             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1411             Tcl_SetIntObj(resultPtr, width);
1412             break;
1413         }
1414         case WIN_VROOTX: {
1415             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1416             Tcl_SetIntObj(resultPtr, x);
1417             break;
1418         }
1419         case WIN_VROOTY: {
1420             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1421             Tcl_SetIntObj(resultPtr, y);
1422             break;
1423         }
1424         case WIN_WIDTH: {
1425             Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
1426             break;
1427         }
1428         case WIN_X: {
1429             Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
1430             break;
1431         }
1432         case WIN_Y: {
1433             Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
1434             break;
1435         }
1436
1437         /*
1438          * Uses -displayof.
1439          */
1440
1441         case WIN_ATOM: {
1442             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1443             if (skip < 0) {
1444                 return TCL_ERROR;
1445             }
1446             if (objc - skip != 3) {
1447                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
1448                 return TCL_ERROR;
1449             }
1450             objv += skip;
1451             string = Tcl_GetStringFromObj(objv[2], NULL);
1452             Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
1453             break;
1454         }
1455         case WIN_ATOMNAME: {
1456             CONST char *name;
1457             long id;
1458
1459             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1460             if (skip < 0) {
1461                 return TCL_ERROR;
1462             }
1463             if (objc - skip != 3) {
1464                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
1465                 return TCL_ERROR;
1466             }
1467             objv += skip;
1468             if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
1469                 return TCL_ERROR;
1470             }
1471             name = Tk_GetAtomName(tkwin, (Atom) id);
1472             if (strcmp(name, "?bad atom?") == 0) {
1473                 string = Tcl_GetStringFromObj(objv[2], NULL);
1474                 Tcl_AppendStringsToObj(resultPtr,
1475                         "no atom exists with id \"", string, "\"", NULL);
1476                 return TCL_ERROR;
1477             }
1478             Tcl_SetStringObj(resultPtr, name, -1);
1479             break;
1480         }
1481         case WIN_CONTAINING: {
1482             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1483             if (skip < 0) {
1484                 return TCL_ERROR;
1485             }
1486             if (objc - skip != 4) {
1487                 Tcl_WrongNumArgs(interp, 2, objv,
1488                         "?-displayof window? rootX rootY");
1489                 return TCL_ERROR;
1490             }
1491             objv += skip;
1492             string = Tcl_GetStringFromObj(objv[2], NULL);
1493             if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
1494                 return TCL_ERROR;
1495             }
1496             string = Tcl_GetStringFromObj(objv[3], NULL);
1497             if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
1498                 return TCL_ERROR;
1499             }
1500             tkwin = Tk_CoordsToWindow(x, y, tkwin);
1501             if (tkwin != NULL) {
1502                 Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
1503             }
1504             break;
1505         }
1506         case WIN_INTERPS: {
1507             int result;
1508
1509             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1510             if (skip < 0) {
1511                 return TCL_ERROR;
1512             }
1513             if (objc - skip != 2) {
1514                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
1515                 return TCL_ERROR;
1516             }
1517             result = TkGetInterpNames(interp, tkwin);
1518             return result;
1519         }
1520         case WIN_PATHNAME: {
1521             Window id;
1522
1523             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1524             if (skip < 0) {
1525                 return TCL_ERROR;
1526             }
1527             if (objc - skip != 3) {
1528                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
1529                 return TCL_ERROR;
1530             }
1531             string = Tcl_GetStringFromObj(objv[2 + skip], NULL);
1532             if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
1533                 return TCL_ERROR;
1534             }
1535             winPtr = (TkWindow *)Tk_IdToWindow(Tk_Display(tkwin), id);
1536             if ((winPtr == NULL) ||
1537                     (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
1538                 Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
1539                         "\" doesn't exist in this application", (char *) NULL);
1540                 return TCL_ERROR;
1541             }
1542
1543             /*
1544              * If the window is a utility window with no associated path
1545              * (such as a wrapper window or send communication window), just
1546              * return an empty string.
1547              */
1548
1549             tkwin = (Tk_Window) winPtr;
1550             if (Tk_PathName(tkwin) != NULL) {
1551                 Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
1552             }
1553             break;
1554         }
1555
1556         /*
1557          * objv[3] is window.
1558          */
1559
1560         case WIN_EXISTS: {
1561             int alive;
1562
1563             if (objc != 3) {
1564                 Tcl_WrongNumArgs(interp, 2, objv, "window");
1565                 return TCL_ERROR;
1566             }
1567             string = Tcl_GetStringFromObj(objv[2], NULL);
1568             winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
1569             Tcl_ResetResult(interp);
1570             resultPtr = Tcl_GetObjResult(interp);
1571
1572             alive = 1;
1573             if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
1574                 alive = 0;
1575             }
1576             Tcl_SetBooleanObj(resultPtr, alive);
1577             break;
1578         }
1579         case WIN_FPIXELS: {
1580             double mm, pixels;
1581
1582             if (objc != 4) {
1583                 Tcl_WrongNumArgs(interp, 2, objv, "window number");
1584                 return TCL_ERROR;
1585             }
1586             string = Tcl_GetStringFromObj(objv[2], NULL);
1587             tkwin = Tk_NameToWindow(interp, string, tkwin);
1588             if (tkwin == NULL) {
1589                 return TCL_ERROR;
1590             }
1591             string = Tcl_GetStringFromObj(objv[3], NULL);
1592             if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
1593                 return TCL_ERROR;
1594             }
1595             pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
1596                     / WidthMMOfScreen(Tk_Screen(tkwin));
1597             Tcl_SetDoubleObj(resultPtr, pixels);
1598             break;
1599         }
1600         case WIN_PIXELS: {
1601             int pixels;
1602
1603             if (objc != 4) {
1604                 Tcl_WrongNumArgs(interp, 2, objv, "window number");
1605                 return TCL_ERROR;
1606             }
1607             string = Tcl_GetStringFromObj(objv[2], NULL);
1608             tkwin = Tk_NameToWindow(interp, string, tkwin);
1609             if (tkwin == NULL) {
1610                 return TCL_ERROR;
1611             }
1612             string = Tcl_GetStringFromObj(objv[3], NULL);
1613             if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
1614                 return TCL_ERROR;
1615             }
1616             Tcl_SetIntObj(resultPtr, pixels);
1617             break;
1618         }
1619         case WIN_RGB: {
1620             XColor *colorPtr;
1621             char buf[TCL_INTEGER_SPACE * 3];
1622
1623             if (objc != 4) {
1624                 Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
1625                 return TCL_ERROR;
1626             }
1627             string = Tcl_GetStringFromObj(objv[2], NULL);
1628             tkwin = Tk_NameToWindow(interp, string, tkwin);
1629             if (tkwin == NULL) {
1630                 return TCL_ERROR;
1631             }
1632             string = Tcl_GetStringFromObj(objv[3], NULL);
1633             colorPtr = Tk_GetColor(interp, tkwin, string);
1634             if (colorPtr == NULL) {
1635                 return TCL_ERROR;
1636             }
1637             sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
1638                     colorPtr->blue);
1639             Tk_FreeColor(colorPtr);
1640             Tcl_SetStringObj(resultPtr, buf, -1);
1641             break;
1642         }
1643         case WIN_VISUALSAVAILABLE: {
1644             XVisualInfo template, *visInfoPtr;
1645             int count, i;
1646             int includeVisualId;
1647             Tcl_Obj *strPtr;
1648             char buf[16 + TCL_INTEGER_SPACE];
1649             char visualIdString[TCL_INTEGER_SPACE];
1650
1651             if (objc == 3) {
1652                 includeVisualId = 0;
1653             } else if ((objc == 4)
1654                     && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
1655                             "includeids") == 0)) {
1656                 includeVisualId = 1;
1657             } else {
1658                 Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
1659                 return TCL_ERROR;
1660             }
1661
1662             string = Tcl_GetStringFromObj(objv[2], NULL);
1663             tkwin = Tk_NameToWindow(interp, string, tkwin);
1664             if (tkwin == NULL) {
1665                 return TCL_ERROR;
1666             }
1667
1668             template.screen = Tk_ScreenNumber(tkwin);
1669             visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
1670                     &template, &count);
1671             if (visInfoPtr == NULL) {
1672                 Tcl_SetStringObj(resultPtr,
1673                         "can't find any visuals for screen", -1);
1674                 return TCL_ERROR;
1675             }
1676             for (i = 0; i < count; i++) {
1677                 string = TkFindStateString(visualMap, visInfoPtr[i].class);
1678                 if (string == NULL) {
1679                     strcpy(buf, "unknown");
1680                 } else {
1681                     sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
1682                 }
1683                 if (includeVisualId) {
1684                     sprintf(visualIdString, " 0x%x",
1685                             (unsigned int) visInfoPtr[i].visualid);
1686                     strcat(buf, visualIdString);
1687                 }
1688                 strPtr = Tcl_NewStringObj(buf, -1);
1689                 Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
1690             }
1691             XFree((char *) visInfoPtr);
1692             break;
1693         }
1694     }
1695     return TCL_OK;
1696 }
1697 \f
1698 #if 0
1699 /*
1700  *----------------------------------------------------------------------
1701  *
1702  * Tk_WmObjCmd --
1703  *
1704  *      This procedure is invoked to process the "wm" Tcl command.
1705  *      See the user documentation for details on what it does.
1706  *
1707  * Results:
1708  *      A standard Tcl result.
1709  *
1710  * Side effects:
1711  *      See the user documentation.
1712  *
1713  *----------------------------------------------------------------------
1714  */
1715
1716         /* ARGSUSED */
1717 int
1718 Tk_WmObjCmd(clientData, interp, objc, objv)
1719     ClientData clientData;      /* Main window associated with
1720                                  * interpreter. */
1721     Tcl_Interp *interp;         /* Current interpreter. */
1722     int objc;                   /* Number of arguments. */
1723     Tcl_Obj *CONST objv[];      /* Argument objects. */
1724 {
1725     Tk_Window tkwin;
1726     TkWindow *winPtr;
1727
1728     static CONST char *optionStrings[] = {
1729         "aspect",       "client",       "command",      "deiconify",
1730         "focusmodel",   "frame",        "geometry",     "grid",
1731         "group",        "iconbitmap",   "iconify",      "iconmask",
1732         "iconname",     "iconposition", "iconwindow",   "maxsize",
1733         "minsize",      "overrideredirect",     "positionfrom", "protocol",
1734         "resizable",    "sizefrom",     "state",        "title",
1735         "tracing",      "transient",    "withdraw",     (char *) NULL
1736     };
1737     enum options {
1738         TKWM_ASPECT,    TKWM_CLIENT,    TKWM_COMMAND,   TKWM_DEICONIFY,
1739         TKWM_FOCUSMOD,  TKWM_FRAME,     TKWM_GEOMETRY,  TKWM_GRID,
1740         TKWM_GROUP,     TKWM_ICONBMP,   TKWM_ICONIFY,   TKWM_ICONMASK,
1741         TKWM_ICONNAME,  TKWM_ICONPOS,   TKWM_ICONWIN,   TKWM_MAXSIZE,
1742         TKWM_MINSIZE,   TKWM_OVERRIDE,  TKWM_POSFROM,   TKWM_PROTOCOL,
1743         TKWM_RESIZABLE, TKWM_SIZEFROM,  TKWM_STATE,     TKWM_TITLE,
1744         TKWM_TRACING,   TKWM_TRANSIENT, TKWM_WITHDRAW
1745     };
1746
1747     tkwin = (Tk_Window) clientData;
1748
1749     if (objc < 2) {
1750         Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");
1751         return TCL_ERROR;
1752     }
1753     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
1754             &index) != TCL_OK) {
1755         return TCL_ERROR;
1756     }
1757
1758     if (index == TKWM_TRACING) {
1759         int wmTracing;
1760         TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
1761
1762         if ((objc != 2) && (objc != 3)) {
1763             Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");
1764             return TCL_ERROR;
1765         }
1766         if (objc == 2) {
1767             Tcl_SetObjResult(interp,
1768                     Tcl_NewBooleanObj(dispPtr->flags & TK_DISPLAY_WM_TRACING));
1769             return TCL_OK;
1770         }
1771         if (Tcl_GetBooleanFromObj(interp, objv[2], &wmTracing) != TCL_OK) {
1772             return TCL_ERROR;
1773         }
1774         if (wmTracing) {
1775             dispPtr->flags |= TK_DISPLAY_WM_TRACING;
1776         } else {
1777             dispPtr->flags &= ~TK_DISPLAY_WM_TRACING;
1778         }
1779         return TCL_OK;
1780     }
1781
1782     if (objc < 3) {
1783         Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");
1784         return TCL_ERROR;
1785     }
1786
1787     winPtr = (TkWindow *) Tk_NameToWindow(interp,
1788             Tcl_GetString(objv[2]), tkwin);
1789     if (winPtr == NULL) {
1790         return TCL_ERROR;
1791     }
1792     if (!(winPtr->flags & TK_TOP_LEVEL)) {
1793         Tcl_AppendResult(interp, "window \"", winPtr->pathName,
1794                 "\" isn't a top-level window", (char *) NULL);
1795         return TCL_ERROR;
1796     }
1797
1798     switch ((enum options) index) {
1799         case TKWM_ASPECT: {
1800             TkpWmAspectCmd(interp, tkwin, winPtr, objc, objv);
1801             break;
1802         }
1803         case TKWM_CLIENT: {
1804             TkpWmClientCmd(interp, tkwin, winPtr, objc, objv);
1805             break;
1806         }
1807         case TKWM_COMMAND: {
1808             TkpWmCommandCmd(interp, tkwin, winPtr, objc, objv);
1809             break;
1810         }
1811         case TKWM_DEICONIFY: {
1812             TkpWmDeiconifyCmd(interp, tkwin, winPtr, objc, objv);
1813             break;
1814         }
1815         case TKWM_FOCUSMOD: {
1816             TkpWmFocusmodCmd(interp, tkwin, winPtr, objc, objv);
1817             break;
1818         }
1819         case TKWM_FRAME: {
1820             TkpWmFrameCmd(interp, tkwin, winPtr, objc, objv);
1821             break;
1822         }
1823         case TKWM_GEOMETRY: {
1824             TkpWmGeometryCmd(interp, tkwin, winPtr, objc, objv);
1825             break;
1826         }
1827         case TKWM_GRID: {
1828             TkpWmGridCmd(interp, tkwin, winPtr, objc, objv);
1829             break;
1830         }
1831         case TKWM_GROUP: {
1832             TkpWmGroupCmd(interp, tkwin, winPtr, objc, objv);
1833             break;
1834         }
1835         case TKWM_ICONBMP: {
1836             TkpWmIconbitmapCmd(interp, tkwin, winPtr, objc, objv);
1837             break;
1838         }
1839         case TKWM_ICONIFY: {
1840             TkpWmIconifyCmd(interp, tkwin, winPtr, objc, objv);
1841             break;
1842         }
1843         case TKWM_ICONMASK: {
1844             TkpWmIconmaskCmd(interp, tkwin, winPtr, objc, objv);
1845             break;
1846         }
1847         case TKWM_ICONNAME: {
1848             /* slight Unix variation */
1849             TkpWmIconnameCmd(interp, tkwin, winPtr, objc, objv);
1850             break;
1851         }
1852         case TKWM_ICONPOS: {
1853             /* nearly same - 1 line more on Unix */
1854             TkpWmIconpositionCmd(interp, tkwin, winPtr, objc, objv);
1855             break;
1856         }
1857         case TKWM_ICONWIN: {
1858             TkpWmIconwindowCmd(interp, tkwin, winPtr, objc, objv);
1859             break;
1860         }
1861         case TKWM_MAXSIZE: {
1862             /* nearly same, win diffs */
1863             TkpWmMaxsizeCmd(interp, tkwin, winPtr, objc, objv);
1864             break;
1865         }
1866         case TKWM_MINSIZE: {
1867             /* nearly same, win diffs */
1868             TkpWmMinsizeCmd(interp, tkwin, winPtr, objc, objv);
1869             break;
1870         }
1871         case TKWM_OVERRIDE: {
1872             /* almost same */
1873             TkpWmOverrideCmd(interp, tkwin, winPtr, objc, objv);
1874             break;
1875         }
1876         case TKWM_POSFROM: {
1877             /* Equal across platforms */
1878             TkpWmPositionfromCmd(interp, tkwin, winPtr, objc, objv);
1879             break;
1880         }
1881         case TKWM_PROTOCOL: {
1882             /* Equal across platforms */
1883             TkpWmProtocolCmd(interp, tkwin, winPtr, objc, objv);
1884             break;
1885         }
1886         case TKWM_RESIZABLE: {
1887             /* almost same */
1888             TkpWmResizableCmd(interp, tkwin, winPtr, objc, objv);
1889             break;
1890         }
1891         case TKWM_SIZEFROM: {
1892             /* Equal across platforms */
1893             TkpWmSizefromCmd(interp, tkwin, winPtr, objc, objv);
1894             break;
1895         }
1896         case TKWM_STATE: {
1897             TkpWmStateCmd(interp, tkwin, winPtr, objc, objv);
1898             break;
1899         }
1900         case TKWM_TITLE: {
1901             TkpWmTitleCmd(interp, tkwin, winPtr, objc, objv);
1902             break;
1903         }
1904         case TKWM_TRANSIENT: {
1905             TkpWmTransientCmd(interp, tkwin, winPtr, objc, objv);
1906             break;
1907         }
1908         case TKWM_WITHDRAW: {
1909             TkpWmWithdrawCmd(interp, tkwin, winPtr, objc, objv);
1910             break;
1911         }
1912     }
1913
1914     updateGeom:
1915     if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
1916         Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
1917         wmPtr->flags |= WM_UPDATE_PENDING;
1918     }
1919     return TCL_OK;
1920 }
1921 #endif
1922 \f
1923 /*
1924  *----------------------------------------------------------------------
1925  *
1926  * TkGetDisplayOf --
1927  *
1928  *      Parses a "-displayof window" option for various commands.  If
1929  *      present, the literal "-displayof" should be in objv[0] and the
1930  *      window name in objv[1].
1931  *
1932  * Results:
1933  *      The return value is 0 if the argument strings did not contain
1934  *      the "-displayof" option.  The return value is 2 if the
1935  *      argument strings contained both the "-displayof" option and
1936  *      a valid window name.  Otherwise, the return value is -1 if
1937  *      the window name was missing or did not specify a valid window.
1938  *
1939  *      If the return value was 2, *tkwinPtr is filled with the
1940  *      token for the window specified on the command line.  If the
1941  *      return value was -1, an error message is left in interp's
1942  *      result object.
1943  *
1944  * Side effects:
1945  *      None.
1946  *
1947  *----------------------------------------------------------------------
1948  */
1949
1950 int
1951 TkGetDisplayOf(interp, objc, objv, tkwinPtr)
1952     Tcl_Interp *interp;         /* Interpreter for error reporting. */
1953     int objc;                   /* Number of arguments. */
1954     Tcl_Obj *CONST objv[];      /* Argument objects. If it is present,
1955                                  * "-displayof" should be in objv[0] and
1956                                  * objv[1] the name of a window. */
1957     Tk_Window *tkwinPtr;        /* On input, contains main window of
1958                                  * application associated with interp.  On
1959                                  * output, filled with window specified as
1960                                  * option to "-displayof" argument, or
1961                                  * unmodified if "-displayof" argument was not
1962                                  * present. */
1963 {
1964     char *string;
1965     int length;
1966
1967     if (objc < 1) {
1968         return 0;
1969     }
1970     string = Tcl_GetStringFromObj(objv[0], &length);
1971     if ((length >= 2) &&
1972             (strncmp(string, "-displayof", (unsigned) length) == 0)) {
1973         if (objc < 2) {
1974             Tcl_SetStringObj(Tcl_GetObjResult(interp),
1975                     "value for \"-displayof\" missing", -1);
1976             return -1;
1977         }
1978         string = Tcl_GetStringFromObj(objv[1], NULL);
1979         *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr);
1980         if (*tkwinPtr == NULL) {
1981             return -1;
1982         }
1983         return 2;
1984     }
1985     return 0;
1986 }
1987 \f
1988 /*
1989  *----------------------------------------------------------------------
1990  *
1991  * TkDeadAppCmd --
1992  *
1993  *      If an application has been deleted then all Tk commands will be
1994  *      re-bound to this procedure.
1995  *
1996  * Results:
1997  *      A standard Tcl error is reported to let the user know that
1998  *      the application is dead.
1999  *
2000  * Side effects:
2001  *      See the user documentation.
2002  *
2003  *----------------------------------------------------------------------
2004  */
2005
2006         /* ARGSUSED */
2007 int
2008 TkDeadAppCmd(clientData, interp, argc, argv)
2009     ClientData clientData;      /* Dummy. */
2010     Tcl_Interp *interp;         /* Current interpreter. */
2011     int argc;                   /* Number of arguments. */
2012     CONST char **argv;          /* Argument strings. */
2013 {
2014     Tcl_AppendResult(interp, "can't invoke \"", argv[0],
2015             "\" command:  application has been destroyed", (char *) NULL);
2016     return TCL_ERROR;
2017 }
2018 \f
2019 /*
2020  *----------------------------------------------------------------------
2021  *
2022  * GetToplevel --
2023  *
2024  *      Retrieves the toplevel window which is the nearest ancestor of
2025  *      of the specified window.
2026  *
2027  * Results:
2028  *      Returns the toplevel window or NULL if the window has no
2029  *      ancestor which is a toplevel.
2030  *
2031  * Side effects:
2032  *      None.
2033  *
2034  *----------------------------------------------------------------------
2035  */
2036
2037 static TkWindow *
2038 GetToplevel(tkwin)
2039     Tk_Window tkwin;            /* Window for which the toplevel should be
2040                                  * deterined. */
2041 {
2042      TkWindow *winPtr = (TkWindow *) tkwin;
2043
2044      while (!(winPtr->flags & TK_TOP_LEVEL)) {
2045          winPtr = winPtr->parentPtr;
2046          if (winPtr == NULL) {
2047              return NULL;
2048          }
2049      }
2050      return winPtr;
2051 }