From 780c535e9d5a3d6e29f9dd81118a3e690e7856c4 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 8 May 2003 09:35:41 +0000 Subject: Stop deleted images from showing up in the various [image *] operations. Can't delete early though as that removes the link with widgets and image names. --- ChangeLog | 10 ++++++++++ generic/tkImage.c | 39 +++++++++++++++++++++++++++++++++++++-- tests/canvImg.test | 9 +++++---- tests/image.test | 33 +++++++++++++++++++++++---------- 4 files changed, 75 insertions(+), 16 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5dc2681..2a81335 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2003-05-08 Donal K. Fellows + + * tests/image.test (image-15.1): Test to ensure that widgets pick + up image information even if the image is deleted and recreated. + * generic/tkImage.c (Tk_ImageObjCmd): Use the ImageMaster's + deleted flag to stop deleted images from showing up in the various + [image *] operations. Can't delete directly from the table + because that makes us lose the information about what widgets want + to use the image. [Bug #634864] + 2003-04-30 Jeff Hobbs * macosx/tkMacOSXButton.c (TkpDisplayButton): correct typo for diff --git a/generic/tkImage.c b/generic/tkImage.c index feb65ab..651c675 100644 --- a/generic/tkImage.c +++ b/generic/tkImage.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: tkImage.c,v 1.19 2003/01/22 14:32:59 dkf Exp $ + * RCS: @(#) $Id: tkImage.c,v 1.20 2003/05/08 09:35:41 dkf Exp $ */ #include "tkInt.h" @@ -293,6 +293,7 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) (*masterPtr->typePtr->deleteProc)(masterPtr->masterData); masterPtr->typePtr = NULL; } + masterPtr->deleted = 0; } /* @@ -343,11 +344,16 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) char *arg = Tcl_GetString(objv[i]); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg); if (hPtr == NULL) { + deleteAlreadyDeleted: Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", (char *) NULL); return TCL_ERROR; } - DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr)); + masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + if (masterPtr->deleted) { + goto deleteAlreadyDeleted; + } + DeleteImage(masterPtr); } break; } @@ -360,11 +366,15 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) arg = Tcl_GetString(objv[2]); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg); if (hPtr == NULL) { + heightAlreadyDeleted: Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", (char *) NULL); return TCL_ERROR; } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + if (masterPtr->deleted) { + goto heightAlreadyDeleted; + } Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height); break; } @@ -379,11 +389,15 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) arg = Tcl_GetString(objv[2]); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg); if (hPtr == NULL) { + inuseAlreadyDeleted: Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", (char *) NULL); return TCL_ERROR; } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + if (masterPtr->deleted) { + goto inuseAlreadyDeleted; + } if (masterPtr->typePtr != NULL && masterPtr->instancePtr != NULL) { count = 1; } @@ -398,6 +412,10 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) } hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { + masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + if (masterPtr->deleted) { + continue; + } Tcl_AppendElement(interp, Tcl_GetHashKey( &winPtr->mainPtr->imageTable, hPtr)); } @@ -413,11 +431,15 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) arg = Tcl_GetString(objv[2]); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg); if (hPtr == NULL) { + typeAlreadyDeleted: Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", (char *) NULL); return TCL_ERROR; } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + if (masterPtr->deleted) { + goto typeAlreadyDeleted; + } if (masterPtr->typePtr != NULL) { Tcl_SetResult(interp, masterPtr->typePtr->name, TCL_STATIC); } @@ -447,11 +469,15 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) arg = Tcl_GetString(objv[2]); hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg); if (hPtr == NULL) { + widthAlreadyDeleted: Tcl_AppendResult(interp, "image \"", arg, "\" doesn't exist", (char *) NULL); return TCL_ERROR; } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + if (masterPtr->deleted) { + goto widthAlreadyDeleted; + } Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->width); break; } @@ -578,6 +604,9 @@ Tk_GetImage(interp, tkwin, name, changeProc, clientData) if (masterPtr->typePtr == NULL) { goto noSuchImage; } + if (masterPtr->deleted) { + goto noSuchImage; + } imagePtr = (Image *) ckalloc(sizeof(Image)); imagePtr->tkwin = tkwin; imagePtr->display = Tk_Display(tkwin); @@ -926,6 +955,8 @@ DeleteImage(masterPtr) Tcl_DeleteHashEntry(masterPtr->hPtr); Tcl_Release((ClientData) masterPtr->winPtr); ckfree((char *) masterPtr); + } else { + masterPtr->deleted = 1; } } @@ -1032,6 +1063,10 @@ Tk_GetImageMasterData(interp, name, typePtrPtr) return NULL; } masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr); + if (masterPtr->deleted) { + *typePtrPtr = NULL; + return NULL; + } *typePtrPtr = masterPtr->typePtr; return masterPtr->masterData; } diff --git a/tests/canvImg.test b/tests/canvImg.test index e848bf3..ec6fb6b 100644 --- a/tests/canvImg.test +++ b/tests/canvImg.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: canvImg.test,v 1.6 2003/04/01 21:06:18 dgp Exp $ +# RCS: @(#) $Id: canvImg.test,v 1.7 2003/05/08 09:35:41 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -128,13 +128,14 @@ test canvImg-5.1 {DeleteImage procedure} testImageType { .c delete all .c create image 50 100 -image xyzzy -tags i1 update + set names [lsort [image names]] image delete xyzzy set z {} - set names [lsort [image names]] + set names2 [lsort [image names]] .c delete i1 update - list $names $z [lsort [image names]] -} {{foo foo2 xyzzy} {} {foo foo2}} + list $names $names2 $z [lsort [image names]] +} {{foo foo2 xyzzy} {foo foo2} {} {foo foo2}} test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} { .c delete all .c create image 50 100 -tags i1 diff --git a/tests/image.test b/tests/image.test index 45bc42d..7199fc9 100644 --- a/tests/image.test +++ b/tests/image.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: image.test,v 1.9 2003/04/01 21:06:36 dgp Exp $ +# RCS: @(#) $Id: image.test,v 1.10 2003/05/08 09:35:41 dkf Exp $ package require tcltest 2.1 eval tcltest::configure $argv @@ -158,8 +158,8 @@ test image-5.5 {Tk_ImageCmd procedure, "type" option} testImageType { image create test myimage .c create image 50 50 -image myimage image delete myimage - image type myimage -} {} + list [catch {image type myimage} msg] $msg +} {1 {image "myimage" doesn't exist}} test image-6.1 {Tk_ImageCmd procedure, "types" option} { list [catch {image types x} msg] $msg @@ -254,16 +254,17 @@ test image-11.2 {Tk_FreeImage procedure} testImageType { eval image delete [image names] image create test foo -variable x .c create image 50 50 -image foo -tags i1 + set names [image names] image delete foo update - set names [image names] + set names2 [image names] set x {} .c delete i1 pack forget .c pack .c update - list $names [image names] $x -} {foo {} {}} + list $names $names2 [image names] $x +} {foo {} {} {}} # Non-portable, apparently due to differences in rounding: @@ -356,10 +357,8 @@ test image-13.2 {DeleteImage procedure} testImageType { .c create image 90 100 -image foo -tags i2 set x {} image delete foo - lappend x | [image names] | - image delete foo - lappend x | [image names] | -} {{foo free} {foo free} {foo delete} | foo | | foo |} + lappend x | [image names] | [catch {image delete foo} msg] | $msg | [image names] | +} {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |} catch {image delete hidden} set l [image names] @@ -372,6 +371,20 @@ test image-14.1 {image command vs hidden commands} { image delete hidden list [image names] [interp hidden] } [list $l $h] + +eval image delete [image names] +test image-15.1 {deleting image does not make widgets forget about it} { + .c delete all + image create photo foo -width 10 -height 10 + .c create image 10 10 -image foo -tags i1 -anchor nw + update + set x [.c bbox i1] + lappend x [image names] + image delete foo + lappend x [image names] + image create photo foo -width 20 -height 20 + lappend x [.c bbox i1] [image names] +} {10 10 20 20 foo {} {10 10 30 30} foo} destroy .c eval image delete [image names] -- cgit v0.12