* tests/menu.test:

	* generic/tk3d.c:
	* generic/tkColor.c:
	* generic/tkCursor.c: corrected handling of 3DBorder, Cursor and
	Color objects on multiple screens. [Bug: 5454]

4 files changed, 94 insertions, 73 deletions

diff --git a/generic/tk3d.c b/generic/tk3d.c
index 805c6bc..5147e95 100644
--- a/generic/tk3d.c
+++ b/generic/tk3d.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tk3d.c,v 1.7 2000/05/10 00:09:38 ericm Exp $
+ * RCS: @(#) $Id: tk3d.c,v 1.8 2000/05/11 22:37:06 hobbs Exp $
  */
 
 #include "tk3d.h"
@@ -502,6 +502,7 @@ Tk_Free3DBorderFromObj(tkwin, objPtr)
     Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
 {
     Tk_Free3DBorder(Tk_Get3DBorderFromObj(tkwin, objPtr));
+    FreeBorderObjProc(objPtr);
 }
 
 /*
@@ -1268,37 +1269,46 @@ Tk_Get3DBorderFromObj(tkwin, objPtr)
 	InitBorderObj(objPtr);
     }
 
-    borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
-    if (borderPtr != NULL) {
-	if ((borderPtr->resourceRefCount > 0)
-		&& (Tk_Screen(tkwin) == borderPtr->screen)
-		&& (Tk_Colormap(tkwin) == borderPtr->colormap)) {
-	    /*
-	     * The object already points to the right border structure.
-	     * Just return it.
-	     */
+    /*
+     * If we are lucky (and the user doesn't use too many different
+     * displays, screens, or colormaps...) then the  TkBorder 
+     * structure we need will be cached in the internal
+     * representation of the Tcl_Obj.  Check it out...
+     */
 
-	    return (Tk_3DBorder) borderPtr;
-	}
-	hashPtr = borderPtr->hashPtr;
-	FreeBorderObjProc(objPtr);
-    } else {
-	hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, 
-                Tcl_GetString(objPtr));
-	if (hashPtr == NULL) {
-	    goto error;
-	}
+    borderPtr = (TkBorder *) objPtr->internalRep.twoPtrValue.ptr1;
+    if ((borderPtr != NULL)
+	    && (borderPtr->resourceRefCount > 0)
+	    && (Tk_Screen(tkwin) == borderPtr->screen)
+	    && (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+	/*
+	 * The object already points to the right border structure.
+	 * Just return it.
+	 */
+	return (Tk_3DBorder) borderPtr;
     }
 
     /*
-     * At this point we've got a hash table entry, off of which hang
-     * one or more  TkBorder structures.  See if any of them will work.
+     * If we make it here, it means we aren't so lucky.  Either there
+     * was no cached TkBorder in the Tcl_Obj, or the TkBorder that was
+     * there is for the wrong screen/colormap.  Either way, we have
+     * to search for the right TkBorder.  For each color name, there is
+     * linked list of TkBorder structures, one structure for each 
+     * screen/colormap combination.  The head of the linked list is
+     * recorded in a hash table (where the key is the color name)
+     * attached to the TkDisplay structure.  Walk this list to find
+     * the right TkBorder structure.
      */
 
+    hashPtr = Tcl_FindHashEntry(&dispPtr->borderTable, Tcl_GetString(objPtr));
+    if (hashPtr == NULL) {
+	goto error;
+    }
     for (borderPtr = (TkBorder *) Tcl_GetHashValue(hashPtr);
 	    (borderPtr != NULL); borderPtr = borderPtr->nextPtr) {
 	if ((Tk_Screen(tkwin) == borderPtr->screen)
 		&& (Tk_Colormap(tkwin) == borderPtr->colormap)) {
+	    FreeBorderObjProc(objPtr);
 	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) borderPtr;
 	    borderPtr->objRefCount++;
 	    return (Tk_3DBorder) borderPtr;
diff --git a/generic/tkColor.c b/generic/tkColor.c
index 006e93b..6c4d4e5 100644
--- a/generic/tkColor.c
+++ b/generic/tkColor.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tkColor.c,v 1.6 1999/11/19 22:00:02 hobbs Exp $
+ * RCS: @(#) $Id: tkColor.c,v 1.7 2000/05/11 22:37:06 hobbs Exp $
  */
 
 #include "tkColor.h"
@@ -540,6 +540,7 @@ Tk_FreeColorFromObj(tkwin, objPtr)
     Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
 {
     Tk_FreeColor(Tk_GetColorFromObj(tkwin, objPtr));
+    FreeColorObjProc(objPtr);
 }
 
 /*
@@ -645,38 +646,43 @@ Tk_GetColorFromObj(tkwin, objPtr)
     if (objPtr->typePtr != &colorObjType) {
 	InitColorObj(objPtr);
     }
-
+  
+    /*
+     * First check to see if the internal representation of the object
+     * is defined and is a color that is valid for the current screen
+     * and color map.  If it is, we are done.
+     */
     tkColPtr = (TkColor *) objPtr->internalRep.twoPtrValue.ptr1;
-    if (tkColPtr != NULL) {
-	if ((tkColPtr->resourceRefCount > 0)
-		&& (Tk_Screen(tkwin) == tkColPtr->screen)
-		&& (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
-	    /*
-	     * The object already points to the right TkColor structure.
-	     * Just return it.
-	     */
-
-	    return (XColor *) tkColPtr;
-	}
-	hashPtr = tkColPtr->hashPtr;
-	FreeColorObjProc(objPtr);
-    } else {
-	hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, 
-                Tcl_GetString(objPtr));
-	if (hashPtr == NULL) {
-	    goto error;
-	}
+    if ((tkColPtr != NULL)
+	    && (tkColPtr->resourceRefCount > 0)
+	    && (Tk_Screen(tkwin) == tkColPtr->screen)
+	    && (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+	/*
+	 * The object already points to the right TkColor structure.
+	 * Just return it.
+	 */
+
+	return (XColor *) tkColPtr;
     }
 
     /*
-     * At this point we've got a hash table entry, off of which hang
-     * one or more TkColor structures.  See if any of them will work.
+     * If we reach this point, it means that the TkColor structure
+     * that we have cached in the internal representation is not valid
+     * for the current screen and colormap.  But there is a list of
+     * other TkColor structures attached to the TkDisplay.  Walk this
+     * list looking for the right TkColor structure.
      */
 
+    hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, 
+	    Tcl_GetString(objPtr));
+    if (hashPtr == NULL) {
+	goto error;
+    }
     for (tkColPtr = (TkColor *) Tcl_GetHashValue(hashPtr);
 	    (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
 	if ((Tk_Screen(tkwin) == tkColPtr->screen)
 		&& (Tk_Colormap(tkwin) == tkColPtr->colormap)) {
+	    FreeColorObjProc(objPtr);
 	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) tkColPtr;
 	    tkColPtr->objRefCount++;
 	    return (XColor *) tkColPtr;
diff --git a/generic/tkCursor.c b/generic/tkCursor.c
index c8e5588..eab40e8 100644
--- a/generic/tkCursor.c
+++ b/generic/tkCursor.c
@@ -11,7 +11,7 @@
  * 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.4 1999/09/02 17:02:28 hobbs Exp $
+ * RCS: @(#) $Id: tkCursor.c,v 1.5 2000/05/11 22:37:06 hobbs Exp $
  */
 
 #include "tkPort.h"
@@ -561,6 +561,7 @@ Tk_FreeCursorFromObj(tkwin, objPtr)
     Tcl_Obj *objPtr;		/* The Tcl_Obj * to be freed. */
 {
     FreeCursor(GetCursorFromObj(tkwin, objPtr));
+    FreeCursorObjProc(objPtr);
 }
 
 /*
@@ -696,28 +697,31 @@ GetCursorFromObj(tkwin, objPtr)
 	InitCursorObj(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.
+     */
     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;
-	}
+    if ((cursorPtr != NULL) && (Tk_Display(tkwin) == cursorPtr->display)) {
+	return cursorPtr;
     }
 
     /*
-     * 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.
+     * If we get to here, it means the cursor we need is not in the cache.
+     * Try to look up the cursor in the TkDisplay structure of the window.
      */
 
+    hashPtr = Tcl_FindHashEntry(&dispPtr->cursorNameTable,
+	    Tcl_GetString(objPtr));
+    if (hashPtr == NULL) {
+	goto error;
+    }
     for (cursorPtr = (TkCursor *) Tcl_GetHashValue(hashPtr);
 	    cursorPtr != NULL; cursorPtr = cursorPtr->nextPtr) {
 	if (Tk_Display(tkwin) == cursorPtr->display) {
+	    FreeCursorObjProc(objPtr);
 	    objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) cursorPtr;
 	    cursorPtr->objRefCount++;
 	    return cursorPtr;
diff --git a/tests/menu.test b/tests/menu.test
index 7b8ba02..4b346ac 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: menu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $
+# RCS: @(#) $Id: menu.test,v 1.4 2000/05/11 22:37:05 hobbs Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -2438,20 +2438,21 @@ test menu-33.1 {menu vs command hiding} {
 
 # menu-34 MenuInit only called at boot time
 
+# creating menus on two different screens then deleting the
+# menu from the first screen crashes Tk8.3.1
+#
+test menu-35.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} {
+    if {[info exists ::env(TK_ALT_DISPLAY)]} {
+	toplevel .one
+	menu .one.m
+	toplevel .two -screen $::env(TK_ALT_DISPLAY)
+	menu .two.m
+	destroy .one
+	destroy .two
+    }
+} {}
+
 # cleanup
 deleteWindows
 ::tcltest::cleanupTests
 return
-
-
-
-
-
-
-
-
-
-
-
-
-