* Merged 8.1 branch into the main trunk

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;
 }