diff options
Diffstat (limited to 'generic/tkCursor.c')
| -rw-r--r-- | generic/tkCursor.c | 670 |
1 files changed, 574 insertions, 96 deletions
diff --git a/generic/tkCursor.c b/generic/tkCursor.c index 297cd3e..87b284d 100644 --- a/generic/tkCursor.c +++ b/generic/tkCursor.c @@ -6,12 +6,12 @@ * also avoids round-trips to the X server. * * Copyright (c) 1990-1994 The Regents of the University of California. - * Copyright (c) 1994-1995 Sun Microsystems, Inc. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkCursor.c,v 1.2 1998/09/14 18:23:09 stanton Exp $ + * RCS: @(#) $Id: tkCursor.c,v 1.3 1999/04/16 01:51:13 stanton Exp $ */ #include "tkPort.h" @@ -20,28 +20,11 @@ /* * 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 idTable, and the other is either - * nameTable or dataTable, also defined below. + * 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. */ -/* - * Hash table to map from a textual description of a cursor to the - * TkCursor record for the cursor, and key structure used in that - * hash table: - */ - -static Tcl_HashTable nameTable; -typedef struct { - Tk_Uid name; /* Textual name for desired cursor. */ - Display *display; /* Display for which cursor will be used. */ -} NameKey; - -/* - * Hash table to map from a collection of in-core data about a - * cursor (bitmap contents, etc.) to a TkCursor structure: - */ - -static Tcl_HashTable dataTable; typedef struct { char *source; /* Cursor bits. */ char *mask; /* Mask bits. */ @@ -53,24 +36,129 @@ typedef struct { } DataKey; /* - * Hash table that maps from <display + cursor id> to the TkCursor structure - * for the cursor. This table is used by Tk_FreeCursor. + * Forward declarations for procedures defined in this file: */ -static Tcl_HashTable idTable; -typedef struct { - Display *display; /* Display for which cursor was allocated. */ - Tk_Cursor cursor; /* Cursor identifier. */ -} IdKey; +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 * GetCursor _ANSI_ARGS_((Tcl_Interp *interp, + Tk_Window tkwin, char *name)); +static TkCursor * GetCursorFromObj _ANSI_ARGS_((Tk_Window tkwin, + Tcl_Obj *objPtr)); +static void InitCursorObj _ANSI_ARGS_((Tcl_Obj *objPtr)); -static int initialized = 0; /* 0 means static structures haven't been - * initialized yet. */ +/* + * The following structure defines the implementation of the "cursor" Tcl + * object, used for drawing. The color object remembers the hash table + * entry associated with a color. The actual allocation and deallocation + * of the color should be done by the configuration package when the cursor + * option is set. + */ +static Tcl_ObjType cursorObjType = { + "cursor", /* name */ + FreeCursorObjProc, /* freeIntRepProc */ + DupCursorObjProc, /* dupIntRepProc */ + NULL, /* updateStringProc */ + NULL /* setFromAnyProc */ +}; + /* - * Forward declarations for procedures defined in this file: + *---------------------------------------------------------------------- + * + * Tk_AllocCursorFromObj -- + * + * 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. + * + * 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. + * + *---------------------------------------------------------------------- */ -static void CursorInit _ANSI_ARGS_((void)); +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. */ +{ + TkCursor *cursorPtr; + + if (objPtr->typePtr != &cursorObjType) { + InitCursorObj(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 (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. + */ + FreeCursorObjProc(objPtr); + cursorPtr = NULL; + } else if (Tk_Display(tkwin) == cursorPtr->display) { + cursorPtr->resourceRefCount++; + return cursorPtr->cursor; + } + } + + /* + * 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); + 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; + return cursorPtr->cursor; + } + } + } + + /* + * Still no luck. Call GetCursor to allocate a new TkCursor object. + */ + + cursorPtr = GetCursor(interp, tkwin, Tcl_GetString(objPtr)); + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + if (cursorPtr == NULL) { + return None; + } else { + cursorPtr->objRefCount++; + return cursorPtr->cursor; + } +} /* *---------------------------------------------------------------------- @@ -83,7 +171,7 @@ static void CursorInit _ANSI_ARGS_((void)); * 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 interp->result. + * 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. @@ -101,52 +189,103 @@ 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 + char *string; /* Description of cursor. See manual entry + * for details on legal syntax. */ +{ + TkCursor *cursorPtr = GetCursor(interp, tkwin, string); + if (cursorPtr == NULL) { + return None; + } + return cursorPtr->cursor; +} + +/* + *---------------------------------------------------------------------- + * + * GetCursor -- + * + * 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. + * + * 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 + * aren't needed anymore. + * + *---------------------------------------------------------------------- + */ + +static TkCursor * +GetCursor(interp, tkwin, string) + Tcl_Interp *interp; /* Interpreter to use for error reporting. */ + Tk_Window tkwin; /* Window in which cursor will be used. */ + char *string; /* Description of cursor. See manual entry * for details on legal syntax. */ { - NameKey nameKey; - IdKey idKey; - Tcl_HashEntry *nameHashPtr, *idHashPtr; + Tcl_HashEntry *nameHashPtr; register TkCursor *cursorPtr; + TkCursor *existingCursorPtr = NULL; int new; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - CursorInit(); + if (!dispPtr->cursorInit) { + CursorInit(dispPtr); } - nameKey.name = string; - nameKey.display = Tk_Display(tkwin); - nameHashPtr = Tcl_CreateHashEntry(&nameTable, (char *) &nameKey, &new); + nameHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorNameTable, + string, &new); if (!new) { - cursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr); - cursorPtr->refCount++; - return cursorPtr->cursor; + existingCursorPtr = (TkCursor *) Tcl_GetHashValue(nameHashPtr); + for (cursorPtr = existingCursorPtr; cursorPtr != NULL; + cursorPtr = cursorPtr->nextPtr) { + if (Tk_Display(tkwin) == cursorPtr->display) { + cursorPtr->resourceRefCount++; + return cursorPtr; + } + } + } else { + existingCursorPtr = NULL; } cursorPtr = TkGetCursorByName(interp, tkwin, string); if (cursorPtr == NULL) { - Tcl_DeleteHashEntry(nameHashPtr); - return None; + if (new) { + Tcl_DeleteHashEntry(nameHashPtr); + } + return NULL; } /* * Add information about this cursor to our database. */ - cursorPtr->refCount = 1; - cursorPtr->otherTable = &nameTable; + cursorPtr->display = Tk_Display(tkwin); + cursorPtr->resourceRefCount = 1; + cursorPtr->objRefCount = 0; + cursorPtr->otherTable = &dispPtr->cursorNameTable; cursorPtr->hashPtr = nameHashPtr; - idKey.display = nameKey.display; - idKey.cursor = cursorPtr->cursor; - idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new); + cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, + (char *) cursorPtr->cursor, &new); if (!new) { panic("cursor already registered in Tk_GetCursor"); } + cursorPtr->nextPtr = existingCursorPtr; Tcl_SetHashValue(nameHashPtr, cursorPtr); - Tcl_SetHashValue(idHashPtr, cursorPtr); + Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr); - return cursorPtr->cursor; + return cursorPtr; } /* @@ -160,7 +299,7 @@ Tk_GetCursor(interp, tkwin, string) * 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 interp->result. The + * 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. @@ -187,14 +326,15 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, Tk_Uid bg; /* Background color for cursor. */ { DataKey dataKey; - IdKey idKey; - Tcl_HashEntry *dataHashPtr, *idHashPtr; + Tcl_HashEntry *dataHashPtr; register TkCursor *cursorPtr; int new; XColor fgColor, bgColor; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; - if (!initialized) { - CursorInit(); + + if (!dispPtr->cursorInit) { + CursorInit(dispPtr); } dataKey.source = source; @@ -206,10 +346,11 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, dataKey.fg = fg; dataKey.bg = bg; dataKey.display = Tk_Display(tkwin); - dataHashPtr = Tcl_CreateHashEntry(&dataTable, (char *) &dataKey, &new); + dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable, + (char *) &dataKey, &new); if (!new) { cursorPtr = (TkCursor *) Tcl_GetHashValue(dataHashPtr); - cursorPtr->refCount++; + cursorPtr->resourceRefCount++; return cursorPtr->cursor; } @@ -236,17 +377,18 @@ Tk_GetCursorFromData(interp, tkwin, source, mask, width, height, goto error; } - cursorPtr->refCount = 1; - cursorPtr->otherTable = &dataTable; + cursorPtr->resourceRefCount = 1; + cursorPtr->otherTable = &dispPtr->cursorDataTable; cursorPtr->hashPtr = dataHashPtr; - idKey.display = dataKey.display; - idKey.cursor = cursorPtr->cursor; - idHashPtr = Tcl_CreateHashEntry(&idTable, (char *) &idKey, &new); + cursorPtr->objRefCount = 0; + cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable, + (char *) cursorPtr->cursor, &new); + if (!new) { panic("cursor already registered in Tk_GetCursorFromData"); } Tcl_SetHashValue(dataHashPtr, cursorPtr); - Tcl_SetHashValue(idHashPtr, cursorPtr); + Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr); return cursorPtr->cursor; error: @@ -281,27 +423,77 @@ Tk_NameOfCursor(display, cursor) Tk_Cursor cursor; /* Identifier for cursor whose name is * wanted. */ { - IdKey idKey; Tcl_HashEntry *idHashPtr; TkCursor *cursorPtr; - static char string[20]; + TkDisplay *dispPtr; - if (!initialized) { + dispPtr = TkGetDisplay(display); + + if (!dispPtr->cursorInit) { printid: - sprintf(string, "cursor id 0x%x", (unsigned int) cursor); - return string; + sprintf(dispPtr->cursorString, "cursor id 0x%x", + (unsigned int) cursor); + return dispPtr->cursorString; } - idKey.display = display; - idKey.cursor = cursor; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor); if (idHashPtr == NULL) { goto printid; } cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr); - if (cursorPtr->otherTable != &nameTable) { + if (cursorPtr->otherTable != &dispPtr->cursorNameTable) { goto printid; } - return ((NameKey *) cursorPtr->hashPtr->key.words)->name; + return cursorPtr->hashPtr->key.string; +} + +/* + *---------------------------------------------------------------------- + * + * FreeCursor -- + * + * This procedure is invoked by both Tk_FreeCursor and + * Tk_FreeCursorFromObj; 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. + * + *---------------------------------------------------------------------- + */ + +static void +FreeCursor(cursorPtr) + TkCursor *cursorPtr; /* Cursor to be released. */ +{ + TkCursor *prevPtr; + + cursorPtr->resourceRefCount--; + if (cursorPtr->resourceRefCount > 0) { + return; + } + + Tcl_DeleteHashEntry(cursorPtr->idHashPtr); + prevPtr = (TkCursor *) Tcl_GetHashValue(cursorPtr->hashPtr); + if (prevPtr == cursorPtr) { + if (cursorPtr->nextPtr == NULL) { + Tcl_DeleteHashEntry(cursorPtr->hashPtr); + } else { + Tcl_SetHashValue(cursorPtr->hashPtr, cursorPtr->nextPtr); + } + } else { + while (prevPtr->nextPtr != cursorPtr) { + prevPtr = prevPtr->nextPtr; + } + prevPtr->nextPtr = cursorPtr->nextPtr; + } + TkpFreeCursor(cursorPtr); + if (cursorPtr->objRefCount == 0) { + ckfree((char *) cursorPtr); + } } /* @@ -327,32 +519,258 @@ Tk_FreeCursor(display, cursor) Display *display; /* Display for which cursor was allocated. */ Tk_Cursor cursor; /* Identifier for cursor to be released. */ { - IdKey idKey; Tcl_HashEntry *idHashPtr; - register TkCursor *cursorPtr; + TkDisplay *dispPtr = TkGetDisplay(display); - if (!initialized) { + if (!dispPtr->cursorInit) { panic("Tk_FreeCursor called before Tk_GetCursor"); } - idKey.display = display; - idKey.cursor = cursor; - idHashPtr = Tcl_FindHashEntry(&idTable, (char *) &idKey); + idHashPtr = Tcl_FindHashEntry(&dispPtr->cursorIdTable, (char *) cursor); if (idHashPtr == NULL) { panic("Tk_FreeCursor received unknown cursor argument"); } - cursorPtr = (TkCursor *) Tcl_GetHashValue(idHashPtr); - cursorPtr->refCount--; - if (cursorPtr->refCount == 0) { - Tcl_DeleteHashEntry(cursorPtr->hashPtr); - Tcl_DeleteHashEntry(idHashPtr); - TkFreeCursor(cursorPtr); + FreeCursor((TkCursor *) Tcl_GetHashValue(idHashPtr)); +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * 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. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + FreeCursor(GetCursorFromObj(tkwin, objPtr)); +} + +/* + *--------------------------------------------------------------------------- + * + * 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. + * + * 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. + * + *--------------------------------------------------------------------------- + */ + +static void +FreeCursorObjProc(objPtr) + Tcl_Obj *objPtr; /* The object we are releasing. */ +{ + TkCursor *cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + + if (cursorPtr != NULL) { + cursorPtr->objRefCount--; + if ((cursorPtr->objRefCount == 0) + && (cursorPtr->resourceRefCount == 0)) { + ckfree((char *) cursorPtr); + } + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; + } +} + +/* + *--------------------------------------------------------------------------- + * + * DupCursorObjProc -- + * + * 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. + * + *--------------------------------------------------------------------------- + */ + +static void +DupCursorObjProc(srcObjPtr, dupObjPtr) + 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; + + if (cursorPtr != NULL) { + cursorPtr->objRefCount++; } } /* *---------------------------------------------------------------------- * + * 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 + * Tk_GetCursor. + * + * Results: + * 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. + * + *---------------------------------------------------------------------- + */ + +Tk_Cursor +Tk_GetCursorFromObj(tkwin, objPtr) + Tk_Window tkwin; + Tcl_Obj *objPtr; /* The object from which to get pixels. */ +{ + TkCursor *cursorPtr = GetCursorFromObj(tkwin, objPtr); + return cursorPtr->cursor; +} + +/* + *---------------------------------------------------------------------- + * + * 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. + * + * Results: + * 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. + * + *---------------------------------------------------------------------- + */ + +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 + * cursor. */ +{ + TkCursor *cursorPtr; + Tcl_HashEntry *hashPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + if (objPtr->typePtr != &cursorObjType) { + InitCursorObj(objPtr); + } + + cursorPtr = (TkCursor *) objPtr->internalRep.twoPtrValue.ptr1; + if (cursorPtr != NULL) { + if (Tk_Display(tkwin) == cursorPtr->display) { + return cursorPtr; + } + hashPtr = cursorPtr->hashPtr; + } else { + hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, + Tcl_GetString(objPtr)); + if (hashPtr == NULL) { + goto error; + } + } + + /* + * At this point we've got a hash table entry, off of which hang + * one or more TkCursor structures. See if any of them will work. + */ + + for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr); + cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) { + if (Tk_Display(tkwin) != cursorPtr->display) { + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr; + cursorPtr->objRefCount++; + return cursorPtr; + } + } + + error: + panic("GetCursorFromObj called with non-existent cursor!"); + /* + * The following code isn't reached; it's just there to please compilers. + */ + return NULL; +} + +/* + *---------------------------------------------------------------------- + * + * InitCursorObj -- + * + * Bookeeping procedure 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. + * + *---------------------------------------------------------------------- + */ + +static void +InitCursorObj(objPtr) + Tcl_Obj *objPtr; /* The object to convert. */ +{ + Tcl_ObjType *typePtr; + + /* + * Free the old internalRep before setting the new one. + */ + + Tcl_GetString(objPtr); + typePtr = objPtr->typePtr; + if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) { + (*typePtr->freeIntRepProc)(objPtr); + } + objPtr->typePtr = &cursorObjType; + objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL; +} + +/* + *---------------------------------------------------------------------- + * * CursorInit -- * * Initialize the structures used for cursor management. @@ -367,11 +785,11 @@ Tk_FreeCursor(display, cursor) */ static void -CursorInit() +CursorInit(dispPtr) + TkDisplay *dispPtr; /* Display used to store thread-specific data. */ { - initialized = 1; - Tcl_InitHashTable(&nameTable, sizeof(NameKey)/sizeof(int)); - Tcl_InitHashTable(&dataTable, sizeof(DataKey)/sizeof(int)); + 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 @@ -379,6 +797,66 @@ CursorInit() * machines. */ - Tcl_InitHashTable(&idTable, (sizeof(Display *) + sizeof(Tk_Cursor)) - /sizeof(int)); + /* + * 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: + */ + + Tcl_InitHashTable(&dispPtr->cursorIdTable, TCL_ONE_WORD_KEYS); + + dispPtr->cursorInit = 1; +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugCursor -- + * + * This procedure 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. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +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. */ +{ + TkCursor *cursorPtr; + Tcl_HashEntry *hashPtr; + Tcl_Obj *resultPtr, *objPtr; + TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr; + + resultPtr = Tcl_NewObj(); + hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable, name); + if (hashPtr != NULL) { + cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr); + if (cursorPtr == NULL) { + panic("TkDebugCursor found empty hash table entry"); + } + for ( ; (cursorPtr != NULL); cursorPtr = cursorPtr->nextPtr) { + objPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(cursorPtr->resourceRefCount)); + Tcl_ListObjAppendElement(NULL, objPtr, + Tcl_NewIntObj(cursorPtr->objRefCount)); + Tcl_ListObjAppendElement(NULL, resultPtr, objPtr); + } + } + return resultPtr; } |