Return to tkcmds.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tk

Annotation of micropolis/src/tk/tkcmds.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.