开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tkCmds.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：53k
源码类别：

通讯编程

开发平台：

Visual C++

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