ckCmds.c

   1 /*
   2  * ckCmds.c --
   3  *
   4  *      This file contains a collection of Ck-related Tcl commands
   5  *      that didn't fit in any particular file of the toolkit.
   6  *
   7  * Copyright (c) 1990-1994 The Regents of the University of California.
   8  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
   9  * Copyright (c) 1995 Christian Werner
  10  *
  11  * See the file "license.terms" for information on usage and redistribution
  12  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13  */
  14
  15 #include "ckPort.h"
  16 #include "ck.h"
  17
  18 static char *     WaitVariableProc _ANSI_ARGS_((ClientData clientData,
  19                       Tcl_Interp *interp, char *name1, char *name2,
  20                       int flags));
  21 static void       WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
  22                       CkEvent *eventPtr));
  23 static void       WaitWindowProc _ANSI_ARGS_((ClientData clientData,
  24                       CkEvent *eventPtr));
  25
  26 \f
  27 /*
  28  *----------------------------------------------------------------------
  29  *
  30  * Ck_DestroyCmd --
  31  *
  32  *      This procedure is invoked to process the "destroy" Tcl command.
  33  *      See the user documentation for details on what it does.
  34  *
  35  * Results:
  36  *      A standard Tcl result.
  37  *
  38  * Side effects:
  39  *      See the user documentation.
  40  *
  41  *----------------------------------------------------------------------
  42  */
  43
  44 int
  45 Ck_DestroyCmd(clientData, interp, argc, argv)
  46     ClientData clientData;      /* Main window associated with
  47                                  * interpreter. */
  48     Tcl_Interp *interp;         /* Current interpreter. */
  49     int argc;                   /* Number of arguments. */
  50     char **argv;                /* Argument strings. */
  51 {
  52     CkWindow *winPtr;
  53     CkWindow *mainPtr = (CkWindow *) clientData;
  54     int i;
  55
  56     for (i = 1; i < argc; i++) {
  57         winPtr = Ck_NameToWindow(interp, argv[i], mainPtr);
  58         if (winPtr == NULL)
  59             return TCL_ERROR;
  60         Ck_DestroyWindow(winPtr);
  61     }
  62     return TCL_OK;
  63 }
  64 \f
  65 /*
  66  *----------------------------------------------------------------------
  67  *
  68  * Ck_ExitCmd --
  69  *
  70  *      This procedure is invoked to process the "exit" Tcl command.
  71  *      See the user documentation for details on what it does.
  72  *      Note: this command replaces the Tcl "exit" command in order
  73  *      to properly destroy all windows.
  74  *
  75  * Results:
  76  *      A standard Tcl result.
  77  *
  78  * Side effects:
  79  *      See the user documentation.
  80  *
  81  *----------------------------------------------------------------------
  82  */
  83
  84 int
  85 Ck_ExitCmd(clientData, interp, argc, argv)
  86     ClientData clientData;      /* Main window associated with
  87                                  * interpreter. */
  88     Tcl_Interp *interp;         /* Current interpreter. */
  89     int argc;                   /* Number of arguments. */
  90     char **argv;                /* Argument strings. */
  91 {
  92     extern CkMainInfo *ckMainInfo;
  93     int index = 1, noclear = 0, value = 0;
  94
  95     if (argc > 3) {
  96 badArgs:
  97         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  98                 " ?-noclear? ?returnCode?\"", (char *) NULL);
  99         return TCL_ERROR;
 100     }
 101     if (argc > 1 && strcmp(argv[1], "-noclear") == 0) {
 102         index++;
 103         noclear++;
 104     }
 105     if (argc > index &&
 106         Tcl_GetInt(interp, argv[index], &value) != TCL_OK) {
 107         return TCL_ERROR;
 108     }
 109
 110     if (ckMainInfo != NULL) {
 111         if (noclear) {
 112             ckMainInfo->flags |= CK_NOCLR_ON_EXIT;
 113         } else {
 114             ckMainInfo->flags &= ~CK_NOCLR_ON_EXIT;
 115         }
 116         Ck_DestroyWindow((CkWindow *) clientData);
 117     }
 118     endwin();   /* just in case */
 119 #if (TCL_MAJOR_VERSION >= 8)
 120     Tcl_Exit(value);
 121 #else
 122     exit(value);
 123 #endif
 124     /* NOTREACHED */
 125     return TCL_OK;
 126 }
 127 \f
 128 /*
 129  *----------------------------------------------------------------------
 130  *
 131  * Ck_LowerCmd --
 132  *
 133  *      This procedure is invoked to process the "lower" Tcl command.
 134  *      See the user documentation for details on what it does.
 135  *
 136  * Results:
 137  *      A standard Tcl result.
 138  *
 139  * Side effects:
 140  *      See the user documentation.
 141  *
 142  *----------------------------------------------------------------------
 143  */
 144
 145 int
 146 Ck_LowerCmd(clientData, interp, argc, argv)
 147     ClientData clientData;      /* Main window associated with
 148                                  * interpreter. */
 149     Tcl_Interp *interp;         /* Current interpreter. */
 150     int argc;                   /* Number of arguments. */
 151     char **argv;                /* Argument strings. */
 152 {
 153     CkWindow *mainPtr = (CkWindow *) clientData;
 154     CkWindow *winPtr, *other;
 155
 156     if ((argc != 2) && (argc != 3)) {
 157         Tcl_AppendResult(interp, "wrong # args: should be \"",
 158                 argv[0], " window ?belowThis?\"", (char *) NULL);
 159         return TCL_ERROR;
 160     }
 161
 162     winPtr = Ck_NameToWindow(interp, argv[1], mainPtr);
 163     if (winPtr == NULL)
 164         return TCL_ERROR;
 165     if (argc == 2)
 166         other = NULL;
 167     else {
 168         other = Ck_NameToWindow(interp, argv[2], mainPtr);
 169         if (other == NULL)
 170             return TCL_ERROR;
 171     }
 172     if (Ck_RestackWindow(winPtr, CK_BELOW, other) != TCL_OK) {
 173         Tcl_AppendResult(interp, "can't lower \"", argv[1], "\" below \"",
 174                 argv[2], "\"", (char *) NULL);
 175         return TCL_ERROR;
 176     }
 177     return TCL_OK;
 178 }
 179 \f
 180 /*
 181  *----------------------------------------------------------------------
 182  *
 183  * Ck_RaiseCmd --
 184  *
 185  *      This procedure is invoked to process the "raise" Tcl command.
 186  *      See the user documentation for details on what it does.
 187  *
 188  * Results:
 189  *      A standard Tcl result.
 190  *
 191  * Side effects:
 192  *      See the user documentation.
 193  *
 194  *----------------------------------------------------------------------
 195  */
 196
 197 int
 198 Ck_RaiseCmd(clientData, interp, argc, argv)
 199     ClientData clientData;      /* Main window associated with
 200                                  * interpreter. */
 201     Tcl_Interp *interp;         /* Current interpreter. */
 202     int argc;                   /* Number of arguments. */
 203     char **argv;                /* Argument strings. */
 204 {
 205     CkWindow *mainPtr = (CkWindow *) clientData;
 206     CkWindow *winPtr, *other;
 207
 208     if ((argc != 2) && (argc != 3)) {
 209         Tcl_AppendResult(interp, "wrong # args: should be \"",
 210                 argv[0], " window ?aboveThis?\"", (char *) NULL);
 211         return TCL_ERROR;
 212     }
 213
 214     winPtr = Ck_NameToWindow(interp, argv[1], mainPtr);
 215     if (winPtr == NULL)
 216         return TCL_ERROR;
 217     if (argc == 2)
 218         other = NULL;
 219     else {
 220         other = Ck_NameToWindow(interp, argv[2], mainPtr);
 221         if (other == NULL)
 222             return TCL_ERROR;
 223     }
 224     if (Ck_RestackWindow(winPtr, CK_ABOVE, other) != TCL_OK) {
 225         Tcl_AppendResult(interp, "can't raise \"", argv[1], "\" above \"",
 226                 argv[2], "\"", (char *) NULL);
 227         return TCL_ERROR;
 228     }
 229     return TCL_OK;
 230 }
 231 \f
 232 /*
 233  *----------------------------------------------------------------------
 234  *
 235  * Ck_BellCmd --
 236  *
 237  *      This procedure is invoked to process the "bell" Tcl command.
 238  *      See the user documentation for details on what it does.
 239  *
 240  * Results:
 241  *      A standard Tcl result.
 242  *
 243  * Side effects:
 244  *      See the user documentation.
 245  *
 246  *----------------------------------------------------------------------
 247  */
 248
 249 int
 250 Ck_BellCmd(clientData, interp, argc, argv)
 251     ClientData clientData;      /* Main window associated with
 252                                  * interpreter. */
 253     Tcl_Interp *interp;         /* Current interpreter. */
 254     int argc;                   /* Number of arguments. */
 255     char **argv;                /* Argument strings. */
 256 {
 257     beep();
 258     doupdate();
 259     return TCL_OK;
 260 }
 261 \f
 262 /*
 263  *----------------------------------------------------------------------
 264  *
 265  * Ck_UpdateCmd --
 266  *
 267  *      This procedure is invoked to process the "update" Tcl command.
 268  *      See the user documentation for details on what it does.
 269  *
 270  * Results:
 271  *      A standard Tcl result.
 272  *
 273  * Side effects:
 274  *      See the user documentation.
 275  *
 276  *----------------------------------------------------------------------
 277  */
 278
 279 int
 280 Ck_UpdateCmd(clientData, interp, argc, argv)
 281     ClientData clientData;      /* Main window associated with
 282                                  * interpreter. */
 283     Tcl_Interp *interp;         /* Current interpreter. */
 284     int argc;                   /* Number of arguments. */
 285     char **argv;                /* Argument strings. */
 286 {
 287     CkWindow *mainPtr = (CkWindow *) clientData;
 288     int flags;
 289
 290     if (argc == 1)
 291         flags = TK_DONT_WAIT;
 292     else if (argc == 2) {
 293         if (strncmp(argv[1], "screen", strlen(argv[1])) == 0) {
 294             wrefresh(curscr);
 295             Ck_EventuallyRefresh(mainPtr);
 296             return TCL_OK;
 297         }
 298         if (strncmp(argv[1], "idletasks", strlen(argv[1])) != 0) {
 299             Tcl_AppendResult(interp, "bad argument \"", argv[1],
 300                     "\": must be idletasks or screen", (char *) NULL);
 301             return TCL_ERROR;
 302         }
 303         flags = TK_IDLE_EVENTS;
 304     } else {
 305         Tcl_AppendResult(interp, "wrong # args: should be \"",
 306                 argv[0], " ?idletasks|screen?\"", (char *) NULL);
 307         return TCL_ERROR;
 308     }
 309
 310     /*
 311      * Handle all pending events, and repeat over and over
 312      * again until all pending events have been handled.
 313      */
 314
 315     while (Tk_DoOneEvent(flags) != 0) {
 316         /* Empty loop body */
 317     }
 318
 319     /*
 320      * Must clear the interpreter's result because event handlers could
 321      * have executed commands.
 322      */
 323
 324     Tcl_ResetResult(interp);
 325     return TCL_OK;
 326 }
 327 \f
 328 /*
 329  *----------------------------------------------------------------------
 330  *
 331  * Ck_CursesCmd --
 332  *
 333  *      This procedure is invoked to process the "curses" Tcl command.
 334  *      See the user documentation for details on what it does.
 335  *
 336  * Results:
 337  *      A standard Tcl result.
 338  *
 339  * Side effects:
 340  *      See the user documentation.
 341  *
 342  *----------------------------------------------------------------------
 343  */
 344
 345 int
 346 Ck_CursesCmd(clientData, interp, argc, argv)
 347     ClientData clientData;      /* Main window associated with
 348                                  * interpreter. */
 349     Tcl_Interp *interp;         /* Current interpreter. */
 350     int argc;                   /* Number of arguments. */
 351     char **argv;                /* Argument strings. */
 352 {
 353     CkWindow *winPtr = (CkWindow *) clientData;
 354     CkMainInfo *mainPtr = winPtr->mainPtr;
 355     int length;
 356     char c;
 357
 358     if (argc < 2) {
 359         Tcl_AppendResult(interp, "wrong # args: should be \"",
 360             argv[0], " option ?arg?\"", (char *) NULL);
 361         return TCL_ERROR;
 362     }
 363     c = argv[1][0];
 364     length = strlen(argv[1]);
 365     if ((c == 'b') && (strncmp(argv[1], "barcode", length) == 0)) {
 366         return CkBarcodeCmd(clientData, interp, argc, argv);
 367     } else if ((c == 'b') && (strncmp(argv[1], "baudrate", length) == 0)) {
 368         char buf[32];
 369
 370         if (argc != 2) {
 371             Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
 372                 " ", argv[1], "\"", (char *) NULL);
 373             return TCL_ERROR;
 374         }
 375         sprintf(buf, "%d", baudrate());
 376         Tcl_AppendResult(interp, buf, (char *) NULL);
 377         return TCL_OK;
 378     } else if ((c == 'e') && (strncmp(argv[1], "encoding", length) == 0)) {
 379         if (argc == 2)
 380             return Ck_GetEncoding(interp);
 381         else if (argc == 3)
 382             return Ck_SetEncoding(interp, argv[2]);
 383         else {
 384             Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
 385                 " ", argv[1], " ?name?\"", (char *) NULL);
 386             return TCL_ERROR;
 387         }
 388     } else if ((c == 'g') && (strncmp(argv[1], "gchar", length) == 0)) {
 389         int gchar;
 390
 391         if (argc == 3) {
 392             if (Ck_GetGChar(interp, argv[2], &gchar) != TCL_OK)
 393                 return TCL_ERROR;
 394             sprintf(interp->result, "%d", gchar);
 395         } else if (argc == 4) {
 396             if (Tcl_GetInt(interp, argv[3], &gchar) != TCL_OK)
 397                 return TCL_ERROR;
 398             if (Ck_SetGChar(interp, argv[2], gchar) != TCL_OK)
 399                 return TCL_ERROR;
 400         } else {
 401             Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
 402                 " ", argv[1], " charName ?value?\"", (char *) NULL);
 403             return TCL_ERROR;
 404         }
 405     } else if ((c == 'h') && (strncmp(argv[1], "haskey", length) == 0)) {
 406         if (argc > 3) {
 407             Tcl_AppendResult(interp, "wrong # args: should be \"",
 408                 argv[0], " haskey ?keySym?\"", (char *) NULL);
 409             return TCL_ERROR;
 410         }
 411         if (argc == 2)
 412             return CkAllKeyNames(interp);
 413         return CkTermHasKey(interp, argv[2]);
 414     } else if ((c == 'p') && (strncmp(argv[1], "purgeinput", length) == 0)) {
 415         if (argc != 2) {
 416             Tcl_AppendResult(interp, "wrong # args: should be \"",
 417                 argv[0], " purgeinput\"", (char *) NULL);
 418             return TCL_ERROR;
 419         }
 420         while (getch() != ERR) {
 421             /* Empty loop body. */
 422         }
 423         return TCL_OK;
 424     } else if ((c == 'r') && (strncmp(argv[1], "refreshdelay", length) == 0)) {
 425         if (argc == 2) {
 426             char buf[32];
 427
 428             sprintf(buf, "%d", mainPtr->refreshDelay);
 429             Tcl_AppendResult(interp, buf, (char *) NULL);
 430             return TCL_OK;
 431         } else if (argc == 3) {
 432             int delay;
 433
 434             if (Tcl_GetInt(interp, argv[2], &delay) != TCL_OK)
 435                 return TCL_ERROR;
 436             mainPtr->refreshDelay = delay < 0 ? 0 : delay;
 437             return TCL_OK;
 438         } else {
 439             Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
 440                 " ", argv[1], " ?milliseconds?\"", (char *) NULL);
 441             return TCL_ERROR;
 442         }
 443     } else if ((c == 'r') && (strncmp(argv[1], "reversekludge", length)
 444         == 0)) {
 445         int onoff;
 446
 447         if (argc == 2) {
 448             interp->result = (mainPtr->flags & CK_REVERSE_KLUDGE) ?
 449                 "1" : "0";
 450         } else if (argc == 3) {
 451             if (Tcl_GetBoolean(interp, argv[2], &onoff) != TCL_OK)
 452                 return TCL_ERROR;
 453             mainPtr->flags |= CK_REVERSE_KLUDGE;
 454         } else {
 455             Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
 456                 " ", argv[1], " ?bool?\"", (char *) NULL);
 457             return TCL_ERROR;
 458         }
 459     } else if ((c == 's') && (strncmp(argv[1], "screendump", length) == 0)) {
 460         Tcl_DString buffer;
 461         char *fileName;
 462 #ifdef HAVE_SCR_DUMP
 463         int ret;
 464 #endif
 465
 466         if (argc != 3) {
 467             Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
 468                 " ", argv[1], " filename\"", (char *) NULL);
 469             return TCL_ERROR;
 470         }
 471         fileName = Tcl_TildeSubst(interp, argv[2], &buffer);
 472         if (fileName == NULL) {
 473             Tcl_DStringFree(&buffer);
 474             return TCL_ERROR;
 475         }
 476 #ifdef HAVE_SCR_DUMP
 477         ret = scr_dump(fileName);
 478         Tcl_DStringFree(&buffer);
 479         if (ret != OK) {
 480             interp->result = "screen dump failed";
 481             return TCL_ERROR;
 482         }
 483         return TCL_OK;
 484 #else
 485         interp->result = "screen dump not supported by this curses";
 486         return TCL_ERROR;
 487 #endif
 488     } else if ((c == 's') && (strncmp(argv[1], "suspend", length) == 0)) {
 489         if (argc != 2) {
 490             Tcl_AppendResult(interp, "wrong # args: must be \"", argv[0],
 491                 " ", argv[1], "\"", (char *) NULL);
 492             return TCL_ERROR;
 493         }
 494 #if !defined(__WIN32__) && !defined(DJGPP)
 495         curs_set(1);
 496         endwin();
 497 #ifdef SIGTSTP
 498         kill(getpid(), SIGTSTP);
 499 #else
 500         kill(getpid(), SIGSTOP);
 501 #endif
 502         Ck_EventuallyRefresh(winPtr);
 503 #endif
 504     } else {
 505         Tcl_AppendResult(interp, "bad option \"", argv[1],
 506             "\": must be barcode, baudrate, encoding, gchar, haskey, ",
 507             "purgeinput, refreshdelay, reversekludge, screendump or suspend",
 508             (char *) NULL);
 509         return TCL_ERROR;
 510     }
 511     return TCL_OK;
 512 }
 513 \f
 514 /*
 515  *----------------------------------------------------------------------
 516  *
 517  * Ck_WinfoCmd --
 518  *
 519  *      This procedure is invoked to process the "winfo" Tcl command.
 520  *      See the user documentation for details on what it does.
 521  *
 522  * Results:
 523  *      A standard Tcl result.
 524  *
 525  * Side effects:
 526  *      See the user documentation.
 527  *
 528  *----------------------------------------------------------------------
 529  */
 530
 531 int
 532 Ck_WinfoCmd(clientData, interp, argc, argv)
 533     ClientData clientData;      /* Main window associated with
 534                                  * interpreter. */
 535     Tcl_Interp *interp;         /* Current interpreter. */
 536     int argc;                   /* Number of arguments. */
 537     char **argv;                /* Argument strings. */
 538 {
 539     CkWindow *mainPtr = (CkWindow *) clientData;
 540     int length;
 541     char c, *argName;
 542     CkWindow *winPtr;
 543
 544 #define SETUP(name) \
 545     if (argc != 3) {\
 546         argName = name; \
 547         goto wrongArgs; \
 548     } \
 549     winPtr = Ck_NameToWindow(interp, argv[2], mainPtr); \
 550     if (winPtr == NULL) { \
 551         return TCL_ERROR; \
 552     }
 553
 554
 555     if (argc < 2) {
 556         Tcl_AppendResult(interp, "wrong # args: should be \"",
 557                 argv[0], " option ?arg?\"", (char *) NULL);
 558         return TCL_ERROR;
 559     }
 560     c = argv[1][0];
 561     length = strlen(argv[1]);
 562     if ((c == 'c') && (strncmp(argv[1], "children", length) == 0)
 563             && (length >= 2)) {
 564         SETUP("children");
 565         for (winPtr = winPtr->childList; winPtr != NULL;
 566                 winPtr = winPtr->nextPtr) {
 567             Tcl_AppendElement(interp, winPtr->pathName);
 568         }
 569     } else if ((c == 'c') && (strncmp(argv[1], "containing", length) == 0)
 570             && (length >= 2)) {
 571         int x, y;
 572
 573         argName = "containing";
 574         if (argc != 4)
 575             goto wrongArgs;
 576         if (Tcl_GetInt(interp, argv[2], &x) != TCL_OK ||
 577             Tcl_GetInt(interp, argv[3], &y) != TCL_OK) {
 578             return TCL_ERROR;
 579         }
 580         winPtr = Ck_GetWindowXY(mainPtr->mainPtr, &x, &y, 0);
 581         if (winPtr != NULL) {
 582             interp->result = winPtr->pathName;
 583         }
 584     } else if ((c == 'd') && (strncmp(argv[1], "depth", length) == 0)) {
 585         SETUP("depth");
 586         interp->result = (winPtr->mainPtr->flags & CK_HAS_COLOR) ? "3" : "1";
 587     } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)) {
 588         if (argc != 3) {
 589             argName = "exists";
 590             goto wrongArgs;
 591         }
 592         if (Ck_NameToWindow(interp, argv[2], mainPtr) == NULL) {
 593             interp->result = "0";
 594         } else {
 595             interp->result = "1";
 596         }
 597     } else if ((c == 'g') && (strncmp(argv[1], "geometry", length) == 0)) {
 598         SETUP("geometry");
 599         sprintf(interp->result, "%dx%d+%d+%d", winPtr->width,
 600                 winPtr->height, winPtr->x, winPtr->y);
 601     } else if ((c == 'h') && (strncmp(argv[1], "height", length) == 0)) {
 602         SETUP("height");
 603         sprintf(interp->result, "%d", winPtr->height);
 604     } else if ((c == 'i') && (strncmp(argv[1], "ismapped", length) == 0)
 605             && (length >= 2)) {
 606         SETUP("ismapped");
 607         interp->result = (winPtr->flags & CK_MAPPED) ? "1" : "0";
 608     } else if ((c == 'm') && (strncmp(argv[1], "manager", length) == 0)) {
 609         SETUP("manager");
 610         if (winPtr->geomMgrPtr != NULL)
 611             interp->result = winPtr->geomMgrPtr->name;
 612     } else if ((c == 'n') && (strncmp(argv[1], "name", length) == 0)) {
 613         SETUP("name");
 614         interp->result = (char *) winPtr->nameUid;
 615     } else if ((c == 'c') && (strncmp(argv[1], "class", length) == 0)) {
 616         SETUP("class");
 617         interp->result = (char *) winPtr->classUid;
 618     } else if ((c == 'p') && (strncmp(argv[1], "parent", length) == 0)) {
 619         SETUP("parent");
 620         if (winPtr->parentPtr != NULL)
 621             interp->result = winPtr->parentPtr->pathName;
 622     } else if ((c == 'r') && (strncmp(argv[1], "reqheight", length) == 0)
 623             && (length >= 4)) {
 624         SETUP("reqheight");
 625         sprintf(interp->result, "%d", winPtr->reqHeight);
 626     } else if ((c == 'r') && (strncmp(argv[1], "reqwidth", length) == 0)
 627             && (length >= 4)) {
 628         SETUP("reqwidth");
 629         sprintf(interp->result, "%d", winPtr->reqWidth);
 630     } else if ((c == 'r') && (strncmp(argv[1], "rootx", length) == 0)
 631             && (length >= 4)) {
 632         int x;
 633
 634         SETUP("rootx");
 635         Ck_GetRootGeometry(winPtr, &x, NULL, NULL, NULL);
 636         sprintf(interp->result, "%d", x);
 637     } else if ((c == 'r') && (strncmp(argv[1], "rooty", length) == 0)
 638             && (length >= 4)) {
 639         int y;
 640
 641         SETUP("rooty");
 642         Ck_GetRootGeometry(winPtr, NULL, &y, NULL, NULL);
 643         sprintf(interp->result, "%d", y);
 644     } else if ((c == 's') && (strncmp(argv[1], "screenheight", length) == 0)
 645             && (length >= 7)) {
 646         SETUP("screenheight");
 647         sprintf(interp->result, "%d", winPtr->mainPtr->winPtr->height);
 648     } else if ((c == 's') && (strncmp(argv[1], "screenwidth", length) == 0)
 649             && (length >= 7)) {
 650         SETUP("screenwidth");
 651         sprintf(interp->result, "%d", winPtr->mainPtr->winPtr->width);
 652     } else if ((c == 't') && (strncmp(argv[1], "toplevel", length) == 0)) {
 653         SETUP("toplevel");
 654         for (; winPtr != NULL; winPtr = winPtr->parentPtr) {
 655             if (winPtr->flags & CK_TOPLEVEL) {
 656                 interp->result = winPtr->pathName;
 657                 break;
 658             }
 659         }
 660     } else if ((c == 'w') && (strncmp(argv[1], "width", length) == 0)) {
 661         SETUP("width");
 662         sprintf(interp->result, "%d", winPtr->width);
 663     } else if ((c == 'x') && (argv[1][1] == '\0')) {
 664         SETUP("x");
 665         sprintf(interp->result, "%d", winPtr->x);
 666     } else if ((c == 'y') && (argv[1][1] == '\0')) {
 667         SETUP("y");
 668         sprintf(interp->result, "%d", winPtr->y);
 669     } else {
 670         Tcl_AppendResult(interp, "bad option \"", argv[1],
 671                 "\": must be children, class, containing, depth ",
 672                 "exists, geometry, height, ",
 673                 "ismapped, manager, name, parent, ",
 674                 "reqheight, reqwidth, rootx, rooty, ",
 675                 "screenheight, screenwidth, ",
 676                 "toplevel, width, x, or y", (char *) NULL);
 677         return TCL_ERROR;
 678     }
 679     return TCL_OK;
 680
 681     wrongArgs:
 682     Tcl_AppendResult(interp, "wrong # arguments: must be \"",
 683             argv[0], " ", argName, " window\"", (char *) NULL);
 684     return TCL_ERROR;
 685 }
 686 \f
 687 /*
 688  *----------------------------------------------------------------------
 689  *
 690  * Ck_BindCmd --
 691  *
 692  *      This procedure is invoked to process the "bind" Tcl command.
 693  *      See the user documentation for details on what it does.
 694  *
 695  * Results:
 696  *      A standard Tcl result.
 697  *
 698  * Side effects:
 699  *      See the user documentation.
 700  *
 701  *----------------------------------------------------------------------
 702  */
 703
 704 int
 705 Ck_BindCmd(clientData, interp, argc, argv)
 706     ClientData clientData;      /* Main window associated with interpreter. */
 707     Tcl_Interp *interp;         /* Current interpreter. */
 708     int argc;                   /* Number of arguments. */
 709     char **argv;                /* Argument strings. */
 710 {
 711     CkWindow *mainWin = (CkWindow *) clientData;
 712     CkWindow *winPtr;
 713     ClientData object;
 714
 715     if ((argc < 2) || (argc > 4)) {
 716         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 717                 " window ?pattern? ?command?\"", (char *) NULL);
 718         return TCL_ERROR;
 719     }
 720     if (argv[1][0] == '.') {
 721         winPtr = (CkWindow *) Ck_NameToWindow(interp, argv[1], mainWin);
 722         if (winPtr == NULL) {
 723             return TCL_ERROR;
 724         }
 725         object = (ClientData) winPtr->pathName;
 726     } else {
 727         winPtr = (CkWindow *) clientData;
 728         object = (ClientData) Ck_GetUid(argv[1]);
 729     }
 730
 731     if (argc == 4) {
 732         int append = 0;
 733
 734         if (argv[3][0] == 0) {
 735             return Ck_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
 736                     object, argv[2]);
 737         }
 738         if (argv[3][0] == '+') {
 739             argv[3]++;
 740             append = 1;
 741         }
 742         if (Ck_CreateBinding(interp, winPtr->mainPtr->bindingTable,
 743                 object, argv[2], argv[3], append) != TCL_OK) {
 744             return TCL_ERROR;
 745         }
 746     } else if (argc == 3) {
 747         char *command;
 748
 749         command = Ck_GetBinding(interp, winPtr->mainPtr->bindingTable,
 750                 object, argv[2]);
 751         if (command == NULL) {
 752             Tcl_ResetResult(interp);
 753             return TCL_OK;
 754         }
 755         interp->result = command;
 756     } else {
 757         Ck_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
 758     }
 759     return TCL_OK;
 760 }
 761 \f
 762 /*
 763  *----------------------------------------------------------------------
 764  *
 765  * CkBindEventProc --
 766  *
 767  *      This procedure is invoked by Ck_HandleEvent for each event;  it
 768  *      causes any appropriate bindings for that event to be invoked.
 769  *
 770  * Results:
 771  *      None.
 772  *
 773  * Side effects:
 774  *      Depends on what bindings have been established with the "bind"
 775  *      command.
 776  *
 777  *----------------------------------------------------------------------
 778  */
 779
 780 void
 781 CkBindEventProc(winPtr, eventPtr)
 782     CkWindow *winPtr;                   /* Pointer to info about window. */
 783     CkEvent *eventPtr;                  /* Information about event. */
 784 {
 785 #define MAX_OBJS 20
 786     ClientData objects[MAX_OBJS], *objPtr;
 787     static Ck_Uid allUid = NULL;
 788     int i, count;
 789     char *p;
 790     Tcl_HashEntry *hPtr;
 791     CkWindow *topLevPtr;
 792
 793     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
 794         return;
 795     }
 796
 797     objPtr = objects;
 798     if (winPtr->numTags != 0) {
 799         /*
 800          * Make a copy of the tags for the window, replacing window names
 801          * with pointers to the pathName from the appropriate window.
 802          */
 803
 804         if (winPtr->numTags > MAX_OBJS) {
 805             objPtr = (ClientData *) ckalloc(winPtr->numTags *
 806                 sizeof (ClientData));
 807         }
 808         for (i = 0; i < winPtr->numTags; i++) {
 809             p = (char *) winPtr->tagPtr[i];
 810             if (*p == '.') {
 811                 hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
 812                 if (hPtr != NULL) {
 813                     p = ((CkWindow *) Tcl_GetHashValue(hPtr))->pathName;
 814                 } else {
 815                     p = NULL;
 816                 }
 817             }
 818             objPtr[i] = (ClientData) p;
 819         }
 820         count = winPtr->numTags;
 821     } else {
 822         objPtr[0] = (ClientData) winPtr->pathName;
 823         objPtr[1] = (ClientData) winPtr->classUid;
 824         for (topLevPtr = winPtr; topLevPtr != NULL &&
 825              !(topLevPtr->flags & CK_TOPLEVEL);
 826              topLevPtr = topLevPtr->parentPtr) {
 827              /* Empty loop body. */
 828         }
 829         if (winPtr != topLevPtr && topLevPtr != NULL) {
 830             objPtr[2] = (ClientData) topLevPtr->pathName;
 831             count = 4;
 832         } else
 833             count = 3;
 834         if (allUid == NULL) {
 835             allUid = Ck_GetUid("all");
 836         }
 837         objPtr[count - 1] = (ClientData) allUid;
 838     }
 839     Ck_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, winPtr,
 840             count, objPtr);
 841     if (objPtr != objects) {
 842         ckfree((char *) objPtr);
 843     }
 844 }
 845 \f
 846 /*
 847  *----------------------------------------------------------------------
 848  *
 849  * Ck_BindtagsCmd --
 850  *
 851  *      This procedure is invoked to process the "bindtags" Tcl command.
 852  *      See the user documentation for details on what it does.
 853  *
 854  * Results:
 855  *      A standard Tcl result.
 856  *
 857  * Side effects:
 858  *      See the user documentation.
 859  *
 860  *----------------------------------------------------------------------
 861  */
 862
 863 int
 864 Ck_BindtagsCmd(clientData, interp, argc, argv)
 865     ClientData clientData;      /* Main window associated with interpreter. */
 866     Tcl_Interp *interp;         /* Current interpreter. */
 867     int argc;                   /* Number of arguments. */
 868     char **argv;                /* Argument strings. */
 869 {
 870     CkWindow *mainWin = (CkWindow *) clientData;
 871     CkWindow *winPtr, *winPtr2;
 872     int i, tagArgc;
 873     char *p, **tagArgv;
 874
 875     if ((argc < 2) || (argc > 3)) {
 876         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
 877                 " window ?tags?\"", (char *) NULL);
 878         return TCL_ERROR;
 879     }
 880     winPtr = (CkWindow *) Ck_NameToWindow(interp, argv[1], mainWin);
 881     if (winPtr == NULL) {
 882         return TCL_ERROR;
 883     }
 884     if (argc == 2) {
 885         if (winPtr->numTags == 0) {
 886             Tcl_AppendElement(interp, winPtr->pathName);
 887             Tcl_AppendElement(interp, winPtr->classUid);
 888             for (winPtr2 = winPtr; winPtr2 != NULL &&
 889                  !(winPtr2->flags & CK_TOPLEVEL);
 890                  winPtr2 = winPtr2->parentPtr) {
 891                  /* Empty loop body. */
 892             }
 893             if (winPtr != winPtr2 && winPtr2 != NULL)
 894                 Tcl_AppendElement(interp, winPtr2->pathName);
 895             Tcl_AppendElement(interp, "all");
 896         } else {
 897             for (i = 0; i < winPtr->numTags; i++) {
 898                 Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]);
 899             }
 900         }
 901         return TCL_OK;
 902     }
 903     if (winPtr->tagPtr != NULL) {
 904         CkFreeBindingTags(winPtr);
 905     }
 906     if (argv[2][0] == 0) {
 907         return TCL_OK;
 908     }
 909     if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) {
 910         return TCL_ERROR;
 911     }
 912     winPtr->numTags = tagArgc;
 913     winPtr->tagPtr = (ClientData *) ckalloc(tagArgc * sizeof(ClientData));
 914     for (i = 0; i < tagArgc; i++) {
 915         p = tagArgv[i];
 916         if (p[0] == '.') {
 917             char *copy;
 918
 919             /*
 920              * Handle names starting with "." specially: store a malloc'ed
 921              * string, rather than a Uid;  at event time we'll look up the
 922              * name in the window table and use the corresponding window,
 923              * if there is one.
 924              */
 925
 926             copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
 927             strcpy(copy, p);
 928             winPtr->tagPtr[i] = (ClientData) copy;
 929         } else {
 930             winPtr->tagPtr[i] = (ClientData) Ck_GetUid(p);
 931         }
 932     }
 933     ckfree((char *) tagArgv);
 934     return TCL_OK;
 935 }
 936 \f
 937 /*
 938  *----------------------------------------------------------------------
 939  *
 940  * CkFreeBindingTags --
 941  *
 942  *      This procedure is called to free all of the binding tags
 943  *      associated with a window;  typically it is only invoked where
 944  *      there are window-specific tags.
 945  *
 946  * Results:
 947  *      None.
 948  *
 949  * Side effects:
 950  *      Any binding tags for winPtr are freed.
 951  *
 952  *----------------------------------------------------------------------
 953  */
 954
 955 void
 956 CkFreeBindingTags(winPtr)
 957     CkWindow *winPtr;           /* Window whose tags are to be released. */
 958 {
 959     int i;
 960     char *p;
 961
 962     for (i = 0; i < winPtr->numTags; i++) {
 963         p = (char *) (winPtr->tagPtr[i]);
 964         if (*p == '.') {
 965             /*
 966              * Names starting with "." are malloced rather than Uids, so
 967              * they have to be freed.
 968              */
 969
 970             ckfree(p);
 971         }
 972     }
 973     ckfree((char *) winPtr->tagPtr);
 974     winPtr->numTags = 0;
 975     winPtr->tagPtr = NULL;
 976 }
 977 \f
 978 /*
 979  *----------------------------------------------------------------------
 980  *
 981  * Ck_TkwaitCmd --
 982  *
 983  *      This procedure is invoked to process the "tkwait" Tcl command.
 984  *      See the user documentation for details on what it does.
 985  *
 986  * Results:
 987  *      A standard Tcl result.
 988  *
 989  * Side effects:
 990  *      See the user documentation.
 991  *
 992  *----------------------------------------------------------------------
 993  */
 994
 995 int
 996 Ck_TkwaitCmd(clientData, interp, argc, argv)
 997     ClientData clientData;      /* Main window associated with
 998                                  * interpreter. */
 999     Tcl_Interp *interp;         /* Current interpreter. */
1000     int argc;                   /* Number of arguments. */
1001     char **argv;                /* Argument strings. */
1002 {
1003     CkWindow *mainPtr = (CkWindow *) clientData;
1004     int c, done;
1005     size_t length;
1006
1007     if (argc != 3) {
1008         Tcl_AppendResult(interp, "wrong # args: should be \"",
1009                 argv[0], " variable|visible|window name\"", (char *) NULL);
1010         return TCL_ERROR;
1011     }
1012     c = argv[1][0];
1013     length = strlen(argv[1]);
1014     if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
1015             && (length >= 2)) {
1016         if (Tcl_TraceVar(interp, argv[2],
1017                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1018                 WaitVariableProc, (ClientData) &done) != TCL_OK) {
1019             return TCL_ERROR;
1020         }
1021         done = 0;
1022         while (!done) {
1023             Tk_DoOneEvent(0);
1024         }
1025         Tcl_UntraceVar(interp, argv[2],
1026                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
1027                 WaitVariableProc, (ClientData) &done);
1028     } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)
1029             && (length >= 2)) {
1030         CkWindow *winPtr;
1031
1032         winPtr = Ck_NameToWindow(interp, argv[2], mainPtr);
1033         if (winPtr == NULL) {
1034             return TCL_ERROR;
1035         }
1036         Ck_CreateEventHandler(winPtr,
1037             CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY,
1038             WaitVisibilityProc, (ClientData) &done);
1039         done = 0;
1040         while (!done) {
1041             Tk_DoOneEvent(0);
1042         }
1043         Ck_DeleteEventHandler(winPtr,
1044             CK_EV_MAP | CK_EV_UNMAP | CK_EV_EXPOSE | CK_EV_DESTROY,
1045             WaitVisibilityProc, (ClientData) &done);
1046     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
1047         CkWindow *winPtr;
1048
1049         winPtr = Ck_NameToWindow(interp, argv[2], mainPtr);
1050         if (winPtr == NULL) {
1051             return TCL_ERROR;
1052         }
1053         Ck_CreateEventHandler(winPtr, CK_EV_DESTROY,
1054             WaitWindowProc, (ClientData) &done);
1055         done = 0;
1056         while (!done) {
1057             Tk_DoOneEvent(0);
1058         }
1059         /*
1060          * Note:  there's no need to delete the event handler.  It was
1061          * deleted automatically when the window was destroyed.
1062          */
1063     } else {
1064         Tcl_AppendResult(interp, "bad option \"", argv[1],
1065                 "\": must be variable, visibility, or window", (char *) NULL);
1066         return TCL_ERROR;
1067     }
1068
1069     /*
1070      * Clear out the interpreter's result, since it may have been set
1071      * by event handlers.
1072      */
1073
1074     Tcl_ResetResult(interp);
1075     return TCL_OK;
1076 }
1077
1078 static char *
1079 WaitVariableProc(clientData, interp, name1, name2, flags)
1080     ClientData clientData;      /* Pointer to integer to set to 1. */
1081     Tcl_Interp *interp;         /* Interpreter containing variable. */
1082     char *name1;                /* Name of variable. */
1083     char *name2;                /* Second part of variable name. */
1084     int flags;                  /* Information about what happened. */
1085 {
1086     int *donePtr = (int *) clientData;
1087
1088     *donePtr = 1;
1089     return (char *) NULL;
1090 }
1091
1092 static void
1093 WaitVisibilityProc(clientData, eventPtr)
1094     ClientData clientData;      /* Pointer to integer to set to 1. */
1095     CkEvent *eventPtr;          /* Information about event (not used). */
1096 {
1097     int *donePtr = (int *) clientData;
1098
1099     *donePtr = 1;
1100 }
1101
1102 static void
1103 WaitWindowProc(clientData, eventPtr)
1104     ClientData clientData;      /* Pointer to integer to set to 1. */
1105     CkEvent *eventPtr;          /* Information about event. */
1106 {
1107     int *donePtr = (int *) clientData;
1108
1109     if (eventPtr->type == CK_EV_DESTROY) {
1110         *donePtr = 1;
1111     }
1112 }