Backport of 8.5 wm iconphoto that added support for Tk photo

	* generic/tkInt.h (TkDisplay):    images as titlebar icons. TIP #159
	* win/tkWinWm.c (WmIconphotoCmd): wm iconphoto ?-default? image1 ...
	* macosx/tkMacOSXWm.c (WmIconphotoCmd): Implemented for Win/Unix,
	* unix/tkUnixWm.c (WmIconphotoCmd):     stubbed out for OS X.
	* tests/wm.test, tests/unixWm.test, tests/winWm.test: [Bug 815751]

3 files changed, 49 insertions, 6 deletions

diff --git a/tests/unixWm.test b/tests/unixWm.test
index da3c328..2985d65 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: unixWm.test,v 1.29.2.2 2003/03/18 16:19:10 dgp Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.29.2.3 2004/10/05 22:27:27 hobbs Exp $
 
 package require tcltest 2.2
 namespace import -force tcltest::configure
@@ -882,7 +882,7 @@ test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} unix {
 
 test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} unix {
     list [catch {wm icon .t} msg] $msg
-} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}
+} {1 {ambiguous option "icon": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}
 test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} unix {
     list [catch {wm iconname .t 12 13} msg] $msg
 } {1 {wrong # args: should be "wm iconname window ?newName?"}}
@@ -1280,7 +1280,7 @@ test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix {
 
 test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} unix {
     list [catch {wm unknown .t} msg] $msg
-} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}
+} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}
 
 catch {destroy .t}
 catch {destroy .icon}
@@ -2404,6 +2404,19 @@ test unixWm-60.2 {wm attributes} unix {
     list [catch {wm attributes .t -foo} msg] $msg
 } {1 {wrong # args: should be "wm attributes window"}}
 
+test unixWm-61.1 {Tk_WmCmd procedure, "iconphoto" option} unix {
+    list [catch {wm iconph .} msg] $msg
+} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}}
+test unixWm-61.2 {Tk_WmCmd procedure, "iconphoto" option} unix {
+    destroy .t
+    toplevel .t
+    image create photo blank16 -width 16 -height 16
+    image create photo blank32 -width 32 -height 32
+    # This should just make blank icons for the window
+    wm iconphoto .t blank16 blank32
+    image delete blank16 blank32
+} {}
+
 # cleanup
 catch {destroy .t}
 ::tcltest::cleanupTests
diff --git a/tests/winWm.test b/tests/winWm.test
index 82e355c..250cf47 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -9,7 +9,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: winWm.test,v 1.9.2.2 2004/09/17 23:45:57 hobbs Exp $
+# RCS: @(#) $Id: winWm.test,v 1.9.2.3 2004/10/05 22:27:27 hobbs Exp $
 
 package require tcltest 2.1
 namespace import -force tcltest::configure
@@ -333,6 +333,19 @@ test winWm-7.4 {UpdateWrapper must maintain focus} win {
     list $res [focus]
 } {.t .t}
 
+test winWm-8.1 {Tk_WmCmd procedure, "iconphoto" option} win {
+    list [catch {wm iconph .} msg] $msg
+} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}}
+test winWm-8.2 {Tk_WmCmd procedure, "iconphoto" option} win {
+    destroy .t
+    toplevel .t
+    image create photo blank16 -width 16 -height 16
+    image create photo blank32 -width 32 -height 32
+    # This should just make blank icons for the window
+    wm iconphoto .t blank16 blank32
+    image delete blank16 blank32
+} {}
+
 destroy .t
 
 # cleanup
diff --git a/tests/wm.test b/tests/wm.test
index 2dcb3a3..9534fa7 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: wm.test,v 1.21.2.1 2004/09/19 00:10:35 hobbs Exp $
+# RCS: @(#) $Id: wm.test,v 1.21.2.2 2004/10/05 22:27:27 hobbs Exp $
 
 # This file tests window manager interactions that work across
 # platforms. Window manager tests that only work on a specific
@@ -51,7 +51,7 @@ test wm-1.1 {Tk_WmObjCmd procedure, miscellaneous errors} {
 
 test wm-1.2 {Tk_WmObjCmd procedure, miscellaneous errors} {
     list [catch {wm foo} msg] $msg
-} {1 {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}
+} {1 {bad option "foo": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}
 
 test wm-1.3 {Tk_WmObjCmd procedure, miscellaneous errors} {
     list [catch {wm command} msg] $msg
@@ -564,6 +564,23 @@ test wm-iconname-2.1 {setting and reading values} {
 } [list {} ThisIconHasAName {}]
 
 
+test wm-iconphoto-1.1 {usage} {
+    list [catch {wm iconphoto} err] $err
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+
+test wm-iconphoto-1.2 {usage} {
+    list [catch {wm iconphoto .} msg] $msg
+} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}}
+test wm-iconphoto-1.3 {usage} {
+    list [catch {wm iconphoto . notanimage} msg] $msg
+} {1 {can't use "notanimage" as iconphoto: not a photo image}}
+test wm-iconphoto-1.4 {usage} {
+    # we currently have no return info
+    list [catch {wm iconphoto . -default} msg] $msg
+} {1 {wrong # args: should be "wm iconphoto window ?-default? image1 ?image2 ...?"}}
+
+# All other iconphoto tests are platform specific
+
 test wm-iconposition-1.1 {usage} {
     list [catch {wm iconposition} err] $err
 } {1 {wrong # args: should be "wm option window ?arg ...?"}}