diff options
Diffstat (limited to 'generic/tkCmds.c')
| -rw-r--r-- | generic/tkCmds.c | 2059 |
1 files changed, 1009 insertions, 1050 deletions
diff --git a/generic/tkCmds.c b/generic/tkCmds.c index acc0ab0..b993dca 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -1,17 +1,17 @@ -/* +/* * tkCmds.c -- * - * This file contains a collection of Tk-related Tcl commands - * that didn't fit in any particular file of the toolkit. + * 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. * Copyright (c) 2000 Scriptics Corporation. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * 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.36 2005/05/27 23:14:29 dkf Exp $ + * RCS: @(#) $Id: tkCmds.c,v 1.37 2005/11/11 23:51:27 dkf Exp $ */ #include "tkPort.h" @@ -20,32 +20,32 @@ #if defined(WIN32) #include "tkWinInt.h" -#elif defined(MAC_OSX_TK) +#elif defined(MAC_OSX_TK) #include "tkMacOSXInt.h" #else #include "tkUnixInt.h" #endif /* - * Forward declarations for procedures defined later in this file: + * Forward declarations for functions defined later in this file: */ -static TkWindow * GetTopHierarchy _ANSI_ARGS_((Tk_Window tkwin)); -static char * WaitVariableProc _ANSI_ARGS_((ClientData clientData, +static TkWindow * GetTopHierarchy(Tk_Window tkwin); +static char * WaitVariableProc(ClientData clientData, Tcl_Interp *interp, CONST char *name1, - CONST char *name2, int flags)); -static void WaitVisibilityProc _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); -static void WaitWindowProc _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); + CONST char *name2, int flags); +static void WaitVisibilityProc(ClientData clientData, + XEvent *eventPtr); +static void WaitWindowProc(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. + * This function is invoked to process the "bell" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -57,18 +57,21 @@ static void WaitWindowProc _ANSI_ARGS_((ClientData clientData, */ 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. */ +Tk_BellObjCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { - static CONST char *bellOptions[] = {"-displayof", "-nice", (char *) NULL}; + static CONST char *bellOptions[] = { + "-displayof", "-nice", NULL + }; enum options { TK_BELL_DISPLAYOF, TK_BELL_NICE }; Tk_Window tkwin = (Tk_Window) clientData; int i, index, nice = 0; if (objc > 4) { + wrongArgs: Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window? ?-nice?"); return TCL_ERROR; } @@ -79,20 +82,18 @@ Tk_BellObjCmd(clientData, interp, objc, objv) return TCL_ERROR; } switch ((enum options) index) { - case TK_BELL_DISPLAYOF: - if (++i >= objc) { - Tcl_WrongNumArgs(interp, 1, objv, - "?-displayof window? ?-nice?"); - return TCL_ERROR; - } - tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin); - if (tkwin == NULL) { - return TCL_ERROR; - } - break; - case TK_BELL_NICE: - nice = 1; - break; + case TK_BELL_DISPLAYOF: + if (++i >= objc) { + goto wrongArgs; + } + tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[i]), tkwin); + if (tkwin == NULL) { + return TCL_ERROR; + } + break; + case TK_BELL_NICE: + nice = 1; + break; } } XBell(Tk_Display(tkwin), 0); @@ -108,8 +109,8 @@ Tk_BellObjCmd(clientData, interp, objc, objv) * * Tk_BindObjCmd -- * - * This procedure is invoked to process the "bind" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "bind" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -121,23 +122,23 @@ Tk_BellObjCmd(clientData, interp, objc, objv) */ int -Tk_BindObjCmd(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_BindObjCmd( + 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 = (Tk_Window) clientData; TkWindow *winPtr; ClientData object; char *string; - + if ((objc < 2) || (objc > 4)) { Tcl_WrongNumArgs(interp, 1, objv, "window ?pattern? ?command?"); return TCL_ERROR; } string = Tcl_GetString(objv[1]); - + /* * Bind tags either a window name or a tag name for the first argument. * If the argument starts with ".", assume it is a window; otherwise, it @@ -156,8 +157,8 @@ Tk_BindObjCmd(clientData, interp, objc, objv) } /* - * If there are four arguments, the command is modifying a binding. If - * there are three arguments, the command is querying a binding. If there + * If there are four arguments, the command is modifying a binding. If + * there are three arguments, the command is querying a binding. If there * are only two arguments, the command is querying all the bindings for * the given tag/window. */ @@ -168,7 +169,7 @@ Tk_BindObjCmd(clientData, interp, objc, objv) char *sequence, *script; sequence = Tcl_GetString(objv[2]); script = Tcl_GetString(objv[3]); - + /* * If the script is null, just delete the binding. */ @@ -182,7 +183,7 @@ Tk_BindObjCmd(clientData, interp, objc, objv) * If the script begins with "+", append this script to the existing * binding. */ - + if (script[0] == '+') { script++; append = 1; @@ -213,8 +214,8 @@ Tk_BindObjCmd(clientData, interp, objc, objv) * * TkBindEventProc -- * - * This procedure is invoked by Tk_HandleEvent for each event; it - * causes any appropriate bindings for that event to be invoked. + * This function is invoked by Tk_HandleEvent for each event; it causes + * any appropriate bindings for that event to be invoked. * * Results: * None. @@ -227,9 +228,9 @@ Tk_BindObjCmd(clientData, interp, objc, objv) */ void -TkBindEventProc(winPtr, eventPtr) - TkWindow *winPtr; /* Pointer to info about window. */ - XEvent *eventPtr; /* Information about event. */ +TkBindEventProc( + TkWindow *winPtr, /* Pointer to info about window. */ + XEvent *eventPtr) /* Information about event. */ { #define MAX_OBJS 20 ClientData objects[MAX_OBJS], *objPtr; @@ -245,8 +246,8 @@ TkBindEventProc(winPtr, eventPtr) 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. + * 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) { @@ -294,8 +295,8 @@ TkBindEventProc(winPtr, eventPtr) * * Tk_BindtagsObjCmd -- * - * This procedure is invoked to process the "bindtags" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "bindtags" Tcl command. See + * the user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -307,18 +308,18 @@ TkBindEventProc(winPtr, eventPtr) */ int -Tk_BindtagsObjCmd(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_BindtagsObjCmd( + 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 = (Tk_Window) clientData; TkWindow *winPtr, *winPtr2; int i, length; char *p; Tcl_Obj *listPtr, **tags; - + if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "window ?taglist?"); return TCL_ERROR; @@ -376,9 +377,9 @@ Tk_BindtagsObjCmd(clientData, interp, objc, objv) /* * 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. + * 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)); @@ -396,9 +397,9 @@ Tk_BindtagsObjCmd(clientData, interp, objc, objv) * * 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. + * This function 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. @@ -410,8 +411,8 @@ Tk_BindtagsObjCmd(clientData, interp, objc, objv) */ void -TkFreeBindingTags(winPtr) - TkWindow *winPtr; /* Window whose tags are to be released. */ +TkFreeBindingTags( + TkWindow *winPtr) /* Window whose tags are to be released. */ { int i; char *p; @@ -420,10 +421,10 @@ TkFreeBindingTags(winPtr) p = (char *) (winPtr->tagPtr[i]); if (*p == '.') { /* - * Names starting with "." are malloced rather than Uids, so - * they have to be freed. + * Names starting with "." are malloced rather than Uids, so they + * have to be freed. */ - + ckfree(p); } } @@ -437,8 +438,8 @@ TkFreeBindingTags(winPtr) * * Tk_DestroyObjCmd -- * - * This procedure is invoked to process the "destroy" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "destroy" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -450,12 +451,11 @@ TkFreeBindingTags(winPtr) */ 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_DestroyObjCmd( + 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; @@ -470,13 +470,12 @@ Tk_DestroyObjCmd(clientData, interp, objc, objv) 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). + * 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; } @@ -486,8 +485,8 @@ Tk_DestroyObjCmd(clientData, interp, objc, objv) * * Tk_LowerObjCmd -- * - * This procedure is invoked to process the "lower" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "lower" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -500,12 +499,11 @@ Tk_DestroyObjCmd(clientData, interp, objc, objv) /* 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_LowerObjCmd( + 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; @@ -530,7 +528,7 @@ Tk_LowerObjCmd(clientData, interp, objc, objv) 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); + "\"", NULL); return TCL_ERROR; } return TCL_OK; @@ -541,8 +539,8 @@ Tk_LowerObjCmd(clientData, interp, objc, objv) * * Tk_RaiseObjCmd -- * - * This procedure is invoked to process the "raise" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "raise" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -555,12 +553,11 @@ Tk_LowerObjCmd(clientData, interp, objc, objv) /* 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_RaiseObjCmd( + 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; @@ -585,7 +582,7 @@ Tk_RaiseObjCmd(clientData, interp, objc, objv) 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); + "\"", NULL); return TCL_ERROR; } return TCL_OK; @@ -596,8 +593,8 @@ Tk_RaiseObjCmd(clientData, interp, objc, objv) * * Tk_TkObjCmd -- * - * This procedure is invoked to process the "tk" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "tk" Tcl command. See the user + * documentation for details on what it does. * * Results: * A standard Tcl result. @@ -609,11 +606,11 @@ Tk_RaiseObjCmd(clientData, interp, objc, objv) */ 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. */ +Tk_TkObjCmd( + 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; @@ -638,253 +635,257 @@ Tk_TkObjCmd(clientData, interp, objc, objv) } switch ((enum options) index) { - case TK_APPNAME: { - TkWindow *winPtr; - char *string; - - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "appname not accessible in a safe interpreter", - TCL_STATIC); - return TCL_ERROR; - } + case TK_APPNAME: { + TkWindow *winPtr; + char *string; + + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "appname not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; + } - winPtr = (TkWindow *) tkwin; + 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; + if (objc > 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?newName?"); + return TCL_ERROR; + } + if (objc == 3) { + string = Tcl_GetString(objv[2]); + winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, string)); + } + Tcl_AppendResult(interp, winPtr->nameUid, NULL); + break; + } + case TK_CARET: { + Tcl_Obj *objPtr; + TkCaret *caretPtr; + Tk_Window window; + static CONST char *caretStrings[] = { + "-x", "-y", "-height", NULL + }; + enum caretOptions { + TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT + }; + + if ((objc < 3) || ((objc > 4) && !(objc & 1))) { + Tcl_WrongNumArgs(interp, 2, objv, + "window ?-x x? ?-y y? ?-height height?"); + return TCL_ERROR; } - case TK_CARET: { - Tcl_Obj *objPtr; - TkCaret *caretPtr; - Tk_Window window; - static CONST char *caretStrings[] - = { "-x", "-y", "-height", NULL }; - enum caretOptions - { TK_CARET_X, TK_CARET_Y, TK_CARET_HEIGHT }; - - if ((objc < 3) || ((objc > 4) && !(objc & 1))) { - Tcl_WrongNumArgs(interp, 2, objv, - "window ?-x x? ?-y y? ?-height height?"); + window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); + if (window == NULL) { + return TCL_ERROR; + } + caretPtr = &(((TkWindow *) window)->dispPtr->caret); + if (objc == 3) { + /* + * Return all the current values + */ + + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-height", 7)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->height)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-x", 2)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->x)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewStringObj("-y", 2)); + Tcl_ListObjAppendElement(interp, objPtr, + Tcl_NewIntObj(caretPtr->y)); + Tcl_SetObjResult(interp, objPtr); + } else if (objc == 4) { + int value; + + /* + * Return the current value of the selected option + */ + + if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings, + "caret option", 0, &index) != TCL_OK) { return TCL_ERROR; } - window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - if (window == NULL) { - return TCL_ERROR; + if (index == TK_CARET_X) { + value = caretPtr->x; + } else if (index == TK_CARET_Y) { + value = caretPtr->y; + } else /* if (index == TK_CARET_HEIGHT) -- last case */ { + value = caretPtr->height; } - caretPtr = &(((TkWindow *) window)->dispPtr->caret); - if (objc == 3) { - /* - * Return all the current values - */ - objPtr = Tcl_NewObj(); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-height", 7)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->height)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-x", 2)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->x)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj("-y", 2)); - Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewIntObj(caretPtr->y)); - Tcl_SetObjResult(interp, objPtr); - } else if (objc == 4) { - int value; - /* - * Return the current value of the selected option - */ - if (Tcl_GetIndexFromObj(interp, objv[3], caretStrings, - "caret option", 0, &index) != TCL_OK) { + Tcl_SetIntObj(Tcl_GetObjResult(interp), value); + } else { + int i, value, x = 0, y = 0, height = -1; + + for (i = 3; i < objc; i += 2) { + if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings, + "caret option", 0, &index) != TCL_OK) || + Tcl_GetIntFromObj(interp,objv[i+1],&value) != TCL_OK) { return TCL_ERROR; } if (index == TK_CARET_X) { - value = caretPtr->x; + x = value; } else if (index == TK_CARET_Y) { - value = caretPtr->y; + y = value; } else /* if (index == TK_CARET_HEIGHT) -- last case */ { - value = caretPtr->height; - } - Tcl_SetIntObj(Tcl_GetObjResult(interp), value); - } else { - int i, value, x = 0, y = 0, height = -1; - - for (i = 3; i < objc; i += 2) { - if ((Tcl_GetIndexFromObj(interp, objv[i], caretStrings, - "caret option", 0, &index) != TCL_OK) || - (Tcl_GetIntFromObj(interp, objv[i+1], &value) - != TCL_OK)) { - return TCL_ERROR; - } - if (index == TK_CARET_X) { - x = value; - } else if (index == TK_CARET_Y) { - y = value; - } else /* if (index == TK_CARET_HEIGHT) -- last case */ { - height = value; - } - } - if (height < 0) { - height = Tk_Height(window); + height = value; } - Tk_SetCaretPos(window, x, y, height); } - break; + if (height < 0) { + height = Tk_Height(window); + } + Tk_SetCaretPos(window, x, y, height); + } + break; + } + case TK_SCALING: { + Screen *screenPtr; + int skip, width, height; + double d; + + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "scaling not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; } - case TK_SCALING: { - Screen *screenPtr; - int skip, width, height; - double d; - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "scaling not accessible in a safe interpreter", - TCL_STATIC); + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + if (skip < 0) { + return TCL_ERROR; + } + screenPtr = Tk_Screen(tkwin); + 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; } - - skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); - if (skip < 0) { - return TCL_ERROR; + d = (25.4 / 72) / d; + width = (int) (d * WidthOfScreen(screenPtr) + 0.5); + if (width <= 0) { + width = 1; } - screenPtr = Tk_Screen(tkwin); - 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; + height = (int) (d * HeightOfScreen(screenPtr) + 0.5); + if (height <= 0) { + height = 1; } - break; + 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; + int skip; + + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "useinputmethods not accessible in a safe interpreter", + TCL_STATIC); + return TCL_ERROR; } - case TK_USE_IM: { - TkDisplay *dispPtr; - int skip; - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "useinputmethods not accessible in a safe interpreter", - TCL_STATIC); - return TCL_ERROR; - } + skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin); + if (skip < 0) { + return TCL_ERROR; + } + 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. + */ - skip = TkGetDisplayOf(interp, objc-2, objv+2, &tkwin); - if (skip < 0) { + int boolVal; + + if (Tcl_GetBooleanFromObj(interp, objv[2+skip], + &boolVal) != TCL_OK) { return TCL_ERROR; } - 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 boolVal; - if (Tcl_GetBooleanFromObj(interp, objv[2+skip], &boolVal) - != TCL_OK) { - return TCL_ERROR; - } #ifdef TK_USE_INPUT_METHODS - if (boolVal) { - dispPtr->flags |= TK_DISPLAY_USE_IM; - } else { - dispPtr->flags &= ~TK_DISPLAY_USE_IM; - } -#endif /* TK_USE_INPUT_METHODS */ - } else if ((objc - skip) != 2) { - Tcl_WrongNumArgs(interp, 2, objv, - "?-displayof window? ?boolean?"); - return TCL_ERROR; + if (boolVal) { + dispPtr->flags |= TK_DISPLAY_USE_IM; + } else { + dispPtr->flags &= ~TK_DISPLAY_USE_IM; } - Tcl_SetBooleanObj(Tcl_GetObjResult(interp), - (int) (dispPtr->flags & TK_DISPLAY_USE_IM)); - break; +#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), + (int) (dispPtr->flags & TK_DISPLAY_USE_IM)); + break; + } + case TK_WINDOWINGSYSTEM: { + CONST char *windowingsystem; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; } - case TK_WINDOWINGSYSTEM: { - CONST char *windowingsystem; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } #if defined(WIN32) - windowingsystem = "win32"; + windowingsystem = "win32"; #elif defined(MAC_OSX_TK) - windowingsystem = "aqua"; + windowingsystem = "aqua"; #else - windowingsystem = "x11"; + windowingsystem = "x11"; #endif - Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1); - break; + Tcl_SetStringObj(Tcl_GetObjResult(interp), windowingsystem, -1); + break; + } + case TK_INACTIVE: { + int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + + if (skip < 0) { + return TCL_ERROR; } - case TK_INACTIVE: { - int skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); - if (skip < 0) { + if (objc - skip == 2) { + long inactive; + + inactive = (Tcl_IsSafe(interp) ? -1 : + Tk_GetUserInactiveTime(Tk_Display(tkwin))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); + + } else if (objc - skip == 3) { + char *string; + + string = Tcl_GetString(objv[objc-1]); + if (strcmp(string, "reset") != 0) { + Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1); + + Tcl_AppendStringsToObj(msg, string, "\": must be reset", NULL); + Tcl_SetObjResult(interp, msg); return TCL_ERROR; } - if (objc - skip == 2) { - long inactive; - - inactive = (Tcl_IsSafe(interp) ? -1 : - Tk_GetUserInactiveTime(Tk_Display(tkwin))); - Tcl_SetObjResult(interp, Tcl_NewLongObj(inactive)); - - } else if (objc - skip == 3) { - char *string; - - string = Tcl_GetStringFromObj(objv[objc-1], NULL); - if (strcmp(string, "reset") != 0) { - Tcl_Obj *msg = Tcl_NewStringObj("bad option \"", -1); - Tcl_AppendStringsToObj(msg, string, - "\": must be reset", NULL); - Tcl_SetObjResult(interp, msg); - return TCL_ERROR; - } - if (Tcl_IsSafe(interp)) { - Tcl_SetResult(interp, - "resetting the user inactivity timer " - "is not allowed in a safe interpreter", - TCL_STATIC); - return TCL_ERROR; - } - Tk_ResetUserInactiveTime(Tk_Display(tkwin)); - Tcl_ResetResult(interp); - } else { - Tcl_WrongNumArgs(interp, 2, objv, - "?-displayof window? ?reset?"); + if (Tcl_IsSafe(interp)) { + Tcl_SetResult(interp, + "resetting the user inactivity timer " + "is not allowed in a safe interpreter", TCL_STATIC); return TCL_ERROR; } - break; + Tk_ResetUserInactiveTime(Tk_Display(tkwin)); + Tcl_ResetResult(interp); + } else { + Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? ?reset?"); + return TCL_ERROR; } + break; + } } return TCL_OK; } @@ -894,8 +895,8 @@ Tk_TkObjCmd(clientData, interp, objc, objv) * * Tk_TkwaitObjCmd -- * - * This procedure is invoked to process the "tkwait" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "tkwait" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -908,19 +909,21 @@ Tk_TkObjCmd(clientData, interp, objc, objv) /* ARGSUSED */ int -Tk_TkwaitObjCmd(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_TkwaitObjCmd( + 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 = (Tk_Window) clientData; int done, index; - static CONST char *optionStrings[] = { "variable", "visibility", "window", - (char *) NULL }; - enum options { TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW }; - + static CONST char *optionStrings[] = { + "variable", "visibility", "window", NULL + }; + enum options { + TKWAIT_VARIABLE, TKWAIT_VISIBILITY, TKWAIT_WINDOW + }; + if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name"); return TCL_ERROR; @@ -932,78 +935,78 @@ Tk_TkwaitObjCmd(clientData, interp, objc, objv) } switch ((enum options) index) { - case TKWAIT_VARIABLE: { - if (Tcl_TraceVar(interp, Tcl_GetString(objv[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, Tcl_GetString(objv[2]), - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - WaitVariableProc, (ClientData) &done); - break; + case TKWAIT_VARIABLE: + if (Tcl_TraceVar(interp, Tcl_GetString(objv[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); } - - case TKWAIT_VISIBILITY: { - Tk_Window window; + Tcl_UntraceVar(interp, Tcl_GetString(objv[2]), + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + WaitVariableProc, (ClientData) &done); + break; - window = Tk_NameToWindow(interp, Tcl_GetString(objv[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 \"", Tcl_GetString(objv[2]), - "\" was deleted before its visibility changed", - (char *) NULL); - return TCL_ERROR; - } - Tk_DeleteEventHandler(window, - VisibilityChangeMask|StructureNotifyMask, - WaitVisibilityProc, (ClientData) &done); - break; + case TKWAIT_VISIBILITY: { + Tk_Window window; + + window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); + if (window == NULL) { + return TCL_ERROR; } - - case TKWAIT_WINDOW: { - Tk_Window window; - - window = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), tkwin); - if (window == NULL) { - return TCL_ERROR; - } - Tk_CreateEventHandler(window, StructureNotifyMask, - WaitWindowProc, (ClientData) &done); - done = 0; - while (!done) { - Tcl_DoOneEvent(0); - } + Tk_CreateEventHandler(window, + VisibilityChangeMask|StructureNotifyMask, + WaitVisibilityProc, (ClientData) &done); + done = 0; + while (!done) { + Tcl_DoOneEvent(0); + } + if (done != 1) { /* - * Note: there's no need to delete the event handler. It was + * Note that we do not delete the event handler because it was * deleted automatically when the window was destroyed. */ - break; + + Tcl_ResetResult(interp); + Tcl_AppendResult(interp, "window \"", Tcl_GetString(objv[2]), + "\" was deleted before its visibility changed", NULL); + return TCL_ERROR; + } + Tk_DeleteEventHandler(window, + VisibilityChangeMask|StructureNotifyMask, + WaitVisibilityProc, (ClientData) &done); + break; + } + + case TKWAIT_WINDOW: { + Tk_Window window; + + window = Tk_NameToWindow(interp, Tcl_GetString(objv[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. + */ + + break; + } } /* - * Clear out the interpreter's result, since it may have been set - * by event handlers. + * Clear out the interpreter's result, since it may have been set by event + * handlers. */ Tcl_ResetResult(interp); @@ -1012,24 +1015,24 @@ Tk_TkwaitObjCmd(clientData, interp, objc, objv) /* ARGSUSED */ static char * -WaitVariableProc(clientData, interp, name1, name2, flags) - ClientData clientData; /* Pointer to integer to set to 1. */ - Tcl_Interp *interp; /* Interpreter containing variable. */ - CONST char *name1; /* Name of variable. */ - CONST char *name2; /* Second part of variable name. */ - int flags; /* Information about what happened. */ +WaitVariableProc( + ClientData clientData, /* Pointer to integer to set to 1. */ + Tcl_Interp *interp, /* Interpreter containing variable. */ + CONST char *name1, /* Name of variable. */ + CONST char *name2, /* Second part of variable name. */ + int flags) /* Information about what happened. */ { int *donePtr = (int *) clientData; *donePtr = 1; - return (char *) NULL; + return NULL; } /*ARGSUSED*/ static void -WaitVisibilityProc(clientData, eventPtr) - ClientData clientData; /* Pointer to integer to set to 1. */ - XEvent *eventPtr; /* Information about event (not used). */ +WaitVisibilityProc( + ClientData clientData, /* Pointer to integer to set to 1. */ + XEvent *eventPtr) /* Information about event (not used). */ { int *donePtr = (int *) clientData; @@ -1042,9 +1045,9 @@ WaitVisibilityProc(clientData, eventPtr) } static void -WaitWindowProc(clientData, eventPtr) - ClientData clientData; /* Pointer to integer to set to 1. */ - XEvent *eventPtr; /* Information about event. */ +WaitWindowProc( + ClientData clientData, /* Pointer to integer to set to 1. */ + XEvent *eventPtr) /* Information about event. */ { int *donePtr = (int *) clientData; @@ -1058,8 +1061,8 @@ WaitWindowProc(clientData, eventPtr) * * Tk_UpdateObjCmd -- * - * This procedure is invoked to process the "update" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "update" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1072,14 +1075,13 @@ WaitWindowProc(clientData, eventPtr) /* 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. */ +Tk_UpdateObjCmd( + ClientData clientData, /* Main window associated with interpreter. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *CONST objv[]) /* Argument objects. */ { - static CONST char *updateOptions[] = {"idletasks", (char *) NULL}; + static CONST char *updateOptions[] = {"idletasks", NULL}; int flags, index; TkDisplay *dispPtr; @@ -1097,14 +1099,13 @@ Tk_UpdateObjCmd(clientData, interp, objc, objv) } /* - * 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. + * 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 */ @@ -1119,8 +1120,8 @@ Tk_UpdateObjCmd(clientData, interp, objc, objv) } /* - * Must clear the interpreter's result because event handlers could - * have executed commands. + * Must clear the interpreter's result because event handlers could have + * executed commands. */ Tcl_ResetResult(interp); @@ -1132,8 +1133,8 @@ Tk_UpdateObjCmd(clientData, interp, objc, objv) * * Tk_WinfoObjCmd -- * - * This procedure is invoked to process the "winfo" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "winfo" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1145,12 +1146,11 @@ Tk_UpdateObjCmd(clientData, interp, objc, objv) */ 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. */ +Tk_WinfoObjCmd( + 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; @@ -1178,7 +1178,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) "toplevel", "viewable", "visual", "visualid", "vrootheight", "vrootwidth", "vrootx", "vrooty", "width", "x", "y", - + "atom", "atomname", "containing", "interps", "pathname", @@ -1198,7 +1198,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) 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, @@ -1207,7 +1207,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) }; tkwin = (Tk_Window) clientData; - + if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?"); return TCL_ERROR; @@ -1222,7 +1222,7 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 2, objv, "window"); return TCL_ERROR; } - string = Tcl_GetStringFromObj(objv[2], NULL); + string = Tcl_GetString(objv[2]); tkwin = Tk_NameToWindow(interp, string, tkwin); if (tkwin == NULL) { return TCL_ERROR; @@ -1232,502 +1232,468 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) 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) { - if (!(winPtr->flags & TK_ANONYMOUS_WINDOW)) { - strPtr = Tcl_NewStringObj(winPtr->pathName, -1); - Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); - } + 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) { + if (!(winPtr->flags & TK_ANONYMOUS_WINDOW)) { + 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]; + 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]; - 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; + Tk_MakeWindowExist(tkwin); + TkpPrintWindowId(buf, Tk_WindowId(tkwin)); + + /* + * interp result may have changed, refetch it + */ + + resultPtr = Tcl_GetObjResult(interp); + 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 = GetTopHierarchy(tkwin); + if (winPtr == NULL) { + x = -1; + y = -1; + } else { + TkGetPointerCoords((Tk_Window) winPtr, &x, &y); } - case WIN_ID: { - char buf[TCL_INTEGER_SPACE]; - - Tk_MakeWindowExist(tkwin); - TkpPrintWindowId(buf, Tk_WindowId(tkwin)); - /* - * interp result may have changed, refetch it - */ - resultPtr = Tcl_GetObjResult(interp); + if (useX & useY) { + char buf[TCL_INTEGER_SPACE * 2]; + + sprintf(buf, "%d %d", x, y); 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; + } else if (useX) { + Tcl_SetIntObj(resultPtr, x); + } else { + Tcl_SetIntObj(resultPtr, y); } - 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 = GetTopHierarchy(tkwin); - if (winPtr == NULL) { - x = -1; - y = -1; - } else { - TkGetPointerCoords((Tk_Window) winPtr, &x, &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 = GetTopHierarchy(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 (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); + if (winPtr->flags & TK_TOP_HIERARCHY) { + viewable = 1; + break; } - 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; + + 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; } - case WIN_SCREEN: { - char buf[TCL_INTEGER_SPACE]; - - sprintf(buf, "%d", Tk_ScreenNumber(tkwin)); - Tcl_AppendStringsToObj(resultPtr, Tk_DisplayName(tkwin), ".", - buf, NULL); - break; + if (objc - skip != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? name"); + return TCL_ERROR; } - case WIN_SCREENCELLS: { - Tcl_SetIntObj(resultPtr, CellsOfScreen(Tk_Screen(tkwin))); - break; + objv += skip; + string = Tcl_GetString(objv[2]); + Tcl_SetLongObj(resultPtr, (long) Tk_InternAtom(tkwin, string)); + break; + case WIN_ATOMNAME: { + CONST char *name; + long id; + + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + if (skip < 0) { + return TCL_ERROR; } - case WIN_SCREENDEPTH: { - Tcl_SetIntObj(resultPtr, DefaultDepthOfScreen(Tk_Screen(tkwin))); - break; + if (objc - skip != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id"); + return TCL_ERROR; } - case WIN_SCREENHEIGHT: { - Tcl_SetIntObj(resultPtr, HeightOfScreen(Tk_Screen(tkwin))); - break; + objv += skip; + if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { + return TCL_ERROR; } - case WIN_SCREENWIDTH: { - Tcl_SetIntObj(resultPtr, WidthOfScreen(Tk_Screen(tkwin))); - break; + name = Tk_GetAtomName(tkwin, (Atom) id); + if (strcmp(name, "?bad atom?") == 0) { + string = Tcl_GetString(objv[2]); + Tcl_AppendStringsToObj(resultPtr, + "no atom exists with id \"", string, "\"", NULL); + return TCL_ERROR; } - case WIN_SCREENMMHEIGHT: { - Tcl_SetIntObj(resultPtr, HeightMMOfScreen(Tk_Screen(tkwin))); - break; + Tcl_SetStringObj(resultPtr, name, -1); + break; + } + case WIN_CONTAINING: + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + if (skip < 0) { + return TCL_ERROR; } - case WIN_SCREENMMWIDTH: { - Tcl_SetIntObj(resultPtr, WidthMMOfScreen(Tk_Screen(tkwin))); - break; + if (objc - skip != 4) { + Tcl_WrongNumArgs(interp, 2, objv, + "?-displayof window? rootX rootY"); + return TCL_ERROR; } - case WIN_SCREENVISUAL: { - class = DefaultVisualOfScreen(Tk_Screen(tkwin))->class; - goto visual; + objv += skip; + string = Tcl_GetString(objv[2]); + if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) { + return TCL_ERROR; } - case WIN_SERVER: { - TkGetServerInfo(interp, tkwin); - break; + string = Tcl_GetString(objv[3]); + if (Tk_GetPixels(interp, tkwin, string, &y) != TCL_OK) { + return TCL_ERROR; } - case WIN_TOPLEVEL: { - winPtr = GetTopHierarchy(tkwin); - if (winPtr != NULL) { - Tcl_SetStringObj(resultPtr, winPtr->pathName, -1); - } - break; + tkwin = Tk_CoordsToWindow(x, y, tkwin); + if (tkwin != NULL) { + Tcl_SetStringObj(resultPtr, Tk_PathName(tkwin), -1); } - case WIN_VIEWABLE: { - int viewable = 0; - for ( ; ; winPtr = winPtr->parentPtr) { - if ((winPtr == NULL) || !(winPtr->flags & TK_MAPPED)) { - break; - } - if (winPtr->flags & TK_TOP_HIERARCHY) { - viewable = 1; - break; - } - } + break; + case WIN_INTERPS: { + int result; - Tcl_SetBooleanObj(resultPtr, viewable); - break; + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + if (skip < 0) { + return TCL_ERROR; } - case WIN_VISUAL: { - class = Tk_Visual(tkwin)->class; - - visual: - string = TkFindStateString(visualMap, class); - if (string == NULL) { - string = "unknown"; - } - Tcl_SetStringObj(resultPtr, string, -1); - break; + if (objc - skip != 2) { + Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?"); + return TCL_ERROR; } - case WIN_VISUALID: { - char buf[TCL_INTEGER_SPACE]; + result = TkGetInterpNames(interp, tkwin); + return result; + } + case WIN_PATHNAME: { + Window id; - 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; + skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin); + if (skip < 0) { + return TCL_ERROR; } - case WIN_WIDTH: { - Tcl_SetIntObj(resultPtr, Tk_Width(tkwin)); - break; + if (objc - skip != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window? id"); + return TCL_ERROR; } - case WIN_X: { - Tcl_SetIntObj(resultPtr, Tk_X(tkwin)); - break; + string = Tcl_GetString(objv[2 + skip]); + if (TkpScanWindowId(interp, string, &id) != TCL_OK) { + return TCL_ERROR; } - case WIN_Y: { - Tcl_SetIntObj(resultPtr, Tk_Y(tkwin)); - break; + winPtr = (TkWindow *)Tk_IdToWindow(Tk_Display(tkwin), id); + if ((winPtr == NULL) || + (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr)) { + Tcl_AppendStringsToObj(resultPtr, "window id \"", string, + "\" doesn't exist in this application", NULL); + return TCL_ERROR; } /* - * Uses -displayof. + * 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. */ - - 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: { - CONST 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: { - Window 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), 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; + 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; + 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); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "window"); + return TCL_ERROR; + } + string = Tcl_GetString(objv[2]); + 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; + alive = 1; + if ((winPtr == NULL) || (winPtr->flags & TK_ALREADY_DEAD)) { + alive = 0; } - case WIN_FPIXELS: { - double mm, pixels; + 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; + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window number"); + return TCL_ERROR; } - 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; + string = Tcl_GetString(objv[2]); + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { + return TCL_ERROR; + } + string = Tcl_GetString(objv[3]); + if (Tk_GetScreenMM(interp, tkwin, string, &mm) != TCL_OK) { + return TCL_ERROR; } - case WIN_RGB: { - XColor *colorPtr; - char buf[TCL_INTEGER_SPACE * 3]; + 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 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; + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window number"); + return TCL_ERROR; } - 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_GetString(objv[2]); + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { + return TCL_ERROR; + } + string = Tcl_GetString(objv[3]); + 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]; - string = Tcl_GetStringFromObj(objv[2], NULL); - tkwin = Tk_NameToWindow(interp, string, tkwin); - if (tkwin == NULL) { - return TCL_ERROR; - } + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "window colorName"); + return TCL_ERROR; + } + string = Tcl_GetString(objv[2]); + tkwin = Tk_NameToWindow(interp, string, tkwin); + if (tkwin == NULL) { + return TCL_ERROR; + } + string = Tcl_GetString(objv[3]); + 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_GetString(objv[3]), "includeids") == 0)) { + includeVisualId = 1; + } else { + Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?"); + 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; + string = Tcl_GetString(objv[2]); + 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); } - 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); + if (includeVisualId) { + sprintf(visualIdString, " 0x%x", + (unsigned int) visInfoPtr[i].visualid); + strcat(buf, visualIdString); } - XFree((char *) visInfoPtr); - break; + strPtr = Tcl_NewStringObj(buf, -1); + Tcl_ListObjAppendElement(NULL, resultPtr, strPtr); } + XFree((char *) visInfoPtr); + break; + } } return TCL_OK; } @@ -1738,8 +1704,8 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) * * Tk_WmObjCmd -- * - * This procedure is invoked to process the "wm" Tcl command. - * See the user documentation for details on what it does. + * This function is invoked to process the "wm" Tcl command. See the user + * documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1752,12 +1718,11 @@ Tk_WinfoObjCmd(clientData, interp, objc, objv) /* 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_WmObjCmd( + 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; @@ -1769,7 +1734,7 @@ Tk_WmObjCmd(clientData, interp, objc, objv) "iconname", "iconposition", "iconwindow", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "state", "title", - "tracing", "transient", "withdraw", (char *) NULL + "tracing", "transient", "withdraw", NULL }; enum options { TKWM_ASPECT, TKWM_CLIENT, TKWM_COMMAND, TKWM_DEICONIFY, @@ -1828,127 +1793,119 @@ Tk_WmObjCmd(clientData, interp, objc, objv) } if (!(winPtr->flags & TK_TOP_LEVEL)) { Tcl_AppendResult(interp, "window \"", winPtr->pathName, - "\" isn't a top-level window", (char *) NULL); + "\" isn't a top-level window", 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; - } + 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: + updateGeom: if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) { Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr); wmPtr->flags |= WM_UPDATE_PENDING; @@ -1962,21 +1919,20 @@ Tk_WmObjCmd(clientData, interp, objc, objv) * * 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]. + * 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. + * 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. + * 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. @@ -1985,14 +1941,14 @@ Tk_WmObjCmd(clientData, interp, objc, objv) */ 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, +TkGetDisplayOf( + 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 + 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 @@ -2000,7 +1956,7 @@ TkGetDisplayOf(interp, objc, objv, tkwinPtr) { char *string; int length; - + if (objc < 1) { return 0; } @@ -2012,8 +1968,7 @@ TkGetDisplayOf(interp, objc, objv, tkwinPtr) "value for \"-displayof\" missing", -1); return -1; } - string = Tcl_GetStringFromObj(objv[1], NULL); - *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr); + *tkwinPtr = Tk_NameToWindow(interp, Tcl_GetString(objv[1]), *tkwinPtr); if (*tkwinPtr == NULL) { return -1; } @@ -2028,11 +1983,11 @@ TkGetDisplayOf(interp, objc, objv, tkwinPtr) * TkDeadAppCmd -- * * If an application has been deleted then all Tk commands will be - * re-bound to this procedure. + * re-bound to this function. * * Results: - * A standard Tcl error is reported to let the user know that - * the application is dead. + * A standard Tcl error is reported to let the user know that the + * application is dead. * * Side effects: * See the user documentation. @@ -2042,14 +1997,14 @@ TkGetDisplayOf(interp, objc, objv, tkwinPtr) /* ARGSUSED */ int -TkDeadAppCmd(clientData, interp, argc, argv) - ClientData clientData; /* Dummy. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +TkDeadAppCmd( + ClientData clientData, /* Dummy. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { Tcl_AppendResult(interp, "can't invoke \"", argv[0], - "\" command: application has been destroyed", (char *) NULL); + "\" command: application has been destroyed", NULL); return TCL_ERROR; } @@ -2058,13 +2013,12 @@ TkDeadAppCmd(clientData, interp, argc, argv) * * GetTopHierarchy -- * - * Retrieves the top-of-hierarchy window which is the nearest - * ancestor of the specified window. + * Retrieves the top-of-hierarchy window which is the nearest ancestor of + * the specified window. * * Results: - * Returns the top-of-hierarchy window, or NULL if the window - * has no ancestor which is at the top of a physical window - * hierarchy. + * Returns the top-of-hierarchy window, or NULL if the window has no + * ancestor which is at the top of a physical window hierarchy. * * Side effects: * None. @@ -2073,17 +2027,22 @@ TkDeadAppCmd(clientData, interp, argc, argv) */ static TkWindow * -GetTopHierarchy(tkwin) - Tk_Window tkwin; /* Window for which the top-of-hierarchy +GetTopHierarchy( + Tk_Window tkwin) /* Window for which the top-of-hierarchy * ancestor should be deterined. */ { TkWindow *winPtr = (TkWindow *) tkwin; - while (!(winPtr->flags & TK_TOP_HIERARCHY)) { + while ((winPtr != NULL) && !(winPtr->flags & TK_TOP_HIERARCHY)) { winPtr = winPtr->parentPtr; - if (winPtr == NULL) { - return NULL; /* This should never happen! */ - } } return winPtr; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |