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