summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog13
-rw-r--r--library/bgerror.tcl4
-rw-r--r--library/clrpick.tcl3
-rw-r--r--library/demos/widget4
-rw-r--r--library/dialog.tcl4
-rw-r--r--library/msgbox.tcl4
-rw-r--r--library/tkfbox.tcl3
-rw-r--r--library/ttk/combobox.tcl6
-rw-r--r--tests/unixWm.test51
-rw-r--r--tests/wm.test4
-rw-r--r--unix/tkUnixWm.c152
11 files changed, 223 insertions, 25 deletions
diff --git a/ChangeLog b/ChangeLog
index dd06354..c075fcb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+2010-01-19 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/bgerror.tcl: [TIP 359]: Extended Window Manager Hints
+ * library/clrpick.tcl: following the freedesktop.org specification
+ * library/demos/widget: are now supported on X11 using a new
+ * library/dialog.tcl: wm attribute called '-type'
+ * library/msgbox.tcl: This feature is now used in the Tk library
+ * library/tkfbox.tcl: functions where appropriate.
+ * library/ttk/combobox.tcl:
+ * tests/unixWm.test:
+ * tests/wm.test:
+ * unix/tkUnixWm.c:
+
2010-01-18 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tkCanvArc.c fix more gcc warnings: missing initializer
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index 54e764e..8a0dd0b 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -11,7 +11,7 @@
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
-# RCS: @(#) $Id: bgerror.tcl,v 1.40 2009/01/11 11:51:39 patthoyts Exp $
+# RCS: @(#) $Id: bgerror.tcl,v 1.41 2010/01/19 01:27:41 patthoyts Exp $
#
namespace eval ::tk::dialog::error {
@@ -146,6 +146,8 @@ proc ::tk::dialog::error::bgerror err {
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $dlg moveableAlert {}
+ } elseif {$windowingsystem eq "x11"} {
+ wm attributes $dlg -type dialog
}
ttk::frame $dlg.bot
diff --git a/library/clrpick.tcl b/library/clrpick.tcl
index 216cdb8..083de84 100644
--- a/library/clrpick.tcl
+++ b/library/clrpick.tcl
@@ -3,7 +3,7 @@
# Color selection dialog for platforms that do not support a
# standard color selection dialog.
#
-# RCS: @(#) $Id: clrpick.tcl,v 1.22 2006/03/17 11:13:15 patthoyts Exp $
+# RCS: @(#) $Id: clrpick.tcl,v 1.23 2010/01/19 01:27:41 patthoyts Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -74,6 +74,7 @@ proc ::tk::dialog::color:: {args} {
destroy $w
}
toplevel $w -class TkColorDialog -screen $sc
+ if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
BuildDialog $w
}
diff --git a/library/demos/widget b/library/demos/widget
index e2c47ce..21bde4f 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -10,7 +10,7 @@ exec wish "$0" ${1+"$@"}
# separate ".tcl" files is this directory, which are sourced by this script as
# needed.
#
-# RCS: @(#) $Id: widget,v 1.58 2009/12/10 11:48:38 dkf Exp $
+# RCS: @(#) $Id: widget,v 1.59 2010/01/19 01:27:41 patthoyts Exp $
package require Tcl 8.5
package require Tk 8.5
@@ -458,6 +458,7 @@ proc positionWindow w {
proc showVars {w args} {
catch {destroy $w}
toplevel $w
+ if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
wm title $w [mc "Variable values"]
set b [ttk::frame $w.frame]
@@ -559,6 +560,7 @@ proc showCode w {
set top .code
if {![winfo exists $top]} {
toplevel $top
+ if {[tk windowingsystem] eq "x11"} {wm attributes $top -type dialog}
set t [frame $top.f]
set text [text $t.text -font fixedFont -height 24 -wrap word \
diff --git a/library/dialog.tcl b/library/dialog.tcl
index 5012823..162ecbe 100644
--- a/library/dialog.tcl
+++ b/library/dialog.tcl
@@ -3,7 +3,7 @@
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
-# RCS: @(#) $Id: dialog.tcl,v 1.25 2010/01/04 21:22:08 patthoyts Exp $
+# RCS: @(#) $Id: dialog.tcl,v 1.26 2010/01/19 01:27:41 patthoyts Exp $
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -74,6 +74,8 @@ proc ::tk_dialog {w title text bitmap default args} {
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
+ } elseif {$windowingsystem eq "x11"} {
+ wm attributes $w -type dialog
}
frame $w.bot
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 41e3960..0f77f7a 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# RCS: @(#) $Id: msgbox.tcl,v 1.39 2009/08/24 21:22:46 dkf Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.40 2010/01/19 01:27:41 patthoyts Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -269,6 +269,8 @@ proc ::tk::MessageBox {args} {
if {$windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
+ } elseif {$windowingsystem eq "x11"} {
+ wm attributes $w -type dialog
}
ttk::frame $w.bot
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index b3c7156..0e091ab 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -10,7 +10,7 @@
# "Directory" option menu. The user can select files by clicking on the
# file icons or by entering a filename in the "Filename:" entry.
#
-# RCS: @(#) $Id: tkfbox.tcl,v 1.75 2009/10/22 10:12:57 dkf Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.76 2010/01/19 01:27:41 patthoyts Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -330,6 +330,7 @@ proc ::tk::dialog::file::Create {w class} {
global tk_library
toplevel $w -class $class
+ if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
pack [ttk::frame $w.contents] -expand 1 -fill both
#set w $w.contents
diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl
index ff41366..20bfc07 100644
--- a/library/ttk/combobox.tcl
+++ b/library/ttk/combobox.tcl
@@ -1,5 +1,5 @@
#
-# $Id: combobox.tcl,v 1.19 2009/11/12 18:17:14 jenglish Exp $
+# $Id: combobox.tcl,v 1.20 2010/01/19 01:27:41 patthoyts Exp $
#
# Combobox bindings.
#
@@ -271,8 +271,7 @@ proc ttk::combobox::PopdownWindow {cb} {
if {![winfo exists $cb.popdown]} {
set poplevel [PopdownToplevel $cb.popdown]
-
- set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame]
+ set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame]
$scrollbar $popdown.sb \
-orient vertical -command [list $popdown.l yview]
@@ -310,6 +309,7 @@ proc ttk::combobox::PopdownToplevel {w} {
default -
x11 {
$w configure -relief flat -borderwidth 0
+ wm attributes $w -type combo
wm overrideredirect $w true
}
win32 {
diff --git a/tests/unixWm.test b/tests/unixWm.test
index c55578b..6f580d8 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.46 2008/10/08 18:57:47 dgp Exp $
+# RCS: @(#) $Id: unixWm.test,v 1.47 2010/01/19 01:27:41 patthoyts Exp $
package require tcltest 2.2
eval tcltest::configure $argv
@@ -2446,7 +2446,7 @@ test unixWm-60.1 {wm attributes - test} -constraints unix -body {
destroy .t
toplevel .t
wm attributes .t
-} -result [list -alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0]
+} -result [list -alpha 1.0 -topmost 0 -zoomed 0 -fullscreen 0 -type {}]
test unixWm-60.2 {wm attributes - test} -constraints unix -body {
destroy .t
@@ -2486,6 +2486,53 @@ test unixWm-61.2 {Tk_WmCmd procedure, "iconphoto" option} unix {
image delete blank16 blank32
} {}
+test unixWm-62.0 {wm attributes -type void} -constraints unix -setup {
+ destroy .t
+ toplevel .t
+} -body {
+ wm attributes .t -type {}
+} -cleanup {
+ destroy .t
+} -result {}
+
+test unixWm-62.1 {wm attributes -type name} -constraints unix -setup {
+ destroy .t
+ toplevel .t
+} -body {
+ wm attributes .t -type dialog
+} -cleanup {
+ destroy .t
+} -result {}
+
+test unixWm-62.1 {wm attributes -type name} -constraints unix -setup {
+ destroy .t
+ toplevel .t
+} -body {
+ tkwait visibility .t
+ wm attributes .t -type dialog
+} -cleanup {
+ destroy .t
+} -result {}
+
+test unixWm-62.2 {wm attributes -type list} -constraints unix -setup {
+ destroy .t
+ toplevel .t
+} -body {
+ wm attributes .t -type {xyzzy dialog}
+} -cleanup {
+ destroy .t
+} -result {}
+
+test unixWm-62.2 {wm attributes -type list} -constraints unix -setup {
+ destroy .t
+ toplevel .t
+} -body {
+ tkwait visibility .t
+ wm attributes .t -type {xyzzy dialog}
+} -cleanup {
+ destroy .t
+} -result {}
+
# cleanup
destroy .t
cleanupTests
diff --git a/tests/wm.test b/tests/wm.test
index 1fd024f..0aa229a 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.47 2010/01/06 09:25:15 dkf Exp $
+# RCS: @(#) $Id: wm.test,v 1.48 2010/01/19 01:27:41 patthoyts Exp $
# This file tests window manager interactions that work across platforms.
# Window manager tests that only work on a specific platform should be placed
@@ -139,7 +139,7 @@ test wm-attributes-1.2.3 {usage} -constraints win -returnCodes error -body {
} -result {wrong # args: should be "wm attributes window ?-alpha ?double?? ?-transparentcolor ?color?? ?-disabled ?bool?? ?-fullscreen ?bool?? ?-toolwindow ?bool?? ?-topmost ?bool??"}
test wm-attributes-1.2.4 {usage} -constraints {unix notAqua} -returnCodes error -body {
wm attributes . _
-} -result {bad attribute "_": must be -alpha, -topmost, -zoomed, or -fullscreen}
+} -result {bad attribute "_": must be -alpha, -topmost, -zoomed, -fullscreen, or -type}
test wm-attributes-1.2.5 {usage} -constraints aqua -returnCodes error -body {
wm attributes . _
} -result {bad attribute "_": must be -alpha, -modified, -notify, or -titlepath}
diff --git a/unix/tkUnixWm.c b/unix/tkUnixWm.c
index adfb31d..e09f66d 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.78 2010/01/06 09:25:15 dkf Exp $
+ * RCS: @(#) $Id: tkUnixWm.c,v 1.79 2010/01/19 01:27:41 patthoyts Exp $
*/
#include "tkUnixInt.h"
@@ -52,12 +52,12 @@ typedef struct {
typedef enum {
WMATT_ALPHA, WMATT_TOPMOST, WMATT_ZOOMED, WMATT_FULLSCREEN,
- _WMATT_LAST_ATTRIBUTE
+ WMATT_TYPE, _WMATT_LAST_ATTRIBUTE
} WmAttribute;
static const char *const WmAttributeNames[] = {
"-alpha", "-topmost", "-zoomed", "-fullscreen",
- NULL
+ "-type", NULL
};
/*
@@ -348,6 +348,8 @@ static void UpdateTitle(TkWindow *winPtr);
static void UpdatePhotoIcon(TkWindow *winPtr);
static void UpdateVRootGeometry(WmInfo *wmPtr);
static void UpdateWmProtocols(WmInfo *wmPtr);
+static int SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr);
+static Tcl_Obj * GetNetWmType(TkWindow *winPtr);
static void SetNetWmState(TkWindow*, const char *atomName, int on);
static void CheckNetWmState(WmInfo *, Atom *atoms, int numAtoms);
static void UpdateNetWmState(WmInfo *);
@@ -1279,6 +1281,10 @@ WmSetAttribute(
}
SetNetWmState(winPtr, "_NET_WM_STATE_ABOVE", wmPtr->reqState.topmost);
break;
+ case WMATT_TYPE:
+ if (TCL_OK != SetNetWmType(winPtr, value))
+ return TCL_ERROR;
+ break;
case WMATT_ZOOMED:
if (Tcl_GetBooleanFromObj(interp, value,
&wmPtr->reqState.zoomed) != TCL_OK) {
@@ -1332,6 +1338,8 @@ WmGetAttribute(
return Tcl_NewBooleanObj(wmPtr->attributes.zoomed);
case WMATT_FULLSCREEN:
return Tcl_NewBooleanObj(wmPtr->attributes.fullscreen);
+ case WMATT_TYPE:
+ return GetNetWmType(winPtr);
case _WMATT_LAST_ATTRIBUTE: /*NOTREACHED*/
break;
}
@@ -5342,6 +5350,130 @@ UpdateHints(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * SetNetWmType --
+ *
+ * Set the extended window manager hints for a toplevel window
+ * to the types provided. The specification states that this
+ * may be a list of window types in preferred order. To permit
+ * for future type definitions, the set of names is unconstrained
+ * and names are converted to upper-case and appended to
+ * "_NET_WM_WINDOW_TYPE_" before being converted to an Atom.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetNetWmType(TkWindow *winPtr, Tcl_Obj *typePtr)
+{
+ Atom typeAtom, *atoms = NULL;
+ WmInfo *wmPtr;
+ TkWindow *wrapperPtr;
+ Tcl_Obj **objv;
+ int objc, n;
+ Tk_Window tkwin = (Tk_Window)winPtr;
+ Tcl_Interp *interp = Tk_Interp(tkwin);
+
+ if (TCL_OK != Tcl_ListObjGetElements(interp, typePtr, &objc, &objv)) {
+ return TCL_ERROR;
+ }
+
+ if (!Tk_HasWrapper(tkwin)) {
+ return TCL_OK; /* error?? */
+ }
+
+ if (objc > 0) {
+ atoms = (Atom *)ckalloc(sizeof(Atom) * objc);
+ }
+
+ for (n = 0; n < objc; ++n) {
+ Tcl_DString ds, dsName;
+ int len;
+ char *name = Tcl_GetStringFromObj(objv[n], &len);
+ Tcl_UtfToUpper(name);
+ Tcl_UtfToExternalDString(NULL, name, len, &dsName);
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, "_NET_WM_WINDOW_TYPE_", 20);
+ Tcl_DStringAppend(&ds, Tcl_DStringValue(&dsName),
+ Tcl_DStringLength(&dsName));
+ Tcl_DStringFree(&dsName);
+ atoms[n] = Tk_InternAtom(tkwin, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+ }
+
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ wrapperPtr = wmPtr->wrapperPtr;
+
+ typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE");
+ XChangeProperty(Tk_Display(tkwin), wrapperPtr->window, typeAtom,
+ XA_ATOM, 32, PropModeReplace, (unsigned char *) atoms, objc);
+
+ ckfree((char *)atoms);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetNetWmType --
+ *
+ * Read the extended window manager type hint from a window
+ * and return as a list of names suitable for use with
+ * SetNetWmType.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetNetWmType(TkWindow *winPtr)
+{
+ Atom typeAtom, actualType, *atoms;
+ int actualFormat;
+ unsigned long n, count, bytesAfter;
+ unsigned char *propertyValue = NULL;
+ long maxLength = 1024;
+ Tk_Window tkwin = (Tk_Window)winPtr;
+ TkWindow *wrapperPtr;
+ Tcl_Obj *typePtr;
+ Tcl_Interp *interp;
+ Tcl_DString ds;
+
+ interp = Tk_Interp(tkwin);
+ typePtr = Tcl_NewListObj(0, NULL);
+
+ if (winPtr->wmInfoPtr->wrapperPtr == NULL) {
+ CreateWrapper(winPtr->wmInfoPtr);
+ }
+ wrapperPtr = winPtr->wmInfoPtr->wrapperPtr;
+
+ typeAtom = Tk_InternAtom(tkwin, "_NET_WM_WINDOW_TYPE");
+ if (Success == XGetWindowProperty(wrapperPtr->display,
+ wrapperPtr->window, typeAtom, 0L, maxLength, False,
+ XA_ATOM, &actualType, &actualFormat, &count,
+ &bytesAfter, &propertyValue)) {
+ atoms = (Atom *)propertyValue;
+ for (n = 0; n < count; ++n) {
+ const char *name = Tk_GetAtomName(tkwin, atoms[n]);
+ if (strncmp("_NET_WM_WINDOW_TYPE_", name, 20) == 0) {
+ Tcl_ExternalToUtfDString(NULL, name+20, -1, &ds);
+ Tcl_UtfToLower(Tcl_DStringValue(&ds));
+ Tcl_ListObjAppendElement(interp, typePtr,
+ Tcl_NewStringObj(Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds)));
+ Tcl_DStringFree(&ds);
+ }
+ }
+ XFree(propertyValue);
+ }
+
+ return typePtr;
+}
+
+/*
*--------------------------------------------------------------
*
* ParseGeometry --
@@ -6670,7 +6802,7 @@ TkpMakeMenuWindow(
WmInfo *wmPtr;
XSetWindowAttributes atts;
TkWindow *wrapperPtr;
- Atom atom;
+ Tcl_Obj *typeObj;
if (!Tk_HasWrapper(tkwin)) {
return;
@@ -6683,22 +6815,18 @@ TkpMakeMenuWindow(
if (typeFlag == TK_MAKE_MENU_TEAROFF) {
atts.override_redirect = False;
atts.save_under = False;
- atom = Tk_InternAtom((Tk_Window) tkwin, "_NET_WM_WINDOW_TYPE_MENU");
+ typeObj = Tcl_NewStringObj("menu", -1);
TkSetTransientFor(tkwin, NULL);
} else {
atts.override_redirect = True;
atts.save_under = True;
if (typeFlag == TK_MAKE_MENU_DROPDOWN) {
- atom = Tk_InternAtom((Tk_Window) tkwin,
- "_NET_WM_WINDOW_TYPE_DROPDOWN_MENU");
+ typeObj = Tcl_NewStringObj("dropdown_menu", -1);
} else {
- atom = Tk_InternAtom((Tk_Window) tkwin,
- "_NET_WM_WINDOW_TYPE_POPUP_MENU");
+ typeObj = Tcl_NewStringObj("popup_menu", -1);
}
}
- XChangeProperty(Tk_Display(tkwin), wrapperPtr->window,
- Tk_InternAtom((Tk_Window) tkwin, "_NET_WM_WINDOW_TYPE"),
- XA_ATOM, 32, PropModeReplace, (unsigned char *) &atom, 1);
+ SetNetWmType((TkWindow *)tkwin, typeObj);
/*
* The override-redirect and save-under bits must be set on the wrapper
generated by cgit v0.12 at 2024-11-07 20:44:54 (GMT)