summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tk3d.c54
-rw-r--r--generic/tkColor.c52
-rw-r--r--generic/tkCursor.c32
-rw-r--r--tests/menu.test29
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
-
-
-
-
-
-
-
-
-
-
-
-
-