TIP #359: Extended window manager hints support for X11.

Modern unix window managers use a set of window properties to give
hints as to the purpose of a toplevel window. They then use these
hints to apply various animation and decoration options based on the
type (dialog, menu, tooltip and more).

This patch adds a [wm attributes $w -type] option to control and read
the type hint and makes use of this for the ttk::combobox and the
dialogs raised from the Tk library scripts.

Signed-off-by: Pat Thoyts <patthoyts@users.sourceforge.net>

7 files changed, 19 insertions, 9 deletions

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 {