* 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.
	* generic/tkFrame.c (TkToplevelWindowForCommand): Added way of
	mapping from command names to tkwins-for-toplevels.
	* tests/image.test (image-1.10,image-1.11): Updated to match new
	error message and added test for the rename case.
	* generic/tclInt.decls: Made TkToplevelWindowForCommand exported
	privately.

7 files changed, 100 insertions, 9 deletions

diff --git a/ChangeLog b/ChangeLog
index 7c675af..164dd9d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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