* doc/image.n: Added documentation for [image inuse] command.

* tests/image.test: Added tests for [image inuse] command.

* generic/tkImage.c (Tk_ImageObjCmd): Added [image inuse] command,
which provides a means for programmers to determine if a given
image is in use by any widgets. [RFE: 3327].

4 files changed, 82 insertions, 24 deletions

diff --git a/ChangeLog b/ChangeLog
index 6ce38d7..0f17c0a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2000-05-15  Eric Melski  <ericm@scriptics.com>
+
+	* doc/image.n: Added documentation for [image inuse] command.
+
+	* tests/image.test: Added tests for [image inuse] command.
+
+	* generic/tkImage.c (Tk_ImageObjCmd): Added [image inuse] command,
+	which provides a means for programmers to determine if a given
+	image is in use by any widgets. [RFE: 3327].
+
 2000-05-14  Eric Melski  <ericm@scriptics.com>
 
 	* doc/clipboard.n: Added documentation for "clipboard get".
diff --git a/doc/image.n b/doc/image.n
index 4c55018..4277ef4 100644
--- a/doc/image.n
+++ b/doc/image.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: image.n,v 1.2 1998/09/14 18:22:57 stanton Exp $
+'\" RCS: @(#) $Id: image.n,v 1.3 2000/05/15 18:21:47 ericm Exp $
 '\" 
 .so man.macros
 .TH image n 4.0 Tk "Tk Built-In Commands"
@@ -54,6 +54,10 @@ the existing instances will use the new image.
 Returns a decimal string giving the height of image \fIname\fR
 in pixels.
 .TP
+\fBimage inuse \fIname\fR
+Returns a boolean value indicating whether or not the image given by
+\fIname\fR is in use by any widgets.
+.TP
 \fBimage names\fR
 Returns a list containing the names of all existing images.
 .TP
diff --git a/generic/tkImage.c b/generic/tkImage.c
index 0c763a1..31ac3bb 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.6 2000/04/25 01:03:06 hobbs Exp $
+ * RCS: @(#) $Id: tkImage.c,v 1.7 2000/05/15 18:21:47 ericm Exp $
  */
 
 #include "tkInt.h"
@@ -157,11 +157,11 @@ Tk_ImageObjCmd(clientData, interp, objc, objv)
     Tcl_Obj *CONST objv[];	/* Argument strings. */
 {
     static char *imageOptions[] = {
-	"create", "delete", "height", "names", "type", "types", "width",
-	(char *) NULL
+	"create", "delete", "height", "inuse", "names", "type", "types",
+	    "width", (char *) NULL
     };
     enum options {
-	IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_NAMES,
+	IMAGE_CREATE, IMAGE_DELETE, IMAGE_HEIGHT, IMAGE_INUSE, IMAGE_NAMES,
 	IMAGE_TYPE, IMAGE_TYPES, IMAGE_WIDTH
     };
     TkWindow *winPtr = (TkWindow *) clientData;
@@ -344,18 +344,46 @@ Tk_ImageObjCmd(clientData, interp, objc, objv)
 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), masterPtr->height);
 	    break;
 	}
+
+	case IMAGE_INUSE: {
+	    int count = 0;
+	    char *arg;
+	    if (objc != 3) {
+		Tcl_WrongNumArgs(interp, 2, objv, "name");
+		return TCL_ERROR;
+	    }
+	    arg = Tcl_GetString(objv[2]);
+	    hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, arg);
+	    if (hPtr == NULL) {
+		Tcl_AppendResult(interp, "image \"", arg,
+			"\" doesn't exist", (char *) NULL);
+		return TCL_ERROR;
+	    }
+	    masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+	    if (masterPtr->typePtr != NULL) {
+		for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+		     imagePtr = imagePtr->nextPtr) {
+		    count = 1;
+		    break;
+		}
+	    }
+	    Tcl_SetBooleanObj(Tcl_GetObjResult(interp), count);
+	    break;
+	}
+
 	case IMAGE_NAMES: {
 	    if (objc != 2) {
 		Tcl_WrongNumArgs(interp, 2, objv, NULL);
 		return TCL_ERROR;
 	    }
-	    for (hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
-		 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+	    hPtr = Tcl_FirstHashEntry(&winPtr->mainPtr->imageTable, &search);
+	    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
 		Tcl_AppendElement(interp, Tcl_GetHashKey(
 		    &winPtr->mainPtr->imageTable, hPtr));
 	    }
 	    break;
 	}
+	
 	case IMAGE_TYPE: {
 	    char *arg;
 	    if (objc != 3) {
diff --git a/tests/image.test b/tests/image.test
index e3f7841..b2abc36 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.3 1999/04/16 01:51:38 stanton Exp $
+# RCS: @(#) $Id: image.test,v 1.4 2000/05/15 18:21:47 ericm Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -36,7 +36,7 @@ test image-1.1 {Tk_ImageCmd procedure, "create" option} {
 } {1 {wrong # args: should be "image option ?args?"}}
 test image-1.2 {Tk_ImageCmd procedure, "create" option} {
     list [catch {image gorp} msg] $msg
-} {1 {bad option "gorp": must be create, delete, height, names, type, types, or width}}
+} {1 {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width}}
 test image-1.3 {Tk_ImageCmd procedure, "create" option} {
     list [catch {image create} msg] $msg
 } {1 {wrong # args: should be "image create type ?name? ?options?"}}
@@ -178,7 +178,21 @@ test image-7.4 {Tk_ImageCmd procedure, "width" option} {
     list $x [image width myimage]
 } {30 60}
 
-test image-8.1 {Tk_ImageChanged procedure} {
+test image-8.1 {Tk_ImageCmd procedure, "inuse" option} {
+    catch {image delete myimage2}
+    image create test myimage2
+    set res {}
+    lappend res [image inuse myimage2]
+    catch {destroy .b}
+    button .b -image myimage2
+    lappend res [image inuse myimage2]
+    catch {destroy .b}
+    image delete myimage2
+    set res
+} [list 0 1]
+    
+
+test image-9.1 {Tk_ImageChanged procedure} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -189,7 +203,7 @@ test image-8.1 {Tk_ImageChanged procedure} {
     update
     set x
 } {{foo display 5 6 7 8 30 30}}
-test image-8.2 {Tk_ImageChanged procedure} {
+test image-9.2 {Tk_ImageChanged procedure} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -202,10 +216,10 @@ test image-8.2 {Tk_ImageChanged procedure} {
     set x
 } {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}
 
-test image-9.1 {Tk_GetImage procedure} {
+test image-10.1 {Tk_GetImage procedure} {
     list [catch {.c create image 100 10 -image bad_name} msg] $msg
 } {1 {image "bad_name" doesn't exist}}
-test image-9.2 {Tk_GetImage procedure} {
+test image-10.2 {Tk_GetImage procedure} {
     image create test mytest
     catch {destroy .l}
     label .l -image mytest
@@ -215,7 +229,7 @@ test image-9.2 {Tk_GetImage procedure} {
     set result
 } {1 {image "mytest" doesn't exist}}
 
-test image-10.1 {Tk_FreeImage procedure} {
+test image-11.1 {Tk_FreeImage procedure} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -229,7 +243,7 @@ test image-10.1 {Tk_FreeImage procedure} {
     update
     list [image names] $x
 } {foo {{foo free} {foo display 0 0 30 15 103 121}}}
-test image-10.2 {Tk_FreeImage procedure} {
+test image-11.2 {Tk_FreeImage procedure} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -247,7 +261,7 @@ test image-10.2 {Tk_FreeImage procedure} {
 
 # Non-portable, apparently due to differences in rounding:
 
-test image-11.1 {Tk_RedrawImage procedure, redisplay area clipping} \
+test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} \
 	{nonPortable} {
     .c delete all
     eval image delete [image names]
@@ -259,7 +273,7 @@ test image-11.1 {Tk_RedrawImage procedure, redisplay area clipping} \
     update
     set x
 } {{foo display 0 0 5 5 50 50}}
-test image-11.2 {Tk_RedrawImage procedure, redisplay area clipping} \
+test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} \
 	{nonPortable} {
     .c delete all
     eval image delete [image names]
@@ -271,7 +285,7 @@ test image-11.2 {Tk_RedrawImage procedure, redisplay area clipping} \
     update
     set x
 } {{foo display 10 0 20 5 30 50}}
-test image-11.3 {Tk_RedrawImage procedure, redisplay area clipping} \
+test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} \
 	{nonPortable} {
     .c delete all
     eval image delete [image names]
@@ -283,7 +297,7 @@ test image-11.3 {Tk_RedrawImage procedure, redisplay area clipping} \
     update
     set x
 } {{foo display 10 10 20 5 30 30}}
-test image-11.4 {Tk_RedrawImage procedure, redisplay area clipping} \
+test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} \
 	{nonPortable} {
     .c delete all
     eval image delete [image names]
@@ -295,7 +309,7 @@ test image-11.4 {Tk_RedrawImage procedure, redisplay area clipping} \
     update
     set x
 } {{foo display 0 10 5 5 50 30}}
-test image-11.5 {Tk_RedrawImage procedure, redisplay area clipping} \
+test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} \
 	{nonPortable} {
     .c delete all
     eval image delete [image names]
@@ -307,7 +321,7 @@ test image-11.5 {Tk_RedrawImage procedure, redisplay area clipping} \
     update
     set x
 } {{foo display 0 0 30 15 70 70}}
-test image-11.6 {Tk_RedrawImage procedure, redisplay area clipping} \
+test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} \
 	{nonPortable} {
     .c delete all
     eval image delete [image names]
@@ -320,7 +334,7 @@ test image-11.6 {Tk_RedrawImage procedure, redisplay area clipping} \
     set x
 } {{foo display 5 5 20 5 30 30}}
 
-test image-12.1 {Tk_SizeOfImage procedure} {
+test image-13.1 {Tk_SizeOfImage procedure} {
     eval image delete [image names]
     image create test foo -variable x
     set result [list [image width foo] [image height foo]]
@@ -328,7 +342,7 @@ test image-12.1 {Tk_SizeOfImage procedure} {
     lappend result [image width foo] [image height foo]
 } {30 15 85 60}
 
-test image-12.2 {DeleteImage procedure} {
+test image-13.2 {DeleteImage procedure} {
     .c delete all
     eval image delete [image names]
     image create test foo -variable x
@@ -345,7 +359,7 @@ catch {image delete hidden}
 set l [image names]
 set h [interp hidden]
 
-test image-13.1 {image command vs hidden commands} {
+test image-14.1 {image command vs hidden commands} {
     catch {image delete hidden}
     image create photo hidden
     interp hide {} hidden
@@ -372,3 +386,5 @@ return
 
 
 
+
+