diff options
| -rw-r--r-- | generic/tkCmds.c | 2059 | ||||
| -rw-r--r-- | generic/tkColor.h | 70 | ||||
| -rw-r--r-- | generic/tkConsole.c | 392 | ||||
| -rw-r--r-- | generic/tkCursor.c | 459 | ||||
| -rw-r--r-- | generic/tkEntry.h | 189 |
5 files changed, 1563 insertions, 1606 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: + */ diff --git a/generic/tkColor.h b/generic/tkColor.h index 53975c1..f662ebe 100644 --- a/generic/tkColor.h +++ b/generic/tkColor.h @@ -1,15 +1,14 @@ /* * tkColor.h -- * - * Declarations of data types and functions used by the - * Tk color module. + * Declarations of data types and functions used by the Tk color module. * * Copyright (c) 1996-1997 by Sun Microsystems, Inc. * - * 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: tkColor.h,v 1.6 1999/11/19 22:00:03 hobbs Exp $ + * RCS: @(#) $Id: tkColor.h,v 1.7 2005/11/11 23:51:27 dkf Exp $ */ #ifndef _TKCOLOR @@ -18,14 +17,14 @@ #include <tkInt.h> #ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT #endif /* - * One of the following data structures is used to keep track of - * each color that is being used by the application; typically there - * is a colormap entry allocated for each of these colors. + * One of the following data structures is used to keep track of each color + * that is being used by the application; typically there is a colormap entry + * allocated for each of these colors. */ #define TK_COLOR_BY_NAME 1 @@ -36,39 +35,38 @@ typedef struct TkColor { XColor color; /* Information about this color. */ unsigned int magic; /* Used for quick integrity check on this - * structure. Must always have the - * value COLOR_MAGIC. */ + * structure. Must always have the value + * COLOR_MAGIC. */ GC gc; /* Simple gc with this color as foreground - * color and all other fields defaulted. - * May be None. */ - Screen *screen; /* Screen where this color is valid. Used - * to delete it, and to find its display. */ + * color and all other fields defaulted. May + * be None. */ + Screen *screen; /* Screen where this color is valid. Used to + * delete it, and to find its display. */ Colormap colormap; /* Colormap from which this entry was * allocated. */ Visual *visual; /* Visual associated with colormap. */ int resourceRefCount; /* Number of active uses of this color (each * active use corresponds to a call to - * Tk_AllocColorFromObj or Tk_GetColor). - * If this count is 0, then this TkColor + * Tk_AllocColorFromObj or Tk_GetColor). If + * this count is 0, then this TkColor * structure is no longer valid and it isn't - * present in a hash table: it is being - * kept around only because there are objects - * referring to it. The structure is freed - * when resourceRefCount and objRefCount - * are both 0. */ + * present in a hash table: it is being kept + * around only because there are objects + * referring to it. The structure is freed + * when resourceRefCount and objRefCount are + * both 0. */ int objRefCount; /* The number of Tcl objects that reference * this structure. */ int type; /* TK_COLOR_BY_NAME or TK_COLOR_BY_VALUE */ Tcl_HashEntry *hashPtr; /* Pointer to hash table entry for this * structure. (for use in deleting entry). */ struct TkColor *nextPtr; /* Points to the next TkColor structure with - * the same color name. Colors with the - * same name but different screens or - * colormaps are chained together off a - * single entry in nameTable. For colors in - * valueTable (those allocated by - * Tk_GetColorByValue) this field is always - * NULL. */ + * the same color name. Colors with the same + * name but different screens or colormaps are + * chained together off a single entry in + * nameTable. For colors in valueTable (those + * allocated by Tk_GetColorByValue) this field + * is always NULL. */ } TkColor; /* @@ -76,14 +74,12 @@ typedef struct TkColor { */ #ifndef TkpFreeColor -EXTERN void TkpFreeColor _ANSI_ARGS_((TkColor *tkColPtr)); +EXTERN void TkpFreeColor(TkColor *tkColPtr); #endif -EXTERN TkColor * TkpGetColor _ANSI_ARGS_((Tk_Window tkwin, - Tk_Uid name)); -EXTERN TkColor * TkpGetColorByValue _ANSI_ARGS_((Tk_Window tkwin, - XColor *colorPtr)); +EXTERN TkColor * TkpGetColor(Tk_Window tkwin, Tk_Uid name); +EXTERN TkColor * TkpGetColorByValue(Tk_Window tkwin, XColor *colorPtr); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TKCOLOR */ diff --git a/generic/tkConsole.c b/generic/tkConsole.c index 30d927a..7f64485 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -1,16 +1,16 @@ -/* +/* * tkConsole.c -- * - * This file implements a Tcl console for systems that may not - * otherwise have access to a console. It uses the Text widget - * and provides special access via a console command. + * This file implements a Tcl console for systems that may not otherwise + * have access to a console. It uses the Text widget and provides special + * access via a console command. * * Copyright (c) 1995-1996 Sun Microsystems, Inc. * - * 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: tkConsole.c,v 1.23 2005/06/23 22:07:46 das Exp $ + * RCS: @(#) $Id: tkConsole.c,v 1.24 2005/11/11 23:51:27 dkf Exp $ */ #include "tk.h" @@ -32,8 +32,8 @@ typedef struct ConsoleInfo { /* * Each interpreter with a console attached stores a reference to the * interpreter's ConsoleInfo in the interpreter's AssocData store. The - * alternative is to look the values up by examining the "console" - * command and that is fragile. [Bug 1016385] + * alternative is to look the values up by examining the "console" command and + * that is fragile. [Bug 1016385] */ #define TK_CONSOLE_INFO_KEY "tk::ConsoleInfo" @@ -44,36 +44,33 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; static int consoleInitialized = 0; -/* +/* * The Mutex below is used to lock access to the consoleIntialized flag */ TCL_DECLARE_MUTEX(consoleMutex) /* - * Forward declarations for procedures defined later in this file: + * Forward declarations for functions defined later in this file: * * The first three will be used in the tk app shells... */ - -static int ConsoleCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); -static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData)); -static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); -static int InterpreterCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, CONST char **argv)); - -static int ConsoleInput _ANSI_ARGS_((ClientData instanceData, - char *buf, int toRead, int *errorCode)); -static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData, - CONST char *buf, int toWrite, int *errorCode)); -static int ConsoleClose _ANSI_ARGS_((ClientData instanceData, - Tcl_Interp *interp)); -static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData, - int mask)); -static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData, - int direction, ClientData *handlePtr)); + +static int ConsoleCmd(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); +static void ConsoleDeleteProc(ClientData clientData); +static void ConsoleEventProc(ClientData clientData, XEvent *eventPtr); +static int InterpreterCmd(ClientData clientData, + Tcl_Interp *interp, int argc, CONST char **argv); + +static int ConsoleInput(ClientData instanceData, + char *buf, int toRead, int *errorCode); +static int ConsoleOutput(ClientData instanceData, + CONST char *buf, int toWrite, int *errorCode); +static int ConsoleClose(ClientData instanceData, Tcl_Interp *interp); +static void ConsoleWatch(ClientData instanceData, int mask); +static int ConsoleHandle(ClientData instanceData, + int direction, ClientData *handlePtr); /* * This structure describes the channel type structure for file based IO: @@ -91,10 +88,8 @@ static Tcl_ChannelType consoleChannelType = { ConsoleWatch, /* Watch for events on console. */ ConsoleHandle, /* Get a handle from the device. */ }; - #ifdef __WIN32__ - #include <windows.h> /* @@ -102,20 +97,21 @@ static Tcl_ChannelType consoleChannelType = { * * ShouldUseConsoleChannel * - * Check to see if console window should be used for a given - * standard channel + * Check to see if console window should be used for a given standard + * channel. * * Results: * None. * * Side effects: - * Creates the console channel and installs it as the standard - * channels. + * Creates the console channel and installs it as the standard channels. * *---------------------------------------------------------------------- */ -static int ShouldUseConsoleChannel(type) - int type; + +static int +ShouldUseConsoleChannel( + int type) { DWORD handleId; /* Standard handle to retrieve. */ DCB dcb; @@ -126,24 +122,24 @@ static int ShouldUseConsoleChannel(type) HANDLE handle; switch (type) { - case TCL_STDIN: - handleId = STD_INPUT_HANDLE; - mode = TCL_READABLE; - bufMode = "line"; - break; - case TCL_STDOUT: - handleId = STD_OUTPUT_HANDLE; - mode = TCL_WRITABLE; - bufMode = "line"; - break; - case TCL_STDERR: - handleId = STD_ERROR_HANDLE; - mode = TCL_WRITABLE; - bufMode = "none"; - break; - default: - return 0; - break; + case TCL_STDIN: + handleId = STD_INPUT_HANDLE; + mode = TCL_READABLE; + bufMode = "line"; + break; + case TCL_STDOUT: + handleId = STD_OUTPUT_HANDLE; + mode = TCL_WRITABLE; + bufMode = "line"; + break; + case TCL_STDERR: + handleId = STD_ERROR_HANDLE; + mode = TCL_WRITABLE; + bufMode = "none"; + break; + default: + return 0; + break; } handle = GetStdHandle(handleId); @@ -151,7 +147,7 @@ static int ShouldUseConsoleChannel(type) /* * Note that we need to check for 0 because Windows will return 0 if this * is not a console mode application, even though this is not a valid - * handle. + * handle. */ if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) { @@ -159,27 +155,27 @@ static int ShouldUseConsoleChannel(type) } /* - * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears - * to be a valid handle. See TclpGetDefaultStdChannel() for this change - * implemented. We didn't change it here because GetFileType() [below] - * will catch this with FILE_TYPE_UNKNOWN and appropriately return a - * value of 1, anyways. + * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears to + * be a valid handle. See TclpGetDefaultStdChannel() for this change + * implemented. We didn't change it here because GetFileType() [below] + * will catch this with FILE_TYPE_UNKNOWN and appropriately return a value + * of 1, anyways. * * char dummyBuff[1]; * DWORD dummyWritten; * * if ((type == TCL_STDOUT) - * && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) { - * return 1; + * && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) { + * return 1; * } */ fileType = GetFileType(handle); /* - * If the file is a character device, we need to try to figure out - * whether it is a serial port, a console, or something else. We - * test for the console case first because this is more common. + * If the file is a character device, we need to try to figure out whether + * it is a serial port, a console, or something else. We test for the + * console case first because this is more common. */ if (fileType == FILE_TYPE_CHAR) { @@ -187,10 +183,10 @@ static int ShouldUseConsoleChannel(type) if (!GetConsoleMode(handle, &consoleParams) && !GetCommState(handle, &dcb)) { /* - * Don't use a CHAR type channel for stdio, otherwise Tk - * runs into trouble with the MS DevStudio debugger. + * Don't use a CHAR type channel for stdio, otherwise Tk runs into + * trouble with the MS DevStudio debugger. */ - + return 1; } } else if (fileType == FILE_TYPE_UNKNOWN) { @@ -214,29 +210,28 @@ static int ShouldUseConsoleChannel(type) * * Tk_InitConsoleChannels -- * - * Create the console channels and install them as the standard - * channels. All I/O will be discarded until TkConsoleInit is - * called to attach the console to a text widget. + * Create the console channels and install them as the standard channels. + * All I/O will be discarded until TkConsoleInit is called to attach the + * console to a text widget. * * Results: * None. * * Side effects: - * Creates the console channel and installs it as the standard - * channels. + * Creates the console channel and installs it as the standard channels. * *---------------------------------------------------------------------- */ void -Tk_InitConsoleChannels(interp) - Tcl_Interp *interp; +Tk_InitConsoleChannels( + Tcl_Interp *interp) { Tcl_Channel consoleChannel; /* - * Ensure that we are getting the matching version of Tcl. This is - * really only an issue when Tk is loaded dynamically. + * Ensure that we are getting the matching version of Tcl. This is really + * only an issue when Tk is loaded dynamically. */ if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) { @@ -247,13 +242,13 @@ Tk_InitConsoleChannels(interp) if (!consoleInitialized) { consoleInitialized = 1; - + /* * check for STDIN, otherwise create it * * Don't do this check on the Mac, because it is hard to prevent - * callbacks from the SIOUX layer from opening stdout & stdin, but - * we don't want to use the SIOUX console. Since the console is not + * callbacks from the SIOUX layer from opening stdout & stdin, but we + * don't want to use the SIOUX console. Since the console is not * actually created till something is written to the channel, it is * okay to just ignore it here. * @@ -278,7 +273,7 @@ Tk_InitConsoleChannels(interp) /* * check for STDOUT, otherwise create it */ - + if (ShouldUseConsoleChannel(TCL_STDOUT)) { consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1", (ClientData) TCL_STDOUT, TCL_WRITABLE); @@ -292,11 +287,11 @@ Tk_InitConsoleChannels(interp) } Tcl_SetStdChannel(consoleChannel, TCL_STDOUT); } - + /* * check for STDERR, otherwise create it */ - + if (ShouldUseConsoleChannel(TCL_STDERR)) { consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2", (ClientData) TCL_STDERR, TCL_WRITABLE); @@ -319,9 +314,9 @@ Tk_InitConsoleChannels(interp) * * Tk_CreateConsoleWindow -- * - * Initialize the console. This code actually creates a new - * application and associated interpreter. This effectivly hides - * the implementation from the main application. + * Initialize the console. This code actually creates a new application + * and associated interpreter. This effectivly hides the implementation + * from the main application. * * Results: * None. @@ -332,14 +327,14 @@ Tk_InitConsoleChannels(interp) *---------------------------------------------------------------------- */ -int -Tk_CreateConsoleWindow(interp) - Tcl_Interp *interp; /* Interpreter to use for prompting. */ +int +Tk_CreateConsoleWindow( + Tcl_Interp *interp) /* Interpreter to use for prompting. */ { Tcl_Interp *consoleInterp; ConsoleInfo *info; Tk_Window mainWindow = Tk_MainWindow(interp); - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); static const char *initCmd = "source $tk_library/console.tcl"; @@ -347,7 +342,7 @@ Tk_CreateConsoleWindow(interp) if (consoleInterp == NULL) { goto error; } - + /* * Initialized Tcl and Tk. */ @@ -359,17 +354,18 @@ Tk_CreateConsoleWindow(interp) goto error; } tsdPtr->gStdoutInterp = interp; - - /* - * Add console commands to the interp + + /* + * Add console commands to the interp */ + info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo)); info->interp = interp; info->consoleInterp = consoleInterp; Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info, (Tcl_CmdDeleteProc *) ConsoleDeleteProc); Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd, - (ClientData) info, (Tcl_CmdDeleteProc *) NULL); + (ClientData) info, NULL); Tcl_SetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL, (ClientData) info); Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc, @@ -377,13 +373,15 @@ Tk_CreateConsoleWindow(interp) Tcl_Preserve((ClientData) consoleInterp); if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) { - /* goto error; -- no problem for now... */ + /* + * goto error; -- no problem for now... + */ printf("Eval error: %s", consoleInterp->result); } Tcl_Release((ClientData) consoleInterp); return TCL_OK; - - error: + + error: if (consoleInterp != NULL) { Tcl_DeleteInterp(consoleInterp); } @@ -395,12 +393,12 @@ Tk_CreateConsoleWindow(interp) * * ConsoleOutput-- * - * Writes the given output on the IO channel. Returns count of how - * many characters were actually written, and an error indication. + * Writes the given output on the IO channel. Returns count of how many + * characters were actually written, and an error indication. * * Results: - * A count of how many characters were written is returned and an - * error indication is returned in an output argument. + * A count of how many characters were written is returned and an error + * indication is returned in an output argument. * * Side effects: * Writes output on the actual channel. @@ -409,23 +407,23 @@ Tk_CreateConsoleWindow(interp) */ static int -ConsoleOutput(instanceData, buf, toWrite, errorCode) - ClientData instanceData; /* Indicates which device to use. */ - CONST char *buf; /* The data buffer. */ - int toWrite; /* How many bytes to write? */ - int *errorCode; /* Where to store error code. */ +ConsoleOutput( + ClientData instanceData, /* Indicates which device to use. */ + CONST char *buf, /* The data buffer. */ + int toWrite, /* How many bytes to write? */ + int *errorCode) /* Where to store error code. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); *errorCode = 0; Tcl_SetErrno(0); if (tsdPtr->gStdoutInterp != NULL) { - TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf, + TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf, toWrite); } - + return toWrite; } @@ -434,7 +432,7 @@ ConsoleOutput(instanceData, buf, toWrite, errorCode) * * ConsoleInput -- * - * Read input from the console. Not currently implemented. + * Read input from the console. Not currently implemented. * * Results: * Always returns EOF. @@ -447,12 +445,12 @@ ConsoleOutput(instanceData, buf, toWrite, errorCode) /* ARGSUSED */ static int -ConsoleInput(instanceData, buf, bufSize, errorCode) - ClientData instanceData; /* Unused. */ - char *buf; /* Where to store data read. */ - int bufSize; /* How much space is available - * in the buffer? */ - int *errorCode; /* Where to store error code. */ +ConsoleInput( + ClientData instanceData, /* Unused. */ + char *buf, /* Where to store data read. */ + int bufSize, /* How much space is available in the + * buffer? */ + int *errorCode) /* Where to store error code. */ { return 0; /* Always return EOF. */ } @@ -475,11 +473,11 @@ ConsoleInput(instanceData, buf, bufSize, errorCode) /* ARGSUSED */ static int -ConsoleClose(instanceData, interp) - ClientData instanceData; /* Unused. */ - Tcl_Interp *interp; /* Unused. */ +ConsoleClose( + ClientData instanceData, /* Unused. */ + Tcl_Interp *interp) /* Unused. */ { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); tsdPtr->gStdoutInterp = NULL; return 0; @@ -490,9 +488,9 @@ ConsoleClose(instanceData, interp) * * ConsoleWatch -- * - * Called by the notifier to set up the console device so that - * events will be noticed. Since there are no events on the - * console, this routine just returns without doing anything. + * Called by the notifier to set up the console device so that events + * will be noticed. Since there are no events on the console, this + * routine just returns without doing anything. * * Results: * None. @@ -505,12 +503,11 @@ ConsoleClose(instanceData, interp) /* ARGSUSED */ static void -ConsoleWatch(instanceData, mask) - ClientData instanceData; /* Device ID for the channel. */ - int mask; /* OR-ed combination of - * TCL_READABLE, TCL_WRITABLE and - * TCL_EXCEPTION, for the events - * we are interested in. */ +ConsoleWatch( + ClientData instanceData, /* Device ID for the channel. */ + int mask) /* OR-ed combination of TCL_READABLE, + * TCL_WRITABLE and TCL_EXCEPTION, for the + * events we are interested in. */ { } @@ -520,8 +517,7 @@ ConsoleWatch(instanceData, mask) * ConsoleHandle -- * * Invoked by the generic IO layer to get a handle from a channel. - * Because console channels are not devices, this function always - * fails. + * Because console channels are not devices, this function always fails. * * Results: * Always returns TCL_ERROR. @@ -534,12 +530,12 @@ ConsoleWatch(instanceData, mask) /* ARGSUSED */ static int -ConsoleHandle(instanceData, direction, handlePtr) - ClientData instanceData; /* Device ID for the channel. */ - int direction; /* TCL_READABLE or TCL_WRITABLE to indicate +ConsoleHandle( + ClientData instanceData, /* Device ID for the channel. */ + int direction, /* TCL_READABLE or TCL_WRITABLE to indicate * which direction of the channel is being * requested. */ - ClientData *handlePtr; /* Where to store handle */ + ClientData *handlePtr) /* Where to store handle */ { return TCL_ERROR; } @@ -562,11 +558,11 @@ ConsoleHandle(instanceData, direction, handlePtr) */ static int -ConsoleCmd(clientData, interp, argc, argv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +ConsoleCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { ConsoleInfo *info = (ConsoleInfo *) clientData; char c; @@ -576,10 +572,10 @@ ConsoleCmd(clientData, interp, argc, argv) if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg ...?\"", (char *) NULL); + " option ?arg arg ...?\"", NULL); return TCL_ERROR; } - + c = argv[1][0]; length = strlen(argv[1]); result = TCL_OK; @@ -604,16 +600,15 @@ ConsoleCmd(clientData, interp, argc, argv) if (argc == 3) { result = Tcl_Eval(consoleInterp, argv[2]); Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp), - (char *) NULL); + NULL); } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " eval command\"", (char *) NULL); + " eval command\"", NULL); result = TCL_ERROR; } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": should be hide, show, or title", - (char *) NULL); + "\": should be hide, show, or title", NULL); result = TCL_ERROR; } Tcl_Release((ClientData) consoleInterp); @@ -625,8 +620,8 @@ ConsoleCmd(clientData, interp, argc, argv) * * InterpreterCmd -- * - * This command allows the console interp to communicate with the - * main interpreter. + * This command allows the console interp to communicate with the main + * interpreter. * * Results: * None. @@ -638,11 +633,11 @@ ConsoleCmd(clientData, interp, argc, argv) */ static int -InterpreterCmd(clientData, interp, argc, argv) - ClientData clientData; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int argc; /* Number of arguments. */ - CONST char **argv; /* Argument strings. */ +InterpreterCmd( + ClientData clientData, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int argc, /* Number of arguments. */ + CONST char **argv) /* Argument strings. */ { ConsoleInfo *info = (ConsoleInfo *) clientData; char c; @@ -653,10 +648,10 @@ InterpreterCmd(clientData, interp, argc, argv) if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option ?arg arg ...?\"", (char *) NULL); + " option ?arg arg ...?\"", NULL); return TCL_ERROR; } - + c = argv[1][0]; length = strlen(argv[1]); consoleInterp = info->consoleInterp; @@ -665,16 +660,15 @@ InterpreterCmd(clientData, interp, argc, argv) Tcl_Preserve((ClientData) otherInterp); if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) { result = Tcl_GlobalEval(otherInterp, argv[2]); - Tcl_AppendResult(interp, otherInterp->result, (char *) NULL); + Tcl_AppendResult(interp, otherInterp->result, NULL); } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) { Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL); result = TCL_OK; Tcl_ResetResult(interp); - Tcl_AppendResult(interp, otherInterp->result, (char *) NULL); + Tcl_AppendResult(interp, otherInterp->result, NULL); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": should be eval or record", - (char *) NULL); + "\": should be eval or record", NULL); result = TCL_ERROR; } Tcl_Release((ClientData) otherInterp); @@ -687,8 +681,8 @@ InterpreterCmd(clientData, interp, argc, argv) * * ConsoleDeleteProc -- * - * If the console command is deleted we destroy the console window - * and all associated data structures. + * If the console command is deleted we destroy the console window and + * all associated data structures. * * Results: * None. @@ -700,8 +694,8 @@ InterpreterCmd(clientData, interp, argc, argv) */ static void -ConsoleDeleteProc(clientData) - ClientData clientData; +ConsoleDeleteProc( + ClientData clientData) { ConsoleInfo *info = (ConsoleInfo *) clientData; ThreadSpecificData *tsdPtr = (ThreadSpecificData *) @@ -712,6 +706,7 @@ ConsoleDeleteProc(clientData) * * Fix [Bug #756840] */ + if (tsdPtr != NULL) { tsdPtr->gStdoutInterp = NULL; } @@ -725,46 +720,45 @@ ConsoleDeleteProc(clientData) * * ConsoleEventProc -- * - * This event procedure is registered on the main window of the - * slave interpreter. If the user or a running script causes the - * main window to be destroyed, then we need to inform the console - * interpreter by invoking "::tk::ConsoleExit". + * This event function is registered on the main window of the slave + * interpreter. If the user or a running script causes the main window to + * be destroyed, then we need to inform the console interpreter by + * invoking "::tk::ConsoleExit". * * Results: * None. * * Side effects: - * Invokes the "::tk::ConsoleExit" procedure in the console interp. + * Invokes the "::tk::ConsoleExit" command in the console interp. * *---------------------------------------------------------------------- */ static void -ConsoleEventProc(clientData, eventPtr) - ClientData clientData; - XEvent *eventPtr; +ConsoleEventProc( + ClientData clientData, + XEvent *eventPtr) { ConsoleInfo *info = (ConsoleInfo *) clientData; Tcl_Interp *consoleInterp; - - if (eventPtr->type == DestroyNotify) { + if (eventPtr->type == DestroyNotify) { consoleInterp = info->consoleInterp; /* - * It is possible that the console interpreter itself has - * already been deleted. In that case the consoleInterp - * field will be set to NULL. If the interpreter is already - * gone, we do not have to do any work here. + * It is possible that the console interpreter itself has already been + * deleted. In that case the consoleInterp field will be set to + * NULL. If the interpreter is already gone, we do not have to do any + * work here. */ - - if (consoleInterp == (Tcl_Interp *) NULL) { + + if (consoleInterp == NULL) { return; - } else { - Tcl_Preserve((ClientData) consoleInterp); - Tcl_Eval(consoleInterp, "::tk::ConsoleExit"); - Tcl_Release((ClientData) consoleInterp); - } + } + + Tcl_Preserve((ClientData) consoleInterp); + Tcl_Eval(consoleInterp, "::tk::ConsoleExit"); + Tcl_Release((ClientData) consoleInterp); } } @@ -773,9 +767,9 @@ ConsoleEventProc(clientData, eventPtr) * * TkConsolePrint -- * - * Prints to the give text to the console. Given the main interp - * this functions find the appropiate console interp and forwards - * the text to be added to that console. + * Prints to the give text to the console. Given the main interp this + * functions find the appropiate console interp and forwards the text to + * be added to that console. * * Results: * None. @@ -787,12 +781,12 @@ ConsoleEventProc(clientData, eventPtr) */ void -TkConsolePrint(interp, devId, buffer, size) - Tcl_Interp *interp; /* Main interpreter. */ - int devId; /* TCL_STDOUT for stdout, TCL_STDERR for +TkConsolePrint( + Tcl_Interp *interp, /* Main interpreter. */ + int devId, /* TCL_STDOUT for stdout, TCL_STDERR for * stderr. */ - CONST char *buffer; /* Text buffer. */ - long size; /* Size of text buffer. */ + CONST char *buffer, /* Text buffer. */ + long size) /* Size of text buffer. */ { Tcl_DString command, output; ConsoleInfo *info; @@ -826,3 +820,11 @@ TkConsolePrint(interp, devId, buffer, size) Tcl_DStringFree(&command); } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 45dd96d..11c0ace 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -1,54 +1,53 @@ -/* +/* * tkCursor.c -- * * This file maintains a database of read-only cursors for the Tk - * toolkit. This allows cursors to be shared between widgets and - * also avoids round-trips to the X server. + * toolkit. This allows cursors to be shared between widgets and also + * avoids round-trips to the X server. * * Copyright (c) 1990-1994 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCursor.c,v 1.12 2004/09/24 17:36:22 dgp Exp $ + * RCS: @(#) $Id: tkCursor.c,v 1.13 2005/11/11 23:51:27 dkf Exp $ */ #include "tkPort.h" #include "tkInt.h" /* - * A TkCursor structure exists for each cursor that is currently - * active. Each structure is indexed with two hash tables defined - * below. One of the tables is cursorIdTable, and the other is either - * cursorNameTable or cursorDataTable, each of which are stored in the - * TkDisplay structure for the current thread. + * A TkCursor structure exists for each cursor that is currently active. Each + * structure is indexed with two hash tables defined below. One of the tables + * is cursorIdTable, and the other is either cursorNameTable or + * cursorDataTable, each of which are stored in the TkDisplay structure for + * the current thread. */ typedef struct { CONST char *source; /* Cursor bits. */ CONST char *mask; /* Mask bits. */ - int width, height; /* Dimensions of cursor (and data - * and mask). */ + int width, height; /* Dimensions of cursor (and data and + * mask). */ int xHot, yHot; /* Location of cursor hot-spot. */ Tk_Uid fg, bg; /* Colors for cursor. */ Display *display; /* Display on which cursor will be used. */ } DataKey; /* - * Forward declarations for procedures defined in this file: + * Forward declarations for functions defined in this file: */ -static void CursorInit _ANSI_ARGS_((TkDisplay *dispPtr)); -static void DupCursorObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr, - Tcl_Obj *dupObjPtr)); -static void FreeCursor _ANSI_ARGS_((TkCursor *cursorPtr)); -static void FreeCursorObjProc _ANSI_ARGS_((Tcl_Obj *objPtr)); -static TkCursor * TkcGetCursor _ANSI_ARGS_((Tcl_Interp *interp, - Tk_Window tkwin, CONST char *name)); -static TkCursor * GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin, - Tcl_Obj *objPtr)); -static void InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr)); +static void CursorInit(TkDisplay *dispPtr); +static void DupCursorObjProc(Tcl_Obj *srcObjPtr, + Tcl_Obj *dupObjPtr); +static void FreeCursor(TkCursor *cursorPtr); +static void FreeCursorObjProc(Tcl_Obj *objPtr); +static TkCursor * TkcGetCursor(Tcl_Interp *interp, + Tk_Window tkwin, CONST char *name); +static TkCursor * GetCursorFromObj(Tk_Window tkwin, Tcl_Obj *objPtr); +static void InitCursorObj(Tcl_Obj *objPtr); /* * The following structure defines the implementation of the "cursor" Tcl @@ -71,33 +70,32 @@ Tcl_ObjType tkCursorObjType = { * * Tk_AllocCursorFromObj -- * - * Given a Tcl_Obj *, map the value to a corresponding - * Tk_Cursor structure based on the tkwin given. + * Given a Tcl_Obj *, map the value to a corresponding Tk_Cursor + * structure based on the tkwin given. * * Results: - * The return value is the X identifer for the desired cursor, - * unless objPtr couldn't be parsed correctly. In this case, - * None is returned and an error message is left in the interp's result. - * The caller should never modify the cursor that is returned, and - * should eventually call Tk_FreeCursorFromObj when the cursor is no - * longer needed. + * The return value is the X identifer for the desired cursor, unless + * objPtr couldn't be parsed correctly. In this case, None is returned + * and an error message is left in the interp's result. The caller should + * never modify the cursor that is returned, and should eventually call + * Tk_FreeCursorFromObj when the cursor is no longer needed. * * Side effects: * The cursor is added to an internal database with a reference count. - * For each call to this procedure, there should eventually be a call - * to Tk_FreeCursorFromObj, so that the database can be cleaned up - * when cursors aren't needed anymore. + * For each call to this function, there should eventually be a call to + * Tk_FreeCursorFromObj, so that the database can be cleaned up when + * cursors aren't needed anymore. * *---------------------------------------------------------------------- */ Tk_Cursor -Tk_AllocCursorFromObj(interp, tkwin, objPtr) - Tcl_Interp *interp; /* Interp for error results. */ - Tk_Window tkwin; /* Window in which the cursor will be used.*/ - Tcl_Obj *objPtr; /* Object describing cursor; see manual - * entry for description of legal - * syntax of this obj's string rep. */ +Tk_AllocCursorFromObj( + Tcl_Interp *interp, /* Interp for error results. */ + Tk_Window tkwin, /* Window in which the cursor will be used.*/ + Tcl_Obj *objPtr) /* Object describing cursor; see manual entry + * for description of legal syntax of this + * obj's string rep. */ { TkCursor *cursorPtr; @@ -107,16 +105,17 @@ Tk_AllocCursorFromObj(interp, tkwin, objPtr) cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; /* - * If the object currently points to a TkCursor, see if it's the - * one we want. If so, increment its reference count and return. + * If the object currently points to a TkCursor, see if it's the one we + * want. If so, increment its reference count and return. */ if (cursorPtr != NULL) { if (cursorPtr->resourceRefCount == 0) { /* - * This is a stale reference: it refers to a TkCursor that's - * no longer in use. Clear the reference. + * This is a stale reference: it refers to a TkCursor that's no + * longer in use. Clear the reference. */ + FreeCursorObjProc(objPtr); cursorPtr = NULL; } else if (Tk_Display(tkwin) == cursorPtr->display) { @@ -126,38 +125,37 @@ Tk_AllocCursorFromObj(interp, tkwin, objPtr) } /* - * The object didn't point to the TkCursor that we wanted. Search - * the list of TkCursors with the same name to see if one of the - * other TkCursors is the right one. + * The object didn't point to the TkCursor that we wanted. Search the list + * of TkCursors with the same name to see if one of the other TkCursors is + * the right one. */ if (cursorPtr != NULL) { - TkCursor *firstCursorPtr = - (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr); + TkCursor *firstCursorPtr = (TkCursor *) + Tcl_GetHashValue(cursorPtr->hashPtr); FreeCursorObjProc(objPtr); for (cursorPtr = firstCursorPtr; cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { if (Tk_Display(tkwin) == cursorPtr->display) { cursorPtr->resourceRefCount++; cursorPtr->objRefCount++; - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; return cursorPtr->cursor; } } } /* - * Still no luck. Call TkcGetCursor to allocate a new TkCursor object. + * Still no luck. Call TkcGetCursor to allocate a new TkCursor object. */ cursorPtr = TkcGetCursor(interp, tkwin, Tcl_GetString(objPtr)); - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; if (cursorPtr == NULL) { return None; - } else { - cursorPtr->objRefCount++; - return cursorPtr->cursor; } + cursorPtr->objRefCount++; + return cursorPtr->cursor; } /* @@ -165,32 +163,31 @@ Tk_AllocCursorFromObj(interp, tkwin, objPtr) * * Tk_GetCursor -- * - * Given a string describing a cursor, locate (or create if necessary) - * a cursor that fits the description. + * Given a string describing a cursor, locate (or create if necessary) a + * cursor that fits the description. * * Results: - * The return value is the X identifer for the desired cursor, - * unless string couldn't be parsed correctly. In this case, - * None is returned and an error message is left in the interp's result. - * The caller should never modify the cursor that is returned, and - * should eventually call Tk_FreeCursor when the cursor is no longer - * needed. + * The return value is the X identifer for the desired cursor, unless + * string couldn't be parsed correctly. In this case, None is returned + * and an error message is left in the interp's result. The caller should + * never modify the cursor that is returned, and should eventually call + * Tk_FreeCursor when the cursor is no longer needed. * * Side effects: * The cursor is added to an internal database with a reference count. - * For each call to this procedure, there should eventually be a call - * to Tk_FreeCursor, so that the database can be cleaned up when cursors + * For each call to this function, there should eventually be a call to + * Tk_FreeCursor, so that the database can be cleaned up when cursors * aren't needed anymore. * *---------------------------------------------------------------------- */ Tk_Cursor -Tk_GetCursor(interp, tkwin, string) - Tcl_Interp *interp; /* Interpreter to use for error reporting. */ - Tk_Window tkwin; /* Window in which cursor will be used. */ - Tk_Uid string; /* Description of cursor. See manual entry - * for details on legal syntax. */ +Tk_GetCursor( + Tcl_Interp *interp, /* Interpreter to use for error reporting. */ + Tk_Window tkwin, /* Window in which cursor will be used. */ + Tk_Uid string) /* Description of cursor. See manual entry for + * details on legal syntax. */ { TkCursor *cursorPtr = TkcGetCursor(interp, tkwin, string); if (cursorPtr == NULL) { @@ -204,34 +201,33 @@ Tk_GetCursor(interp, tkwin, string) * * TkcGetCursor -- * - * Given a string describing a cursor, locate (or create if necessary) - * a cursor that fits the description. This routine returns the - * internal data structure for the cursor, which avoids extra - * hash table lookups in Tk_AllocCursorFromObj. + * Given a string describing a cursor, locate (or create if necessary) a + * cursor that fits the description. This routine returns the internal + * data structure for the cursor, which avoids extra hash table lookups + * in Tk_AllocCursorFromObj. * * Results: - * The return value is a pointer to the TkCursor for the desired - * cursor, unless string couldn't be parsed correctly. In this - * case, NULL is returned and an error message is left in the - * interp's result. The caller should never modify the cursor that - * is returned, and should eventually call Tk_FreeCursor when the - * cursor is no longer needed. + * The return value is a pointer to the TkCursor for the desired cursor, + * unless string couldn't be parsed correctly. In this case, NULL is + * returned and an error message is left in the interp's result. The + * caller should never modify the cursor that is returned, and should + * eventually call Tk_FreeCursor when the cursor is no longer needed. * * Side effects: * The cursor is added to an internal database with a reference count. - * For each call to this procedure, there should eventually be a call - * to Tk_FreeCursor, so that the database can be cleaned up when cursors + * For each call to this function, there should eventually be a call to + * Tk_FreeCursor, so that the database can be cleaned up when cursors * aren't needed anymore. * *---------------------------------------------------------------------- */ static TkCursor * -TkcGetCursor(interp, tkwin, string) - Tcl_Interp *interp; /* Interpreter to use for error reporting. */ - Tk_Window tkwin; /* Window in which cursor will be used. */ - CONST char *string; /* Description of cursor. See manual entry - * for details on legal syntax. */ +TkcGetCursor( + Tcl_Interp *interp, /* Interpreter to use for error reporting. */ + Tk_Window tkwin, /* Window in which cursor will be used. */ + CONST char *string) /* Description of cursor. See manual entry for + * details on legal syntax. */ { Tcl_HashEntry *nameHashPtr; register TkCursor *cursorPtr; @@ -243,7 +239,7 @@ TkcGetCursor(interp, tkwin, string) CursorInit(dispPtr); } - nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable, + nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable, string, &new); if (!new) { existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr); @@ -277,7 +273,7 @@ TkcGetCursor(interp, tkwin, string) cursorPtr->otherTable = &dispPtr->cursorNameTable; cursorPtr->hashPtr = nameHashPtr; cursorPtr->nextPtr = existingCursorPtr; - cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, + cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, (char *) cursorPtr->cursor, &new); if (!new) { Tcl_Panic("cursor already registered in Tk_GetCursor"); @@ -293,37 +289,35 @@ TkcGetCursor(interp, tkwin, string) * * Tk_GetCursorFromData -- * - * Given a description of the bits and colors for a cursor, - * make a cursor that has the given properties. + * Given a description of the bits and colors for a cursor, make a cursor + * that has the given properties. * * Results: - * The return value is the X identifer for the desired cursor, - * unless it couldn't be created properly. In this case, None is - * returned and an error message is left in the interp's result. The - * caller should never modify the cursor that is returned, and - * should eventually call Tk_FreeCursor when the cursor is no - * longer needed. + * The return value is the X identifer for the desired cursor, unless it + * couldn't be created properly. In this case, None is returned and an + * error message is left in the interp's result. The caller should never + * modify the cursor that is returned, and should eventually call + * Tk_FreeCursor when the cursor is no longer needed. * * Side effects: * The cursor is added to an internal database with a reference count. - * For each call to this procedure, there should eventually be a call - * to Tk_FreeCursor, so that the database can be cleaned up when cursors + * For each call to this function, there should eventually be a call to + * Tk_FreeCursor, so that the database can be cleaned up when cursors * aren't needed anymore. * *---------------------------------------------------------------------- */ Tk_Cursor -Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, - xHot, yHot, fg, bg) - Tcl_Interp *interp; /* Interpreter to use for error reporting. */ - Tk_Window tkwin; /* Window in which cursor will be used. */ - CONST char *source; /* Bitmap data for cursor shape. */ - CONST char *mask; /* Bitmap data for cursor mask. */ - int width, height; /* Dimensions of cursor. */ - int xHot, yHot; /* Location of hot-spot in cursor. */ - Tk_Uid fg; /* Foreground color for cursor. */ - Tk_Uid bg; /* Background color for cursor. */ +Tk_GetCursorFromData( + Tcl_Interp *interp, /* Interpreter to use for error reporting. */ + Tk_Window tkwin, /* Window in which cursor will be used. */ + CONST char *source, /* Bitmap data for cursor shape. */ + CONST char *mask, /* Bitmap data for cursor mask. */ + int width, int height, /* Dimensions of cursor. */ + int xHot, int yHot, /* Location of hot-spot in cursor. */ + Tk_Uid fg, /* Foreground color for cursor. */ + Tk_Uid bg) /* Background color for cursor. */ { DataKey dataKey; Tcl_HashEntry *dataHashPtr; @@ -332,7 +326,6 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, XColor fgColor, bgColor; TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!dispPtr->cursorInit) { CursorInit(dispPtr); } @@ -346,7 +339,7 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, dataKey.fg = fg; dataKey.bg = bg; dataKey.display = Tk_Display(tkwin); - dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable, + dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable, (char *) &dataKey, &new); if (!new) { cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr); @@ -355,18 +348,16 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, } /* - * No suitable cursor exists yet. Make one using the data - * available and add it to the database. + * No suitable cursor exists yet. Make one using the data available and + * add it to the database. */ if (XParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", fg, "\"", - (char *) NULL); + Tcl_AppendResult(interp, "invalid color name \"", fg, "\"", NULL); goto error; } if (XParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) { - Tcl_AppendResult(interp, "invalid color name \"", bg, "\"", - (char *) NULL); + Tcl_AppendResult(interp, "invalid color name \"", bg, "\"", NULL); goto error; } @@ -381,7 +372,7 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, cursorPtr->otherTable = &dispPtr->cursorDataTable; cursorPtr->hashPtr = dataHashPtr; cursorPtr->objRefCount = 0; - cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, + cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, (char *) cursorPtr->cursor, &new); cursorPtr->nextPtr = NULL; @@ -392,7 +383,7 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr); return cursorPtr->cursor; - error: + error: Tcl_DeleteHashEntry(dataHashPtr); return None; } @@ -405,12 +396,11 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, * Given a cursor, return a textual string identifying it. * * Results: - * If cursor was created by Tk_GetCursor, then the return - * value is the "string" that was used to create it. - * Otherwise the return value is a string giving the X - * identifier for the cursor. The storage for the returned - * string is only guaranteed to persist up until the next - * call to this procedure. + * If cursor was created by Tk_GetCursor, then the return value is the + * "string" that was used to create it. Otherwise the return value is a + * string giving the X identifier for the cursor. The storage for the + * returned string is only guaranteed to persist up until the next call + * to this function. * * Side effects: * None. @@ -419,9 +409,9 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, */ CONST char * -Tk_NameOfCursor(display, cursor) - Display *display; /* Display for which cursor was allocated. */ - Tk_Cursor cursor; /* Identifier for cursor whose name is +Tk_NameOfCursor( + Display *display, /* Display for which cursor was allocated. */ + Tk_Cursor cursor) /* Identifier for cursor whose name is * wanted. */ { Tcl_HashEntry *idHashPtr; @@ -431,8 +421,8 @@ Tk_NameOfCursor(display, cursor) dispPtr = TkGetDisplay(display); if (!dispPtr->cursorInit) { - printid: - sprintf(dispPtr->cursorString, "cursor id 0x%x", + printid: + sprintf(dispPtr->cursorString, "cursor id 0x%x", (unsigned int) cursor); return dispPtr->cursorString; } @@ -452,23 +442,22 @@ Tk_NameOfCursor(display, cursor) * * FreeCursor -- * - * This procedure is invoked by both Tk_FreeCursor and - * Tk_FreeCursorFromObj; it does all the real work of deallocating - * a cursor. + * This function is invoked by both Tk_FreeCursorFromObj and + * Tk_FreeCursor; it does all the real work of deallocating a cursor. * * Results: * None. * * Side effects: - * The reference count associated with cursor is decremented, and - * it is officially deallocated if no-one is using it anymore. + * The reference count associated with cursor is decremented, and it is + * officially deallocated if no-one is using it anymore. * *---------------------------------------------------------------------- */ static void -FreeCursor(cursorPtr) - TkCursor *cursorPtr; /* Cursor to be released. */ +FreeCursor( + TkCursor *cursorPtr) /* Cursor to be released. */ { TkCursor *prevPtr; @@ -502,23 +491,23 @@ FreeCursor(cursorPtr) * * Tk_FreeCursor -- * - * This procedure is called to release a cursor allocated by - * Tk_GetCursor or TkGetCursorFromData. + * This function is called to release a cursor allocated by Tk_GetCursor + * or TkGetCursorFromData. * * Results: * None. * * Side effects: - * The reference count associated with cursor is decremented, and - * it is officially deallocated if no-one is using it anymore. + * The reference count associated with cursor is decremented, and it is + * officially deallocated if no-one is using it anymore. * *---------------------------------------------------------------------- */ void -Tk_FreeCursor(display, cursor) - Display *display; /* Display for which cursor was allocated. */ - Tk_Cursor cursor; /* Identifier for cursor to be released. */ +Tk_FreeCursor( + Display *display, /* Display for which cursor was allocated. */ + Tk_Cursor cursor) /* Identifier for cursor to be released. */ { Tcl_HashEntry *idHashPtr; TkDisplay *dispPtr = TkGetDisplay(display); @@ -539,27 +528,27 @@ Tk_FreeCursor(display, cursor) * * Tk_FreeCursorFromObj -- * - * This procedure is called to release a cursor allocated by - * Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *; - * it only gets rid of the hash table entry for this cursor - * and clears the cached value that is normally stored in the object. + * This function is called to release a cursor allocated by + * Tk_AllocCursorFromObj. It does not throw away the Tcl_Obj *; it only + * gets rid of the hash table entry for this cursor and clears the cached + * value that is normally stored in the object. * * Results: * None. * * Side effects: - * The reference count associated with the cursor represented by - * objPtr is decremented, and the cursor is released to X if there are - * no remaining uses for it. + * The reference count associated with the cursor represented by objPtr + * is decremented, and the cursor is released to X if there are no + * remaining uses for it. * *---------------------------------------------------------------------- */ void -Tk_FreeCursorFromObj(tkwin, objPtr) - Tk_Window tkwin; /* The window this cursor lives in. Needed - * for the display value. */ - Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */ +Tk_FreeCursorFromObj( + Tk_Window tkwin, /* The window this cursor lives in. Needed for + * the display value. */ + Tcl_Obj *objPtr) /* The Tcl_Obj * to be freed. */ { FreeCursor(GetCursorFromObj(tkwin, objPtr)); FreeCursorObjProc(objPtr); @@ -568,66 +557,65 @@ Tk_FreeCursorFromObj(tkwin, objPtr) /* *--------------------------------------------------------------------------- * - * FreeCursorFromObjProc -- + * FreeCursorFromObjProc -- * * This proc is called to release an object reference to a cursor. - * Called when the object's internal rep is released or when - * the cached tkColPtr needs to be changed. + * Called when the object's internal rep is released or when the cached + * tkColPtr needs to be changed. * * Results: * None. * * Side effects: - * The object reference count is decremented. When both it - * and the hash ref count go to zero, the color's resources - * are released. + * The object reference count is decremented. When both it and the hash + * ref count go to zero, the color's resources are released. * *--------------------------------------------------------------------------- */ static void -FreeCursorObjProc(objPtr) - Tcl_Obj *objPtr; /* The object we are releasing. */ +FreeCursorObjProc( + Tcl_Obj *objPtr) /* The object we are releasing. */ { TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; if (cursorPtr != NULL) { cursorPtr->objRefCount--; - if ((cursorPtr->objRefCount == 0) + if ((cursorPtr->objRefCount == 0) && (cursorPtr->resourceRefCount == 0)) { ckfree((char *) cursorPtr); } - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; } } /* *--------------------------------------------------------------------------- * - * DupCursorObjProc -- + * DupCursorObjProc -- * - * When a cached cursor object is duplicated, this is called to - * update the internal reps. + * When a cached cursor object is duplicated, this is called to update + * the internal reps. * * Results: * None. * * Side effects: - * The color's objRefCount is incremented and the internal rep - * of the copy is set to point to it. + * The color's objRefCount is incremented and the internal rep of the + * copy is set to point to it. * *--------------------------------------------------------------------------- */ static void -DupCursorObjProc(srcObjPtr, dupObjPtr) - Tcl_Obj *srcObjPtr; /* The object we are copying from. */ - Tcl_Obj *dupObjPtr; /* The object we are copying to. */ +DupCursorObjProc( + Tcl_Obj *srcObjPtr, /* The object we are copying from. */ + Tcl_Obj *dupObjPtr) /* The object we are copying to. */ { TkCursor *cursorPtr = (TkCursor *) srcObjPtr->internalRep.twoPtrValue.ptr1; - + dupObjPtr->typePtr = srcObjPtr->typePtr; - dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + dupObjPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; if (cursorPtr != NULL) { cursorPtr->objRefCount++; @@ -640,27 +628,31 @@ DupCursorObjProc(srcObjPtr, dupObjPtr) * Tk_GetCursorFromObj -- * * Returns the cursor referred to buy a Tcl object. The cursor must - * already have been allocated via a call to Tk_AllocCursorFromObj or + * already have been allocated via a call to Tk_AllocCursorFromObj or * Tk_GetCursor. * * Results: - * Returns the Tk_Cursor that matches the tkwin and the string rep - * of the name of the cursor given in objPtr. + * Returns the Tk_Cursor that matches the tkwin and the string rep of the + * name of the cursor given in objPtr. * * Side effects: - * If the object is not already a cursor, the conversion will free - * any old internal representation. + * If the object is not already a cursor, the conversion will free any + * old internal representation. * *---------------------------------------------------------------------- */ Tk_Cursor -Tk_GetCursorFromObj(tkwin, objPtr) - Tk_Window tkwin; - Tcl_Obj *objPtr; /* The object from which to get pixels. */ +Tk_GetCursorFromObj( + Tk_Window tkwin, + Tcl_Obj *objPtr) /* The object from which to get pixels. */ { TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr); - /* GetCursorFromObj should never return NULL */ + + /* + * GetCursorFromObj should never return NULL + */ + return cursorPtr->cursor; } @@ -669,25 +661,25 @@ Tk_GetCursorFromObj(tkwin, objPtr) * * GetCursorFromObj -- * - * Returns the cursor referred to by a Tcl object. The cursor must - * already have been allocated via a call to Tk_AllocCursorFromObj - * or Tk_GetCursor. + * Returns the cursor referred to by a Tcl object. The cursor must + * already have been allocated via a call to Tk_AllocCursorFromObj or + * Tk_GetCursor. * * Results: - * Returns the TkCursor * that matches the tkwin and the string rep - * of the name of the cursor given in objPtr. + * Returns the TkCursor * that matches the tkwin and the string rep of + * the name of the cursor given in objPtr. * * Side effects: - * If the object is not already a cursor, the conversion will free - * any old internal representation. + * If the object is not already a cursor, the conversion will free any + * old internal representation. * *---------------------------------------------------------------------- */ static TkCursor * -GetCursorFromObj(tkwin, objPtr) - Tk_Window tkwin; /* Window in which the cursor will be used. */ - Tcl_Obj *objPtr; /* The object that describes the desired +GetCursorFromObj( + Tk_Window tkwin, /* Window in which the cursor will be used. */ + Tcl_Obj *objPtr) /* The object that describes the desired * cursor. */ { TkCursor *cursorPtr; @@ -699,11 +691,12 @@ GetCursorFromObj(tkwin, objPtr) } /* - * The internal representation is a cache of the last cursor used - * with the given name. But there can be lots different cursors - * for each cursor name; one cursor for each display. Check to - * see if the cursor we have cached is the one that is needed. + * The internal representation is a cache of the last cursor used with the + * given name. But there can be lots different cursors for each cursor + * name; one cursor for each display. Check to see if the cursor we have + * cached is the one that is needed. */ + cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; if ((cursorPtr != NULL) && (Tk_Display(tkwin) == cursorPtr->display)) { return cursorPtr; @@ -723,13 +716,13 @@ GetCursorFromObj(tkwin, objPtr) cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { if (Tk_Display(tkwin) == cursorPtr->display) { FreeCursorObjProc(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) cursorPtr; cursorPtr->objRefCount++; return cursorPtr; } } - error: + error: Tcl_Panic("GetCursorFromObj called with non-existent cursor!"); /* * The following code isn't reached; it's just there to please compilers. @@ -742,27 +735,27 @@ GetCursorFromObj(tkwin, objPtr) * * InitCursorObj -- * - * Bookeeping procedure to change an objPtr to a cursor type. + * Bookeeping function to change an objPtr to a cursor type. * * Results: * None. * * Side effects: - * The old internal rep of the object is freed. The internal - * rep is cleared. The final form of the object is set - * by either Tk_AllocCursorFromObj or GetCursorFromObj. + * The old internal rep of the object is freed. The internal rep is + * cleared. The final form of the object is set by either + * Tk_AllocCursorFromObj or GetCursorFromObj. * *---------------------------------------------------------------------- */ static void -InitCursorObj(objPtr) - Tcl_Obj *objPtr; /* The object to convert. */ +InitCursorObj( + Tcl_Obj *objPtr) /* The object to convert. */ { Tcl_ObjType *typePtr; /* - * Free the old internalRep before setting the new one. + * Free the old internalRep before setting the new one. */ Tcl_GetString(objPtr); @@ -771,7 +764,7 @@ InitCursorObj(objPtr) (*typePtr->freeIntRepProc)(objPtr); } objPtr->typePtr = &tkCursorObjType; - objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; + objPtr->internalRep.twoPtrValue.ptr1 = NULL; } /* @@ -791,26 +784,26 @@ InitCursorObj(objPtr) */ static void -CursorInit(dispPtr) - TkDisplay *dispPtr; /* Display used to store thread-specific data. */ +CursorInit( + TkDisplay *dispPtr) /* Display used to store thread-specific + * data. */ { Tcl_InitHashTable(&dispPtr->cursorNameTable, TCL_STRING_KEYS); Tcl_InitHashTable(&dispPtr->cursorDataTable, sizeof(DataKey)/sizeof(int)); /* - * The call below is tricky: can't use sizeof(IdKey) because it - * gets padded with extra unpredictable bytes on some 64-bit - * machines. + * The call below is tricky: can't use sizeof(IdKey) because it gets + * padded with extra unpredictable bytes on some 64-bit machines. */ - /* - * Old code.... - * Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *) + /* + * Old code.... + * Tcl_InitHashTable(&dispPtr->cursorIdTable, sizeof(Display *) * /sizeof(int)); * - * The comment above doesn't make sense. - * However, XIDs should only be 32 bits, by the definition of X, - * so the code above causes Tk to crash. Here is the real code: + * The comment above doesn't make sense. However, XIDs should only be 32 + * bits, by the definition of X, so the code above causes Tk to crash. + * Here is the real code: */ Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS); @@ -823,13 +816,13 @@ CursorInit(dispPtr) * * TkDebugCursor -- * - * This procedure returns debugging information about a cursor. + * This function returns debugging information about a cursor. * * Results: * The return value is a list with one sublist for each TkCursor - * corresponding to "name". Each sublist has two elements that - * contain the resourceRefCount and objRefCount fields from the - * TkCursor structure. + * corresponding to "name". Each sublist has two elements that contain + * the resourceRefCount and objRefCount fields from the TkCursor + * structure. * * Side effects: * None. @@ -838,10 +831,10 @@ CursorInit(dispPtr) */ Tcl_Obj * -TkDebugCursor(tkwin, name) - Tk_Window tkwin; /* The window in which the cursor will be - * used (not currently used). */ - char *name; /* Name of the desired color. */ +TkDebugCursor( + Tk_Window tkwin, /* The window in which the cursor will be used + * (not currently used). */ + char *name) /* Name of the desired color. */ { TkCursor *cursorPtr; Tcl_HashEntry *hashPtr; @@ -863,9 +856,17 @@ TkDebugCursor(tkwin, name) Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(cursorPtr->resourceRefCount)); Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewIntObj(cursorPtr->objRefCount)); + Tcl_NewIntObj(cursorPtr->objRefCount)); Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); } } return resultPtr; } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tkEntry.h b/generic/tkEntry.h index 3bb2f1d..636aefc 100644 --- a/generic/tkEntry.h +++ b/generic/tkEntry.h @@ -1,13 +1,12 @@ /* * tkEntry.h -- - * - * This module defined the structures for the Entry & SpinBox widgets. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * This module defined the structures for the Entry & SpinBox widgets. * - * Copyright (c) 2002 Apple Computer, Inc. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * + * Copyright (c) 2002 Apple Computer, Inc. */ #ifndef _TKENTRY @@ -18,8 +17,8 @@ #endif #ifdef BUILD_tk -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLEXPORT +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT #endif enum EntryType { @@ -27,16 +26,16 @@ enum EntryType { }; /* - * A data structure of the following type is kept for each Entry - * widget managed by this file: + * A data structure of the following type is kept for each Entry widget + * managed by this file: */ typedef struct { - Tk_Window tkwin; /* Window that embodies the entry. NULL - * means that the window has been destroyed - * but the data structures haven't yet been - * cleaned up.*/ - Display *display; /* Display containing widget. Used, among + Tk_Window tkwin; /* Window that embodies the entry. NULL means + * that the window has been destroyed but the + * data structures haven't yet been cleaned + * up.*/ + Display *display; /* Display containing widget. Used, among * other things, so that resources can be * freed even after tkwin has gone away. */ Tcl_Interp *interp; /* Interpreter associated with entry. */ @@ -48,9 +47,9 @@ typedef struct { /* * Fields that are set by widget commands other than "configure". */ - + CONST char *string; /* Pointer to storage for string; - * NULL-terminated; malloc-ed. */ + * NULL-terminated; malloc-ed. */ int insertPos; /* Character index before which next typed * character will be inserted. */ @@ -58,8 +57,8 @@ typedef struct { * Information about what's selected, if any. */ - int selectFirst; /* Character index of first selected - * character (-1 means nothing selected. */ + int selectFirst; /* Character index of first selected character + * (-1 means nothing selected. */ int selectLast; /* Character index just after last selected * character (-1 means nothing selected. */ int selectAnchor; /* Fixed end of selection (i.e. "select to" @@ -81,11 +80,11 @@ typedef struct { Tk_3DBorder normalBorder; /* Used for drawing border around whole * window, plus used for background. */ - Tk_3DBorder disabledBorder; /* Used for drawing border around whole - * window in disabled state, plus used for + Tk_3DBorder disabledBorder; /* Used for drawing border around whole window + * in disabled state, plus used for * background. */ - Tk_3DBorder readonlyBorder; /* Used for drawing border around whole - * window in readonly state, plus used for + Tk_3DBorder readonlyBorder; /* Used for drawing border around whole window + * in readonly state, plus used for * background. */ int borderWidth; /* Width of 3-D border around window. */ Tk_Cursor cursor; /* Current cursor for window, or None. */ @@ -94,12 +93,12 @@ typedef struct { Tk_Font tkfont; /* Information about text font, or NULL. */ XColor *fgColorPtr; /* Text color in normal mode. */ XColor *dfgColorPtr; /* Text color in disabled mode. */ - XColor *highlightBgColorPtr;/* Color for drawing traversal highlight - * area when highlight is off. */ + XColor *highlightBgColorPtr;/* Color for drawing traversal highlight area + * when highlight is off. */ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */ - int highlightWidth; /* Width in pixels of highlight to draw - * around widget when it has the focus. - * <= 0 means don't draw a highlight. */ + int highlightWidth; /* Width in pixels of highlight to draw around + * widget when it has the focus. <= 0 means + * don't draw a highlight. */ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion * cursor. */ int insertBorderWidth; /* Width of 3-D border around insert cursor. */ @@ -115,44 +114,46 @@ typedef struct { * characters. */ int selBorderWidth; /* Width of border around selection. */ XColor *selFgColorPtr; /* Foreground color for selected text. */ - int state; /* Normal or disabled. Entry is read-only - * when disabled. */ - char *textVarName; /* Name of variable (malloc'ed) or NULL. - * If non-NULL, entry's string tracks the - * contents of this variable and vice versa. */ - char *takeFocus; /* Value of -takefocus option; not used in - * the C code, but used by keyboard traversal - * scripts. Malloc'ed, but may be NULL. */ + int state; /* Normal or disabled. Entry is read-only when + * disabled. */ + char *textVarName; /* Name of variable (malloc'ed) or NULL. If + * non-NULL, entry's string tracks the + * contents of this variable and vice + * versa. */ + char *takeFocus; /* Value of -takefocus option; not used in the + * C code, but used by keyboard traversal + * scripts. Malloc'ed, but may be NULL. */ int prefWidth; /* Desired width of window, measured in * average characters. */ char *scrollCmd; /* Command prefix for communicating with - * scrollbar(s). Malloc'ed. NULL means - * no command to issue. */ - char *showChar; /* Value of -show option. If non-NULL, first + * scrollbar(s). Malloc'ed. NULL means no + * command to issue. */ + char *showChar; /* Value of -show option. If non-NULL, first * character is used for displaying all - * characters in entry. Malloc'ed. - * This is only used by the Entry widget. */ + * characters in entry. Malloc'ed. This is + * only used by the Entry widget. */ /* * Fields whose values are derived from the current values of the * configuration settings above. */ - CONST char *displayString; /* String to use when displaying. This may - * be a pointer to string, or a pointer to + CONST char *displayString; /* String to use when displaying. This may be + * a pointer to string, or a pointer to * malloced memory with the same character - * length as string but whose characters - * are all equal to showChar. */ + * length as string but whose characters are + * all equal to showChar. */ int numBytes; /* Length of string in bytes. */ - int numChars; /* Length of string in characters. Both - * string and displayString have the same - * character length, but may have different - * byte lengths due to being made from - * different UTF-8 characters. */ + int numChars; /* Length of string in characters. Both string + * and displayString have the same character + * length, but may have different byte lengths + * due to being made from different UTF-8 + * characters. */ int numDisplayBytes; /* Length of displayString in bytes. */ int inset; /* Number of pixels on the left and right - * sides that are taken up by XPAD, borderWidth - * (if any), and highlightWidth (if any). */ + * sides that are taken up by XPAD, + * borderWidth (if any), and highlightWidth + * (if any). */ Tk_TextLayout textLayout; /* Cached text layout information. */ int layoutX, layoutY; /* Origin for layout. */ int leftX; /* X position at which character at leftIndex @@ -166,23 +167,22 @@ typedef struct { GC selTextGC; /* For drawing selected text. */ GC highlightGC; /* For drawing traversal highlight. */ int avgWidth; /* Width of average character. */ - int xWidth; /* Extra width to reserve for widget. - * Used by spinboxes for button space. */ - int flags; /* Miscellaneous flags; see below for + int xWidth; /* Extra width to reserve for widget. Used by + * spinboxes for button space. */ + int flags; /* Miscellaneous flags; see below for * definitions. */ - int validate; /* Non-zero means try to validate */ - char *validateCmd; /* Command prefix to use when invoking - * validate command. NULL means don't - * invoke commands. Malloc'ed. */ + int validate; /* Non-zero means try to validate */ + char *validateCmd; /* Command prefix to use when invoking + * validate command. NULL means don't invoke + * commands. Malloc'ed. */ char *invalidCmd; /* Command called when a validation returns 0 * (successfully fails), defaults to {}. */ - } Entry; /* - * A data structure of the following type is kept for each spinbox - * widget managed by this file: + * A data structure of the following type is kept for each spinbox widget + * managed by this file: */ typedef struct { @@ -200,8 +200,8 @@ typedef struct { Tk_Cursor bCursor; /* cursor for buttons, or None. */ int bdRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */ int buRelief; /* 3-D effect: TK_RELIEF_RAISED, etc. */ - char *command; /* Command to invoke for spin buttons. - * NULL means no command to issue. */ + char *command; /* Command to invoke for spin buttons. NULL + * means no command to issue. */ /* * Spinbox specific fields for use with configuration settings above. @@ -216,38 +216,37 @@ typedef struct { int repeatInterval; /* repeat interval */ double fromValue; /* Value corresponding to left/top of dial */ - double toValue; /* Value corresponding to right/bottom - * of dial */ - double increment; /* If > 0, all values are rounded to an - * even multiple of this value. */ + double toValue; /* Value corresponding to right/bottom of + * dial */ + double increment; /* If > 0, all values are rounded to an even + * multiple of this value. */ char *formatBuf; /* string into which to format value. * Malloc'ed. */ char *reqFormat; /* Sprintf conversion specifier used for the - * value that the users requests. Malloc'ed. */ - char *valueFormat; /* Sprintf conversion specifier used for - * the value. */ + * value that the users requests. Malloc'ed */ + char *valueFormat; /* Sprintf conversion specifier used for the + * value. */ char digitFormat[10]; /* Sprintf conversion specifier computed from - * digits and other information; used for - * the value. */ + * digits and other information; used for the + * value. */ char *valueStr; /* Values List. Malloc'ed. */ Tcl_Obj *listObj; /* Pointer to the list object being used */ int eIndex; /* Holds the current index into elements */ int nElements; /* Holds the current count of elements */ - } Spinbox; /* - * Assigned bits of "flags" fields of Entry structures, and what those - * bits mean: + * Assigned bits of "flags" fields of Entry structures, and what those bits + * mean: * * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has * already been queued to redisplay the entry. * BORDER_NEEDED: Non-zero means 3-D border must be redrawn - * around window during redisplay. Normally - * only text portion needs to be redrawn. + * around window during redisplay. Normally only + * text portion needs to be redrawn. * CURSOR_ON: Non-zero means insert cursor is displayed at - * present. 0 means it isn't displayed. + * present. 0 means it isn't displayed. * GOT_FOCUS: Non-zero means this window has the input * focus. * UPDATE_SCROLLBAR: Non-zero means scrollbar should be updated @@ -268,40 +267,40 @@ typedef struct { #define GOT_FOCUS 8 #define UPDATE_SCROLLBAR 0x10 #define GOT_SELECTION 0x20 -#define ENTRY_DELETED 0x40 -#define VALIDATING 0x80 -#define VALIDATE_VAR 0x100 -#define VALIDATE_ABORT 0x200 -#define ENTRY_VAR_TRACED 0x400 +#define ENTRY_DELETED 0x40 +#define VALIDATING 0x80 +#define VALIDATE_VAR 0x100 +#define VALIDATE_ABORT 0x200 +#define ENTRY_VAR_TRACED 0x400 /* - * The following enum is used to define a type for the -state option - * of the Entry widget. These values are used as indices into the - * string table below. + * The following enum is used to define a type for the -state option of the + * Entry widget. These values are used as indices into the string table below. */ enum state { STATE_DISABLED, STATE_NORMAL, STATE_READONLY }; -/* +/* * This is the element index corresponding to the strings in selElementNames. * If you modify them, you must modify the numbers here. */ - + enum selelement { SEL_NONE, SEL_BUTTONDOWN, SEL_BUTTONUP, SEL_NULL, SEL_ENTRY }; /* - * Declaration of procedures used in the implementation of the native side - * of the Entry widget. + * Declaration of functions used in the implementation of the native side of + * the Entry widget. */ -int TkpDrawEntryBorderAndFocus(Entry *entryPtr, Drawable d, int isSpinbox); -int TkpDrawSpinboxButtons(Spinbox *sbPtr, Drawable d); +int TkpDrawEntryBorderAndFocus(Entry *entryPtr, + Drawable d, int isSpinbox); +int TkpDrawSpinboxButtons(Spinbox *sbPtr, Drawable d); -# undef TCL_STORAGE_CLASS -# define TCL_STORAGE_CLASS DLLIMPORT +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT -#endif /* _TKBUTTON */ +#endif /* _TKENTRY */ |