diff options
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | generic/tkFrame.c | 44 | ||||
| -rw-r--r-- | generic/tkImage.c | 17 | ||||
| -rw-r--r-- | generic/tkInt.decls | 7 | ||||
| -rw-r--r-- | generic/tkIntDecls.h | 10 | ||||
| -rw-r--r-- | generic/tkStubInit.c | 3 | ||||
| -rw-r--r-- | tests/image.test | 17 |
7 files changed, 100 insertions, 9 deletions
@@ -1,3 +1,14 @@ +2003-01-22 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * generic/tkFrame.c (TkToplevelWindowForCommand): Added way of + mapping from command names to tkwins-for-toplevels. + * generic/tkImage.c (Tk_ImageObjCmd): Added check to make sure + that you're not creating an image named the same as .'s command, + which refixes 220891, even when the name of the command has been + changed with 'rename'. The error message is better too. + * tests/image.test (image-1.10,image-1.11): Updated to match new + error message and added test for the rename case. + 2003-01-19 Jeff Hobbs <jeffh@ActiveState.com> * generic/tkImage.c (DeleteImage): delete the image's entry in the diff --git a/generic/tkFrame.c b/generic/tkFrame.c index 63e8245..f4f0a53 100644 --- a/generic/tkFrame.c +++ b/generic/tkFrame.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkFrame.c,v 1.14 2003/01/03 22:43:45 hobbs Exp $ + * RCS: @(#) $Id: tkFrame.c,v 1.15 2003/01/22 14:32:59 dkf Exp $ */ #include "default.h" @@ -1933,3 +1933,45 @@ FrameLostSlaveProc(clientData, tkwin) } FrameWorldChanged((ClientData) framePtr); } + +/* + *-------------------------------------------------------------- + * + * TkToplevelWindowFromCommandToken -- + * + * If the given command name to the command for a toplevel window + * in the given interpreter, return the tkwin for that toplevel + * window. Note that this lookup can't be done using the + * standard tkwin internal table because the command might have + * been renamed. + * + * Results: + * A Tk_Window token, or NULL if the name does not refer to a + * toplevel window. + * + * Side effects: + * None. + * + *-------------------------------------------------------------- + */ + +Tk_Window +TkToplevelWindowForCommand(interp, cmdName) + Tcl_Interp *interp; + CONST char *cmdName; +{ + Tcl_CmdInfo cmdInfo; + Frame *framePtr; + + if (Tcl_GetCommandInfo(interp, cmdName, &cmdInfo) == 0) { + return NULL; + } + if (cmdInfo.objProc != FrameWidgetObjCmd) { + return NULL; + } + framePtr = (Frame *) cmdInfo.objClientData; + if (framePtr->type != TYPE_TOPLEVEL) { + return NULL; + } + return framePtr->tkwin; +} diff --git a/generic/tkImage.c b/generic/tkImage.c index 3312aef..feb65ab 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.18 2003/01/19 09:50:01 hobbs Exp $ + * RCS: @(#) $Id: tkImage.c,v 1.19 2003/01/22 14:32:59 dkf Exp $ */ #include "tkInt.h" @@ -237,8 +237,23 @@ Tk_ImageObjCmd(clientData, interp, objc, objv) name = idString; firstOption = 3; } else { + TkWindow *topWin; + name = arg; firstOption = 4; + /* + * Need to check if the _command_ that we are about to + * create is the name of the current master widget + * command (normally "." but could have been renamed) + * and fail in that case before a really nasty and + * hard to stop crash happens. + */ + topWin = (TkWindow *) TkToplevelWindowForCommand(interp, name); + if (topWin != NULL && winPtr->mainPtr->winPtr == topWin) { + Tcl_AppendResult(interp, "images may not be named the ", + "same as the main window", (char *) NULL); + return TCL_ERROR; + } } /* diff --git a/generic/tkInt.decls b/generic/tkInt.decls index 1b105ae..951bb45 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tkInt.decls,v 1.32 2002/12/08 00:46:51 hobbs Exp $ +# RCS: @(#) $Id: tkInt.decls,v 1.33 2003/01/22 14:32:59 dkf Exp $ library tk @@ -668,6 +668,11 @@ declare 147 generic { void TkStylePkgFree (TkMainInfo *mainPtr) } +declare 148 generic { + Tk_Window TkToplevelWindowForCommand(Tcl_Interp *interp, + CONST char *cmdName) +} + ############################################################################## # Define the platform specific internal Tcl interface. These functions are diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index 88ca960..d50dab4 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -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: tkIntDecls.h,v 1.21 2002/08/31 06:12:20 das Exp $ + * RCS: @(#) $Id: tkIntDecls.h,v 1.22 2003/01/22 14:33:00 dkf Exp $ */ #ifndef _TKINTDECLS @@ -556,6 +556,9 @@ EXTERN void TkSubtractRegion _ANSI_ARGS_((TkRegion sra, EXTERN void TkStylePkgInit _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 147 */ EXTERN void TkStylePkgFree _ANSI_ARGS_((TkMainInfo * mainPtr)); +/* 148 */ +EXTERN Tk_Window TkToplevelWindowForCommand _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * cmdName)); typedef struct TkIntStubs { int magic; @@ -830,6 +833,7 @@ typedef struct TkIntStubs { #endif /* MAC_OSX_TK */ void (*tkStylePkgInit) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 146 */ void (*tkStylePkgFree) _ANSI_ARGS_((TkMainInfo * mainPtr)); /* 147 */ + Tk_Window (*tkToplevelWindowForCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName)); /* 148 */ } TkIntStubs; #ifdef __cplusplus @@ -1535,6 +1539,10 @@ extern TkIntStubs *tkIntStubsPtr; #define TkStylePkgFree \ (tkIntStubsPtr->tkStylePkgFree) /* 147 */ #endif +#ifndef TkToplevelWindowForCommand +#define TkToplevelWindowForCommand \ + (tkIntStubsPtr->tkToplevelWindowForCommand) /* 148 */ +#endif #endif /* defined(USE_TK_STUBS) && !defined(USE_TK_STUB_PROCS) */ diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index e2bc17a..259baf3 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkStubInit.c,v 1.40 2002/12/08 00:46:51 hobbs Exp $ + * RCS: @(#) $Id: tkStubInit.c,v 1.41 2003/01/22 14:33:00 dkf Exp $ */ #include "tkInt.h" @@ -328,6 +328,7 @@ TkIntStubs tkIntStubs = { #endif /* MAC_OSX_TK */ TkStylePkgInit, /* 146 */ TkStylePkgFree, /* 147 */ + TkToplevelWindowForCommand, /* 148 */ }; TkIntPlatStubs tkIntPlatStubs = { diff --git a/tests/image.test b/tests/image.test index 384c38a..dd5d3dd 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.7 2002/07/13 21:52:34 dgp Exp $ +# RCS: @(#) $Id: image.test,v 1.8 2003/01/22 14:32:59 dkf Exp $ package require tcltest 2.1 namespace import -force tcltest::configure @@ -73,7 +73,7 @@ test image-1.9 {Tk_ImageCmd procedure, "create" option} testImageType { eval image delete [image names] list [catch {image create test -badName foo} msg] $msg [image names] } {1 {bad option name "-badName"} {}} -test image-1.10 {Tk_ImageCmd procedure, "create" option with "." as name} { +test image-1.10 {Tk_ImageCmd procedure, "create" option with same name as main window} { set script [makeFile { update puts [list [catch {image create photo .} msg] $msg] @@ -82,8 +82,17 @@ test image-1.10 {Tk_ImageCmd procedure, "create" option with "." as name} { set x [list [catch {exec [interpreter] <$script} msg] $msg] removeFile script set x -} {0 {1 {this isn't a Tk applicationNULL main window}}} -# I don't like the error message! +} {0 {1 {images may not be named the same as the main window}}} +test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} { + set script [makeFile { + update + puts [list [catch {rename . foo;image create photo foo} msg] $msg] + exit + } script] + set x [list [catch {exec [interpreter] <$script} msg] $msg] + removeFile script + set x +} {0 {1 {images may not be named the same as the main window}}} test image-2.1 {Tk_ImageCmd procedure, "delete" option} { list [catch {image delete} msg] $msg |