/[dtapublic]/projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkcmds.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkcmds.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/tk_base/tkcmds.c revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkcmds.c revision 220 by dashley, Sun Jul 22 15:58:07 2018 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkcmds.c,v 1.1.1.1 2001/06/13 04:58:24 dtashley Exp $ */  
   
 /*  
  * tkCmds.c --  
  *  
  *      This file contains a collection of Tk-related Tcl commands  
  *      that didn't fit in any particular file of the toolkit.  
  *  
  * Copyright (c) 1990-1994 The Regents of the University of California.  
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tkcmds.c,v 1.1.1.1 2001/06/13 04:58:24 dtashley Exp $  
  */  
   
 #include "tkPort.h"  
 #include "tkInt.h"  
 #include <errno.h>  
   
 #if defined(__WIN32__)  
 #include "tkWinInt.h"  
 #elif defined(MAC_TCL)  
 #include "tkMacInt.h"  
 #else  
 #include "tkUnixInt.h"  
 #endif  
   
 /*  
  * Forward declarations for procedures defined later in this file:  
  */  
   
 static TkWindow *       GetToplevel _ANSI_ARGS_((Tk_Window tkwin));  
 static char *           WaitVariableProc _ANSI_ARGS_((ClientData clientData,  
                             Tcl_Interp *interp, char *name1, char *name2,  
                             int flags));  
 static void             WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,  
                             XEvent *eventPtr));  
 static void             WaitWindowProc _ANSI_ARGS_((ClientData clientData,  
                             XEvent *eventPtr));  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_BellObjCmd --  
  *  
  *      This procedure is invoked to process the "bell" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_BellObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     static char *bellOptions[] = {"-displayof", (char *) NULL};  
     Tk_Window tkwin = (Tk_Window) clientData;  
     char *displayName;  
     int index;  
   
     if ((objc != 1) && (objc != 3)) {  
         Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window?");  
         return TCL_ERROR;  
     }  
   
     if (objc == 3) {  
         if (Tcl_GetIndexFromObj(interp, objv[1], bellOptions, "option", 0,  
                 &index) != TCL_OK) {  
             return TCL_ERROR;  
         }  
         displayName = Tcl_GetStringFromObj(objv[2], (int *) NULL);  
           
         tkwin = Tk_NameToWindow(interp, displayName, tkwin);  
         if (tkwin == NULL) {  
             return TCL_ERROR;  
         }  
     }  
     XBell(Tk_Display(tkwin), 0);  
     XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);  
     XFlush(Tk_Display(tkwin));  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_BindCmd --  
  *  
  *      This procedure is invoked to process the "bind" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_BindCmd(clientData, interp, argc, argv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int argc;                   /* Number of arguments. */  
     char **argv;                /* Argument strings. */  
 {  
     Tk_Window tkwin = (Tk_Window) clientData;  
     TkWindow *winPtr;  
     ClientData object;  
   
     if ((argc < 2) || (argc > 4)) {  
         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                 " window ?pattern? ?command?\"", (char *) NULL);  
         return TCL_ERROR;  
     }  
     if (argv[1][0] == '.') {  
         winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);  
         if (winPtr == NULL) {  
             return TCL_ERROR;  
         }  
         object = (ClientData) winPtr->pathName;  
     } else {  
         winPtr = (TkWindow *) clientData;  
         object = (ClientData) Tk_GetUid(argv[1]);  
     }  
   
     if (argc == 4) {  
         int append = 0;  
         unsigned long mask;  
   
         if (argv[3][0] == 0) {  
             return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,  
                     object, argv[2]);  
         }  
         if (argv[3][0] == '+') {  
             argv[3]++;  
             append = 1;  
         }  
         mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,  
                 object, argv[2], argv[3], append);  
         if (mask == 0) {  
             return TCL_ERROR;  
         }  
     } else if (argc == 3) {  
         char *command;  
   
         command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,  
                 object, argv[2]);  
         if (command == NULL) {  
             Tcl_ResetResult(interp);  
             return TCL_OK;  
         }  
         Tcl_SetResult(interp, command, TCL_STATIC);  
     } else {  
         Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TkBindEventProc --  
  *  
  *      This procedure is invoked by Tk_HandleEvent for each event;  it  
  *      causes any appropriate bindings for that event to be invoked.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Depends on what bindings have been established with the "bind"  
  *      command.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 TkBindEventProc(winPtr, eventPtr)  
     TkWindow *winPtr;                   /* Pointer to info about window. */  
     XEvent *eventPtr;                   /* Information about event. */  
 {  
 #define MAX_OBJS 20  
     ClientData objects[MAX_OBJS], *objPtr;  
     TkWindow *topLevPtr;  
     int i, count;  
     char *p;  
     Tcl_HashEntry *hPtr;  
   
     if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {  
         return;  
     }  
   
     objPtr = objects;  
     if (winPtr->numTags != 0) {  
         /*  
          * Make a copy of the tags for the window, replacing window names  
          * with pointers to the pathName from the appropriate window.  
          */  
   
         if (winPtr->numTags > MAX_OBJS) {  
             objPtr = (ClientData *) ckalloc((unsigned)  
                     (winPtr->numTags * sizeof(ClientData)));  
         }  
         for (i = 0; i < winPtr->numTags; i++) {  
             p = (char *) winPtr->tagPtr[i];  
             if (*p == '.') {  
                 hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);  
                 if (hPtr != NULL) {  
                     p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;  
                 } else {  
                     p = NULL;  
                 }  
             }  
             objPtr[i] = (ClientData) p;  
         }  
         count = winPtr->numTags;  
     } else {  
         objPtr[0] = (ClientData) winPtr->pathName;  
         objPtr[1] = (ClientData) winPtr->classUid;  
         for (topLevPtr = winPtr;  
                 (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_LEVEL);  
                 topLevPtr = topLevPtr->parentPtr) {  
             /* Empty loop body. */  
         }  
         if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {  
             count = 4;  
             objPtr[2] = (ClientData) topLevPtr->pathName;  
         } else {  
             count = 3;  
         }  
         objPtr[count-1] = (ClientData) Tk_GetUid("all");  
     }  
     Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,  
             count, objPtr);  
     if (objPtr != objects) {  
         ckfree((char *) objPtr);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_BindtagsCmd --  
  *  
  *      This procedure is invoked to process the "bindtags" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_BindtagsCmd(clientData, interp, argc, argv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int argc;                   /* Number of arguments. */  
     char **argv;                /* Argument strings. */  
 {  
     Tk_Window tkwin = (Tk_Window) clientData;  
     TkWindow *winPtr, *winPtr2;  
     int i, tagArgc;  
     char *p, **tagArgv;  
   
     if ((argc < 2) || (argc > 3)) {  
         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],  
                 " window ?tags?\"", (char *) NULL);  
         return TCL_ERROR;  
     }  
     winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);  
     if (winPtr == NULL) {  
         return TCL_ERROR;  
     }  
     if (argc == 2) {  
         if (winPtr->numTags == 0) {  
             Tcl_AppendElement(interp, winPtr->pathName);  
             Tcl_AppendElement(interp, winPtr->classUid);  
             for (winPtr2 = winPtr;  
                     (winPtr2 != NULL) && !(winPtr2->flags & TK_TOP_LEVEL);  
                     winPtr2 = winPtr2->parentPtr) {  
                 /* Empty loop body. */  
             }  
             if ((winPtr != winPtr2) && (winPtr2 != NULL)) {  
                 Tcl_AppendElement(interp, winPtr2->pathName);  
             }  
             Tcl_AppendElement(interp, "all");  
         } else {  
             for (i = 0; i < winPtr->numTags; i++) {  
                 Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]);  
             }  
         }  
         return TCL_OK;  
     }  
     if (winPtr->tagPtr != NULL) {  
         TkFreeBindingTags(winPtr);  
     }  
     if (argv[2][0] == 0) {  
         return TCL_OK;  
     }  
     if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) {  
         return TCL_ERROR;  
     }  
     winPtr->numTags = tagArgc;  
     winPtr->tagPtr = (ClientData *) ckalloc((unsigned)  
             (tagArgc * sizeof(ClientData)));  
     for (i = 0; i < tagArgc; i++) {  
         p = tagArgv[i];  
         if (p[0] == '.') {  
             char *copy;  
   
             /*  
              * Handle names starting with "." specially: store a malloc'ed  
              * string, rather than a Uid;  at event time we'll look up the  
              * name in the window table and use the corresponding window,  
              * if there is one.  
              */  
   
             copy = (char *) ckalloc((unsigned) (strlen(p) + 1));  
             strcpy(copy, p);  
             winPtr->tagPtr[i] = (ClientData) copy;  
         } else {  
             winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);  
         }  
     }  
     ckfree((char *) tagArgv);  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TkFreeBindingTags --  
  *  
  *      This procedure is called to free all of the binding tags  
  *      associated with a window;  typically it is only invoked where  
  *      there are window-specific tags.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Any binding tags for winPtr are freed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 TkFreeBindingTags(winPtr)  
     TkWindow *winPtr;           /* Window whose tags are to be released. */  
 {  
     int i;  
     char *p;  
   
     for (i = 0; i < winPtr->numTags; i++) {  
         p = (char *) (winPtr->tagPtr[i]);  
         if (*p == '.') {  
             /*  
              * Names starting with "." are malloced rather than Uids, so  
              * they have to be freed.  
              */  
       
             ckfree(p);  
         }  
     }  
     ckfree((char *) winPtr->tagPtr);  
     winPtr->numTags = 0;  
     winPtr->tagPtr = NULL;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_DestroyObjCmd --  
  *  
  *      This procedure is invoked to process the "destroy" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_DestroyObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;              /* Main window associated with  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     Tk_Window window;  
     Tk_Window tkwin = (Tk_Window) clientData;  
     int i;  
   
     for (i = 1; i < objc; i++) {  
         window = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);  
         if (window == NULL) {  
             Tcl_ResetResult(interp);  
             continue;  
         }  
         Tk_DestroyWindow(window);  
         if (window == tkwin) {  
             /*  
              * We just deleted the main window for the application! This  
              * makes it impossible to do anything more (tkwin isn't  
              * valid anymore).  
              */  
   
             break;  
          }  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_LowerObjCmd --  
  *  
  *      This procedure is invoked to process the "lower" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 Tk_LowerObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     Tk_Window mainwin = (Tk_Window) clientData;  
     Tk_Window tkwin, other;  
   
     if ((objc != 2) && (objc != 3)) {  
         Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");  
         return TCL_ERROR;  
     }  
   
     tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);  
     if (tkwin == NULL) {  
         return TCL_ERROR;  
     }  
     if (objc == 2) {  
         other = NULL;  
     } else {  
         other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);  
         if (other == NULL) {  
             return TCL_ERROR;  
         }  
     }  
     if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {  
         Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),  
                 "\" below \"", (other ? Tcl_GetString(objv[2]) : ""),  
                 "\"", (char *) NULL);  
         return TCL_ERROR;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_RaiseObjCmd --  
  *  
  *      This procedure is invoked to process the "raise" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 Tk_RaiseObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     Tk_Window mainwin = (Tk_Window) clientData;  
     Tk_Window tkwin, other;  
   
     if ((objc != 2) && (objc != 3)) {  
         Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");  
         return TCL_ERROR;  
     }  
   
     tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);  
     if (tkwin == NULL) {  
         return TCL_ERROR;  
     }  
     if (objc == 2) {  
         other = NULL;  
     } else {  
         other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);  
         if (other == NULL) {  
             return TCL_ERROR;  
         }  
     }  
     if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {  
         Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),  
                 "\" above \"", (other ? Tcl_GetString(objv[2]) : ""),  
                 "\"", (char *) NULL);  
         return TCL_ERROR;  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_TkObjCmd --  
  *  
  *      This procedure is invoked to process the "tk" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_TkObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     int index;  
     Tk_Window tkwin;  
     static char *optionStrings[] = {  
         "appname",      "scaling",      "useinputmethods",      NULL  
     };  
     enum options {  
         TK_APPNAME,     TK_SCALING,     TK_USE_IM  
     };  
   
     tkwin = (Tk_Window) clientData;  
   
     if (objc < 2) {  
         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");  
         return TCL_ERROR;  
     }  
     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,  
             &index) != TCL_OK) {  
         return TCL_ERROR;  
     }  
   
     switch ((enum options) index) {  
         case TK_APPNAME: {  
             TkWindow *winPtr;  
             char *string;  
   
             winPtr = (TkWindow *) tkwin;  
   
             if (objc > 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "?newName?");  
                 return TCL_ERROR;  
             }  
             if (objc == 3) {  
                 string = Tcl_GetStringFromObj(objv[2], NULL);  
                 winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));  
             }  
             Tcl_AppendResult(interp, winPtr->nameUid, NULL);  
             break;  
         }  
         case TK_SCALING: {  
             Screen *screenPtr;  
             int skip, width, height;  
             double d;  
   
             screenPtr = Tk_Screen(tkwin);  
   
             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);  
             if (skip < 0) {  
                 return TCL_ERROR;  
             }  
             if (objc - skip == 2) {  
                 d = 25.4 / 72;  
                 d *= WidthOfScreen(screenPtr);  
                 d /= WidthMMOfScreen(screenPtr);  
                 Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);  
             } else if (objc - skip == 3) {  
                 if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {  
                     return TCL_ERROR;  
                 }  
                 d = (25.4 / 72) / d;  
                 width = (int) (d * WidthOfScreen(screenPtr) + 0.5);  
                 if (width <= 0) {  
                     width = 1;  
                 }  
                 height = (int) (d * HeightOfScreen(screenPtr) + 0.5);  
                 if (height <= 0) {  
                     height = 1;  
                 }  
                 WidthMMOfScreen(screenPtr) = width;  
                 HeightMMOfScreen(screenPtr) = height;  
             } else {  
                 Tcl_WrongNumArgs(interp, 2, objv,  
                         "?-displayof window? ?factor?");  
                 return TCL_ERROR;  
             }  
             break;  
         }  
         case TK_USE_IM: {  
             TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;  
             int skip;  
   
             skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);  
             if (skip < 0) {  
                 return TCL_ERROR;  
             } else if (skip) {  
                 dispPtr = ((TkWindow *) tkwin)->dispPtr;  
             }  
             if ((objc - skip) == 3) {  
                 /*  
                  * In the case where TK_USE_INPUT_METHODS is not defined,  
                  * this will be ignored and we will always return 0.  
                  * That will indicate to the user that input methods  
                  * are just not available.  
                  */  
                 int bool;  
                 if (Tcl_GetBooleanFromObj(interp, objv[2+skip], &bool)  
                         != TCL_OK) {  
                     return TCL_ERROR;  
                 }  
 #ifdef TK_USE_INPUT_METHODS  
                 dispPtr->useInputMethods = bool;  
 #endif /* TK_USE_INPUT_METHODS */  
             } else if ((objc - skip) != 2) {  
                 Tcl_WrongNumArgs(interp, 2, objv,  
                         "?-displayof window? ?boolean?");  
                 return TCL_ERROR;  
             }  
             Tcl_SetBooleanObj(Tcl_GetObjResult(interp),  
                     dispPtr->useInputMethods);  
             break;  
         }  
     }  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_TkwaitCmd --  
  *  
  *      This procedure is invoked to process the "tkwait" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 Tk_TkwaitCmd(clientData, interp, argc, argv)  
     ClientData clientData;      /* Main window associated with  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int argc;                   /* Number of arguments. */  
     char **argv;                /* Argument strings. */  
 {  
     Tk_Window tkwin = (Tk_Window) clientData;  
     int c, done;  
     size_t length;  
   
     if (argc != 3) {  
         Tcl_AppendResult(interp, "wrong # args: should be \"",  
                 argv[0], " variable|visibility|window name\"", (char *) NULL);  
         return TCL_ERROR;  
     }  
     c = argv[1][0];  
     length = strlen(argv[1]);  
     if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)  
             && (length >= 2)) {  
         if (Tcl_TraceVar(interp, argv[2],  
                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,  
                 WaitVariableProc, (ClientData) &done) != TCL_OK) {  
             return TCL_ERROR;  
         }  
         done = 0;  
         while (!done) {  
             Tcl_DoOneEvent(0);  
         }  
         Tcl_UntraceVar(interp, argv[2],  
                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,  
                 WaitVariableProc, (ClientData) &done);  
     } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)  
             && (length >= 2)) {  
         Tk_Window window;  
   
         window = Tk_NameToWindow(interp, argv[2], tkwin);  
         if (window == NULL) {  
             return TCL_ERROR;  
         }  
         Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask,  
             WaitVisibilityProc, (ClientData) &done);  
         done = 0;  
         while (!done) {  
             Tcl_DoOneEvent(0);  
         }  
         if (done != 1) {  
             /*  
              * Note that we do not delete the event handler because it  
              * was deleted automatically when the window was destroyed.  
              */  
   
             Tcl_ResetResult(interp);  
             Tcl_AppendResult(interp, "window \"", argv[2],  
                     "\" was deleted before its visibility changed",  
                     (char *) NULL);  
             return TCL_ERROR;  
         }  
         Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask,  
             WaitVisibilityProc, (ClientData) &done);  
     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {  
         Tk_Window window;  
   
         window = Tk_NameToWindow(interp, argv[2], tkwin);  
         if (window == NULL) {  
             return TCL_ERROR;  
         }  
         Tk_CreateEventHandler(window, StructureNotifyMask,  
             WaitWindowProc, (ClientData) &done);  
         done = 0;  
         while (!done) {  
             Tcl_DoOneEvent(0);  
         }  
         /*  
          * Note:  there's no need to delete the event handler.  It was  
          * deleted automatically when the window was destroyed.  
          */  
     } else {  
         Tcl_AppendResult(interp, "bad option \"", argv[1],  
                 "\": must be variable, visibility, or window", (char *) NULL);  
         return TCL_ERROR;  
     }  
   
     /*  
      * Clear out the interpreter's result, since it may have been set  
      * by event handlers.  
      */  
   
     Tcl_ResetResult(interp);  
     return TCL_OK;  
 }  
   
         /* ARGSUSED */  
 static char *  
 WaitVariableProc(clientData, interp, name1, name2, flags)  
     ClientData clientData;      /* Pointer to integer to set to 1. */  
     Tcl_Interp *interp;         /* Interpreter containing variable. */  
     char *name1;                /* Name of variable. */  
     char *name2;                /* Second part of variable name. */  
     int flags;                  /* Information about what happened. */  
 {  
     int *donePtr = (int *) clientData;  
   
     *donePtr = 1;  
     return (char *) NULL;  
 }  
   
         /*ARGSUSED*/  
 static void  
 WaitVisibilityProc(clientData, eventPtr)  
     ClientData clientData;      /* Pointer to integer to set to 1. */  
     XEvent *eventPtr;           /* Information about event (not used). */  
 {  
     int *donePtr = (int *) clientData;  
   
     if (eventPtr->type == VisibilityNotify) {  
         *donePtr = 1;  
     }  
     if (eventPtr->type == DestroyNotify) {  
         *donePtr = 2;  
     }  
 }  
   
 static void  
 WaitWindowProc(clientData, eventPtr)  
     ClientData clientData;      /* Pointer to integer to set to 1. */  
     XEvent *eventPtr;           /* Information about event. */  
 {  
     int *donePtr = (int *) clientData;  
   
     if (eventPtr->type == DestroyNotify) {  
         *donePtr = 1;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_UpdateObjCmd --  
  *  
  *      This procedure is invoked to process the "update" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 Tk_UpdateObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     static char *updateOptions[] = {"idletasks", (char *) NULL};  
     int flags, index;  
     TkDisplay *dispPtr;  
   
     if (objc == 1) {  
         flags = TCL_DONT_WAIT;  
     } else if (objc == 2) {  
         if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,  
                 &index) != TCL_OK) {  
             return TCL_ERROR;  
         }  
         flags = TCL_IDLE_EVENTS;  
     } else {  
         Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");  
         return TCL_ERROR;  
     }  
   
     /*  
      * Handle all pending events, sync all displays, and repeat over  
      * and over again until all pending events have been handled.  
      * Special note:  it's possible that the entire application could  
      * be destroyed by an event handler that occurs during the update.  
      * Thus, don't use any information from tkwin after calling  
      * Tcl_DoOneEvent.  
      */  
     
     while (1) {  
         while (Tcl_DoOneEvent(flags) != 0) {  
             /* Empty loop body */  
         }  
         for (dispPtr = TkGetDisplayList(); dispPtr != NULL;  
                 dispPtr = dispPtr->nextPtr) {  
             XSync(dispPtr->display, False);  
         }  
         if (Tcl_DoOneEvent(flags) == 0) {  
             break;  
         }  
     }  
   
     /*  
      * Must clear the interpreter's result because event handlers could  
      * have executed commands.  
      */  
   
     Tcl_ResetResult(interp);  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_WinfoObjCmd --  
  *  
  *      This procedure is invoked to process the "winfo" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tk_WinfoObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     int index, x, y, width, height, useX, useY, class, skip;  
     char *string;  
     TkWindow *winPtr;  
     Tk_Window tkwin;  
     Tcl_Obj *resultPtr;  
   
     static TkStateMap visualMap[] = {  
         {PseudoColor,   "pseudocolor"},  
         {GrayScale,     "grayscale"},  
         {DirectColor,   "directcolor"},  
         {TrueColor,     "truecolor"},  
         {StaticColor,   "staticcolor"},  
         {StaticGray,    "staticgray"},  
         {-1,            NULL}  
     };  
     static char *optionStrings[] = {  
         "cells",        "children",     "class",        "colormapfull",  
         "depth",        "geometry",     "height",       "id",  
         "ismapped",     "manager",      "name",         "parent",  
         "pointerx",     "pointery",     "pointerxy",    "reqheight",  
         "reqwidth",     "rootx",        "rooty",        "screen",  
         "screencells",  "screendepth",  "screenheight", "screenwidth",  
         "screenmmheight","screenmmwidth","screenvisual","server",  
         "toplevel",     "viewable",     "visual",       "visualid",  
         "vrootheight",  "vrootwidth",   "vrootx",       "vrooty",  
         "width",        "x",            "y",  
           
         "atom",         "atomname",     "containing",   "interps",  
         "pathname",  
   
         "exists",       "fpixels",      "pixels",       "rgb",  
         "visualsavailable",  
   
         NULL  
     };  
     enum options {  
         WIN_CELLS,      WIN_CHILDREN,   WIN_CLASS,      WIN_COLORMAPFULL,  
         WIN_DEPTH,      WIN_GEOMETRY,   WIN_HEIGHT,     WIN_ID,  
         WIN_ISMAPPED,   WIN_MANAGER,    WIN_NAME,       WIN_PARENT,  
         WIN_POINTERX,   WIN_POINTERY,   WIN_POINTERXY,  WIN_REQHEIGHT,  
         WIN_REQWIDTH,   WIN_ROOTX,      WIN_ROOTY,      WIN_SCREEN,  
         WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,  
         WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,  
         WIN_TOPLEVEL,   WIN_VIEWABLE,   WIN_VISUAL,     WIN_VISUALID,  
         WIN_VROOTHEIGHT,WIN_VROOTWIDTH, WIN_VROOTX,     WIN_VROOTY,  
         WIN_WIDTH,      WIN_X,          WIN_Y,  
           
         WIN_ATOM,       WIN_ATOMNAME,   WIN_CONTAINING, WIN_INTERPS,  
         WIN_PATHNAME,  
   
         WIN_EXISTS,     WIN_FPIXELS,    WIN_PIXELS,     WIN_RGB,  
         WIN_VISUALSAVAILABLE  
     };  
   
     tkwin = (Tk_Window) clientData;  
       
     if (objc < 2) {  
         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");  
         return TCL_ERROR;  
     }  
     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,  
             &index) != TCL_OK) {  
         return TCL_ERROR;  
     }  
   
     if (index < WIN_ATOM) {  
         if (objc != 3) {  
             Tcl_WrongNumArgs(interp, 2, objv, "window");  
             return TCL_ERROR;  
         }  
         string = Tcl_GetStringFromObj(objv[2], NULL);  
         tkwin = Tk_NameToWindow(interp, string, tkwin);  
         if (tkwin == NULL) {  
             return TCL_ERROR;  
         }  
     }  
     winPtr = (TkWindow *) tkwin;  
     resultPtr = Tcl_GetObjResult(interp);  
   
     switch ((enum options) index) {  
         case WIN_CELLS: {  
             Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);  
             break;  
         }  
         case WIN_CHILDREN: {  
             Tcl_Obj *strPtr;  
   
             winPtr = winPtr->childList;  
             for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {  
                 strPtr = Tcl_NewStringObj(winPtr->pathName, -1);  
                 Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);  
             }  
             break;  
         }  
         case WIN_CLASS: {  
             Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);  
             break;  
         }  
         case WIN_COLORMAPFULL: {  
             Tcl_SetBooleanObj(resultPtr,  
                     TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));  
             break;  
         }  
         case WIN_DEPTH: {  
             Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));  
             break;  
         }  
         case WIN_GEOMETRY: {  
             char buf[16 + TCL_INTEGER_SPACE * 4];  
   
             sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),  
                     Tk_X(tkwin), Tk_Y(tkwin));  
             Tcl_SetStringObj(resultPtr, buf, -1);  
             break;  
         }  
         case WIN_HEIGHT: {  
             Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));  
             break;  
         }  
         case WIN_ID: {  
             char buf[TCL_INTEGER_SPACE];  
               
             Tk_MakeWindowExist(tkwin);  
             TkpPrintWindowId(buf, Tk_WindowId(tkwin));  
             Tcl_SetStringObj(resultPtr, buf, -1);  
             break;  
         }  
         case WIN_ISMAPPED: {  
             Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));  
             break;  
         }  
         case WIN_MANAGER: {  
             if (winPtr->geomMgrPtr != NULL) {  
                 Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);  
             }  
             break;  
         }  
         case WIN_NAME: {  
             Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);  
             break;  
         }  
         case WIN_PARENT: {  
             if (winPtr->parentPtr != NULL) {  
                 Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);  
             }  
             break;  
         }  
         case WIN_POINTERX: {  
             useX = 1;  
             useY = 0;  
             goto pointerxy;  
         }  
         case WIN_POINTERY: {  
             useX = 0;  
             useY = 1;  
             goto pointerxy;  
         }  
         case WIN_POINTERXY: {  
             useX = 1;  
             useY = 1;  
   
             pointerxy:  
             winPtr = GetToplevel(tkwin);  
             if (winPtr == NULL) {  
                 x = -1;  
                 y = -1;  
             } else {  
                 TkGetPointerCoords((Tk_Window) winPtr, &x, &y);  
             }  
             if (useX & useY) {  
                 char buf[TCL_INTEGER_SPACE * 2];  
                   
                 sprintf(buf, "%d %d", x, y);  
                 Tcl_SetStringObj(resultPtr, buf, -1);  
             } else if (useX) {  
                 Tcl_SetIntObj(resultPtr, x);  
             } else {  
                 Tcl_SetIntObj(resultPtr, y);  
             }  
             break;  
         }  
         case WIN_REQHEIGHT: {  
             Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));  
             break;  
         }  
         case WIN_REQWIDTH: {  
             Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));  
             break;  
         }  
         case WIN_ROOTX: {  
             Tk_GetRootCoords(tkwin, &x, &y);  
             Tcl_SetIntObj(resultPtr, x);  
             break;  
         }  
         case WIN_ROOTY: {  
             Tk_GetRootCoords(tkwin, &x, &y);  
             Tcl_SetIntObj(resultPtr, y);  
             break;  
         }  
         case WIN_SCREEN: {  
             char buf[TCL_INTEGER_SPACE];  
               
             sprintf(buf, "%d", Tk_ScreenNumber(tkwin));  
             Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".",  
                     buf, NULL);  
             break;  
         }  
         case WIN_SCREENCELLS: {  
             Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));  
             break;  
         }  
         case WIN_SCREENDEPTH: {  
             Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));  
             break;  
         }  
         case WIN_SCREENHEIGHT: {  
             Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));  
             break;  
         }  
         case WIN_SCREENWIDTH: {  
             Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));  
             break;  
         }  
         case WIN_SCREENMMHEIGHT: {  
             Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));  
             break;  
         }  
         case WIN_SCREENMMWIDTH: {  
             Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));  
             break;  
         }  
         case WIN_SCREENVISUAL: {  
             class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;  
             goto visual;  
         }  
         case WIN_SERVER: {  
             TkGetServerInfo(interp, tkwin);  
             break;  
         }  
         case WIN_TOPLEVEL: {  
             winPtr = GetToplevel(tkwin);  
             if (winPtr != NULL) {  
                 Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);  
             }  
             break;  
         }  
         case WIN_VIEWABLE: {  
             int viewable = 0;  
             for ( ; ; winPtr = winPtr->parentPtr) {  
                 if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {  
                     break;  
                 }  
                 if (winPtr->flags & TK_TOP_LEVEL) {  
                     viewable = 1;  
                     break;  
                 }  
             }  
   
             Tcl_SetBooleanObj(resultPtr, viewable);  
             break;  
         }  
         case WIN_VISUAL: {  
             class = Tk_Visual(tkwin)->class;  
   
             visual:  
             string = TkFindStateString(visualMap, class);  
             if (string == NULL) {  
                 string = "unknown";  
             }  
             Tcl_SetStringObj(resultPtr, string, -1);  
             break;  
         }  
         case WIN_VISUALID: {  
             char buf[TCL_INTEGER_SPACE];  
   
             sprintf(buf, "0x%x",  
                     (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));  
             Tcl_SetStringObj(resultPtr, buf, -1);  
             break;  
         }  
         case WIN_VROOTHEIGHT: {  
             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);  
             Tcl_SetIntObj(resultPtr, height);  
             break;  
         }  
         case WIN_VROOTWIDTH: {  
             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);  
             Tcl_SetIntObj(resultPtr, width);  
             break;  
         }  
         case WIN_VROOTX: {  
             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);  
             Tcl_SetIntObj(resultPtr, x);  
             break;  
         }  
         case WIN_VROOTY: {  
             Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);  
             Tcl_SetIntObj(resultPtr, y);  
             break;  
         }  
         case WIN_WIDTH: {  
             Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));  
             break;  
         }  
         case WIN_X: {  
             Tcl_SetIntObj(resultPtr, Tk_X(tkwin));  
             break;  
         }  
         case WIN_Y: {  
             Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));  
             break;  
         }  
   
         /*  
          * Uses -displayof.  
          */  
           
         case WIN_ATOM: {  
             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);  
             if (skip < 0) {  
                 return TCL_ERROR;  
             }  
             if (objc - skip != 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");  
                 return TCL_ERROR;  
             }  
             objv += skip;  
             string = Tcl_GetStringFromObj(objv[2], NULL);  
             Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));  
             break;  
         }  
         case WIN_ATOMNAME: {  
             char *name;  
             long id;  
               
             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);  
             if (skip < 0) {  
                 return TCL_ERROR;  
             }  
             if (objc - skip != 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");  
                 return TCL_ERROR;  
             }  
             objv += skip;  
             if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {  
                 return TCL_ERROR;  
             }  
             name = Tk_GetAtomName(tkwin, (Atom) id);  
             if (strcmp(name, "?bad atom?") == 0) {  
                 string = Tcl_GetStringFromObj(objv[2], NULL);  
                 Tcl_AppendStringsToObj(resultPtr,  
                         "no atom exists with id \"", string, "\"", NULL);  
                 return TCL_ERROR;  
             }  
             Tcl_SetStringObj(resultPtr, name, -1);  
             break;  
         }  
         case WIN_CONTAINING: {  
             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);  
             if (skip < 0) {  
                 return TCL_ERROR;  
             }  
             if (objc - skip != 4) {  
                 Tcl_WrongNumArgs(interp, 2, objv,  
                         "?-displayof window? rootX rootY");  
                 return TCL_ERROR;  
             }  
             objv += skip;  
             string = Tcl_GetStringFromObj(objv[2], NULL);  
             if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[3], NULL);  
             if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {  
                 return TCL_ERROR;  
             }  
             tkwin = Tk_CoordsToWindow(x, y, tkwin);  
             if (tkwin != NULL) {  
                 Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);  
             }  
             break;  
         }  
         case WIN_INTERPS: {  
             int result;  
               
             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);  
             if (skip < 0) {  
                 return TCL_ERROR;  
             }  
             if (objc - skip != 2) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");  
                 return TCL_ERROR;  
             }  
             result = TkGetInterpNames(interp, tkwin);  
             return result;  
         }  
         case WIN_PATHNAME: {  
             int id;  
   
             skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);  
             if (skip < 0) {  
                 return TCL_ERROR;  
             }  
             if (objc - skip != 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[2 + skip], NULL);  
             if (TkpScanWindowId(interp, string, &id) != TCL_OK) {  
                 return TCL_ERROR;  
             }  
             winPtr = (TkWindow *)  
                     Tk_IdToWindow(Tk_Display(tkwin), (Window) id);  
             if ((winPtr == NULL) ||  
                     (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {  
                 Tcl_AppendStringsToObj(resultPtr, "window id \"", string,  
                         "\" doesn't exist in this application", (char *) NULL);  
                 return TCL_ERROR;  
             }  
   
             /*  
              * If the window is a utility window with no associated path  
              * (such as a wrapper window or send communication window), just  
              * return an empty string.  
              */  
   
             tkwin = (Tk_Window) winPtr;  
             if (Tk_PathName(tkwin) != NULL) {  
                 Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);  
             }  
             break;  
         }  
   
         /*  
          * objv[3] is window.  
          */  
   
         case WIN_EXISTS: {  
             int alive;  
   
             if (objc != 3) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "window");  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[2], NULL);  
             winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);  
             Tcl_ResetResult(interp);  
             resultPtr = Tcl_GetObjResult(interp);  
   
             alive = 1;  
             if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {  
                 alive = 0;  
             }  
             Tcl_SetBooleanObj(resultPtr, alive);  
             break;  
         }  
         case WIN_FPIXELS: {  
             double mm, pixels;  
   
             if (objc != 4) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "window number");  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[2], NULL);  
             tkwin = Tk_NameToWindow(interp, string, tkwin);  
             if (tkwin == NULL) {  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[3], NULL);  
             if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {  
                 return TCL_ERROR;  
             }  
             pixels = mm * WidthOfScreen(Tk_Screen(tkwin))  
                     / WidthMMOfScreen(Tk_Screen(tkwin));  
             Tcl_SetDoubleObj(resultPtr, pixels);  
             break;  
         }  
         case WIN_PIXELS: {  
             int pixels;  
               
             if (objc != 4) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "window number");  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[2], NULL);  
             tkwin = Tk_NameToWindow(interp, string, tkwin);  
             if (tkwin == NULL) {  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[3], NULL);  
             if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {  
                 return TCL_ERROR;  
             }  
             Tcl_SetIntObj(resultPtr, pixels);  
             break;  
         }  
         case WIN_RGB: {  
             XColor *colorPtr;  
             char buf[TCL_INTEGER_SPACE * 3];  
   
             if (objc != 4) {  
                 Tcl_WrongNumArgs(interp, 2, objv, "window colorName");  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[2], NULL);  
             tkwin = Tk_NameToWindow(interp, string, tkwin);  
             if (tkwin == NULL) {  
                 return TCL_ERROR;  
             }  
             string = Tcl_GetStringFromObj(objv[3], NULL);  
             colorPtr = Tk_GetColor(interp, tkwin, string);  
             if (colorPtr == NULL) {  
                 return TCL_ERROR;  
             }  
             sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,  
                     colorPtr->blue);  
             Tk_FreeColor(colorPtr);  
             Tcl_SetStringObj(resultPtr, buf, -1);  
             break;  
         }  
         case WIN_VISUALSAVAILABLE: {  
             XVisualInfo template, *visInfoPtr;  
             int count, i;  
             int includeVisualId;  
             Tcl_Obj *strPtr;  
             char buf[16 + TCL_INTEGER_SPACE];  
             char visualIdString[TCL_INTEGER_SPACE];  
   
             if (objc == 3) {  
                 includeVisualId = 0;  
             } else if ((objc == 4)  
                     && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),  
                             "includeids") == 0)) {  
                 includeVisualId = 1;  
             } else {  
                 Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");  
                 return TCL_ERROR;  
             }  
   
             string = Tcl_GetStringFromObj(objv[2], NULL);  
             tkwin = Tk_NameToWindow(interp, string, tkwin);  
             if (tkwin == NULL) {  
                 return TCL_ERROR;  
             }  
   
             template.screen = Tk_ScreenNumber(tkwin);  
             visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,  
                     &template, &count);  
             if (visInfoPtr == NULL) {  
                 Tcl_SetStringObj(resultPtr,  
                         "can't find any visuals for screen", -1);  
                 return TCL_ERROR;  
             }  
             for (i = 0; i < count; i++) {  
                 string = TkFindStateString(visualMap, visInfoPtr[i].class);  
                 if (string == NULL) {  
                     strcpy(buf, "unknown");  
                 } else {  
                     sprintf(buf, "%s %d", string, visInfoPtr[i].depth);  
                 }  
                 if (includeVisualId) {  
                     sprintf(visualIdString, " 0x%x",  
                             (unsigned int) visInfoPtr[i].visualid);  
                     strcat(buf, visualIdString);  
                 }  
                 strPtr = Tcl_NewStringObj(buf, -1);  
                 Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);  
             }  
             XFree((char *) visInfoPtr);  
             break;  
         }  
     }  
     return TCL_OK;  
 }  
   
 #if 0  
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tk_WmObjCmd --  
  *  
  *      This procedure is invoked to process the "wm" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 Tk_WmObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Main window associated with  
                                  * interpreter. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. */  
 {  
     Tk_Window tkwin;  
     TkWindow *winPtr;  
   
     static char *optionStrings[] = {  
         "aspect",       "client",       "command",      "deiconify",  
         "focusmodel",   "frame",        "geometry",     "grid",  
         "group",        "iconbitmap",   "iconify",      "iconmask",  
         "iconname",     "iconposition", "iconwindow",   "maxsize",  
         "minsize",      "overrideredirect",     "positionfrom", "protocol",  
         "resizable",    "sizefrom",     "state",        "title",  
         "tracing",      "transient",    "withdraw",     (char *) NULL  
     };  
     enum options {  
         TKWM_ASPECT,    TKWM_CLIENT,    TKWM_COMMAND,   TKWM_DEICONIFY,  
         TKWM_FOCUSMOD,  TKWM_FRAME,     TKWM_GEOMETRY,  TKWM_GRID,  
         TKWM_GROUP,     TKWM_ICONBMP,   TKWM_ICONIFY,   TKWM_ICONMASK,  
         TKWM_ICONNAME,  TKWM_ICONPOS,   TKWM_ICONWIN,   TKWM_MAXSIZE,  
         TKWM_MINSIZE,   TKWM_OVERRIDE,  TKWM_POSFROM,   TKWM_PROTOCOL,  
         TKWM_RESIZABLE, TKWM_SIZEFROM,  TKWM_STATE,     TKWM_TITLE,  
         TKWM_TRACING,   TKWM_TRANSIENT, TKWM_WITHDRAW  
     };  
   
     tkwin = (Tk_Window) clientData;  
   
     if (objc < 2) {  
         Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");  
         return TCL_ERROR;  
     }  
     if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,  
             &index) != TCL_OK) {  
         return TCL_ERROR;  
     }  
   
     if (index == TKWM_TRACING) {  
         TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;  
   
         if ((objc != 2) && (objc != 3)) {  
             Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");  
             return TCL_ERROR;  
         }  
         if (objc == 2) {  
             Tcl_SetObjResult(interp, Tcl_NewBooleanObj(dispPtr->wmTracing));  
             return TCL_OK;  
         }  
         return Tcl_GetBooleanFromObj(interp, objv[2], &dispPtr->wmTracing);  
     }  
   
     if (objc < 3) {  
         Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");  
         return TCL_ERROR;  
     }  
   
     winPtr = (TkWindow *) Tk_NameToWindow(interp,  
             Tcl_GetString(objv[2]), tkwin);  
     if (winPtr == NULL) {  
         return TCL_ERROR;  
     }  
     if (!(winPtr->flags & TK_TOP_LEVEL)) {  
         Tcl_AppendResult(interp, "window \"", winPtr->pathName,  
                 "\" isn't a top-level window", (char *) NULL);  
         return TCL_ERROR;  
     }  
   
     switch ((enum options) index) {  
         case TKWM_ASPECT: {  
             TkpWmAspectCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_CLIENT: {  
             TkpWmClientCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_COMMAND: {  
             TkpWmCommandCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_DEICONIFY: {  
             TkpWmDeiconifyCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_FOCUSMOD: {  
             TkpWmFocusmodCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_FRAME: {  
             TkpWmFrameCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_GEOMETRY: {  
             TkpWmGeometryCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_GRID: {  
             TkpWmGridCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_GROUP: {  
             TkpWmGroupCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_ICONBMP: {  
             TkpWmIconbitmapCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_ICONIFY: {  
             TkpWmIconifyCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_ICONMASK: {  
             TkpWmIconmaskCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_ICONNAME: {  
             /* slight Unix variation */  
             TkpWmIconnameCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_ICONPOS: {  
             /* nearly same - 1 line more on Unix */  
             TkpWmIconpositionCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_ICONWIN: {  
             TkpWmIconwindowCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_MAXSIZE: {  
             /* nearly same, win diffs */  
             TkpWmMaxsizeCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_MINSIZE: {  
             /* nearly same, win diffs */  
             TkpWmMinsizeCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_OVERRIDE: {  
             /* almost same */  
             TkpWmOverrideCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_POSFROM: {  
             /* Equal across platforms */  
             TkpWmPositionfromCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_PROTOCOL: {  
             /* Equal across platforms */  
             TkpWmProtocolCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_RESIZABLE: {  
             /* almost same */  
             TkpWmResizableCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_SIZEFROM: {  
             /* Equal across platforms */  
             TkpWmSizefromCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_STATE: {  
             TkpWmStateCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_TITLE: {  
             TkpWmTitleCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_TRANSIENT: {  
             TkpWmTransientCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
         case TKWM_WITHDRAW: {  
             TkpWmWithdrawCmd(interp, tkwin, winPtr, objc, objv);  
             break;  
         }  
     }  
   
     updateGeom:  
     if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {  
         Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);  
         wmPtr->flags |= WM_UPDATE_PENDING;  
     }  
     return TCL_OK;  
 }  
 #endif  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TkGetDisplayOf --  
  *  
  *      Parses a "-displayof window" option for various commands.  If  
  *      present, the literal "-displayof" should be in objv[0] and the  
  *      window name in objv[1].  
  *  
  * Results:  
  *      The return value is 0 if the argument strings did not contain  
  *      the "-displayof" option.  The return value is 2 if the  
  *      argument strings contained both the "-displayof" option and  
  *      a valid window name.  Otherwise, the return value is -1 if  
  *      the window name was missing or did not specify a valid window.  
  *  
  *      If the return value was 2, *tkwinPtr is filled with the  
  *      token for the window specified on the command line.  If the  
  *      return value was -1, an error message is left in interp's  
  *      result object.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TkGetDisplayOf(interp, objc, objv, tkwinPtr)  
     Tcl_Interp *interp;         /* Interpreter for error reporting. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument objects. If it is present,  
                                  * "-displayof" should be in objv[0] and  
                                  * objv[1] the name of a window. */  
     Tk_Window *tkwinPtr;        /* On input, contains main window of  
                                  * application associated with interp.  On  
                                  * output, filled with window specified as  
                                  * option to "-displayof" argument, or  
                                  * unmodified if "-displayof" argument was not  
                                  * present. */  
 {  
     char *string;  
     int length;  
       
     if (objc < 1) {  
         return 0;  
     }  
     string = Tcl_GetStringFromObj(objv[0], &length);  
     if ((length >= 2) &&  
             (strncmp(string, "-displayof", (unsigned) length) == 0)) {  
         if (objc < 2) {  
             Tcl_SetStringObj(Tcl_GetObjResult(interp),  
                     "value for \"-displayof\" missing", -1);  
             return -1;  
         }  
         string = Tcl_GetStringFromObj(objv[1], NULL);  
         *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr);  
         if (*tkwinPtr == NULL) {  
             return -1;  
         }  
         return 2;  
     }  
     return 0;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TkDeadAppCmd --  
  *  
  *      If an application has been deleted then all Tk commands will be  
  *      re-bound to this procedure.  
  *  
  * Results:  
  *      A standard Tcl error is reported to let the user know that  
  *      the application is dead.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* ARGSUSED */  
 int  
 TkDeadAppCmd(clientData, interp, argc, argv)  
     ClientData clientData;      /* Dummy. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int argc;                   /* Number of arguments. */  
     char **argv;                /* Argument strings. */  
 {  
     Tcl_AppendResult(interp, "can't invoke \"", argv[0],  
             "\" command:  application has been destroyed", (char *) NULL);  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * GetToplevel --  
  *  
  *      Retrieves the toplevel window which is the nearest ancestor of  
  *      of the specified window.  
  *  
  * Results:  
  *      Returns the toplevel window or NULL if the window has no  
  *      ancestor which is a toplevel.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static TkWindow *  
 GetToplevel(tkwin)  
     Tk_Window tkwin;            /* Window for which the toplevel should be  
                                  * deterined. */  
 {  
      TkWindow *winPtr = (TkWindow *) tkwin;  
   
      while (!(winPtr->flags & TK_TOP_LEVEL)) {  
          winPtr = winPtr->parentPtr;  
          if (winPtr == NULL) {  
              return NULL;  
          }  
      }  
      return winPtr;  
 }  
   
   
 /* $History: tkCmds.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 2:41a  
  * Created in $/IjuScripter, IjuConsole/Source/Tk Base  
  * Initial check-in.  
  */  
   
 /* End of TKCMDS.C */  
1    /* $Header$ */
2    
3    /*
4     * tkCmds.c --
5     *
6     *      This file contains a collection of Tk-related Tcl commands
7     *      that didn't fit in any particular file of the toolkit.
8     *
9     * Copyright (c) 1990-1994 The Regents of the University of California.
10     * Copyright (c) 1994-1997 Sun Microsystems, Inc.
11     *
12     * See the file "license.terms" for information on usage and redistribution
13     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14     *
15     * RCS: @(#) $Id: tkcmds.c,v 1.1.1.1 2001/06/13 04:58:24 dtashley Exp $
16     */
17    
18    #include "tkPort.h"
19    #include "tkInt.h"
20    #include <errno.h>
21    
22    #if defined(__WIN32__)
23    #include "tkWinInt.h"
24    #elif defined(MAC_TCL)
25    #include "tkMacInt.h"
26    #else
27    #include "tkUnixInt.h"
28    #endif
29    
30    /*
31     * Forward declarations for procedures defined later in this file:
32     */
33    
34    static TkWindow *       GetToplevel _ANSI_ARGS_((Tk_Window tkwin));
35    static char *           WaitVariableProc _ANSI_ARGS_((ClientData clientData,
36                                Tcl_Interp *interp, char *name1, char *name2,
37                                int flags));
38    static void             WaitVisibilityProc _ANSI_ARGS_((ClientData clientData,
39                                XEvent *eventPtr));
40    static void             WaitWindowProc _ANSI_ARGS_((ClientData clientData,
41                                XEvent *eventPtr));
42    
43    /*
44     *----------------------------------------------------------------------
45     *
46     * Tk_BellObjCmd --
47     *
48     *      This procedure is invoked to process the "bell" Tcl command.
49     *      See the user documentation for details on what it does.
50     *
51     * Results:
52     *      A standard Tcl result.
53     *
54     * Side effects:
55     *      See the user documentation.
56     *
57     *----------------------------------------------------------------------
58     */
59    
60    int
61    Tk_BellObjCmd(clientData, interp, objc, objv)
62        ClientData clientData;      /* Main window associated with interpreter. */
63        Tcl_Interp *interp;         /* Current interpreter. */
64        int objc;                   /* Number of arguments. */
65        Tcl_Obj *CONST objv[];      /* Argument objects. */
66    {
67        static char *bellOptions[] = {"-displayof", (char *) NULL};
68        Tk_Window tkwin = (Tk_Window) clientData;
69        char *displayName;
70        int index;
71    
72        if ((objc != 1) && (objc != 3)) {
73            Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window?");
74            return TCL_ERROR;
75        }
76    
77        if (objc == 3) {
78            if (Tcl_GetIndexFromObj(interp, objv[1], bellOptions, "option", 0,
79                    &index) != TCL_OK) {
80                return TCL_ERROR;
81            }
82            displayName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
83            
84            tkwin = Tk_NameToWindow(interp, displayName, tkwin);
85            if (tkwin == NULL) {
86                return TCL_ERROR;
87            }
88        }
89        XBell(Tk_Display(tkwin), 0);
90        XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
91        XFlush(Tk_Display(tkwin));
92        return TCL_OK;
93    }
94    
95    /*
96     *----------------------------------------------------------------------
97     *
98     * Tk_BindCmd --
99     *
100     *      This procedure is invoked to process the "bind" Tcl command.
101     *      See the user documentation for details on what it does.
102     *
103     * Results:
104     *      A standard Tcl result.
105     *
106     * Side effects:
107     *      See the user documentation.
108     *
109     *----------------------------------------------------------------------
110     */
111    
112    int
113    Tk_BindCmd(clientData, interp, argc, argv)
114        ClientData clientData;      /* Main window associated with interpreter. */
115        Tcl_Interp *interp;         /* Current interpreter. */
116        int argc;                   /* Number of arguments. */
117        char **argv;                /* Argument strings. */
118    {
119        Tk_Window tkwin = (Tk_Window) clientData;
120        TkWindow *winPtr;
121        ClientData object;
122    
123        if ((argc < 2) || (argc > 4)) {
124            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
125                    " window ?pattern? ?command?\"", (char *) NULL);
126            return TCL_ERROR;
127        }
128        if (argv[1][0] == '.') {
129            winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
130            if (winPtr == NULL) {
131                return TCL_ERROR;
132            }
133            object = (ClientData) winPtr->pathName;
134        } else {
135            winPtr = (TkWindow *) clientData;
136            object = (ClientData) Tk_GetUid(argv[1]);
137        }
138    
139        if (argc == 4) {
140            int append = 0;
141            unsigned long mask;
142    
143            if (argv[3][0] == 0) {
144                return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
145                        object, argv[2]);
146            }
147            if (argv[3][0] == '+') {
148                argv[3]++;
149                append = 1;
150            }
151            mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
152                    object, argv[2], argv[3], append);
153            if (mask == 0) {
154                return TCL_ERROR;
155            }
156        } else if (argc == 3) {
157            char *command;
158    
159            command = Tk_GetBinding(interp, winPtr->mainPtr->bindingTable,
160                    object, argv[2]);
161            if (command == NULL) {
162                Tcl_ResetResult(interp);
163                return TCL_OK;
164            }
165            Tcl_SetResult(interp, command, TCL_STATIC);
166        } else {
167            Tk_GetAllBindings(interp, winPtr->mainPtr->bindingTable, object);
168        }
169        return TCL_OK;
170    }
171    
172    /*
173     *----------------------------------------------------------------------
174     *
175     * TkBindEventProc --
176     *
177     *      This procedure is invoked by Tk_HandleEvent for each event;  it
178     *      causes any appropriate bindings for that event to be invoked.
179     *
180     * Results:
181     *      None.
182     *
183     * Side effects:
184     *      Depends on what bindings have been established with the "bind"
185     *      command.
186     *
187     *----------------------------------------------------------------------
188     */
189    
190    void
191    TkBindEventProc(winPtr, eventPtr)
192        TkWindow *winPtr;                   /* Pointer to info about window. */
193        XEvent *eventPtr;                   /* Information about event. */
194    {
195    #define MAX_OBJS 20
196        ClientData objects[MAX_OBJS], *objPtr;
197        TkWindow *topLevPtr;
198        int i, count;
199        char *p;
200        Tcl_HashEntry *hPtr;
201    
202        if ((winPtr->mainPtr == NULL) || (winPtr->mainPtr->bindingTable == NULL)) {
203            return;
204        }
205    
206        objPtr = objects;
207        if (winPtr->numTags != 0) {
208            /*
209             * Make a copy of the tags for the window, replacing window names
210             * with pointers to the pathName from the appropriate window.
211             */
212    
213            if (winPtr->numTags > MAX_OBJS) {
214                objPtr = (ClientData *) ckalloc((unsigned)
215                        (winPtr->numTags * sizeof(ClientData)));
216            }
217            for (i = 0; i < winPtr->numTags; i++) {
218                p = (char *) winPtr->tagPtr[i];
219                if (*p == '.') {
220                    hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
221                    if (hPtr != NULL) {
222                        p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
223                    } else {
224                        p = NULL;
225                    }
226                }
227                objPtr[i] = (ClientData) p;
228            }
229            count = winPtr->numTags;
230        } else {
231            objPtr[0] = (ClientData) winPtr->pathName;
232            objPtr[1] = (ClientData) winPtr->classUid;
233            for (topLevPtr = winPtr;
234                    (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_LEVEL);
235                    topLevPtr = topLevPtr->parentPtr) {
236                /* Empty loop body. */
237            }
238            if ((winPtr != topLevPtr) && (topLevPtr != NULL)) {
239                count = 4;
240                objPtr[2] = (ClientData) topLevPtr->pathName;
241            } else {
242                count = 3;
243            }
244            objPtr[count-1] = (ClientData) Tk_GetUid("all");
245        }
246        Tk_BindEvent(winPtr->mainPtr->bindingTable, eventPtr, (Tk_Window) winPtr,
247                count, objPtr);
248        if (objPtr != objects) {
249            ckfree((char *) objPtr);
250        }
251    }
252    
253    /*
254     *----------------------------------------------------------------------
255     *
256     * Tk_BindtagsCmd --
257     *
258     *      This procedure is invoked to process the "bindtags" Tcl command.
259     *      See the user documentation for details on what it does.
260     *
261     * Results:
262     *      A standard Tcl result.
263     *
264     * Side effects:
265     *      See the user documentation.
266     *
267     *----------------------------------------------------------------------
268     */
269    
270    int
271    Tk_BindtagsCmd(clientData, interp, argc, argv)
272        ClientData clientData;      /* Main window associated with interpreter. */
273        Tcl_Interp *interp;         /* Current interpreter. */
274        int argc;                   /* Number of arguments. */
275        char **argv;                /* Argument strings. */
276    {
277        Tk_Window tkwin = (Tk_Window) clientData;
278        TkWindow *winPtr, *winPtr2;
279        int i, tagArgc;
280        char *p, **tagArgv;
281    
282        if ((argc < 2) || (argc > 3)) {
283            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
284                    " window ?tags?\"", (char *) NULL);
285            return TCL_ERROR;
286        }
287        winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
288        if (winPtr == NULL) {
289            return TCL_ERROR;
290        }
291        if (argc == 2) {
292            if (winPtr->numTags == 0) {
293                Tcl_AppendElement(interp, winPtr->pathName);
294                Tcl_AppendElement(interp, winPtr->classUid);
295                for (winPtr2 = winPtr;
296                        (winPtr2 != NULL) && !(winPtr2->flags & TK_TOP_LEVEL);
297                        winPtr2 = winPtr2->parentPtr) {
298                    /* Empty loop body. */
299                }
300                if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
301                    Tcl_AppendElement(interp, winPtr2->pathName);
302                }
303                Tcl_AppendElement(interp, "all");
304            } else {
305                for (i = 0; i < winPtr->numTags; i++) {
306                    Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]);
307                }
308            }
309            return TCL_OK;
310        }
311        if (winPtr->tagPtr != NULL) {
312            TkFreeBindingTags(winPtr);
313        }
314        if (argv[2][0] == 0) {
315            return TCL_OK;
316        }
317        if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) {
318            return TCL_ERROR;
319        }
320        winPtr->numTags = tagArgc;
321        winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
322                (tagArgc * sizeof(ClientData)));
323        for (i = 0; i < tagArgc; i++) {
324            p = tagArgv[i];
325            if (p[0] == '.') {
326                char *copy;
327    
328                /*
329                 * Handle names starting with "." specially: store a malloc'ed
330                 * string, rather than a Uid;  at event time we'll look up the
331                 * name in the window table and use the corresponding window,
332                 * if there is one.
333                 */
334    
335                copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
336                strcpy(copy, p);
337                winPtr->tagPtr[i] = (ClientData) copy;
338            } else {
339                winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
340            }
341        }
342        ckfree((char *) tagArgv);
343        return TCL_OK;
344    }
345    
346    /*
347     *----------------------------------------------------------------------
348     *
349     * TkFreeBindingTags --
350     *
351     *      This procedure is called to free all of the binding tags
352     *      associated with a window;  typically it is only invoked where
353     *      there are window-specific tags.
354     *
355     * Results:
356     *      None.
357     *
358     * Side effects:
359     *      Any binding tags for winPtr are freed.
360     *
361     *----------------------------------------------------------------------
362     */
363    
364    void
365    TkFreeBindingTags(winPtr)
366        TkWindow *winPtr;           /* Window whose tags are to be released. */
367    {
368        int i;
369        char *p;
370    
371        for (i = 0; i < winPtr->numTags; i++) {
372            p = (char *) (winPtr->tagPtr[i]);
373            if (*p == '.') {
374                /*
375                 * Names starting with "." are malloced rather than Uids, so
376                 * they have to be freed.
377                 */
378        
379                ckfree(p);
380            }
381        }
382        ckfree((char *) winPtr->tagPtr);
383        winPtr->numTags = 0;
384        winPtr->tagPtr = NULL;
385    }
386    
387    /*
388     *----------------------------------------------------------------------
389     *
390     * Tk_DestroyObjCmd --
391     *
392     *      This procedure is invoked to process the "destroy" Tcl command.
393     *      See the user documentation for details on what it does.
394     *
395     * Results:
396     *      A standard Tcl result.
397     *
398     * Side effects:
399     *      See the user documentation.
400     *
401     *----------------------------------------------------------------------
402     */
403    
404    int
405    Tk_DestroyObjCmd(clientData, interp, objc, objv)
406        ClientData clientData;              /* Main window associated with
407                                     * interpreter. */
408        Tcl_Interp *interp;         /* Current interpreter. */
409        int objc;                   /* Number of arguments. */
410        Tcl_Obj *CONST objv[];      /* Argument objects. */
411    {
412        Tk_Window window;
413        Tk_Window tkwin = (Tk_Window) clientData;
414        int i;
415    
416        for (i = 1; i < objc; i++) {
417            window = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin);
418            if (window == NULL) {
419                Tcl_ResetResult(interp);
420                continue;
421            }
422            Tk_DestroyWindow(window);
423            if (window == tkwin) {
424                /*
425                 * We just deleted the main window for the application! This
426                 * makes it impossible to do anything more (tkwin isn't
427                 * valid anymore).
428                 */
429    
430                break;
431             }
432        }
433        return TCL_OK;
434    }
435    
436    /*
437     *----------------------------------------------------------------------
438     *
439     * Tk_LowerObjCmd --
440     *
441     *      This procedure is invoked to process the "lower" Tcl command.
442     *      See the user documentation for details on what it does.
443     *
444     * Results:
445     *      A standard Tcl result.
446     *
447     * Side effects:
448     *      See the user documentation.
449     *
450     *----------------------------------------------------------------------
451     */
452    
453            /* ARGSUSED */
454    int
455    Tk_LowerObjCmd(clientData, interp, objc, objv)
456        ClientData clientData;      /* Main window associated with
457                                     * interpreter. */
458        Tcl_Interp *interp;         /* Current interpreter. */
459        int objc;                   /* Number of arguments. */
460        Tcl_Obj *CONST objv[];      /* Argument objects. */
461    {
462        Tk_Window mainwin = (Tk_Window) clientData;
463        Tk_Window tkwin, other;
464    
465        if ((objc != 2) && (objc != 3)) {
466            Tcl_WrongNumArgs(interp, 1, objv, "window ?belowThis?");
467            return TCL_ERROR;
468        }
469    
470        tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
471        if (tkwin == NULL) {
472            return TCL_ERROR;
473        }
474        if (objc == 2) {
475            other = NULL;
476        } else {
477            other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
478            if (other == NULL) {
479                return TCL_ERROR;
480            }
481        }
482        if (Tk_RestackWindow(tkwin, Below, other) != TCL_OK) {
483            Tcl_AppendResult(interp, "can't lower \"", Tcl_GetString(objv[1]),
484                    "\" below \"", (other ? Tcl_GetString(objv[2]) : ""),
485                    "\"", (char *) NULL);
486            return TCL_ERROR;
487        }
488        return TCL_OK;
489    }
490    
491    /*
492     *----------------------------------------------------------------------
493     *
494     * Tk_RaiseObjCmd --
495     *
496     *      This procedure is invoked to process the "raise" Tcl command.
497     *      See the user documentation for details on what it does.
498     *
499     * Results:
500     *      A standard Tcl result.
501     *
502     * Side effects:
503     *      See the user documentation.
504     *
505     *----------------------------------------------------------------------
506     */
507    
508            /* ARGSUSED */
509    int
510    Tk_RaiseObjCmd(clientData, interp, objc, objv)
511        ClientData clientData;      /* Main window associated with
512                                     * interpreter. */
513        Tcl_Interp *interp;         /* Current interpreter. */
514        int objc;                   /* Number of arguments. */
515        Tcl_Obj *CONST objv[];      /* Argument objects. */
516    {
517        Tk_Window mainwin = (Tk_Window) clientData;
518        Tk_Window tkwin, other;
519    
520        if ((objc != 2) && (objc != 3)) {
521            Tcl_WrongNumArgs(interp, 1, objv, "window ?aboveThis?");
522            return TCL_ERROR;
523        }
524    
525        tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), mainwin);
526        if (tkwin == NULL) {
527            return TCL_ERROR;
528        }
529        if (objc == 2) {
530            other = NULL;
531        } else {
532            other = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), mainwin);
533            if (other == NULL) {
534                return TCL_ERROR;
535            }
536        }
537        if (Tk_RestackWindow(tkwin, Above, other) != TCL_OK) {
538            Tcl_AppendResult(interp, "can't raise \"", Tcl_GetString(objv[1]),
539                    "\" above \"", (other ? Tcl_GetString(objv[2]) : ""),
540                    "\"", (char *) NULL);
541            return TCL_ERROR;
542        }
543        return TCL_OK;
544    }
545    
546    /*
547     *----------------------------------------------------------------------
548     *
549     * Tk_TkObjCmd --
550     *
551     *      This procedure is invoked to process the "tk" Tcl command.
552     *      See the user documentation for details on what it does.
553     *
554     * Results:
555     *      A standard Tcl result.
556     *
557     * Side effects:
558     *      See the user documentation.
559     *
560     *----------------------------------------------------------------------
561     */
562    
563    int
564    Tk_TkObjCmd(clientData, interp, objc, objv)
565        ClientData clientData;      /* Main window associated with interpreter. */
566        Tcl_Interp *interp;         /* Current interpreter. */
567        int objc;                   /* Number of arguments. */
568        Tcl_Obj *CONST objv[];      /* Argument objects. */
569    {
570        int index;
571        Tk_Window tkwin;
572        static char *optionStrings[] = {
573            "appname",      "scaling",      "useinputmethods",      NULL
574        };
575        enum options {
576            TK_APPNAME,     TK_SCALING,     TK_USE_IM
577        };
578    
579        tkwin = (Tk_Window) clientData;
580    
581        if (objc < 2) {
582            Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
583            return TCL_ERROR;
584        }
585        if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
586                &index) != TCL_OK) {
587            return TCL_ERROR;
588        }
589    
590        switch ((enum options) index) {
591            case TK_APPNAME: {
592                TkWindow *winPtr;
593                char *string;
594    
595                winPtr = (TkWindow *) tkwin;
596    
597                if (objc > 3) {
598                    Tcl_WrongNumArgs(interp, 2, objv, "?newName?");
599                    return TCL_ERROR;
600                }
601                if (objc == 3) {
602                    string = Tcl_GetStringFromObj(objv[2], NULL);
603                    winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string));
604                }
605                Tcl_AppendResult(interp, winPtr->nameUid, NULL);
606                break;
607            }
608            case TK_SCALING: {
609                Screen *screenPtr;
610                int skip, width, height;
611                double d;
612    
613                screenPtr = Tk_Screen(tkwin);
614    
615                skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
616                if (skip < 0) {
617                    return TCL_ERROR;
618                }
619                if (objc - skip == 2) {
620                    d = 25.4 / 72;
621                    d *= WidthOfScreen(screenPtr);
622                    d /= WidthMMOfScreen(screenPtr);
623                    Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
624                } else if (objc - skip == 3) {
625                    if (Tcl_GetDoubleFromObj(interp, objv[2+skip], &d) != TCL_OK) {
626                        return TCL_ERROR;
627                    }
628                    d = (25.4 / 72) / d;
629                    width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
630                    if (width <= 0) {
631                        width = 1;
632                    }
633                    height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
634                    if (height <= 0) {
635                        height = 1;
636                    }
637                    WidthMMOfScreen(screenPtr) = width;
638                    HeightMMOfScreen(screenPtr) = height;
639                } else {
640                    Tcl_WrongNumArgs(interp, 2, objv,
641                            "?-displayof window? ?factor?");
642                    return TCL_ERROR;
643                }
644                break;
645            }
646            case TK_USE_IM: {
647                TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
648                int skip;
649    
650                skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin);
651                if (skip < 0) {
652                    return TCL_ERROR;
653                } else if (skip) {
654                    dispPtr = ((TkWindow *) tkwin)->dispPtr;
655                }
656                if ((objc - skip) == 3) {
657                    /*
658                     * In the case where TK_USE_INPUT_METHODS is not defined,
659                     * this will be ignored and we will always return 0.
660                     * That will indicate to the user that input methods
661                     * are just not available.
662                     */
663                    int bool;
664                    if (Tcl_GetBooleanFromObj(interp, objv[2+skip], &bool)
665                            != TCL_OK) {
666                        return TCL_ERROR;
667                    }
668    #ifdef TK_USE_INPUT_METHODS
669                    dispPtr->useInputMethods = bool;
670    #endif /* TK_USE_INPUT_METHODS */
671                } else if ((objc - skip) != 2) {
672                    Tcl_WrongNumArgs(interp, 2, objv,
673                            "?-displayof window? ?boolean?");
674                    return TCL_ERROR;
675                }
676                Tcl_SetBooleanObj(Tcl_GetObjResult(interp),
677                        dispPtr->useInputMethods);
678                break;
679            }
680        }
681        return TCL_OK;
682    }
683    
684    /*
685     *----------------------------------------------------------------------
686     *
687     * Tk_TkwaitCmd --
688     *
689     *      This procedure is invoked to process the "tkwait" Tcl command.
690     *      See the user documentation for details on what it does.
691     *
692     * Results:
693     *      A standard Tcl result.
694     *
695     * Side effects:
696     *      See the user documentation.
697     *
698     *----------------------------------------------------------------------
699     */
700    
701            /* ARGSUSED */
702    int
703    Tk_TkwaitCmd(clientData, interp, argc, argv)
704        ClientData clientData;      /* Main window associated with
705                                     * interpreter. */
706        Tcl_Interp *interp;         /* Current interpreter. */
707        int argc;                   /* Number of arguments. */
708        char **argv;                /* Argument strings. */
709    {
710        Tk_Window tkwin = (Tk_Window) clientData;
711        int c, done;
712        size_t length;
713    
714        if (argc != 3) {
715            Tcl_AppendResult(interp, "wrong # args: should be \"",
716                    argv[0], " variable|visibility|window name\"", (char *) NULL);
717            return TCL_ERROR;
718        }
719        c = argv[1][0];
720        length = strlen(argv[1]);
721        if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
722                && (length >= 2)) {
723            if (Tcl_TraceVar(interp, argv[2],
724                    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
725                    WaitVariableProc, (ClientData) &done) != TCL_OK) {
726                return TCL_ERROR;
727            }
728            done = 0;
729            while (!done) {
730                Tcl_DoOneEvent(0);
731            }
732            Tcl_UntraceVar(interp, argv[2],
733                    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
734                    WaitVariableProc, (ClientData) &done);
735        } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)
736                && (length >= 2)) {
737            Tk_Window window;
738    
739            window = Tk_NameToWindow(interp, argv[2], tkwin);
740            if (window == NULL) {
741                return TCL_ERROR;
742            }
743            Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
744                WaitVisibilityProc, (ClientData) &done);
745            done = 0;
746            while (!done) {
747                Tcl_DoOneEvent(0);
748            }
749            if (done != 1) {
750                /*
751                 * Note that we do not delete the event handler because it
752                 * was deleted automatically when the window was destroyed.
753                 */
754    
755                Tcl_ResetResult(interp);
756                Tcl_AppendResult(interp, "window \"", argv[2],
757                        "\" was deleted before its visibility changed",
758                        (char *) NULL);
759                return TCL_ERROR;
760            }
761            Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
762                WaitVisibilityProc, (ClientData) &done);
763        } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
764            Tk_Window window;
765    
766            window = Tk_NameToWindow(interp, argv[2], tkwin);
767            if (window == NULL) {
768                return TCL_ERROR;
769            }
770            Tk_CreateEventHandler(window, StructureNotifyMask,
771                WaitWindowProc, (ClientData) &done);
772            done = 0;
773            while (!done) {
774                Tcl_DoOneEvent(0);
775            }
776            /*
777             * Note:  there's no need to delete the event handler.  It was
778             * deleted automatically when the window was destroyed.
779             */
780        } else {
781            Tcl_AppendResult(interp, "bad option \"", argv[1],
782                    "\": must be variable, visibility, or window", (char *) NULL);
783            return TCL_ERROR;
784        }
785    
786        /*
787         * Clear out the interpreter's result, since it may have been set
788         * by event handlers.
789         */
790    
791        Tcl_ResetResult(interp);
792        return TCL_OK;
793    }
794    
795            /* ARGSUSED */
796    static char *
797    WaitVariableProc(clientData, interp, name1, name2, flags)
798        ClientData clientData;      /* Pointer to integer to set to 1. */
799        Tcl_Interp *interp;         /* Interpreter containing variable. */
800        char *name1;                /* Name of variable. */
801        char *name2;                /* Second part of variable name. */
802        int flags;                  /* Information about what happened. */
803    {
804        int *donePtr = (int *) clientData;
805    
806        *donePtr = 1;
807        return (char *) NULL;
808    }
809    
810            /*ARGSUSED*/
811    static void
812    WaitVisibilityProc(clientData, eventPtr)
813        ClientData clientData;      /* Pointer to integer to set to 1. */
814        XEvent *eventPtr;           /* Information about event (not used). */
815    {
816        int *donePtr = (int *) clientData;
817    
818        if (eventPtr->type == VisibilityNotify) {
819            *donePtr = 1;
820        }
821        if (eventPtr->type == DestroyNotify) {
822            *donePtr = 2;
823        }
824    }
825    
826    static void
827    WaitWindowProc(clientData, eventPtr)
828        ClientData clientData;      /* Pointer to integer to set to 1. */
829        XEvent *eventPtr;           /* Information about event. */
830    {
831        int *donePtr = (int *) clientData;
832    
833        if (eventPtr->type == DestroyNotify) {
834            *donePtr = 1;
835        }
836    }
837    
838    /*
839     *----------------------------------------------------------------------
840     *
841     * Tk_UpdateObjCmd --
842     *
843     *      This procedure is invoked to process the "update" Tcl command.
844     *      See the user documentation for details on what it does.
845     *
846     * Results:
847     *      A standard Tcl result.
848     *
849     * Side effects:
850     *      See the user documentation.
851     *
852     *----------------------------------------------------------------------
853     */
854    
855            /* ARGSUSED */
856    int
857    Tk_UpdateObjCmd(clientData, interp, objc, objv)
858        ClientData clientData;      /* Main window associated with
859                                     * interpreter. */
860        Tcl_Interp *interp;         /* Current interpreter. */
861        int objc;                   /* Number of arguments. */
862        Tcl_Obj *CONST objv[];      /* Argument objects. */
863    {
864        static char *updateOptions[] = {"idletasks", (char *) NULL};
865        int flags, index;
866        TkDisplay *dispPtr;
867    
868        if (objc == 1) {
869            flags = TCL_DONT_WAIT;
870        } else if (objc == 2) {
871            if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, "option", 0,
872                    &index) != TCL_OK) {
873                return TCL_ERROR;
874            }
875            flags = TCL_IDLE_EVENTS;
876        } else {
877            Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
878            return TCL_ERROR;
879        }
880    
881        /*
882         * Handle all pending events, sync all displays, and repeat over
883         * and over again until all pending events have been handled.
884         * Special note:  it's possible that the entire application could
885         * be destroyed by an event handler that occurs during the update.
886         * Thus, don't use any information from tkwin after calling
887         * Tcl_DoOneEvent.
888         */
889      
890        while (1) {
891            while (Tcl_DoOneEvent(flags) != 0) {
892                /* Empty loop body */
893            }
894            for (dispPtr = TkGetDisplayList(); dispPtr != NULL;
895                    dispPtr = dispPtr->nextPtr) {
896                XSync(dispPtr->display, False);
897            }
898            if (Tcl_DoOneEvent(flags) == 0) {
899                break;
900            }
901        }
902    
903        /*
904         * Must clear the interpreter's result because event handlers could
905         * have executed commands.
906         */
907    
908        Tcl_ResetResult(interp);
909        return TCL_OK;
910    }
911    
912    /*
913     *----------------------------------------------------------------------
914     *
915     * Tk_WinfoObjCmd --
916     *
917     *      This procedure is invoked to process the "winfo" Tcl command.
918     *      See the user documentation for details on what it does.
919     *
920     * Results:
921     *      A standard Tcl result.
922     *
923     * Side effects:
924     *      See the user documentation.
925     *
926     *----------------------------------------------------------------------
927     */
928    
929    int
930    Tk_WinfoObjCmd(clientData, interp, objc, objv)
931        ClientData clientData;      /* Main window associated with
932                                     * interpreter. */
933        Tcl_Interp *interp;         /* Current interpreter. */
934        int objc;                   /* Number of arguments. */
935        Tcl_Obj *CONST objv[];      /* Argument objects. */
936    {
937        int index, x, y, width, height, useX, useY, class, skip;
938        char *string;
939        TkWindow *winPtr;
940        Tk_Window tkwin;
941        Tcl_Obj *resultPtr;
942    
943        static TkStateMap visualMap[] = {
944            {PseudoColor,   "pseudocolor"},
945            {GrayScale,     "grayscale"},
946            {DirectColor,   "directcolor"},
947            {TrueColor,     "truecolor"},
948            {StaticColor,   "staticcolor"},
949            {StaticGray,    "staticgray"},
950            {-1,            NULL}
951        };
952        static char *optionStrings[] = {
953            "cells",        "children",     "class",        "colormapfull",
954            "depth",        "geometry",     "height",       "id",
955            "ismapped",     "manager",      "name",         "parent",
956            "pointerx",     "pointery",     "pointerxy",    "reqheight",
957            "reqwidth",     "rootx",        "rooty",        "screen",
958            "screencells",  "screendepth",  "screenheight", "screenwidth",
959            "screenmmheight","screenmmwidth","screenvisual","server",
960            "toplevel",     "viewable",     "visual",       "visualid",
961            "vrootheight",  "vrootwidth",   "vrootx",       "vrooty",
962            "width",        "x",            "y",
963            
964            "atom",         "atomname",     "containing",   "interps",
965            "pathname",
966    
967            "exists",       "fpixels",      "pixels",       "rgb",
968            "visualsavailable",
969    
970            NULL
971        };
972        enum options {
973            WIN_CELLS,      WIN_CHILDREN,   WIN_CLASS,      WIN_COLORMAPFULL,
974            WIN_DEPTH,      WIN_GEOMETRY,   WIN_HEIGHT,     WIN_ID,
975            WIN_ISMAPPED,   WIN_MANAGER,    WIN_NAME,       WIN_PARENT,
976            WIN_POINTERX,   WIN_POINTERY,   WIN_POINTERXY,  WIN_REQHEIGHT,
977            WIN_REQWIDTH,   WIN_ROOTX,      WIN_ROOTY,      WIN_SCREEN,
978            WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
979            WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
980            WIN_TOPLEVEL,   WIN_VIEWABLE,   WIN_VISUAL,     WIN_VISUALID,
981            WIN_VROOTHEIGHT,WIN_VROOTWIDTH, WIN_VROOTX,     WIN_VROOTY,
982            WIN_WIDTH,      WIN_X,          WIN_Y,
983            
984            WIN_ATOM,       WIN_ATOMNAME,   WIN_CONTAINING, WIN_INTERPS,
985            WIN_PATHNAME,
986    
987            WIN_EXISTS,     WIN_FPIXELS,    WIN_PIXELS,     WIN_RGB,
988            WIN_VISUALSAVAILABLE
989        };
990    
991        tkwin = (Tk_Window) clientData;
992        
993        if (objc < 2) {
994            Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
995            return TCL_ERROR;
996        }
997        if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
998                &index) != TCL_OK) {
999            return TCL_ERROR;
1000        }
1001    
1002        if (index < WIN_ATOM) {
1003            if (objc != 3) {
1004                Tcl_WrongNumArgs(interp, 2, objv, "window");
1005                return TCL_ERROR;
1006            }
1007            string = Tcl_GetStringFromObj(objv[2], NULL);
1008            tkwin = Tk_NameToWindow(interp, string, tkwin);
1009            if (tkwin == NULL) {
1010                return TCL_ERROR;
1011            }
1012        }
1013        winPtr = (TkWindow *) tkwin;
1014        resultPtr = Tcl_GetObjResult(interp);
1015    
1016        switch ((enum options) index) {
1017            case WIN_CELLS: {
1018                Tcl_SetIntObj(resultPtr, Tk_Visual(tkwin)->map_entries);
1019                break;
1020            }
1021            case WIN_CHILDREN: {
1022                Tcl_Obj *strPtr;
1023    
1024                winPtr = winPtr->childList;
1025                for ( ; winPtr != NULL; winPtr = winPtr->nextPtr) {
1026                    strPtr = Tcl_NewStringObj(winPtr->pathName, -1);
1027                    Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
1028                }
1029                break;
1030            }
1031            case WIN_CLASS: {
1032                Tcl_SetStringObj(resultPtr, Tk_Class(tkwin), -1);
1033                break;
1034            }
1035            case WIN_COLORMAPFULL: {
1036                Tcl_SetBooleanObj(resultPtr,
1037                        TkpCmapStressed(tkwin, Tk_Colormap(tkwin)));
1038                break;
1039            }
1040            case WIN_DEPTH: {
1041                Tcl_SetIntObj(resultPtr, Tk_Depth(tkwin));
1042                break;
1043            }
1044            case WIN_GEOMETRY: {
1045                char buf[16 + TCL_INTEGER_SPACE * 4];
1046    
1047                sprintf(buf, "%dx%d+%d+%d", Tk_Width(tkwin), Tk_Height(tkwin),
1048                        Tk_X(tkwin), Tk_Y(tkwin));
1049                Tcl_SetStringObj(resultPtr, buf, -1);
1050                break;
1051            }
1052            case WIN_HEIGHT: {
1053                Tcl_SetIntObj(resultPtr, Tk_Height(tkwin));
1054                break;
1055            }
1056            case WIN_ID: {
1057                char buf[TCL_INTEGER_SPACE];
1058                
1059                Tk_MakeWindowExist(tkwin);
1060                TkpPrintWindowId(buf, Tk_WindowId(tkwin));
1061                Tcl_SetStringObj(resultPtr, buf, -1);
1062                break;
1063            }
1064            case WIN_ISMAPPED: {
1065                Tcl_SetBooleanObj(resultPtr, (int) Tk_IsMapped(tkwin));
1066                break;
1067            }
1068            case WIN_MANAGER: {
1069                if (winPtr->geomMgrPtr != NULL) {
1070                    Tcl_SetStringObj(resultPtr, winPtr->geomMgrPtr->name, -1);
1071                }
1072                break;
1073            }
1074            case WIN_NAME: {
1075                Tcl_SetStringObj(resultPtr, Tk_Name(tkwin), -1);
1076                break;
1077            }
1078            case WIN_PARENT: {
1079                if (winPtr->parentPtr != NULL) {
1080                    Tcl_SetStringObj(resultPtr, winPtr->parentPtr->pathName, -1);
1081                }
1082                break;
1083            }
1084            case WIN_POINTERX: {
1085                useX = 1;
1086                useY = 0;
1087                goto pointerxy;
1088            }
1089            case WIN_POINTERY: {
1090                useX = 0;
1091                useY = 1;
1092                goto pointerxy;
1093            }
1094            case WIN_POINTERXY: {
1095                useX = 1;
1096                useY = 1;
1097    
1098                pointerxy:
1099                winPtr = GetToplevel(tkwin);
1100                if (winPtr == NULL) {
1101                    x = -1;
1102                    y = -1;
1103                } else {
1104                    TkGetPointerCoords((Tk_Window) winPtr, &x, &y);
1105                }
1106                if (useX & useY) {
1107                    char buf[TCL_INTEGER_SPACE * 2];
1108                    
1109                    sprintf(buf, "%d %d", x, y);
1110                    Tcl_SetStringObj(resultPtr, buf, -1);
1111                } else if (useX) {
1112                    Tcl_SetIntObj(resultPtr, x);
1113                } else {
1114                    Tcl_SetIntObj(resultPtr, y);
1115                }
1116                break;
1117            }
1118            case WIN_REQHEIGHT: {
1119                Tcl_SetIntObj(resultPtr, Tk_ReqHeight(tkwin));
1120                break;
1121            }
1122            case WIN_REQWIDTH: {
1123                Tcl_SetIntObj(resultPtr, Tk_ReqWidth(tkwin));
1124                break;
1125            }
1126            case WIN_ROOTX: {
1127                Tk_GetRootCoords(tkwin, &x, &y);
1128                Tcl_SetIntObj(resultPtr, x);
1129                break;
1130            }
1131            case WIN_ROOTY: {
1132                Tk_GetRootCoords(tkwin, &x, &y);
1133                Tcl_SetIntObj(resultPtr, y);
1134                break;
1135            }
1136            case WIN_SCREEN: {
1137                char buf[TCL_INTEGER_SPACE];
1138                
1139                sprintf(buf, "%d", Tk_ScreenNumber(tkwin));
1140                Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".",
1141                        buf, NULL);
1142                break;
1143            }
1144            case WIN_SCREENCELLS: {
1145                Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin)));
1146                break;
1147            }
1148            case WIN_SCREENDEPTH: {
1149                Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin)));
1150                break;
1151            }
1152            case WIN_SCREENHEIGHT: {
1153                Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin)));
1154                break;
1155            }
1156            case WIN_SCREENWIDTH: {
1157                Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin)));
1158                break;
1159            }
1160            case WIN_SCREENMMHEIGHT: {
1161                Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin)));
1162                break;
1163            }
1164            case WIN_SCREENMMWIDTH: {
1165                Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin)));
1166                break;
1167            }
1168            case WIN_SCREENVISUAL: {
1169                class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class;
1170                goto visual;
1171            }
1172            case WIN_SERVER: {
1173                TkGetServerInfo(interp, tkwin);
1174                break;
1175            }
1176            case WIN_TOPLEVEL: {
1177                winPtr = GetToplevel(tkwin);
1178                if (winPtr != NULL) {
1179                    Tcl_SetStringObj(resultPtr, winPtr->pathName, -1);
1180                }
1181                break;
1182            }
1183            case WIN_VIEWABLE: {
1184                int viewable = 0;
1185                for ( ; ; winPtr = winPtr->parentPtr) {
1186                    if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) {
1187                        break;
1188                    }
1189                    if (winPtr->flags & TK_TOP_LEVEL) {
1190                        viewable = 1;
1191                        break;
1192                    }
1193                }
1194    
1195                Tcl_SetBooleanObj(resultPtr, viewable);
1196                break;
1197            }
1198            case WIN_VISUAL: {
1199                class = Tk_Visual(tkwin)->class;
1200    
1201                visual:
1202                string = TkFindStateString(visualMap, class);
1203                if (string == NULL) {
1204                    string = "unknown";
1205                }
1206                Tcl_SetStringObj(resultPtr, string, -1);
1207                break;
1208            }
1209            case WIN_VISUALID: {
1210                char buf[TCL_INTEGER_SPACE];
1211    
1212                sprintf(buf, "0x%x",
1213                        (unsigned int) XVisualIDFromVisual(Tk_Visual(tkwin)));
1214                Tcl_SetStringObj(resultPtr, buf, -1);
1215                break;
1216            }
1217            case WIN_VROOTHEIGHT: {
1218                Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1219                Tcl_SetIntObj(resultPtr, height);
1220                break;
1221            }
1222            case WIN_VROOTWIDTH: {
1223                Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1224                Tcl_SetIntObj(resultPtr, width);
1225                break;
1226            }
1227            case WIN_VROOTX: {
1228                Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1229                Tcl_SetIntObj(resultPtr, x);
1230                break;
1231            }
1232            case WIN_VROOTY: {
1233                Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
1234                Tcl_SetIntObj(resultPtr, y);
1235                break;
1236            }
1237            case WIN_WIDTH: {
1238                Tcl_SetIntObj(resultPtr, Tk_Width(tkwin));
1239                break;
1240            }
1241            case WIN_X: {
1242                Tcl_SetIntObj(resultPtr, Tk_X(tkwin));
1243                break;
1244            }
1245            case WIN_Y: {
1246                Tcl_SetIntObj(resultPtr, Tk_Y(tkwin));
1247                break;
1248            }
1249    
1250            /*
1251             * Uses -displayof.
1252             */
1253            
1254            case WIN_ATOM: {
1255                skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1256                if (skip < 0) {
1257                    return TCL_ERROR;
1258                }
1259                if (objc - skip != 3) {
1260                    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name");
1261                    return TCL_ERROR;
1262                }
1263                objv += skip;
1264                string = Tcl_GetStringFromObj(objv[2], NULL);
1265                Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string));
1266                break;
1267            }
1268            case WIN_ATOMNAME: {
1269                char *name;
1270                long id;
1271                
1272                skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1273                if (skip < 0) {
1274                    return TCL_ERROR;
1275                }
1276                if (objc - skip != 3) {
1277                    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
1278                    return TCL_ERROR;
1279                }
1280                objv += skip;
1281                if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) {
1282                    return TCL_ERROR;
1283                }
1284                name = Tk_GetAtomName(tkwin, (Atom) id);
1285                if (strcmp(name, "?bad atom?") == 0) {
1286                    string = Tcl_GetStringFromObj(objv[2], NULL);
1287                    Tcl_AppendStringsToObj(resultPtr,
1288                            "no atom exists with id \"", string, "\"", NULL);
1289                    return TCL_ERROR;
1290                }
1291                Tcl_SetStringObj(resultPtr, name, -1);
1292                break;
1293            }
1294            case WIN_CONTAINING: {
1295                skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1296                if (skip < 0) {
1297                    return TCL_ERROR;
1298                }
1299                if (objc - skip != 4) {
1300                    Tcl_WrongNumArgs(interp, 2, objv,
1301                            "?-displayof window? rootX rootY");
1302                    return TCL_ERROR;
1303                }
1304                objv += skip;
1305                string = Tcl_GetStringFromObj(objv[2], NULL);
1306                if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
1307                    return TCL_ERROR;
1308                }
1309                string = Tcl_GetStringFromObj(objv[3], NULL);
1310                if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) {
1311                    return TCL_ERROR;
1312                }
1313                tkwin = Tk_CoordsToWindow(x, y, tkwin);
1314                if (tkwin != NULL) {
1315                    Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
1316                }
1317                break;
1318            }
1319            case WIN_INTERPS: {
1320                int result;
1321                
1322                skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1323                if (skip < 0) {
1324                    return TCL_ERROR;
1325                }
1326                if (objc - skip != 2) {
1327                    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
1328                    return TCL_ERROR;
1329                }
1330                result = TkGetInterpNames(interp, tkwin);
1331                return result;
1332            }
1333            case WIN_PATHNAME: {
1334                int id;
1335    
1336                skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
1337                if (skip < 0) {
1338                    return TCL_ERROR;
1339                }
1340                if (objc - skip != 3) {
1341                    Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id");
1342                    return TCL_ERROR;
1343                }
1344                string = Tcl_GetStringFromObj(objv[2 + skip], NULL);
1345                if (TkpScanWindowId(interp, string, &id) != TCL_OK) {
1346                    return TCL_ERROR;
1347                }
1348                winPtr = (TkWindow *)
1349                        Tk_IdToWindow(Tk_Display(tkwin), (Window) id);
1350                if ((winPtr == NULL) ||
1351                        (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) {
1352                    Tcl_AppendStringsToObj(resultPtr, "window id \"", string,
1353                            "\" doesn't exist in this application", (char *) NULL);
1354                    return TCL_ERROR;
1355                }
1356    
1357                /*
1358                 * If the window is a utility window with no associated path
1359                 * (such as a wrapper window or send communication window), just
1360                 * return an empty string.
1361                 */
1362    
1363                tkwin = (Tk_Window) winPtr;
1364                if (Tk_PathName(tkwin) != NULL) {
1365                    Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1);
1366                }
1367                break;
1368            }
1369    
1370            /*
1371             * objv[3] is window.
1372             */
1373    
1374            case WIN_EXISTS: {
1375                int alive;
1376    
1377                if (objc != 3) {
1378                    Tcl_WrongNumArgs(interp, 2, objv, "window");
1379                    return TCL_ERROR;
1380                }
1381                string = Tcl_GetStringFromObj(objv[2], NULL);
1382                winPtr = (TkWindow *) Tk_NameToWindow(interp, string, tkwin);
1383                Tcl_ResetResult(interp);
1384                resultPtr = Tcl_GetObjResult(interp);
1385    
1386                alive = 1;
1387                if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) {
1388                    alive = 0;
1389                }
1390                Tcl_SetBooleanObj(resultPtr, alive);
1391                break;
1392            }
1393            case WIN_FPIXELS: {
1394                double mm, pixels;
1395    
1396                if (objc != 4) {
1397                    Tcl_WrongNumArgs(interp, 2, objv, "window number");
1398                    return TCL_ERROR;
1399                }
1400                string = Tcl_GetStringFromObj(objv[2], NULL);
1401                tkwin = Tk_NameToWindow(interp, string, tkwin);
1402                if (tkwin == NULL) {
1403                    return TCL_ERROR;
1404                }
1405                string = Tcl_GetStringFromObj(objv[3], NULL);
1406                if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) {
1407                    return TCL_ERROR;
1408                }
1409                pixels = mm * WidthOfScreen(Tk_Screen(tkwin))
1410                        / WidthMMOfScreen(Tk_Screen(tkwin));
1411                Tcl_SetDoubleObj(resultPtr, pixels);
1412                break;
1413            }
1414            case WIN_PIXELS: {
1415                int pixels;
1416                
1417                if (objc != 4) {
1418                    Tcl_WrongNumArgs(interp, 2, objv, "window number");
1419                    return TCL_ERROR;
1420                }
1421                string = Tcl_GetStringFromObj(objv[2], NULL);
1422                tkwin = Tk_NameToWindow(interp, string, tkwin);
1423                if (tkwin == NULL) {
1424                    return TCL_ERROR;
1425                }
1426                string = Tcl_GetStringFromObj(objv[3], NULL);
1427                if (Tk_GetPixels(interp, tkwin, string, &pixels) != TCL_OK) {
1428                    return TCL_ERROR;
1429                }
1430                Tcl_SetIntObj(resultPtr, pixels);
1431                break;
1432            }
1433            case WIN_RGB: {
1434                XColor *colorPtr;
1435                char buf[TCL_INTEGER_SPACE * 3];
1436    
1437                if (objc != 4) {
1438                    Tcl_WrongNumArgs(interp, 2, objv, "window colorName");
1439                    return TCL_ERROR;
1440                }
1441                string = Tcl_GetStringFromObj(objv[2], NULL);
1442                tkwin = Tk_NameToWindow(interp, string, tkwin);
1443                if (tkwin == NULL) {
1444                    return TCL_ERROR;
1445                }
1446                string = Tcl_GetStringFromObj(objv[3], NULL);
1447                colorPtr = Tk_GetColor(interp, tkwin, string);
1448                if (colorPtr == NULL) {
1449                    return TCL_ERROR;
1450                }
1451                sprintf(buf, "%d %d %d", colorPtr->red, colorPtr->green,
1452                        colorPtr->blue);
1453                Tk_FreeColor(colorPtr);
1454                Tcl_SetStringObj(resultPtr, buf, -1);
1455                break;
1456            }
1457            case WIN_VISUALSAVAILABLE: {
1458                XVisualInfo template, *visInfoPtr;
1459                int count, i;
1460                int includeVisualId;
1461                Tcl_Obj *strPtr;
1462                char buf[16 + TCL_INTEGER_SPACE];
1463                char visualIdString[TCL_INTEGER_SPACE];
1464    
1465                if (objc == 3) {
1466                    includeVisualId = 0;
1467                } else if ((objc == 4)
1468                        && (strcmp(Tcl_GetStringFromObj(objv[3], NULL),
1469                                "includeids") == 0)) {
1470                    includeVisualId = 1;
1471                } else {
1472                    Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
1473                    return TCL_ERROR;
1474                }
1475    
1476                string = Tcl_GetStringFromObj(objv[2], NULL);
1477                tkwin = Tk_NameToWindow(interp, string, tkwin);
1478                if (tkwin == NULL) {
1479                    return TCL_ERROR;
1480                }
1481    
1482                template.screen = Tk_ScreenNumber(tkwin);
1483                visInfoPtr = XGetVisualInfo(Tk_Display(tkwin), VisualScreenMask,
1484                        &template, &count);
1485                if (visInfoPtr == NULL) {
1486                    Tcl_SetStringObj(resultPtr,
1487                            "can't find any visuals for screen", -1);
1488                    return TCL_ERROR;
1489                }
1490                for (i = 0; i < count; i++) {
1491                    string = TkFindStateString(visualMap, visInfoPtr[i].class);
1492                    if (string == NULL) {
1493                        strcpy(buf, "unknown");
1494                    } else {
1495                        sprintf(buf, "%s %d", string, visInfoPtr[i].depth);
1496                    }
1497                    if (includeVisualId) {
1498                        sprintf(visualIdString, " 0x%x",
1499                                (unsigned int) visInfoPtr[i].visualid);
1500                        strcat(buf, visualIdString);
1501                    }
1502                    strPtr = Tcl_NewStringObj(buf, -1);
1503                    Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
1504                }
1505                XFree((char *) visInfoPtr);
1506                break;
1507            }
1508        }
1509        return TCL_OK;
1510    }
1511    
1512    #if 0
1513    /*
1514     *----------------------------------------------------------------------
1515     *
1516     * Tk_WmObjCmd --
1517     *
1518     *      This procedure is invoked to process the "wm" Tcl command.
1519     *      See the user documentation for details on what it does.
1520     *
1521     * Results:
1522     *      A standard Tcl result.
1523     *
1524     * Side effects:
1525     *      See the user documentation.
1526     *
1527     *----------------------------------------------------------------------
1528     */
1529    
1530            /* ARGSUSED */
1531    int
1532    Tk_WmObjCmd(clientData, interp, objc, objv)
1533        ClientData clientData;      /* Main window associated with
1534                                     * interpreter. */
1535        Tcl_Interp *interp;         /* Current interpreter. */
1536        int objc;                   /* Number of arguments. */
1537        Tcl_Obj *CONST objv[];      /* Argument objects. */
1538    {
1539        Tk_Window tkwin;
1540        TkWindow *winPtr;
1541    
1542        static char *optionStrings[] = {
1543            "aspect",       "client",       "command",      "deiconify",
1544            "focusmodel",   "frame",        "geometry",     "grid",
1545            "group",        "iconbitmap",   "iconify",      "iconmask",
1546            "iconname",     "iconposition", "iconwindow",   "maxsize",
1547            "minsize",      "overrideredirect",     "positionfrom", "protocol",
1548            "resizable",    "sizefrom",     "state",        "title",
1549            "tracing",      "transient",    "withdraw",     (char *) NULL
1550        };
1551        enum options {
1552            TKWM_ASPECT,    TKWM_CLIENT,    TKWM_COMMAND,   TKWM_DEICONIFY,
1553            TKWM_FOCUSMOD,  TKWM_FRAME,     TKWM_GEOMETRY,  TKWM_GRID,
1554            TKWM_GROUP,     TKWM_ICONBMP,   TKWM_ICONIFY,   TKWM_ICONMASK,
1555            TKWM_ICONNAME,  TKWM_ICONPOS,   TKWM_ICONWIN,   TKWM_MAXSIZE,
1556            TKWM_MINSIZE,   TKWM_OVERRIDE,  TKWM_POSFROM,   TKWM_PROTOCOL,
1557            TKWM_RESIZABLE, TKWM_SIZEFROM,  TKWM_STATE,     TKWM_TITLE,
1558            TKWM_TRACING,   TKWM_TRANSIENT, TKWM_WITHDRAW
1559        };
1560    
1561        tkwin = (Tk_Window) clientData;
1562    
1563        if (objc < 2) {
1564            Tcl_WrongNumArgs(interp, 1, objv, "option window ?arg?");
1565            return TCL_ERROR;
1566        }
1567        if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
1568                &index) != TCL_OK) {
1569            return TCL_ERROR;
1570        }
1571    
1572        if (index == TKWM_TRACING) {
1573            TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
1574    
1575            if ((objc != 2) && (objc != 3)) {
1576                Tcl_WrongNumArgs(interp, 1, objv, "tracing ?boolean?");
1577                return TCL_ERROR;
1578            }
1579            if (objc == 2) {
1580                Tcl_SetObjResult(interp, Tcl_NewBooleanObj(dispPtr->wmTracing));
1581                return TCL_OK;
1582            }
1583            return Tcl_GetBooleanFromObj(interp, objv[2], &dispPtr->wmTracing);
1584        }
1585    
1586        if (objc < 3) {
1587            Tcl_WrongNumArgs(interp, 2, objv, "window ?arg?");
1588            return TCL_ERROR;
1589        }
1590    
1591        winPtr = (TkWindow *) Tk_NameToWindow(interp,
1592                Tcl_GetString(objv[2]), tkwin);
1593        if (winPtr == NULL) {
1594            return TCL_ERROR;
1595        }
1596        if (!(winPtr->flags & TK_TOP_LEVEL)) {
1597            Tcl_AppendResult(interp, "window \"", winPtr->pathName,
1598                    "\" isn't a top-level window", (char *) NULL);
1599            return TCL_ERROR;
1600        }
1601    
1602        switch ((enum options) index) {
1603            case TKWM_ASPECT: {
1604                TkpWmAspectCmd(interp, tkwin, winPtr, objc, objv);
1605                break;
1606            }
1607            case TKWM_CLIENT: {
1608                TkpWmClientCmd(interp, tkwin, winPtr, objc, objv);
1609                break;
1610            }
1611            case TKWM_COMMAND: {
1612                TkpWmCommandCmd(interp, tkwin, winPtr, objc, objv);
1613                break;
1614            }
1615            case TKWM_DEICONIFY: {
1616                TkpWmDeiconifyCmd(interp, tkwin, winPtr, objc, objv);
1617                break;
1618            }
1619            case TKWM_FOCUSMOD: {
1620                TkpWmFocusmodCmd(interp, tkwin, winPtr, objc, objv);
1621                break;
1622            }
1623            case TKWM_FRAME: {
1624                TkpWmFrameCmd(interp, tkwin, winPtr, objc, objv);
1625                break;
1626            }
1627            case TKWM_GEOMETRY: {
1628                TkpWmGeometryCmd(interp, tkwin, winPtr, objc, objv);
1629                break;
1630            }
1631            case TKWM_GRID: {
1632                TkpWmGridCmd(interp, tkwin, winPtr, objc, objv);
1633                break;
1634            }
1635            case TKWM_GROUP: {
1636                TkpWmGroupCmd(interp, tkwin, winPtr, objc, objv);
1637                break;
1638            }
1639            case TKWM_ICONBMP: {
1640                TkpWmIconbitmapCmd(interp, tkwin, winPtr, objc, objv);
1641                break;
1642            }
1643            case TKWM_ICONIFY: {
1644                TkpWmIconifyCmd(interp, tkwin, winPtr, objc, objv);
1645                break;
1646            }
1647            case TKWM_ICONMASK: {
1648                TkpWmIconmaskCmd(interp, tkwin, winPtr, objc, objv);
1649                break;
1650            }
1651            case TKWM_ICONNAME: {
1652                /* slight Unix variation */
1653                TkpWmIconnameCmd(interp, tkwin, winPtr, objc, objv);
1654                break;
1655            }
1656            case TKWM_ICONPOS: {
1657                /* nearly same - 1 line more on Unix */
1658                TkpWmIconpositionCmd(interp, tkwin, winPtr, objc, objv);
1659                break;
1660            }
1661            case TKWM_ICONWIN: {
1662                TkpWmIconwindowCmd(interp, tkwin, winPtr, objc, objv);
1663                break;
1664            }
1665            case TKWM_MAXSIZE: {
1666                /* nearly same, win diffs */
1667                TkpWmMaxsizeCmd(interp, tkwin, winPtr, objc, objv);
1668                break;
1669            }
1670            case TKWM_MINSIZE: {
1671                /* nearly same, win diffs */
1672                TkpWmMinsizeCmd(interp, tkwin, winPtr, objc, objv);
1673                break;
1674            }
1675            case TKWM_OVERRIDE: {
1676                /* almost same */
1677                TkpWmOverrideCmd(interp, tkwin, winPtr, objc, objv);
1678                break;
1679            }
1680            case TKWM_POSFROM: {
1681                /* Equal across platforms */
1682                TkpWmPositionfromCmd(interp, tkwin, winPtr, objc, objv);
1683                break;
1684            }
1685            case TKWM_PROTOCOL: {
1686                /* Equal across platforms */
1687                TkpWmProtocolCmd(interp, tkwin, winPtr, objc, objv);
1688                break;
1689            }
1690            case TKWM_RESIZABLE: {
1691                /* almost same */
1692                TkpWmResizableCmd(interp, tkwin, winPtr, objc, objv);
1693                break;
1694            }
1695            case TKWM_SIZEFROM: {
1696                /* Equal across platforms */
1697                TkpWmSizefromCmd(interp, tkwin, winPtr, objc, objv);
1698                break;
1699            }
1700            case TKWM_STATE: {
1701                TkpWmStateCmd(interp, tkwin, winPtr, objc, objv);
1702                break;
1703            }
1704            case TKWM_TITLE: {
1705                TkpWmTitleCmd(interp, tkwin, winPtr, objc, objv);
1706                break;
1707            }
1708            case TKWM_TRANSIENT: {
1709                TkpWmTransientCmd(interp, tkwin, winPtr, objc, objv);
1710                break;
1711            }
1712            case TKWM_WITHDRAW: {
1713                TkpWmWithdrawCmd(interp, tkwin, winPtr, objc, objv);
1714                break;
1715            }
1716        }
1717    
1718        updateGeom:
1719        if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
1720            Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
1721            wmPtr->flags |= WM_UPDATE_PENDING;
1722        }
1723        return TCL_OK;
1724    }
1725    #endif
1726    
1727    /*
1728     *----------------------------------------------------------------------
1729     *
1730     * TkGetDisplayOf --
1731     *
1732     *      Parses a "-displayof window" option for various commands.  If
1733     *      present, the literal "-displayof" should be in objv[0] and the
1734     *      window name in objv[1].
1735     *
1736     * Results:
1737     *      The return value is 0 if the argument strings did not contain
1738     *      the "-displayof" option.  The return value is 2 if the
1739     *      argument strings contained both the "-displayof" option and
1740     *      a valid window name.  Otherwise, the return value is -1 if
1741     *      the window name was missing or did not specify a valid window.
1742     *
1743     *      If the return value was 2, *tkwinPtr is filled with the
1744     *      token for the window specified on the command line.  If the
1745     *      return value was -1, an error message is left in interp's
1746     *      result object.
1747     *
1748     * Side effects:
1749     *      None.
1750     *
1751     *----------------------------------------------------------------------
1752     */
1753    
1754    int
1755    TkGetDisplayOf(interp, objc, objv, tkwinPtr)
1756        Tcl_Interp *interp;         /* Interpreter for error reporting. */
1757        int objc;                   /* Number of arguments. */
1758        Tcl_Obj *CONST objv[];      /* Argument objects. If it is present,
1759                                     * "-displayof" should be in objv[0] and
1760                                     * objv[1] the name of a window. */
1761        Tk_Window *tkwinPtr;        /* On input, contains main window of
1762                                     * application associated with interp.  On
1763                                     * output, filled with window specified as
1764                                     * option to "-displayof" argument, or
1765                                     * unmodified if "-displayof" argument was not
1766                                     * present. */
1767    {
1768        char *string;
1769        int length;
1770        
1771        if (objc < 1) {
1772            return 0;
1773        }
1774        string = Tcl_GetStringFromObj(objv[0], &length);
1775        if ((length >= 2) &&
1776                (strncmp(string, "-displayof", (unsigned) length) == 0)) {
1777            if (objc < 2) {
1778                Tcl_SetStringObj(Tcl_GetObjResult(interp),
1779                        "value for \"-displayof\" missing", -1);
1780                return -1;
1781            }
1782            string = Tcl_GetStringFromObj(objv[1], NULL);
1783            *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr);
1784            if (*tkwinPtr == NULL) {
1785                return -1;
1786            }
1787            return 2;
1788        }
1789        return 0;
1790    }
1791    
1792    /*
1793     *----------------------------------------------------------------------
1794     *
1795     * TkDeadAppCmd --
1796     *
1797     *      If an application has been deleted then all Tk commands will be
1798     *      re-bound to this procedure.
1799     *
1800     * Results:
1801     *      A standard Tcl error is reported to let the user know that
1802     *      the application is dead.
1803     *
1804     * Side effects:
1805     *      See the user documentation.
1806     *
1807     *----------------------------------------------------------------------
1808     */
1809    
1810            /* ARGSUSED */
1811    int
1812    TkDeadAppCmd(clientData, interp, argc, argv)
1813        ClientData clientData;      /* Dummy. */
1814        Tcl_Interp *interp;         /* Current interpreter. */
1815        int argc;                   /* Number of arguments. */
1816        char **argv;                /* Argument strings. */
1817    {
1818        Tcl_AppendResult(interp, "can't invoke \"", argv[0],
1819                "\" command:  application has been destroyed", (char *) NULL);
1820        return TCL_ERROR;
1821    }
1822    
1823    /*
1824     *----------------------------------------------------------------------
1825     *
1826     * GetToplevel --
1827     *
1828     *      Retrieves the toplevel window which is the nearest ancestor of
1829     *      of the specified window.
1830     *
1831     * Results:
1832     *      Returns the toplevel window or NULL if the window has no
1833     *      ancestor which is a toplevel.
1834     *
1835     * Side effects:
1836     *      None.
1837     *
1838     *----------------------------------------------------------------------
1839     */
1840    
1841    static TkWindow *
1842    GetToplevel(tkwin)
1843        Tk_Window tkwin;            /* Window for which the toplevel should be
1844                                     * deterined. */
1845    {
1846         TkWindow *winPtr = (TkWindow *) tkwin;
1847    
1848         while (!(winPtr->flags & TK_TOP_LEVEL)) {
1849             winPtr = winPtr->parentPtr;
1850             if (winPtr == NULL) {
1851                 return NULL;
1852             }
1853         }
1854         return winPtr;
1855    }
1856    
1857    /* End of tkcmds.c */
Legend:
Removed from v.42  
changed lines
  Added in v.220
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25