git.zerfleddert.de Git - micropolis/blob - src/tk/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 1990-1992 Regents of the University of California
   8  * Permission to use, copy, modify, and distribute this
   9  * software and its documentation for any purpose and without
  10  * fee is hereby granted, provided that the above copyright
  11  * notice appear in all copies.  The University of California
  12  * makes no representations about the suitability of this
  13  * software for any purpose.  It is provided "as is" without
  14  * express or implied warranty.
  15  */
  16
  17 #ifndef lint
  18 static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkCmds.c,v 1.32 92/06/03 14:21:14 ouster Exp $ SPRITE (Berkeley)";
  19 #endif /* not lint */
  20
  21 #include "tkconfig.h"
  22 #include "tkint.h"
  23
  24 /*
  25  * The data structure below is used by the "after" command to remember
  26  * the command to be executed later.
  27  */
  28
  29 typedef struct {
  30     Tcl_Interp *interp;         /* Interpreter in which to execute command. */
  31     char *command;              /* Command to execute.  Malloc'ed, so must
  32                                  * be freed when structure is deallocated.
  33                                  * NULL means nothing to execute. */
  34     int *donePtr;               /* If non-NULL indicates address of word to
  35                                  * set to 1 when command has finally been
  36                                  * executed. */
  37 } AfterInfo;
  38
  39 /*
  40  * Forward declarations for procedures defined later in this file:
  41  */
  42
  43 static void             AfterProc _ANSI_ARGS_((ClientData clientData));
  44 static char *           WaitVariableProc _ANSI_ARGS_((ClientData clientData,
  45                             Tcl_Interp *interp, char *name1, char *name2,
  46                             int flags));
  47 static void             WaitWindowProc _ANSI_ARGS_((ClientData clientData,
  48                             XEvent *eventPtr));
  49 \f
  50 /*
  51  *----------------------------------------------------------------------
  52  *
  53  * Tk_AfterCmd --
  54  *
  55  *      This procedure is invoked to process the "after" Tcl command.
  56  *      See the user documentation for details on what it does.
  57  *
  58  * Results:
  59  *      A standard Tcl result.
  60  *
  61  * Side effects:
  62  *      See the user documentation.
  63  *
  64  *----------------------------------------------------------------------
  65  */
  66
  67         /* ARGSUSED */
  68 int
  69 Tk_AfterCmd(clientData, interp, argc, argv)
  70     ClientData clientData;      /* Main window associated with
  71                                  * interpreter.  Not used.*/
  72     Tcl_Interp *interp;         /* Current interpreter. */
  73     int argc;                   /* Number of arguments. */
  74     char **argv;                /* Argument strings. */
  75 {
  76     int ms;
  77     AfterInfo *afterPtr;
  78     int done;
  79
  80     if (argc < 2) {
  81         Tcl_AppendResult(interp, "wrong # args: should be \"",
  82                 argv[0], " milliseconds ?command? ?arg arg ...?\"",
  83                 (char *) NULL);
  84         return TCL_ERROR;
  85     }
  86
  87     if ((Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) || (ms <= 0)) {
  88         Tcl_AppendResult(interp, "bad milliseconds value \"",
  89                 argv[1], "\"", (char *) NULL);
  90         return TCL_ERROR;
  91     }
  92     afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
  93     afterPtr->interp = interp;
  94     if (argc == 2) {
  95         afterPtr->command = (char *) NULL;
  96         done = 0;
  97         afterPtr->donePtr = &done;
  98     } else if (argc == 3) {
  99         afterPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
 100         strcpy(afterPtr->command, argv[2]);
 101         afterPtr->donePtr = (int *) NULL;
 102     } else {
 103         afterPtr->command = Tcl_Concat(argc-2, argv+2);
 104         afterPtr->donePtr = (int *) NULL;
 105     }
 106     Tk_CreateTimerHandler(ms, AfterProc, (ClientData) afterPtr);
 107     if (argc == 2) {
 108         while (!done) {
 109             Tk_DoOneEvent(0);
 110         }
 111     }
 112
 113     /*
 114      * Must reset interpreter result because it could have changed as
 115      * part of events processed by Tk_DoOneEvent.
 116      */
 117
 118     Tcl_ResetResult(interp);
 119     return TCL_OK;
 120 }
 121 \f
 122 /*
 123  *----------------------------------------------------------------------
 124  *
 125  * AfterProc --
 126  *
 127  *      Timer callback to execute commands registered with the
 128  *      "after" command.
 129  *
 130  * Results:
 131  *      None.
 132  *
 133  * Side effects:
 134  *      Executes whatever command was specified.  If the command
 135  *      returns an error, then the command "tkerror" is invoked
 136  *      to process the error;  if tkerror fails then information
 137  *      about the error is output on stderr.
 138  *
 139  *----------------------------------------------------------------------
 140  */
 141
 142 static void
 143 AfterProc(clientData)
 144     ClientData clientData;      /* Describes command to execute. */
 145 {
 146     AfterInfo *afterPtr = (AfterInfo *) clientData;
 147     int result;
 148
 149     if (afterPtr->command != NULL) {
 150         result = Tcl_GlobalEval(afterPtr->interp, afterPtr->command);
 151         if (result != TCL_OK) {
 152             TkBindError(afterPtr->interp);
 153         }
 154         ckfree(afterPtr->command);
 155     }
 156     if (afterPtr->donePtr != NULL) {
 157         *afterPtr->donePtr = 1;
 158     }
 159     ckfree((char *) afterPtr);
 160 }
 161 \f
 162 /*
 163  *----------------------------------------------------------------------
 164  *
 165  * Tk_BindCmd --
 166  *
 167  *      This procedure is invoked to process the "bind" Tcl command.
 168  *      See the user documentation for details on what it does.
 169  *
 170  * Results:
 171  *      A standard Tcl result.
 172  *
 173  * Side effects:
 174  *      See the user documentation.
 175  *
 176  *----------------------------------------------------------------------
 177  */
 178
 179 int
 180 Tk_BindCmd(clientData, interp, argc, argv)
 181     ClientData clientData;              /* Main window associated with
 182                                  * interpreter. */
 183     Tcl_Interp *interp;         /* Current interpreter. */
 184     int argc;                   /* Number of arguments. */
 185     char **argv;                /* Argument strings. */
 186 {
 187     Tk_Window tkwin = (Tk_Window) clientData;
 188     TkWindow *winPtr;
 189     ClientData object;
 190
 191     if ((argc < 2) || (argc > 4)) {
 192         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 193                 " window ?pattern? ?command?\"", (char *) NULL);
 194         return TCL_ERROR;
 195     }
 196     if (argv[1][0] == '.') {
 197         winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
 198         if (winPtr == NULL) {
 199             return TCL_ERROR;
 200         }
 201         object = (ClientData) winPtr->pathName;
 202     } else {
 203         winPtr = (TkWindow *) clientData;
 204         object = (ClientData) Tk_GetUid(argv[1]);
 205     }
 206
 207     if (argc == 4) {
 208         int append = 0;
 209         unsigned long mask;
 210
 211         if (argv[3][0] == 0) {
 212             return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
 213                     object, argv[2]);
 214         }
 215         if (argv[3][0] == '+') {
 216             argv[3]++;
 217             append = 1;
 218         }
 219         mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
 220                 object, argv[2], argv[3], append);
 221         if (mask == 0) {
 222             return TCL_ERROR;
 223         }
 224     } else if (argc == 3) {
 225         char *command;
 226
 227         command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
 228                 object, argv[2]);
 229         if (command == NULL) {
 230             Tcl_ResetResult(interp);
 231             return TCL_OK;
 232         }
 233         interp->result = command;
 234     } else {
 235         Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
 236     }
 237     return TCL_OK;
 238 }
 239 \f
 240 /*
 241  *----------------------------------------------------------------------
 242  *
 243  * TkBindEventProc --
 244  *
 245  *      This procedure is invoked by Tk_HandleEvent for each event;  it
 246  *      causes any appropriate bindings for that event to be invoked.
 247  *
 248  * Results:
 249  *      None.
 250  *
 251  * Side effects:
 252  *      Depends on what bindings have been established with the "bind"
 253  *      command.
 254  *
 255  *----------------------------------------------------------------------
 256  */
 257
 258 void
 259 TkBindEventProc(winPtr, eventPtr)
 260     TkWindow *winPtr;                   /* Pointer to info about window. */
 261     XEvent *eventPtr;                   /* Information about event. */
 262 {
 263     ClientData objects[3];
 264     static Tk_Uid allUid = NULL;
 265
 266     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
 267         return;
 268     }
 269     objects[0] = (ClientData) winPtr->pathName;
 270     objects[1] = (ClientData) winPtr->classUid;
 271     if (allUid == NULL) {
 272         allUid = Tk_GetUid("all");
 273     }
 274     objects[2] = (ClientData) allUid;
 275     Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr,
 276             (Tk_Window) winPtr, 3, objects);
 277 }
 278 \f
 279 /*
 280  *----------------------------------------------------------------------
 281  *
 282  * Tk_DestroyCmd --
 283  *
 284  *      This procedure is invoked to process the "destroy" Tcl command.
 285  *      See the user documentation for details on what it does.
 286  *
 287  * Results:
 288  *      A standard Tcl result.
 289  *
 290  * Side effects:
 291  *      See the user documentation.
 292  *
 293  *----------------------------------------------------------------------
 294  */
 295
 296 int
 297 Tk_DestroyCmd(clientData, interp, argc, argv)
 298     ClientData clientData;              /* Main window associated with
 299                                  * interpreter. */
 300     Tcl_Interp *interp;         /* Current interpreter. */
 301     int argc;                   /* Number of arguments. */
 302     char **argv;                /* Argument strings. */
 303 {
 304     Tk_Window window;
 305     Tk_Window tkwin = (Tk_Window) clientData;
 306
 307     if (argc != 2) {
 308         Tcl_AppendResult(interp, "wrong # args: should be \"",
 309                 argv[0], " pathName\"", (char *) NULL);
 310         return TCL_ERROR;
 311     }
 312
 313     window = Tk_NameToWindow(interp, argv[1], tkwin);
 314     if (window == NULL) {
 315         return TCL_ERROR;
 316     }
 317     Tk_DestroyWindow(window);
 318     return TCL_OK;
 319 }
 320 \f
 321 /*
 322  *----------------------------------------------------------------------
 323  *
 324  * Tk_UpdateCmd --
 325  *
 326  *      This procedure is invoked to process the "update" Tcl command.
 327  *      See the user documentation for details on what it does.
 328  *
 329  * Results:
 330  *      A standard Tcl result.
 331  *
 332  * Side effects:
 333  *      See the user documentation.
 334  *
 335  *----------------------------------------------------------------------
 336  */
 337
 338         /* ARGSUSED */
 339 int
 340 Tk_UpdateCmd(clientData, interp, argc, argv)
 341     ClientData clientData;      /* Main window associated with
 342                                  * interpreter. */
 343     Tcl_Interp *interp;         /* Current interpreter. */
 344     int argc;                   /* Number of arguments. */
 345     char **argv;                /* Argument strings. */
 346 {
 347     Tk_Window tkwin = (Tk_Window) clientData;
 348     int flags;
 349
 350     if (argc == 1) {
 351         flags = TK_DONT_WAIT;
 352     } else if (argc == 2) {
 353         if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
 354             Tcl_AppendResult(interp, "bad argument \"", argv[1],
 355                     "\": must be idletasks", (char *) NULL);
 356             return TCL_ERROR;
 357         }
 358         flags = TK_IDLE_EVENTS;
 359     } else {
 360         Tcl_AppendResult(interp, "wrong # args: should be \"",
 361                 argv[0], " ?idletasks?\"", (char *) NULL);
 362         return TCL_ERROR;
 363     }
 364
 365     /*
 366      * Handle all pending events, sync the display, and repeat over
 367      * and over again until all pending events have been handled.
 368      */
 369
 370     while (1) {
 371         while (Tk_DoOneEvent(flags) != 0) {
 372             /* Empty loop body */
 373         }
 374         XSync(Tk_Display(tkwin), False);
 375         if (Tk_DoOneEvent(flags) == 0) {
 376             break;
 377         }
 378     }
 379
 380     /*
 381      * Must clear the interpreter's result because event handlers could
 382      * have executed commands.
 383      */
 384
 385     Tcl_ResetResult(interp);
 386     return TCL_OK;
 387 }
 388 \f
 389 /*
 390  *----------------------------------------------------------------------
 391  *
 392  * Tk_TkwaitCmd --
 393  *
 394  *      This procedure is invoked to process the "wait" Tcl command.
 395  *      See the user documentation for details on what it does.
 396  *
 397  * Results:
 398  *      A standard Tcl result.
 399  *
 400  * Side effects:
 401  *      See the user documentation.
 402  *
 403  *----------------------------------------------------------------------
 404  */
 405
 406         /* ARGSUSED */
 407 int
 408 Tk_TkwaitCmd(clientData, interp, argc, argv)
 409     ClientData clientData;      /* Main window associated with
 410                                  * interpreter. */
 411     Tcl_Interp *interp;         /* Current interpreter. */
 412     int argc;                   /* Number of arguments. */
 413     char **argv;                /* Argument strings. */
 414 {
 415     Tk_Window tkwin = (Tk_Window) clientData;
 416     int c, length;
 417     int done;
 418
 419     if (argc != 3) {
 420         Tcl_AppendResult(interp, "wrong # args: should be \"",
 421                 argv[0], " variable|window name\"", (char *) NULL);
 422         return TCL_ERROR;
 423     }
 424     c = argv[1][0];
 425     length = strlen(argv[1]);
 426     if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)) {
 427         Tcl_TraceVar(interp, argv[2],
 428                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 429                 WaitVariableProc, (ClientData) &done);
 430         done = 0;
 431         while (!done) {
 432             Tk_DoOneEvent(0);
 433         }
 434         Tcl_UntraceVar(interp, argv[2],
 435                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
 436                 WaitVariableProc, (ClientData) &done);
 437     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
 438         Tk_Window window;
 439
 440         window = Tk_NameToWindow(interp, argv[2], tkwin);
 441         if (window == NULL) {
 442             return TCL_ERROR;
 443         }
 444         Tk_CreateEventHandler(window, StructureNotifyMask,
 445             WaitWindowProc, (ClientData) &done);
 446         done = 0;
 447         while (!done) {
 448             Tk_DoOneEvent(0);
 449         }
 450         Tk_DeleteEventHandler(window, StructureNotifyMask,
 451             WaitWindowProc, (ClientData) &done);
 452     } else {
 453         Tcl_AppendResult(interp, "bad option \"", argv[1],
 454                 "\": must be variable or window", (char *) NULL);
 455         return TCL_ERROR;
 456     }
 457
 458     /*
 459      * Clear out the interpreter's result, since it may have been set
 460      * by event handlers.
 461      */
 462
 463     Tcl_ResetResult(interp);
 464     return TCL_OK;
 465 }
 466
 467         /* ARGSUSED */
 468 static char *
 469 WaitVariableProc(clientData, interp, name1, name2, flags)
 470     ClientData clientData;      /* Pointer to integer to set to 1. */
 471     Tcl_Interp *interp;         /* Interpreter containing variable. */
 472     char *name1;                /* Name of variable. */
 473     char *name2;                /* Second part of variable name. */
 474     int flags;                  /* Information about what happened. */
 475 {
 476     int *donePtr = (int *) clientData;
 477
 478     *donePtr = 1;
 479     return (char *) NULL;
 480 }
 481
 482 static void
 483 WaitWindowProc(clientData, eventPtr)
 484     ClientData clientData;      /* Pointer to integer to set to 1. */
 485     XEvent *eventPtr;           /* Information about event. */
 486 {
 487     int *donePtr = (int *) clientData;
 488
 489     if (eventPtr->type == DestroyNotify) {
 490         *donePtr = 1;
 491     }
 492 }
 493 \f
 494 /*
 495  *----------------------------------------------------------------------
 496  *
 497  * Tk_WinfoCmd --
 498  *
 499  *      This procedure is invoked to process the "winfo" Tcl command.
 500  *      See the user documentation for details on what it does.
 501  *
 502  * Results:
 503  *      A standard Tcl result.
 504  *
 505  * Side effects:
 506  *      See the user documentation.
 507  *
 508  *----------------------------------------------------------------------
 509  */
 510
 511 int
 512 Tk_WinfoCmd(clientData, interp, argc, argv)
 513     ClientData clientData;      /* Main window associated with
 514                                  * interpreter. */
 515     Tcl_Interp *interp;         /* Current interpreter. */
 516     int argc;                   /* Number of arguments. */
 517     char **argv;                /* Argument strings. */
 518 {
 519     Tk_Window tkwin = (Tk_Window) clientData;
 520     int length;
 521     char c, *argName;
 522     Tk_Window window;
 523     register TkWindow *winPtr;
 524
 525 #define SETUP(name) \
 526     if (argc != 3) {\
 527         argName = name; \
 528         goto wrongArgs; \
 529     } \
 530     window = Tk_NameToWindow(interp, argv[2], tkwin); \
 531     if (window == NULL) { \
 532         return TCL_ERROR; \
 533     }
 534
 535     if (argc < 2) {
 536         Tcl_AppendResult(interp, "wrong # args: should be \"",
 537                 argv[0], " option ?arg?\"", (char *) NULL);
 538         return TCL_ERROR;
 539     }
 540     c = argv[1][0];
 541     length = strlen(argv[1]);
 542     if ((c == 'a') && (strcmp(argv[1], "atom") == 0)) {
 543         if (argc != 3) {
 544             Tcl_AppendResult(interp, "wrong # args: should be \"",
 545                     argv[0], " atom name\"", (char *) NULL);
 546             return TCL_ERROR;
 547         }
 548         sprintf(interp->result, "%d", Tk_InternAtom(tkwin, argv[2]));
 549     } else if ((c == 'a') && (strncmp(argv[1], "atomname", length) == 0)
 550             && (length >= 5)) {
 551         Atom atom;
 552         char *name;
 553
 554         if (argc != 3) {
 555             Tcl_AppendResult(interp, "wrong # args: should be \"",
 556                     argv[0], " atomname id\"", (char *) NULL);
 557             return TCL_ERROR;
 558         }
 559         if (Tcl_GetInt(interp, argv[2], (int *) &atom) != TCL_OK) {
 560             return TCL_ERROR;
 561         }
 562         name = Tk_GetAtomName(tkwin, atom);
 563         if (strcmp(name, "?bad atom?") == 0) {
 564             Tcl_AppendResult(interp, "no atom exists with id \"",
 565                     argv[2], "\"", (char *) NULL);
 566             return TCL_ERROR;
 567         }
 568         interp->result = name;
 569     } else if ((c == 'c') && (strncmp(argv[1], "children", length) == 0)
 570             && (length >= 2)) {
 571         char *separator, *childName;
 572
 573         SETUP("children");
 574         separator = "";
 575         for (winPtr = ((TkWindow *) window)->childList; winPtr != NULL;
 576                 winPtr = winPtr->nextPtr) {
 577             childName = Tcl_Merge(1, &winPtr->pathName);
 578             Tcl_AppendResult(interp, separator, childName, (char *) NULL);
 579             ckfree(childName);
 580             separator = " ";
 581         }
 582     } else if ((c == 'c') && (strncmp(argv[1], "class", length) == 0)
 583             && (length >= 2)) {
 584         SETUP("class");
 585         interp->result = Tk_Class(window);
 586     } else if ((c == 'c') && (strncmp(argv[1], "containing", length) == 0)
 587             && (length >= 2)) {
 588         int rootX, rootY;
 589
 590         if (argc != 4) {
 591             Tcl_AppendResult(interp, "wrong # args: should be \"",
 592                     argv[0], " containing rootX rootY\"", (char *) NULL);
 593             return TCL_ERROR;
 594         }
 595         if ((Tk_GetPixels(interp, tkwin, argv[2], &rootX) != TCL_OK)
 596                 || (Tk_GetPixels(interp, tkwin, argv[3], &rootY) != TCL_OK)) {
 597             return TCL_ERROR;
 598         }
 599         window = Tk_CoordsToWindow(rootX, rootY, tkwin);
 600         if (window != NULL) {
 601             interp->result = Tk_PathName(window);
 602         }
 603     } else if ((c == 'f') && (strncmp(argv[1], "fpixels", length) == 0)
 604             && (length >= 2)) {
 605         double mm, pixels;
 606
 607         if (argc != 4) {
 608             Tcl_AppendResult(interp, "wrong # args: should be \"",
 609                     argv[0], " fpixels window number\"", (char *) NULL);
 610             return TCL_ERROR;
 611         }
 612         window = Tk_NameToWindow(interp, argv[2], tkwin);
 613         if (window == NULL) {
 614             return TCL_ERROR;
 615         }
 616         if (Tk_GetScreenMM(interp, window, argv[3], &mm) != TCL_OK) {
 617             return TCL_ERROR;
 618         }
 619         pixels = mm * WidthOfScreen(Tk_Screen(window))
 620                 / WidthMMOfScreen(Tk_Screen(window));
 621         sprintf(interp->result, "%g", pixels);
 622     } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)) {
 623         SETUP("geometry");
 624         sprintf(interp->result, "%dx%d+%d+%d", Tk_Width(window),
 625                 Tk_Height(window), Tk_X(window), Tk_Y(window));
 626     } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
 627         SETUP("height");
 628         sprintf(interp->result, "%d", Tk_Height(window));
 629     } else if ((c == 'i') && (strcmp(argv[1], "id") == 0)) {
 630         SETUP("id");
 631         sprintf(interp->result, "0x%x", Tk_WindowId(window));
 632     } else if ((c == 'i') && (strncmp(argv[1], "interps", length) == 0)
 633             && (length >= 2)) {
 634         if (argc != 2) {
 635             Tcl_AppendResult(interp, "wrong # args:  should be \"",
 636                     argv[1], " interps\"", (char *) NULL);
 637             return TCL_ERROR;
 638         }
 639         return TkGetInterpNames(interp, tkwin);
 640     } else if ((c == 'i') && (strncmp(argv[1], "ismapped", length) == 0)
 641             && (length >= 2)) {
 642         SETUP("ismapped");
 643         interp->result = Tk_IsMapped(window) ? "1" : "0";
 644     } else if ((c == 'n') && (strncmp(argv[1], "name", length) == 0)) {
 645         SETUP("geometry");
 646         interp->result = Tk_Name(window);
 647     } else if ((c == 'p') && (strncmp(argv[1], "parent", length) == 0)) {
 648         SETUP("geometry");
 649         winPtr = (TkWindow *) window;
 650         if (winPtr->parentPtr != NULL) {
 651             interp->result = winPtr->parentPtr->pathName;
 652         }
 653     } else if ((c == 'p') && (strncmp(argv[1], "pathname", length) == 0)
 654             && (length >= 2)) {
 655         Window id;
 656
 657         if (argc != 3) {
 658             argName = "pathname";
 659             goto wrongArgs;
 660         }
 661         if (Tcl_GetInt(interp, argv[2], (int *) &id) != TCL_OK) {
 662             return TCL_ERROR;
 663         }
 664         if ((XFindContext(Tk_Display(tkwin), id, tkWindowContext,
 665                 (void *) &window) != 0) || (((TkWindow *) window)->mainPtr
 666                 != ((TkWindow *) tkwin)->mainPtr)) {
 667             Tcl_AppendResult(interp, "window id \"", argv[2],
 668                     "\" doesn't exist in this application", (char *) NULL);
 669             return TCL_ERROR;
 670         }
 671         interp->result = Tk_PathName(window);
 672     } else if ((c == 'p') && (strncmp(argv[1], "pixels", length) == 0)
 673             && (length >= 2)) {
 674         int pixels;
 675
 676         if (argc != 4) {
 677             Tcl_AppendResult(interp, "wrong # args: should be \"",
 678                     argv[0], " pixels window number\"", (char *) NULL);
 679             return TCL_ERROR;
 680         }
 681         window = Tk_NameToWindow(interp, argv[2], tkwin);
 682         if (window == NULL) {
 683             return TCL_ERROR;
 684         }
 685         if (Tk_GetPixels(interp, window, argv[3], &pixels) != TCL_OK) {
 686             return TCL_ERROR;
 687         }
 688         sprintf(interp->result, "%d", pixels);
 689     } else if ((c == 'r') && (strncmp(argv[1], "reqheight", length) == 0)
 690             && (length >= 4)) {
 691         SETUP("reqheight");
 692         sprintf(interp->result, "%d", Tk_ReqHeight(window));
 693     } else if ((c == 'r') && (strncmp(argv[1], "reqwidth", length) == 0)
 694             && (length >= 4)) {
 695         SETUP("reqwidth");
 696         sprintf(interp->result, "%d", Tk_ReqWidth(window));
 697     } else if ((c == 'r') && (strcmp(argv[1], "rootx") == 0)) {
 698         int x, y;
 699
 700         SETUP("rootx");
 701         Tk_GetRootCoords(window, &x, &y);
 702         sprintf(interp->result, "%d", x);
 703     } else if ((c == 'r') && (strcmp(argv[1], "rooty") == 0)) {
 704         int x, y;
 705
 706         SETUP("rooty");
 707         Tk_GetRootCoords(window, &x, &y);
 708         sprintf(interp->result, "%d", y);
 709     } else if ((c == 's') && (strcmp(argv[1], "screen") == 0)) {
 710         char string[20];
 711
 712         SETUP("screen");
 713         sprintf(string, "%d", Tk_ScreenNumber(window));
 714         Tcl_AppendResult(interp, Tk_DisplayName(window), ".", string,
 715                 (char *) NULL);
 716     } else if ((c == 's') && (strncmp(argv[1], "screencells", length) == 0)
 717             && (length >= 7)) {
 718         SETUP("screencells");
 719         sprintf(interp->result, "%d", Tk_DefaultVisual(Tk_Screen(window))->map_entries);
 720     } else if ((c == 's') && (strncmp(argv[1], "screendepth", length) == 0)
 721             && (length >= 7)) {
 722         SETUP("screendepth");
 723         sprintf(interp->result, "%d", Tk_DefaultDepth(Tk_Screen(window)));
 724     } else if ((c == 's') && (strncmp(argv[1], "screenheight", length) == 0)
 725             && (length >= 7)) {
 726         SETUP("screenheight");
 727         sprintf(interp->result, "%d",  HeightOfScreen(Tk_Screen(window)));
 728     } else if ((c == 's') && (strncmp(argv[1], "screenmmheight", length) == 0)
 729             && (length >= 9)) {
 730         SETUP("screenmmheight");
 731         sprintf(interp->result, "%d",  HeightMMOfScreen(Tk_Screen(window)));
 732     } else if ((c == 's') && (strncmp(argv[1], "screenmmwidth", length) == 0)
 733             && (length >= 9)) {
 734         SETUP("screenmmwidth");
 735         sprintf(interp->result, "%d",  WidthMMOfScreen(Tk_Screen(window)));
 736     } else if ((c == 's') && (strncmp(argv[1], "screenvisual", length) == 0)
 737             && (length >= 7)) {
 738         SETUP("screenvisual");
 739         switch (Tk_DefaultVisual(Tk_Screen(window))->class) {
 740             case PseudoColor:   interp->result = "pseudocolor"; break;
 741             case GrayScale:     interp->result = "grayscale"; break;
 742             case DirectColor:   interp->result = "directcolor"; break;
 743             case TrueColor:     interp->result = "truecolor"; break;
 744             case StaticColor:   interp->result = "staticcolor"; break;
 745             case StaticGray:    interp->result = "staticgray"; break;
 746             default:            interp->result = "unknown"; break;
 747         }
 748     } else if ((c == 's') && (strncmp(argv[1], "screenwidth", length) == 0)
 749             && (length >= 7)) {
 750         SETUP("screenwidth");
 751         sprintf(interp->result, "%d",  WidthOfScreen(Tk_Screen(window)));
 752     } else if ((c == 's') && (strcmp(argv[1], "server") == 0)) {
 753         SETUP("server");
 754         Tcl_AppendResult(interp, Tk_DisplayName(window), (char *) NULL);
 755     } else if ((c == 't') && (strncmp(argv[1], "toplevel", length) == 0)) {
 756         SETUP("toplevel");
 757         for (winPtr = (TkWindow *) window; !(winPtr->flags & TK_TOP_LEVEL);
 758                 winPtr = winPtr->parentPtr) {
 759             /* Empty loop body. */
 760         }
 761         interp->result = winPtr->pathName;
 762     } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
 763         SETUP("width");
 764         sprintf(interp->result, "%d", Tk_Width(window));
 765     } else if ((c == 'x') && (argv[1][1] == '\0')) {
 766         SETUP("x");
 767         sprintf(interp->result, "%d", Tk_X(window));
 768     } else if ((c == 'y') && (argv[1][1] == '\0')) {
 769         SETUP("y");
 770         sprintf(interp->result, "%d", Tk_Y(window));
 771     } else {
 772         Tcl_AppendResult(interp, "bad option \"", argv[1],
 773                 "\": must be atom, atomname, children, class, fpixels, geometry, height, ",
 774                 "id, interps, ismapped, name, parent, pathname, ",
 775                 "pixels, reqheight, reqwidth, rootx, rooty, ",
 776                 "screen, screencells, screendepth, screenheight, ",
 777                 "screenmmheight, screenmmwidth, screenvisual, ",
 778                 "screenwidth, toplevel, width, x, or y", (char *) NULL);
 779         return TCL_ERROR;
 780     }
 781     return TCL_OK;
 782
 783     wrongArgs:
 784     Tcl_AppendResult(interp, "wrong # arguments: must be \"",
 785             argv[0], " ", argName, " window\"", (char *) NULL);
 786     return TCL_ERROR;
 787 }
 788 \f
 789 /*
 790  *----------------------------------------------------------------------
 791  *
 792  * TkDeadAppCmd --
 793  *
 794  *      If an application has been deleted then all Tk commands will be
 795  *      re-bound to this procedure.
 796  *
 797  * Results:
 798  *      A standard Tcl error is reported to let the user know that
 799  *      the application is dead.
 800  *
 801  * Side effects:
 802  *      See the user documentation.
 803  *
 804  *----------------------------------------------------------------------
 805  */
 806
 807         /* ARGSUSED */
 808 int
 809 TkDeadAppCmd(clientData, interp, argc, argv)
 810     ClientData clientData;      /* Dummy. */
 811     Tcl_Interp *interp;         /* Current interpreter. */
 812     int argc;                   /* Number of arguments. */
 813     char **argv;                /* Argument strings. */
 814 {
 815     Tcl_AppendResult(interp, "can't invoke \"", argv[0],
 816             "\" command:  application has been destroyed", (char *) NULL);
 817     return TCL_ERROR;
 818 }