* doc/wm.n (iconphoto): 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]


FossilOrigin-Name: 96b7bb4f893670fa9c634d5ff0ccda037ad686b2

3 files changed, 49 insertions, 6 deletions

diff --git a/tests/unixWm.test b/tests/unixWm.test
index 32d3c76..026f665 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.39 2004/06/24 12:45:44 dkf Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.40 2004/10/05 22:04:45 hobbs Exp $
 
 package require tcltest 2.2
 eval tcltest::configure $argv
@@ -875,7 +875,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?"}}
@@ -1321,7 +1321,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}
@@ -2449,6 +2449,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}
 cleanupTests
diff --git a/tests/winWm.test b/tests/winWm.test
index 51a86f0..03771a5 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.13 2004/09/17 23:26:21 hobbs Exp $
+# RCS: @(#) $Id: winWm.test,v 1.14 2004/10/05 22:04:46 hobbs Exp $
 
 package require tcltest 2.1
 eval tcltest::configure $argv
@@ -330,6 +330,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 110af60..ff75136 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.28 2004/09/19 00:10:25 hobbs Exp $
+# RCS: @(#) $Id: wm.test,v 1.29 2004/10/05 22:04:46 hobbs Exp $
 
 # This file tests window manager interactions that work across
 # platforms. Window manager tests that only work on a specific
@@ -48,7 +48,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
@@ -561,6 +561,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 ...?"}}