summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog9
-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
8 files changed, 454 insertions, 19 deletions
diff --git a/ChangeLog b/ChangeLog
index c373d06..ff7e0fa 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2004-10-05 Jeff Hobbs <jeffh@ActiveState.com>
+
+ 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]
+
2004-09-24 Don Porter <dgp@users.sourceforge.net>
* generic/tkCursor.c: Add missing initialization in debug routine.
diff --git a/generic/tkInt.h b/generic/tkInt.h
index 4cf39d5..72782ed 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.56.2.1 2003/10/13 03:30:05 hobbs Exp $
+ * RCS: $Id: tkInt.h,v 1.56.2.2 2004/10/05 22:27:26 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 9e17a9d..d1477f0 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.7.2.4 2004/07/25 01:57:41 wolfsuit Exp $
+ * RCS: @(#) $Id: tkMacOSXWm.c,v 1.7.2.5 2004/10/05 22:27:26 hobbs Exp $
*/
#include <Carbon/Carbon.h>
@@ -129,6 +129,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[]));
@@ -542,7 +545,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",
@@ -551,7 +555,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,
@@ -630,6 +635,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:
@@ -1733,6 +1740,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 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 ...?"}}
diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c
index f9f4cc5..1d5a7fa 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.36.2.2 2004/08/10 18:14:18 jenglish Exp $
+ * RCS: @(#) $Id: tkUnixWm.c,v 1.36.2.3 2004/10/05 22:27:27 hobbs Exp $
*/
#include "tkPort.h"
@@ -198,6 +198,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;
@@ -333,6 +335,7 @@ static void UpdateGeometryInfo _ANSI_ARGS_((
ClientData clientData));
static void UpdateHints _ANSI_ARGS_((TkWindow *winPtr));
static void UpdateSizeHints _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,
@@ -394,6 +397,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[]));
@@ -472,6 +478,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);
}
@@ -496,6 +505,10 @@ void TkWmCleanup(dispPtr)
}
ckfree((char *) wmPtr);
}
+ if (dispPtr->iconDataPtr != NULL) {
+ ckfree(dispPtr->iconDataPtr);
+ dispPtr->iconDataPtr = NULL;
+ }
}
/*
@@ -638,6 +651,7 @@ TkWmMapWindow(winPtr)
Tcl_DStringFree(&ds);
TkWmSetClass(winPtr);
+ UpdatePhotoIcon(winPtr);
if (wmPtr->iconName != NULL) {
Tcl_UtfToExternalDString(NULL, wmPtr->iconName, -1, &ds);
@@ -798,6 +812,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);
}
@@ -968,7 +985,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",
@@ -977,7 +995,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,
@@ -1069,6 +1088,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:
@@ -2058,6 +2079,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"
@@ -4257,6 +4419,42 @@ UpdateSizeHints(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 acb0bcf..441f83e 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.54.2.13 2004/09/23 01:49:08 hobbs Exp $
+ * RCS: @(#) $Id: tkWinWm.c,v 1.54.2.14 2004/10/05 22:27:28 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"
generated by cgit v0.12 at 2024-11-02 07:08:03 (GMT)