diff options
| -rw-r--r-- | generic/tk3d.c | 54 | ||||
| -rw-r--r-- | generic/tkColor.c | 52 | ||||
| -rw-r--r-- | generic/tkCursor.c | 32 | ||||
| -rw-r--r-- | tests/menu.test | 29 |
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 - - - - - - - - - - - - - |