home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tk3.3b1 / tkCmds.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-07-08  |  33.1 KB  |  1,158 lines
  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-1993 The Regents of the University of California.
  8.  * All rights reserved.
  9.  *
  10.  * Permission is hereby granted, without written agreement and without
  11.  * license or royalty fees, to use, copy, modify, and distribute this
  12.  * software and its documentation for any purpose, provided that the
  13.  * above copyright notice and the following two paragraphs appear in
  14.  * all copies of this software.
  15.  * 
  16.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20.  *
  21.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26.  */
  27.  
  28. #ifndef lint
  29. static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkCmds.c,v 1.53 93/07/08 10:47:04 ouster Exp $ SPRITE (Berkeley)";
  30. #endif /* not lint */
  31.  
  32. #include "tkConfig.h"
  33. #include "tkInt.h"
  34. #include <errno.h>
  35.  
  36. /*
  37.  * The data structure below is used by the "after" command to remember
  38.  * the command to be executed later.
  39.  */
  40.  
  41. typedef struct {
  42.     Tcl_Interp *interp;        /* Interpreter in which to execute command. */
  43.     char *command;        /* Command to execute.  Malloc'ed, so must
  44.                  * be freed when structure is deallocated. */
  45. } AfterInfo;
  46.  
  47. /*
  48.  * Forward declarations for procedures defined later in this file:
  49.  */
  50.  
  51. static void        AfterProc _ANSI_ARGS_((ClientData clientData));
  52. static char *        WaitVariableProc _ANSI_ARGS_((ClientData clientData,
  53.                 Tcl_Interp *interp, char *name1, char *name2,
  54.                 int flags));
  55. static void        WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
  56.                 XEvent *eventPtr));
  57. static void        WaitWindowProc _ANSI_ARGS_((ClientData clientData,
  58.                 XEvent *eventPtr));
  59.  
  60. /*
  61.  *----------------------------------------------------------------------
  62.  *
  63.  * Tk_AfterCmd --
  64.  *
  65.  *    This procedure is invoked to process the "after" Tcl command.
  66.  *    See the user documentation for details on what it does.
  67.  *
  68.  * Results:
  69.  *    A standard Tcl result.
  70.  *
  71.  * Side effects:
  72.  *    See the user documentation.
  73.  *
  74.  *----------------------------------------------------------------------
  75.  */
  76.  
  77.     /* ARGSUSED */
  78. int
  79. Tk_AfterCmd(clientData, interp, argc, argv)
  80.     ClientData clientData;    /* Main window associated with
  81.                  * interpreter.  Not used.*/
  82.     Tcl_Interp *interp;        /* Current interpreter. */
  83.     int argc;            /* Number of arguments. */
  84.     char **argv;        /* Argument strings. */
  85. {
  86.     int ms;
  87.     AfterInfo *afterPtr;
  88.  
  89.     if (argc < 2) {
  90.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  91.         argv[0], " milliseconds ?command? ?arg arg ...?\"",
  92.         (char *) NULL);
  93.     return TCL_ERROR;
  94.     }
  95.  
  96.     if (Tcl_GetInt(interp, argv[1], &ms) != TCL_OK) {
  97.     Tcl_AppendResult(interp, "bad milliseconds value \"",
  98.         argv[1], "\"", (char *) NULL);
  99.     return TCL_ERROR;
  100.     }
  101.     if (ms < 0) {
  102.     ms = 0;
  103.     }
  104.     if (argc == 2) {
  105.     Tk_Sleep(ms);
  106.     return TCL_OK;
  107.     }
  108.     afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
  109.     afterPtr->interp = interp;
  110.     if (argc == 3) {
  111.     afterPtr->command = (char *) ckalloc((unsigned) (strlen(argv[2]) + 1));
  112.     strcpy(afterPtr->command, argv[2]);
  113.     } else {
  114.     afterPtr->command = Tcl_Concat(argc-2, argv+2);
  115.     }
  116.     Tk_CreateTimerHandler(ms, AfterProc, (ClientData) afterPtr);
  117.     return TCL_OK;
  118. }
  119.  
  120. /*
  121.  *----------------------------------------------------------------------
  122.  *
  123.  * AfterProc --
  124.  *
  125.  *    Timer callback to execute commands registered with the
  126.  *    "after" command.
  127.  *
  128.  * Results:
  129.  *    None.
  130.  *
  131.  * Side effects:
  132.  *    Executes whatever command was specified.  If the command
  133.  *    returns an error, then the command "tkerror" is invoked
  134.  *    to process the error;  if tkerror fails then information
  135.  *    about the error is output on stderr.
  136.  *
  137.  *----------------------------------------------------------------------
  138.  */
  139.  
  140. static void
  141. AfterProc(clientData)
  142.     ClientData clientData;    /* Describes command to execute. */
  143. {
  144.     AfterInfo *afterPtr = (AfterInfo *) clientData;
  145.     int result;
  146.  
  147.     if (afterPtr->command != NULL) {
  148.     result = Tcl_GlobalEval(afterPtr->interp, afterPtr->command);
  149.     if (result != TCL_OK) {
  150.         Tk_BackgroundError(afterPtr->interp);
  151.     }
  152.     ckfree(afterPtr->command);
  153.     }
  154.     ckfree((char *) afterPtr);
  155. }
  156.  
  157. /*
  158.  *----------------------------------------------------------------------
  159.  *
  160.  * Tk_BindCmd --
  161.  *
  162.  *    This procedure is invoked to process the "bind" Tcl command.
  163.  *    See the user documentation for details on what it does.
  164.  *
  165.  * Results:
  166.  *    A standard Tcl result.
  167.  *
  168.  * Side effects:
  169.  *    See the user documentation.
  170.  *
  171.  *----------------------------------------------------------------------
  172.  */
  173.  
  174. int
  175. Tk_BindCmd(clientData, interp, argc, argv)
  176.     ClientData clientData;        /* Main window associated with
  177.                  * interpreter. */
  178.     Tcl_Interp *interp;        /* Current interpreter. */
  179.     int argc;            /* Number of arguments. */
  180.     char **argv;        /* Argument strings. */
  181. {
  182.     Tk_Window tkwin = (Tk_Window) clientData;
  183.     TkWindow *winPtr;
  184.     ClientData object;
  185.  
  186.     if ((argc < 2) || (argc > 4)) {
  187.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  188.         " window ?pattern? ?command?\"", (char *) NULL);
  189.     return TCL_ERROR;
  190.     }
  191.     if (argv[1][0] == '.') {
  192.     winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
  193.     if (winPtr == NULL) {
  194.         return TCL_ERROR;
  195.     }
  196.     object = (ClientData) winPtr->pathName;
  197.     } else {
  198.     winPtr = (TkWindow *) clientData;
  199.     object = (ClientData) Tk_GetUid(argv[1]);
  200.     }
  201.  
  202.     if (argc == 4) {
  203.     int append = 0;
  204.     unsigned long mask;
  205.  
  206.     if (argv[3][0] == 0) {
  207.         return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
  208.             object, argv[2]);
  209.     }
  210.     if (argv[3][0] == '+') {
  211.         argv[3]++;
  212.         append = 1;
  213.     }
  214.     mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
  215.         object, argv[2], argv[3], append);
  216.     if (mask == 0) {
  217.         return TCL_ERROR;
  218.     }
  219.     } else if (argc == 3) {
  220.     char *command;
  221.  
  222.     command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
  223.         object, argv[2]);
  224.     if (command == NULL) {
  225.         Tcl_ResetResult(interp);
  226.         return TCL_OK;
  227.     }
  228.     interp->result = command;
  229.     } else {
  230.     Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
  231.     }
  232.     return TCL_OK;
  233. }
  234.  
  235. /*
  236.  *----------------------------------------------------------------------
  237.  *
  238.  * TkBindEventProc --
  239.  *
  240.  *    This procedure is invoked by Tk_HandleEvent for each event;  it
  241.  *    causes any appropriate bindings for that event to be invoked.
  242.  *
  243.  * Results:
  244.  *    None.
  245.  *
  246.  * Side effects:
  247.  *    Depends on what bindings have been established with the "bind"
  248.  *    command.
  249.  *
  250.  *----------------------------------------------------------------------
  251.  */
  252.  
  253. void
  254. TkBindEventProc(winPtr, eventPtr)
  255.     TkWindow *winPtr;            /* Pointer to info about window. */
  256.     XEvent *eventPtr;            /* Information about event. */
  257. {
  258.     ClientData objects[3];
  259.     static Tk_Uid allUid = NULL;
  260.  
  261.     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
  262.     return;
  263.     }
  264.     objects[0] = (ClientData) winPtr->pathName;
  265.     objects[1] = (ClientData) winPtr->classUid;
  266.     if (allUid == NULL) {
  267.     allUid = Tk_GetUid("all");
  268.     }
  269.     objects[2] = (ClientData) allUid;
  270.     Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr,
  271.         (Tk_Window) winPtr, 3, objects);
  272. }
  273.  
  274. /*
  275.  *----------------------------------------------------------------------
  276.  *
  277.  * Tk_DestroyCmd --
  278.  *
  279.  *    This procedure is invoked to process the "destroy" Tcl command.
  280.  *    See the user documentation for details on what it does.
  281.  *
  282.  * Results:
  283.  *    A standard Tcl result.
  284.  *
  285.  * Side effects:
  286.  *    See the user documentation.
  287.  *
  288.  *----------------------------------------------------------------------
  289.  */
  290.  
  291. int
  292. Tk_DestroyCmd(clientData, interp, argc, argv)
  293.     ClientData clientData;        /* Main window associated with
  294.                  * interpreter. */
  295.     Tcl_Interp *interp;        /* Current interpreter. */
  296.     int argc;            /* Number of arguments. */
  297.     char **argv;        /* Argument strings. */
  298. {
  299.     Tk_Window window;
  300.     Tk_Window tkwin = (Tk_Window) clientData;
  301.     int i;
  302.  
  303.     for (i = 1; i < argc; i++) {
  304.     window = Tk_NameToWindow(interp, argv[i], tkwin);
  305.     if (window == NULL) {
  306.         return TCL_ERROR;
  307.     }
  308.     Tk_DestroyWindow(window);
  309.     }
  310.     return TCL_OK;
  311. }
  312.  
  313. /*
  314.  *----------------------------------------------------------------------
  315.  *
  316.  * Tk_ExitCmd --
  317.  *
  318.  *    This procedure is invoked to process the "exit" Tcl command.
  319.  *    See the user documentation for details on what it does.
  320.  *    Note: this command replaces the Tcl "exit" command in order
  321.  *    to properly destroy all windows.
  322.  *
  323.  * Results:
  324.  *    A standard Tcl result.
  325.  *
  326.  * Side effects:
  327.  *    See the user documentation.
  328.  *
  329.  *----------------------------------------------------------------------
  330.  */
  331.  
  332.     /*ARGSUSED*/
  333. int
  334. Tk_ExitCmd(clientData, interp, argc, argv)
  335.     ClientData clientData;        /* Main window associated with
  336.                  * interpreter. */
  337.     Tcl_Interp *interp;        /* Current interpreter. */
  338.     int argc;            /* Number of arguments. */
  339.     char **argv;        /* Argument strings. */
  340. {
  341.     int value;
  342.  
  343.     if ((argc != 1) && (argc != 2)) {
  344.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  345.         " ?returnCode?\"", (char *) NULL);
  346.     return TCL_ERROR;
  347.     }
  348.     if (argc == 1) {
  349.     value = 0;
  350.     } else {
  351.     if (Tcl_GetInt(interp, argv[1], &value) != TCL_OK) {
  352.         return TCL_ERROR;
  353.     }
  354.     }
  355.  
  356.     while (tkMainWindowList != NULL) {
  357.     Tk_DestroyWindow((Tk_Window) tkMainWindowList->winPtr);
  358.     }
  359.     exit(value);
  360.     /* NOTREACHED */
  361.     return TCL_OK;
  362. }
  363.  
  364. /*
  365.  *----------------------------------------------------------------------
  366.  *
  367.  * Tk_LowerCmd --
  368.  *
  369.  *    This procedure is invoked to process the "lower" Tcl command.
  370.  *    See the user documentation for details on what it does.
  371.  *
  372.  * Results:
  373.  *    A standard Tcl result.
  374.  *
  375.  * Side effects:
  376.  *    See the user documentation.
  377.  *
  378.  *----------------------------------------------------------------------
  379.  */
  380.  
  381.     /* ARGSUSED */
  382. int
  383. Tk_LowerCmd(clientData, interp, argc, argv)
  384.     ClientData clientData;    /* Main window associated with
  385.                  * interpreter. */
  386.     Tcl_Interp *interp;        /* Current interpreter. */
  387.     int argc;            /* Number of arguments. */
  388.     char **argv;        /* Argument strings. */
  389. {
  390.     Tk_Window main = (Tk_Window) clientData;
  391.     Tk_Window tkwin, other;
  392.  
  393.     if ((argc != 2) && (argc != 3)) {
  394.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  395.         argv[0], " window ?belowThis?\"", (char *) NULL);
  396.     return TCL_ERROR;
  397.     }
  398.  
  399.     tkwin = Tk_NameToWindow(interp, argv[1], main);
  400.     if (tkwin == NULL) {
  401.     return TCL_ERROR;
  402.     }
  403.     if (argc == 2) {
  404.     other = NULL;
  405.     } else {
  406.     other = Tk_NameToWindow(interp, argv[2], main);
  407.     if (other == NULL) {
  408.         return TCL_ERROR;
  409.     }
  410.     }
  411.     if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
  412.     Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"",
  413.         argv[2], "\"", (char *) NULL);
  414.     return TCL_ERROR;
  415.     }
  416.     return TCL_OK;
  417. }
  418.  
  419. /*
  420.  *----------------------------------------------------------------------
  421.  *
  422.  * Tk_RaiseCmd --
  423.  *
  424.  *    This procedure is invoked to process the "raise" Tcl command.
  425.  *    See the user documentation for details on what it does.
  426.  *
  427.  * Results:
  428.  *    A standard Tcl result.
  429.  *
  430.  * Side effects:
  431.  *    See the user documentation.
  432.  *
  433.  *----------------------------------------------------------------------
  434.  */
  435.  
  436.     /* ARGSUSED */
  437. int
  438. Tk_RaiseCmd(clientData, interp, argc, argv)
  439.     ClientData clientData;    /* Main window associated with
  440.                  * interpreter. */
  441.     Tcl_Interp *interp;        /* Current interpreter. */
  442.     int argc;            /* Number of arguments. */
  443.     char **argv;        /* Argument strings. */
  444. {
  445.     Tk_Window main = (Tk_Window) clientData;
  446.     Tk_Window tkwin, other;
  447.  
  448.     if ((argc != 2) && (argc != 3)) {
  449.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  450.         argv[0], " window ?aboveThis?\"", (char *) NULL);
  451.     return TCL_ERROR;
  452.     }
  453.  
  454.     tkwin = Tk_NameToWindow(interp, argv[1], main);
  455.     if (tkwin == NULL) {
  456.     return TCL_ERROR;
  457.     }
  458.     if (argc == 2) {
  459.     other = NULL;
  460.     } else {
  461.     other = Tk_NameToWindow(interp, argv[2], main);
  462.     if (other == NULL) {
  463.         return TCL_ERROR;
  464.     }
  465.     }
  466.     if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
  467.     Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"",
  468.         argv[2], "\"", (char *) NULL);
  469.     return TCL_ERROR;
  470.     }
  471.     return TCL_OK;
  472. }
  473.  
  474. /*
  475.  *----------------------------------------------------------------------
  476.  *
  477.  * Tk_TkCmd --
  478.  *
  479.  *    This procedure is invoked to process the "tk" Tcl command.
  480.  *    See the user documentation for details on what it does.
  481.  *
  482.  * Results:
  483.  *    A standard Tcl result.
  484.  *
  485.  * Side effects:
  486.  *    See the user documentation.
  487.  *
  488.  *----------------------------------------------------------------------
  489.  */
  490.  
  491.     /* ARGSUSED */
  492. int
  493. Tk_TkCmd(clientData, interp, argc, argv)
  494.     ClientData clientData;    /* Main window associated with
  495.                  * interpreter. */
  496.     Tcl_Interp *interp;        /* Current interpreter. */
  497.     int argc;            /* Number of arguments. */
  498.     char **argv;        /* Argument strings. */
  499. {
  500.     char c;
  501.     int length;
  502.     Tk_Window tkwin = (Tk_Window) clientData;
  503.     TkWindow *winPtr;
  504.  
  505.     if (argc < 2) {
  506.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  507.         argv[0], " option ?arg?\"", (char *) NULL);
  508.     return TCL_ERROR;
  509.     }
  510.     c = argv[1][0];
  511.     length = strlen(argv[1]);
  512.     if ((c == 'c') && (strncmp(argv[1], "colormodel", length) == 0)) {
  513.     if ((argc != 3) && (argc != 4)) {
  514.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  515.             " colormodel window ?mono|color?\"", (char *) NULL);
  516.         return TCL_ERROR;
  517.     }
  518.     winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
  519.     if (winPtr == NULL) {
  520.         return TCL_ERROR;
  521.     }
  522.     if (argc == 3) {
  523.         switch (winPtr->dispPtr->colorModels[winPtr->screenNum]) {
  524.         case TK_MONO:
  525.             interp->result = "monochrome";
  526.             break;
  527.         case TK_COLOR:
  528.             interp->result = "color";
  529.             break;
  530.         }
  531.     } else {
  532.         int valueLength;
  533.  
  534.         valueLength = strlen(argv[3]);
  535.         if ((argv[3][0] == 'c')
  536.             && (strncmp(argv[3], "color", valueLength) == 0)) {
  537.         if (DisplayPlanes(winPtr->display, winPtr->screenNum) == 1) {
  538.             interp->result =
  539.                 "can't treat screen as color: only 1 bit plane";
  540.             return TCL_ERROR;
  541.         }
  542.         winPtr->dispPtr->colorModels[winPtr->screenNum] = TK_COLOR;
  543.         } else if ((argv[3][0] == 'm')
  544.             && (strncmp(argv[3], "monochrome", valueLength) == 0)) {
  545.         winPtr->dispPtr->colorModels[winPtr->screenNum] = TK_MONO;
  546.         } else {
  547.         Tcl_AppendResult(interp, "bad color model \"", argv[3],
  548.             "\": must be color or monochrome", (char *) NULL);
  549.         }
  550.     }
  551.     } else {
  552.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  553.         "\": must be colormodel", (char *) NULL);
  554.     return TCL_ERROR;
  555.     }
  556.     return TCL_OK;
  557. }
  558.  
  559. /*
  560.  *----------------------------------------------------------------------
  561.  *
  562.  * Tk_TkwaitCmd --
  563.  *
  564.  *    This procedure is invoked to process the "tkwait" Tcl command.
  565.  *    See the user documentation for details on what it does.
  566.  *
  567.  * Results:
  568.  *    A standard Tcl result.
  569.  *
  570.  * Side effects:
  571.  *    See the user documentation.
  572.  *
  573.  *----------------------------------------------------------------------
  574.  */
  575.  
  576.     /* ARGSUSED */
  577. int
  578. Tk_TkwaitCmd(clientData, interp, argc, argv)
  579.     ClientData clientData;    /* Main window associated with
  580.                  * interpreter. */
  581.     Tcl_Interp *interp;        /* Current interpreter. */
  582.     int argc;            /* Number of arguments. */
  583.     char **argv;        /* Argument strings. */
  584. {
  585.     Tk_Window tkwin = (Tk_Window) clientData;
  586.     int c, length;
  587.     int done;
  588.  
  589.     if (argc != 3) {
  590.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  591.         argv[0], " variable|visible|window name\"", (char *) NULL);
  592.     return TCL_ERROR;
  593.     }
  594.     c = argv[1][0];
  595.     length = strlen(argv[1]);
  596.     if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
  597.         && (length >= 2)) {
  598.     Tcl_TraceVar(interp, argv[2],
  599.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  600.         WaitVariableProc, (ClientData) &done);
  601.     done = 0;
  602.     while (!done) {
  603.         Tk_DoOneEvent(0);
  604.     }
  605.     Tcl_UntraceVar(interp, argv[2],
  606.         TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  607.         WaitVariableProc, (ClientData) &done);
  608.     } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)
  609.         && (length >= 2)) {
  610.     Tk_Window window;
  611.  
  612.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  613.     if (window == NULL) {
  614.         return TCL_ERROR;
  615.     }
  616.     Tk_CreateEventHandler(window, VisibilityChangeMask,
  617.         WaitVisibilityProc, (ClientData) &done);
  618.     done = 0;
  619.     while (!done) {
  620.         Tk_DoOneEvent(0);
  621.     }
  622.     Tk_DeleteEventHandler(window, VisibilityChangeMask,
  623.         WaitVisibilityProc, (ClientData) &done);
  624.     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
  625.     Tk_Window window;
  626.  
  627.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  628.     if (window == NULL) {
  629.         return TCL_ERROR;
  630.     }
  631.     Tk_CreateEventHandler(window, StructureNotifyMask,
  632.         WaitWindowProc, (ClientData) &done);
  633.     done = 0;
  634.     while (!done) {
  635.         Tk_DoOneEvent(0);
  636.     }
  637.     /*
  638.      * Note:  there's no need to delete the event handler.  It was
  639.      * deleted automatically when the window was destroyed.
  640.      */
  641.     } else {
  642.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  643.         "\": must be variable, visibility, or window", (char *) NULL);
  644.     return TCL_ERROR;
  645.     }
  646.  
  647.     /*
  648.      * Clear out the interpreter's result, since it may have been set
  649.      * by event handlers.
  650.      */
  651.  
  652.     Tcl_ResetResult(interp);
  653.     return TCL_OK;
  654. }
  655.  
  656.     /* ARGSUSED */
  657. static char *
  658. WaitVariableProc(clientData, interp, name1, name2, flags)
  659.     ClientData clientData;    /* Pointer to integer to set to 1. */
  660.     Tcl_Interp *interp;        /* Interpreter containing variable. */
  661.     char *name1;        /* Name of variable. */
  662.     char *name2;        /* Second part of variable name. */
  663.     int flags;            /* Information about what happened. */
  664. {
  665.     int *donePtr = (int *) clientData;
  666.  
  667.     *donePtr = 1;
  668.     return (char *) NULL;
  669. }
  670.  
  671.     /*ARGSUSED*/
  672. static void
  673. WaitVisibilityProc(clientData, eventPtr)
  674.     ClientData clientData;    /* Pointer to integer to set to 1. */
  675.     XEvent *eventPtr;        /* Information about event (not used). */
  676. {
  677.     int *donePtr = (int *) clientData;
  678.     *donePtr = 1;
  679. }
  680.  
  681. static void
  682. WaitWindowProc(clientData, eventPtr)
  683.     ClientData clientData;    /* Pointer to integer to set to 1. */
  684.     XEvent *eventPtr;        /* Information about event. */
  685. {
  686.     int *donePtr = (int *) clientData;
  687.  
  688.     if (eventPtr->type == DestroyNotify) {
  689.     *donePtr = 1;
  690.     }
  691. }
  692.  
  693. /*
  694.  *----------------------------------------------------------------------
  695.  *
  696.  * Tk_UpdateCmd --
  697.  *
  698.  *    This procedure is invoked to process the "update" Tcl command.
  699.  *    See the user documentation for details on what it does.
  700.  *
  701.  * Results:
  702.  *    A standard Tcl result.
  703.  *
  704.  * Side effects:
  705.  *    See the user documentation.
  706.  *
  707.  *----------------------------------------------------------------------
  708.  */
  709.  
  710.     /* ARGSUSED */
  711. int
  712. Tk_UpdateCmd(clientData, interp, argc, argv)
  713.     ClientData clientData;    /* Main window associated with
  714.                  * interpreter. */
  715.     Tcl_Interp *interp;        /* Current interpreter. */
  716.     int argc;            /* Number of arguments. */
  717.     char **argv;        /* Argument strings. */
  718. {
  719.     Tk_Window tkwin = (Tk_Window) clientData;
  720.     int flags;
  721.  
  722.     if (argc == 1) {
  723.     flags = TK_DONT_WAIT;
  724.     } else if (argc == 2) {
  725.     if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
  726.         Tcl_AppendResult(interp, "bad argument \"", argv[1],
  727.             "\": must be idletasks", (char *) NULL);
  728.         return TCL_ERROR;
  729.     }
  730.     flags = TK_IDLE_EVENTS;
  731.     } else {
  732.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  733.         argv[0], " ?idletasks?\"", (char *) NULL);
  734.     return TCL_ERROR;
  735.     }
  736.  
  737.     /*
  738.      * Handle all pending events, sync the display, and repeat over
  739.      * and over again until all pending events have been handled.
  740.      */
  741.  
  742.     while (1) {
  743.     while (Tk_DoOneEvent(flags) != 0) {
  744.         /* Empty loop body */
  745.     }
  746.     XSync(Tk_Display(tkwin), False);
  747.     if (Tk_DoOneEvent(flags) == 0) {
  748.         break;
  749.     }
  750.     }
  751.  
  752.     /*
  753.      * Must clear the interpreter's result because event handlers could
  754.      * have executed commands.
  755.      */
  756.  
  757.     Tcl_ResetResult(interp);
  758.     return TCL_OK;
  759. }
  760.  
  761. /*
  762.  *----------------------------------------------------------------------
  763.  *
  764.  * Tk_WinfoCmd --
  765.  *
  766.  *    This procedure is invoked to process the "winfo" Tcl command.
  767.  *    See the user documentation for details on what it does.
  768.  *
  769.  * Results:
  770.  *    A standard Tcl result.
  771.  *
  772.  * Side effects:
  773.  *    See the user documentation.
  774.  *
  775.  *----------------------------------------------------------------------
  776.  */
  777.  
  778. int
  779. Tk_WinfoCmd(clientData, interp, argc, argv)
  780.     ClientData clientData;    /* Main window associated with
  781.                  * interpreter. */
  782.     Tcl_Interp *interp;        /* Current interpreter. */
  783.     int argc;            /* Number of arguments. */
  784.     char **argv;        /* Argument strings. */
  785. {
  786.     Tk_Window tkwin = (Tk_Window) clientData;
  787.     int length;
  788.     char c, *argName;
  789.     Tk_Window window;
  790.     register TkWindow *winPtr;
  791.  
  792. #define SETUP(name) \
  793.     if (argc != 3) {\
  794.     argName = name; \
  795.     goto wrongArgs; \
  796.     } \
  797.     window = Tk_NameToWindow(interp, argv[2], tkwin); \
  798.     if (window == NULL) { \
  799.     return TCL_ERROR; \
  800.     }
  801.  
  802.     if (argc < 2) {
  803.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  804.         argv[0], " option ?arg?\"", (char *) NULL);
  805.     return TCL_ERROR;
  806.     }
  807.     c = argv[1][0];
  808.     length = strlen(argv[1]);
  809.     if ((c == 'a') && (strcmp(argv[1], "atom") == 0)) {
  810.     if (argc != 3) {
  811.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  812.             argv[0], " atom name\"", (char *) NULL);
  813.         return TCL_ERROR;
  814.     }
  815.     sprintf(interp->result, "%d", Tk_InternAtom(tkwin, argv[2]));
  816.     } else if ((c == 'a') && (strncmp(argv[1], "atomname", length) == 0)
  817.         && (length >= 5)) {
  818.     Atom atom;
  819.     char *name;
  820.  
  821.     if (argc != 3) {
  822.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  823.             argv[0], " atomname id\"", (char *) NULL);
  824.         return TCL_ERROR;
  825.     }
  826.     if (Tcl_GetInt(interp, argv[2], (int *) &atom) != TCL_OK) {
  827.         return TCL_ERROR;
  828.     }
  829.     name = Tk_GetAtomName(tkwin, atom);
  830.     if (strcmp(name, "?bad atom?") == 0) {
  831.         Tcl_AppendResult(interp, "no atom exists with id \"",
  832.             argv[2], "\"", (char *) NULL);
  833.         return TCL_ERROR;
  834.     }
  835.     interp->result = name;
  836.     } else if ((c == 'c') && (strncmp(argv[1], "cells", length) == 0)
  837.         && (length >= 2)) {
  838.     SETUP("cells");
  839.     sprintf(interp->result, "%d", 1<<Tk_Depth(window));
  840.     } else if ((c == 'c') && (strncmp(argv[1], "children", length) == 0)
  841.         && (length >= 2)) {
  842.     SETUP("children");
  843.     for (winPtr = ((TkWindow *) window)->childList; winPtr != NULL;
  844.         winPtr = winPtr->nextPtr) {
  845.         Tcl_AppendElement(interp, winPtr->pathName);
  846.     }
  847.     } else if ((c == 'c') && (strncmp(argv[1], "class", length) == 0)
  848.         && (length >= 2)) {
  849.     SETUP("class");
  850.     interp->result = Tk_Class(window);
  851.     } else if ((c == 'c') && (strncmp(argv[1], "containing", length) == 0)
  852.         && (length >= 2)) {
  853.     int rootX, rootY;
  854.  
  855.     if (argc != 4) {
  856.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  857.             argv[0], " containing rootX rootY\"", (char *) NULL);
  858.         return TCL_ERROR;
  859.     }
  860.     if ((Tk_GetPixels(interp, tkwin, argv[2], &rootX) != TCL_OK)
  861.         || (Tk_GetPixels(interp, tkwin, argv[3], &rootY) != TCL_OK)) {
  862.         return TCL_ERROR;
  863.     }
  864.     window = Tk_CoordsToWindow(rootX, rootY, tkwin);
  865.     if (window != NULL) {
  866.         interp->result = Tk_PathName(window);
  867.     }
  868.     } else if ((c == 'd') && (strncmp(argv[1], "depth", length) == 0)) {
  869.     SETUP("depth");
  870.     sprintf(interp->result, "%d", Tk_Depth(window));
  871.     } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)) {
  872.     if (argc != 3) {
  873.         argName = "exists";
  874.         goto wrongArgs;
  875.     }
  876.     if (Tk_NameToWindow(interp, argv[2], tkwin) == NULL) {
  877.         interp->result = "0";
  878.     } else {
  879.         interp->result = "1";
  880.     }
  881.     } else if ((c == 'f') && (strncmp(argv[1], "fpixels", length) == 0)
  882.         && (length >= 2)) {
  883.     double mm, pixels;
  884.  
  885.     if (argc != 4) {
  886.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  887.             argv[0], " fpixels window number\"", (char *) NULL);
  888.         return TCL_ERROR;
  889.     }
  890.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  891.     if (window == NULL) {
  892.         return TCL_ERROR;
  893.     }
  894.     if (Tk_GetScreenMM(interp, window, argv[3], &mm) != TCL_OK) {
  895.         return TCL_ERROR;
  896.     }
  897.     pixels = mm * WidthOfScreen(Tk_Screen(window))
  898.         / WidthMMOfScreen(Tk_Screen(window));
  899.     Tcl_PrintDouble(interp, pixels, interp->result);
  900.     } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)) {
  901.     SETUP("geometry");
  902.     sprintf(interp->result, "%dx%d+%d+%d", Tk_Width(window),
  903.         Tk_Height(window), Tk_X(window), Tk_Y(window));
  904.     } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
  905.     SETUP("height");
  906.     sprintf(interp->result, "%d", Tk_Height(window));
  907.     } else if ((c == 'i') && (strcmp(argv[1], "id") == 0)) {
  908.     SETUP("id");
  909.     sprintf(interp->result, "0x%x", Tk_WindowId(window));
  910.     } else if ((c == 'i') && (strncmp(argv[1], "interps", length) == 0)
  911.         && (length >= 2)) {
  912.     if (argc != 2) {
  913.         Tcl_AppendResult(interp, "wrong # args:  should be \"",
  914.             argv[0], " interps\"", (char *) NULL);
  915.         return TCL_ERROR;
  916.     }
  917.     return TkGetInterpNames(interp, tkwin);
  918.     } else if ((c == 'i') && (strncmp(argv[1], "ismapped", length) == 0)
  919.         && (length >= 2)) {
  920.     SETUP("ismapped");
  921.     interp->result = Tk_IsMapped(window) ? "1" : "0";
  922.     } else if ((c == 'n') && (strncmp(argv[1], "name", length) == 0)) {
  923.     SETUP("name");
  924.     interp->result = Tk_Name(window);
  925.     } else if ((c == 'p') && (strncmp(argv[1], "parent", length) == 0)) {
  926.     SETUP("parent");
  927.     winPtr = (TkWindow *) window;
  928.     if (winPtr->parentPtr != NULL) {
  929.         interp->result = winPtr->parentPtr->pathName;
  930.     }
  931.     } else if ((c == 'p') && (strncmp(argv[1], "pathname", length) == 0)
  932.         && (length >= 2)) {
  933.     Window id;
  934.  
  935.     if (argc != 3) {
  936.         argName = "pathname";
  937.         goto wrongArgs;
  938.     }
  939.     if (Tcl_GetInt(interp, argv[2], (int *) &id) != TCL_OK) {
  940.         return TCL_ERROR;
  941.     }
  942.     if ((XFindContext(Tk_Display(tkwin), id, tkWindowContext,
  943.         (caddr_t *) &window) != 0) || (((TkWindow *) window)->mainPtr
  944.         != ((TkWindow *) tkwin)->mainPtr)) {
  945.         Tcl_AppendResult(interp, "window id \"", argv[2],
  946.             "\" doesn't exist in this application", (char *) NULL);
  947.         return TCL_ERROR;
  948.     }
  949.     interp->result = Tk_PathName(window);
  950.     } else if ((c == 'p') && (strncmp(argv[1], "pixels", length) == 0)
  951.         && (length >= 2)) {
  952.     int pixels;
  953.  
  954.     if (argc != 4) {
  955.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  956.             argv[0], " pixels window number\"", (char *) NULL);
  957.         return TCL_ERROR;
  958.     }
  959.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  960.     if (window == NULL) {
  961.         return TCL_ERROR;
  962.     }
  963.     if (Tk_GetPixels(interp, window, argv[3], &pixels) != TCL_OK) {
  964.         return TCL_ERROR;
  965.     }
  966.     sprintf(interp->result, "%d", pixels);
  967.     } else if ((c == 'r') && (strncmp(argv[1], "reqheight", length) == 0)
  968.         && (length >= 4)) {
  969.     SETUP("reqheight");
  970.     sprintf(interp->result, "%d", Tk_ReqHeight(window));
  971.     } else if ((c == 'r') && (strncmp(argv[1], "reqwidth", length) == 0)
  972.         && (length >= 4)) {
  973.     SETUP("reqwidth");
  974.     sprintf(interp->result, "%d", Tk_ReqWidth(window));
  975.     } else if ((c == 'r') && (strncmp(argv[1], "rgb", length) == 0)
  976.         && (length >= 2)) {
  977.     XColor *colorPtr;
  978.  
  979.     if (argc != 4) {
  980.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  981.             argv[0], " rgb window colorName\"", (char *) NULL);
  982.         return TCL_ERROR;
  983.     }
  984.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  985.     if (window == NULL) {
  986.         return TCL_ERROR;
  987.     }
  988.     colorPtr = Tk_GetColor(interp, window, (Colormap) None, argv[3]);
  989.     if (colorPtr == NULL) {
  990.         return TCL_ERROR;
  991.     }
  992.     sprintf(interp->result, "%d %d %d", colorPtr->red, colorPtr->green,
  993.         colorPtr->blue);
  994.     Tk_FreeColor(colorPtr);
  995.     } else if ((c == 'r') && (strcmp(argv[1], "rootx") == 0)) {
  996.     int x, y;
  997.  
  998.     SETUP("rootx");
  999.     Tk_GetRootCoords(window, &x, &y);
  1000.     sprintf(interp->result, "%d", x);
  1001.     } else if ((c == 'r') && (strcmp(argv[1], "rooty") == 0)) {
  1002.     int x, y;
  1003.  
  1004.     SETUP("rooty");
  1005.     Tk_GetRootCoords(window, &x, &y);
  1006.     sprintf(interp->result, "%d", y);
  1007.     } else if ((c == 's') && (strcmp(argv[1], "screen") == 0)) {
  1008.     char string[20];
  1009.  
  1010.     SETUP("screen");
  1011.     sprintf(string, "%d", Tk_ScreenNumber(window));
  1012.     Tcl_AppendResult(interp, Tk_DisplayName(window), ".", string,
  1013.         (char *) NULL);
  1014.     } else if ((c == 's') && (strncmp(argv[1], "screencells", length) == 0)
  1015.         && (length >= 7)) {
  1016.     SETUP("screencells");
  1017.     sprintf(interp->result, "%d", CellsOfScreen(Tk_Screen(window)));
  1018.     } else if ((c == 's') && (strncmp(argv[1], "screendepth", length) == 0)
  1019.         && (length >= 7)) {
  1020.     SETUP("screendepth");
  1021.     sprintf(interp->result, "%d", DefaultDepthOfScreen(Tk_Screen(window)));
  1022.     } else if ((c == 's') && (strncmp(argv[1], "screenheight", length) == 0)
  1023.         && (length >= 7)) {
  1024.     SETUP("screenheight");
  1025.     sprintf(interp->result, "%d",  HeightOfScreen(Tk_Screen(window)));
  1026.     } else if ((c == 's') && (strncmp(argv[1], "screenmmheight", length) == 0)
  1027.         && (length >= 9)) {
  1028.     SETUP("screenmmheight");
  1029.     sprintf(interp->result, "%d",  HeightMMOfScreen(Tk_Screen(window)));
  1030.     } else if ((c == 's') && (strncmp(argv[1], "screenmmwidth", length) == 0)
  1031.         && (length >= 9)) {
  1032.     SETUP("screenmmwidth");
  1033.     sprintf(interp->result, "%d",  WidthMMOfScreen(Tk_Screen(window)));
  1034.     } else if ((c == 's') && (strncmp(argv[1], "screenvisual", length) == 0)
  1035.         && (length >= 7)) {
  1036.     SETUP("screenvisual");
  1037.     switch (DefaultVisualOfScreen(Tk_Screen(window))->class) {
  1038.         case PseudoColor:    interp->result = "pseudocolor"; break;
  1039.         case GrayScale:    interp->result = "grayscale"; break;
  1040.         case DirectColor:    interp->result = "directcolor"; break;
  1041.         case TrueColor:    interp->result = "truecolor"; break;
  1042.         case StaticColor:    interp->result = "staticcolor"; break;
  1043.         case StaticGray:    interp->result = "staticgray"; break;
  1044.         default:        interp->result = "unknown"; break;
  1045.     }
  1046.     } else if ((c == 's') && (strncmp(argv[1], "screenwidth", length) == 0)
  1047.         && (length >= 7)) {
  1048.     SETUP("screenwidth");
  1049.     sprintf(interp->result, "%d",  WidthOfScreen(Tk_Screen(window)));
  1050.     } else if ((c == 't') && (strncmp(argv[1], "toplevel", length) == 0)) {
  1051.     SETUP("toplevel");
  1052.     for (winPtr = (TkWindow *) window; !(winPtr->flags & TK_TOP_LEVEL);
  1053.         winPtr = winPtr->parentPtr) {
  1054.         /* Empty loop body. */
  1055.     }
  1056.     interp->result = winPtr->pathName;
  1057.     } else if ((c == 'v') && (strncmp(argv[1], "visual", length) == 0)
  1058.         && (length >= 2)) {
  1059.     SETUP("visual");
  1060.     switch (Tk_Visual(window)->class) {
  1061.         case PseudoColor:    interp->result = "pseudocolor"; break;
  1062.         case GrayScale:    interp->result = "grayscale"; break;
  1063.         case DirectColor:    interp->result = "directcolor"; break;
  1064.         case TrueColor:    interp->result = "truecolor"; break;
  1065.         case StaticColor:    interp->result = "staticcolor"; break;
  1066.         case StaticGray:    interp->result = "staticgray"; break;
  1067.         default:        interp->result = "unknown"; break;
  1068.     }
  1069.     } else if ((c == 'v') && (strncmp(argv[1], "vrootheight", length) == 0)
  1070.         && (length >= 6)) {
  1071.     int x, y;
  1072.     unsigned int width, height;
  1073.  
  1074.     SETUP("vrootheight");
  1075.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1076.     sprintf(interp->result, "%d", height);
  1077.     } else if ((c == 'v') && (strncmp(argv[1], "vrootwidth", length) == 0)
  1078.         && (length >= 6)) {
  1079.     int x, y;
  1080.     unsigned int width, height;
  1081.  
  1082.     SETUP("vrootwidth");
  1083.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1084.     sprintf(interp->result, "%d", width);
  1085.     } else if ((c == 'v') && (strcmp(argv[1], "vrootx") == 0)) {
  1086.     int x, y;
  1087.     unsigned int width, height;
  1088.  
  1089.     SETUP("vrootx");
  1090.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1091.     sprintf(interp->result, "%d", x);
  1092.     } else if ((c == 'v') && (strcmp(argv[1], "vrooty") == 0)) {
  1093.     int x, y;
  1094.     unsigned int width, height;
  1095.  
  1096.     SETUP("vrooty");
  1097.     Tk_GetVRootGeometry(window, &x, &y, &width, &height);
  1098.     sprintf(interp->result, "%d", y);
  1099.     } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
  1100.     SETUP("width");
  1101.     sprintf(interp->result, "%d", Tk_Width(window));
  1102.     } else if ((c == 'x') && (argv[1][1] == '\0')) {
  1103.     SETUP("x");
  1104.     sprintf(interp->result, "%d", Tk_X(window));
  1105.     } else if ((c == 'y') && (argv[1][1] == '\0')) {
  1106.     SETUP("y");
  1107.     sprintf(interp->result, "%d", Tk_Y(window));
  1108.     } else {
  1109.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  1110.         "\": must be atom, atomname, cells, children, class, ",
  1111.         "depth, exists, fpixels, geometry, height, ",
  1112.         "id, interps, ismapped, name, parent, pathname, ",
  1113.         "pixels, reqheight, reqwidth, rgb, rootx, rooty, ",
  1114.         "screen, screencells, screendepth, screenheight, ",
  1115.         "screenmmheight, screenmmwidth, screenvisual, ",
  1116.         "screenwidth, toplevel, visual, vrootheight, vrootwidth, ",
  1117.         "vrootx, vrooty, width, x, or y", (char *) NULL);
  1118.     return TCL_ERROR;
  1119.     }
  1120.     return TCL_OK;
  1121.  
  1122.     wrongArgs:
  1123.     Tcl_AppendResult(interp, "wrong # arguments: must be \"",
  1124.         argv[0], " ", argName, " window\"", (char *) NULL);
  1125.     return TCL_ERROR;
  1126. }
  1127.  
  1128. /*
  1129.  *----------------------------------------------------------------------
  1130.  *
  1131.  * TkDeadAppCmd --
  1132.  *
  1133.  *    If an application has been deleted then all Tk commands will be
  1134.  *    re-bound to this procedure.
  1135.  *
  1136.  * Results:
  1137.  *    A standard Tcl error is reported to let the user know that
  1138.  *    the application is dead.
  1139.  *
  1140.  * Side effects:
  1141.  *    See the user documentation.
  1142.  *
  1143.  *----------------------------------------------------------------------
  1144.  */
  1145.  
  1146.     /* ARGSUSED */
  1147. int
  1148. TkDeadAppCmd(clientData, interp, argc, argv)
  1149.     ClientData clientData;    /* Dummy. */
  1150.     Tcl_Interp *interp;        /* Current interpreter. */
  1151.     int argc;            /* Number of arguments. */
  1152.     char **argv;        /* Argument strings. */
  1153. {
  1154.     Tcl_AppendResult(interp, "can't invoke \"", argv[0],
  1155.         "\" command:  application has been destroyed", (char *) NULL);
  1156.     return TCL_ERROR;
  1157. }
  1158.