summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog9
-rw-r--r--doc/wm.n24
-rw-r--r--generic/tkInt.h5
-rw-r--r--macosx/tkMacOSXWm.c77
-rw-r--r--tests/unixWm.test19
-rw-r--r--tests/winWm.test15
-rw-r--r--tests/wm.test21
-rw-r--r--unix/tkUnixWm.c204
-rw-r--r--win/tkWinWm.c123
9 files changed, 477 insertions, 20 deletions
diff --git a/ChangeLog b/ChangeLog
index b34b611..be4177d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-10-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ * 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]
+
2004-10-04 Jeff Hobbs <jeffh@ActiveState.com>
* generic/tkTextWind.c (EmbWinDelayedUnmap): Fix init warnings
diff --git a/doc/wm.n b/doc/wm.n
index f31e95d..e479679 100644
--- a/doc/wm.n
+++ b/doc/wm.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: wm.n,v 1.16 2004/09/28 18:54:37 hobbs Exp $
+'\" RCS: @(#) $Id: wm.n,v 1.17 2004/10/05 22:04:44 hobbs Exp $
'\"
.so man.macros
.TH wm n 8.5 Tk "Tk Built-In Commands"
@@ -279,6 +279,28 @@ then the command returns the current icon name for \fIwindow\fR,
or an empty string if no icon name has been specified (in this
case the window manager will normally display the window's title,
as specified with the \fBwm title\fR command).
+.VS 8.5
+.TP
+\fBwm iconphoto \fIwindow\fR ?\fI-default\fR? \fIimage1\fR ?\fIimage2 ...\fR?
+.RS
+Sets the titlebar icon for \fIwindow\fR based on the named photo images.
+If \fI-default\fR is specified, this is applied to all future created
+toplevels as well. The data in the images is taken as a snapshot at the
+time of invocation. If the images are later changed, this is not
+reflected to the titlebar icons. Multiple images are accepted to allow
+different images sizes (eg, 16x16 and 32x32) to be provided.
+.PP
+On Windows, the images are packed into a Windows icon structure.
+This will override an ico specified to \fBwm iconbitmap\fR, and
+vice versa.
+.PP
+On X, the images are arranged into the _NET_WM_ICON X property, which
+most modern window managers support. A \fBwm iconbitmap\fR may exist
+simultaneously.
+.PP
+On Macintosh, this is currently does nothing.
+.VE 8.5
+.RE
.TP
\fBwm iconposition \fIwindow\fR ?\fIx y\fR?
If \fIx\fR and \fIy\fR are specified, they are passed to the window
diff --git a/generic/tkInt.h b/generic/tkInt.h
index b7bc84a..4909404 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.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: tkInt.h,v 1.62 2004/07/05 21:21:52 dkf Exp $
+ * RCS: $Id: tkInt.h,v 1.63 2004/10/05 22:04:44 hobbs Exp $
*/
#ifndef _TKINT
@@ -506,6 +506,9 @@ typedef struct TkDisplay {
* defined in below. */
TkCaret caret; /* information about the caret for this
* display. This is not a pointer. */
+
+ int iconDataSize; /* size of default iconphoto image data */
+ unsigned char *iconDataPtr; /* default iconphoto image data, if set */
} TkDisplay;
/*
diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c
index ae9e799..c53f404 100644
--- a/macosx/tkMacOSXWm.c
+++ b/macosx/tkMacOSXWm.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: tkMacOSXWm.c,v 1.13 2004/08/25 22:23:32 dgp Exp $
+ * RCS: @(#) $Id: tkMacOSXWm.c,v 1.14 2004/10/05 22:04:44 hobbs Exp $
*/
#include <Carbon/Carbon.h>
@@ -125,6 +125,9 @@ static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
TkWindow *winPtr, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int WmIconphotoCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
TkWindow *winPtr, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -538,7 +541,8 @@ Tk_WmObjCmd(
"aspect", "attributes", "client", "colormapwindows",
"command", "deiconify", "focusmodel", "frame",
"geometry", "grid", "group", "iconbitmap",
- "iconify", "iconmask", "iconname", "iconposition",
+ "iconify", "iconmask", "iconname",
+ "iconphoto", "iconposition",
"iconwindow", "maxsize", "minsize", "overrideredirect",
"positionfrom", "protocol", "resizable", "sizefrom",
"stackorder", "state", "title", "transient",
@@ -547,7 +551,8 @@ Tk_WmObjCmd(
WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
- WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME,
+ WMOPT_ICONPHOTO, WMOPT_ICONPOSITION,
WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
@@ -626,6 +631,8 @@ wrongNumArgs:
return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONNAME:
return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPHOTO:
+ return WmIconphotoCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONPOSITION:
return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONWINDOW:
@@ -1637,6 +1644,70 @@ Tcl_Obj *CONST objv[]; /* Argument objects. */
/*
*----------------------------------------------------------------------
*
+ * WmIconphotoCmd --
+ *
+ * This procedure is invoked to process the "wm iconphoto"
+ * Tcl command.
+ * See the user documentation for details on what it does.
+ * Not yet implemented for OS X.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconphotoCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_PhotoHandle photo;
+ int i, width, height, isDefault = 0;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-default? image1 ?image2 ...?");
+ return TCL_ERROR;
+ }
+ if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) {
+ isDefault = 1;
+ if (objc == 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-default? image1 ?image2 ...?");
+ return TCL_ERROR;
+ }
+ }
+ /*
+ * Iterate over all images to retrieve their sizes, in order to allocate a
+ * buffer large enough to hold all images.
+ */
+ for (i = 3 + isDefault; i < objc; i++) {
+ photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i]));
+ if (photo == NULL) {
+ Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]),
+ "\" as iconphoto: not a photo image", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_PhotoGetSize(photo, &width, &height);
+ }
+ /*
+ * This requires implementation for OS X, but we silently return
+ * for now.
+ */
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* WmIconpositionCmd --
*
* This procedure is invoked to process the "wm iconposition"
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 ...?"}}
diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c
index 012f713..8a7568a 100644
--- a/unix/tkUnixWm.c
+++ b/unix/tkUnixWm.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: tkUnixWm.c,v 1.45 2004/08/19 19:39:33 jenglish Exp $
+ * RCS: @(#) $Id: tkUnixWm.c,v 1.46 2004/10/05 22:04:46 hobbs Exp $
*/
#include "tkPort.h"
@@ -197,6 +197,8 @@ typedef struct TkWmInfo {
* property, or NULL. */
int flags; /* Miscellaneous flags, defined below. */
int numTransients; /* number of transients on this window */
+ int iconDataSize; /* size of iconphoto image data */
+ unsigned char *iconDataPtr; /* iconphoto image data, if set */
struct TkWmInfo *nextPtr; /* Next in list of all top-level windows. */
} WmInfo;
@@ -334,6 +336,7 @@ static void UpdateHints _ANSI_ARGS_((TkWindow *winPtr));
static void UpdateSizeHints _ANSI_ARGS_((TkWindow *winPtr,
int newWidth, int newHeight));
static void UpdateTitle _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdatePhotoIcon _ANSI_ARGS_((TkWindow *winPtr));
static void UpdateVRootGeometry _ANSI_ARGS_((WmInfo *wmPtr));
static void UpdateWmProtocols _ANSI_ARGS_((WmInfo *wmPtr));
static void WaitForConfigureNotify _ANSI_ARGS_((TkWindow *winPtr,
@@ -395,6 +398,9 @@ static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
TkWindow *winPtr, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int WmIconphotoCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
TkWindow *winPtr, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -473,6 +479,9 @@ void TkWmCleanup(dispPtr)
if (wmPtr->iconName != NULL) {
ckfree(wmPtr->iconName);
}
+ if (wmPtr->iconDataPtr != NULL) {
+ ckfree(wmPtr->iconDataPtr);
+ }
if (wmPtr->leaderName != NULL) {
ckfree(wmPtr->leaderName);
}
@@ -497,6 +506,10 @@ void TkWmCleanup(dispPtr)
}
ckfree((char *) wmPtr);
}
+ if (dispPtr->iconDataPtr != NULL) {
+ ckfree(dispPtr->iconDataPtr);
+ dispPtr->iconDataPtr = NULL;
+ }
}
/*
@@ -631,6 +644,7 @@ TkWmMapWindow(winPtr)
TkWmSetClass(winPtr);
UpdateTitle(winPtr);
+ UpdatePhotoIcon(winPtr);
if (wmPtr->masterPtr != NULL) {
/*
@@ -784,6 +798,9 @@ TkWmDeadWindow(winPtr)
if (wmPtr->iconName != NULL) {
ckfree(wmPtr->iconName);
}
+ if (wmPtr->iconDataPtr != NULL) {
+ ckfree(wmPtr->iconDataPtr);
+ }
if (wmPtr->hints.flags & IconPixmapHint) {
Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
}
@@ -954,7 +971,8 @@ Tk_WmObjCmd(clientData, interp, objc, objv)
"aspect", "attributes", "client", "colormapwindows",
"command", "deiconify", "focusmodel", "frame",
"geometry", "grid", "group", "iconbitmap",
- "iconify", "iconmask", "iconname", "iconposition",
+ "iconify", "iconmask", "iconname",
+ "iconphoto", "iconposition",
"iconwindow", "maxsize", "minsize", "overrideredirect",
"positionfrom", "protocol", "resizable", "sizefrom",
"stackorder", "state", "title", "transient",
@@ -963,7 +981,8 @@ Tk_WmObjCmd(clientData, interp, objc, objv)
WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
- WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME,
+ WMOPT_ICONPHOTO, WMOPT_ICONPOSITION,
WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
@@ -1055,6 +1074,8 @@ Tk_WmObjCmd(clientData, interp, objc, objv)
return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONNAME:
return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPHOTO:
+ return WmIconphotoCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONPOSITION:
return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONWINDOW:
@@ -2039,6 +2060,147 @@ WmIconnameCmd(tkwin, winPtr, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * WmIconphotoCmd --
+ *
+ * This procedure is invoked to process the "wm iconphoto"
+ * Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconphotoCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Tk_PhotoHandle photo;
+ Tk_PhotoImageBlock block;
+ int i, size = 0, width, height, index = 0, x, y, isDefault = 0;
+ long R, G, B, A;
+ long *iconPropertyData;
+ unsigned char *pixelByte;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-default? image1 ?image2 ...?");
+ return TCL_ERROR;
+ }
+ if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) {
+ isDefault = 1;
+ if (objc == 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-default? image1 ?image2 ...?");
+ return TCL_ERROR;
+ }
+ }
+ /*
+ * Iterate over all images to retrieve their sizes, in order to allocate a
+ * buffer large enough to hold all images.
+ */
+ for (i = 3 + isDefault; i < objc; i++) {
+ photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i]));
+ if (photo == NULL) {
+ Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]),
+ "\" as iconphoto: not a photo image", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_PhotoGetSize(photo, &width, &height);
+ /* We need to cardinals for width & height and one cardinal for each
+ * image pixel. */
+ size += 2 + width * height;
+ }
+ /* We have calculated the size of the data. Try to allocate the needed
+ * memory space. */
+ iconPropertyData = (long *) Tcl_AttemptAlloc(sizeof(long)*size);
+ if (iconPropertyData == NULL) {
+ return TCL_ERROR;
+ }
+ memset(iconPropertyData, 0, sizeof(long)*size);
+
+ for (i = 3 + isDefault; i < objc; i++) {
+ photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i]));
+ if (photo == NULL) {
+ Tcl_Free((char *) iconPropertyData);
+ return TCL_ERROR;
+ }
+ Tk_PhotoGetSize(photo, &width, &height);
+ Tk_PhotoGetImage(photo, &block);
+ /*
+ * Each image data will be placed as an array of 32bit packed
+ * CARDINAL, in a window property named "_NET_WM_ICON":
+ * _NET_WM_ICON
+ *
+ * _NET_WM_ICON CARDINAL[][2+n]/32
+ *
+ * This is an array of possible icons for the client.
+ * This specification does not stipulate what size these icons should
+ * be, but individual desktop environments or toolkits may do so.
+ * The Window Manager MAY scale any of these icons to an appropriate
+ * size.
+ *
+ * This is an array of 32bit packed CARDINAL ARGB with high byte being
+ * A, low byte being B. The first two cardinals are width, height.
+ * Data is in rows, left to right and top to bottom.
+ */
+
+ /*
+ * Encode the image data in the iconPropertyData array.
+ */
+ iconPropertyData[index++] = width;
+ iconPropertyData[index++] = height;
+ for (y = 0; y < height; y++) {
+ for (x = 0; x < width; x++) {
+ R = *(block.pixelPtr + x*block.pixelSize +
+ y*block.pitch + block.offset[0]);
+ G = *(block.pixelPtr + x*block.pixelSize +
+ y*block.pitch + block.offset[1]);
+ B = *(block.pixelPtr + x*block.pixelSize +
+ y*block.pitch + block.offset[2]);
+ A = *(block.pixelPtr + x*block.pixelSize +
+ y*block.pitch + block.offset[3]);
+ pixelByte = (unsigned char *) &iconPropertyData[index];
+ pixelByte[3] = A;
+ pixelByte[2] = R;
+ pixelByte[1] = G;
+ pixelByte[0] = B;
+ index++;
+ }
+ }
+ }
+ if (wmPtr->iconDataPtr != NULL) {
+ ckfree(wmPtr->iconDataPtr);
+ wmPtr->iconDataPtr = NULL;
+ }
+ if (isDefault) {
+ if (winPtr->dispPtr->iconDataPtr != NULL) {
+ ckfree((char *) winPtr->dispPtr->iconDataPtr);
+ }
+ winPtr->dispPtr->iconDataPtr = (unsigned char *) iconPropertyData;
+ winPtr->dispPtr->iconDataSize = size;
+ } else {
+ wmPtr->iconDataPtr = (unsigned char *) iconPropertyData;
+ wmPtr->iconDataSize = size;
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ UpdatePhotoIcon(winPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* WmIconpositionCmd --
*
* This procedure is invoked to process the "wm iconposition"
@@ -4341,6 +4503,42 @@ UpdateTitle(winPtr)
}
/*
+ *--------------------------------------------------------------
+ *
+ * UpdatePhotoIcon --
+ *
+ * This procedure is called to update the window ohoto icon.
+ * It sets the EWMH-defined properties _NET_WM_ICON.
+ *
+ * Side effects:
+ * Properties get changed for winPtr.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+UpdatePhotoIcon(winPtr)
+ TkWindow *winPtr;
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ unsigned char *data = wmPtr->iconDataPtr;
+ int size = wmPtr->iconDataSize;
+
+ if (data == NULL) {
+ data = winPtr->dispPtr->iconDataPtr;
+ size = winPtr->dispPtr->iconDataSize;
+ }
+ if (data != NULL) {
+ /*
+ * Set icon:
+ */
+ XChangeProperty(winPtr->display, wmPtr->wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) winPtr, "_NET_WM_ICON"),
+ XA_CARDINAL, 32, PropModeReplace,
+ (unsigned char *) data, size);
+ }
+}
+
+/*
*----------------------------------------------------------------------
*
* WaitForConfigureNotify --
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index 4dc51d9..f5587b2 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.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: tkWinWm.c,v 1.76 2004/09/23 01:08:11 hobbs Exp $
+ * RCS: @(#) $Id: tkWinWm.c,v 1.77 2004/10/05 22:04:47 hobbs Exp $
*/
#include "tkWinInt.h"
@@ -500,6 +500,9 @@ static int WmIconmaskCmd _ANSI_ARGS_((Tk_Window tkwin,
static int WmIconnameCmd _ANSI_ARGS_((Tk_Window tkwin,
TkWindow *winPtr, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
+static int WmIconphotoCmd _ANSI_ARGS_((Tk_Window tkwin,
+ TkWindow *winPtr, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
static int WmIconpositionCmd _ANSI_ARGS_((Tk_Window tkwin,
TkWindow *winPtr, Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -1351,7 +1354,7 @@ GetIconFromPixmap(dsPtr, pixmap)
int width, height;
Tk_SizeOfBitmap(dsPtr, pixmap, &width, &height);
-
+
icon.fIcon = TRUE;
icon.xHotspot = 0;
icon.yHotspot = 0;
@@ -1368,7 +1371,7 @@ GetIconFromPixmap(dsPtr, pixmap)
DestroyIcon(hIcon);
return NULL;
}
-
+
lpIR->nNumImages = 1;
lpIR->IconImages[0].Width = width;
lpIR->IconImages[0].Height = height;
@@ -1379,7 +1382,7 @@ GetIconFromPixmap(dsPtr, pixmap)
lpIR->IconImages[0].dwNumBytes = 0;
lpIR->IconImages[0].lpXOR = 0;
lpIR->IconImages[0].lpAND = 0;
-
+
titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance));
titlebaricon->iconBlock = lpIR;
titlebaricon->refCount = 1;
@@ -2618,7 +2621,8 @@ Tk_WmObjCmd(clientData, interp, objc, objv)
"aspect", "attributes", "client", "colormapwindows",
"command", "deiconify", "focusmodel", "frame",
"geometry", "grid", "group", "iconbitmap",
- "iconify", "iconmask", "iconname", "iconposition",
+ "iconify", "iconmask", "iconname",
+ "iconphoto", "iconposition",
"iconwindow", "maxsize", "minsize", "overrideredirect",
"positionfrom", "protocol", "resizable", "sizefrom",
"stackorder", "state", "title", "transient",
@@ -2627,7 +2631,8 @@ Tk_WmObjCmd(clientData, interp, objc, objv)
WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS,
WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME,
WMOPT_GEOMETRY, WMOPT_GRID, WMOPT_GROUP, WMOPT_ICONBITMAP,
- WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME, WMOPT_ICONPOSITION,
+ WMOPT_ICONIFY, WMOPT_ICONMASK, WMOPT_ICONNAME,
+ WMOPT_ICONPHOTO, WMOPT_ICONPOSITION,
WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT,
WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM,
WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT,
@@ -2718,6 +2723,8 @@ Tk_WmObjCmd(clientData, interp, objc, objv)
return WmIconmaskCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONNAME:
return WmIconnameCmd(tkwin, winPtr, interp, objc, objv);
+ case WMOPT_ICONPHOTO:
+ return WmIconphotoCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONPOSITION:
return WmIconpositionCmd(tkwin, winPtr, interp, objc, objv);
case WMOPT_ICONWINDOW:
@@ -3914,6 +3921,110 @@ WmIconnameCmd(tkwin, winPtr, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
+ * WmIconphotoCmd --
+ *
+ * This procedure is invoked to process the "wm iconphoto"
+ * Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WmIconphotoCmd(tkwin, winPtr, interp, objc, objv)
+ Tk_Window tkwin; /* Main window of the application. */
+ TkWindow *winPtr; /* Toplevel to work with */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ TkWindow *useWinPtr = winPtr; /* window to apply to (NULL if -default) */
+ Tk_PhotoHandle photo;
+ Tk_PhotoImageBlock block;
+ int i, size, width, height, startObj = 3;
+ BlockOfIconImagesPtr lpIR;
+ WinIconPtr titlebaricon = NULL;
+ HICON hIcon;
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-default? image1 ?image2 ...?");
+ return TCL_ERROR;
+ }
+ /*
+ * Iterate over all images to validate their existence.
+ */
+ if (strcmp(Tcl_GetString(objv[3]), "-default") == 0) {
+ useWinPtr = NULL;
+ startObj = 4;
+ if (objc == 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "window ?-default? image1 ?image2 ...?");
+ return TCL_ERROR;
+ }
+ }
+ for (i = startObj; i < objc; i++) {
+ photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i]));
+ if (photo == NULL) {
+ Tcl_AppendResult(interp, "can't use \"", Tcl_GetString(objv[i]),
+ "\" as iconphoto: not a photo image", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ /* We have calculated the size of the data. Try to allocate the needed
+ * memory space. */
+ size = sizeof(BlockOfIconImages)
+ + (sizeof(ICONIMAGE) * (objc - (startObj+1)));
+ lpIR = (BlockOfIconImagesPtr) Tcl_AttemptAlloc(size);
+ if (lpIR == NULL) {
+ return TCL_ERROR;
+ }
+ ZeroMemory(lpIR, size);
+
+ lpIR->nNumImages = objc - startObj;
+ for (i = startObj; i < objc; i++) {
+ photo = Tk_FindPhoto(interp, Tcl_GetString(objv[i]));
+ Tk_PhotoGetSize(photo, &width, &height);
+ Tk_PhotoGetImage(photo, &block);
+
+ /*
+ * Encode the image data into an HICON.
+ */
+ hIcon = CreateIcon(Tk_GetHINSTANCE(), width, height, 1, 32,
+ NULL, (BYTE *) block.pixelPtr);
+ if (hIcon == NULL) {
+ /* XXX should free up created icons */
+ Tcl_Free((char *) lpIR);
+ Tcl_AppendResult(interp, "failed to create icon for \"",
+ Tcl_GetString(objv[i]), "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ lpIR->IconImages[i-startObj].Width = width;
+ lpIR->IconImages[i-startObj].Height = height;
+ lpIR->IconImages[i-startObj].Colors = 4;
+ lpIR->IconImages[i-startObj].hIcon = hIcon;
+ }
+ titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance));
+ titlebaricon->iconBlock = lpIR;
+ titlebaricon->refCount = 1;
+ if (WinSetIcon(interp, titlebaricon, (Tk_Window) useWinPtr) != TCL_OK) {
+ /* We didn't use the titlebaricon after all */
+ DecrIconRefCount(titlebaricon);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* WmIconpositionCmd --
*
* This procedure is invoked to process the "wm iconposition"