Subject: | Tk::OlWm on wrapper window |
Date: | Fri, 10 Feb 2012 09:16:37 +1100 |
To: | bug-Tk-Contrib [...] rt.cpan.org |
From: | Kevin Ryde <user42 [...] zip.com.au> |
With Tk::OlWm 1.3 and the debian packaged olwm, the program foo.pl
displays a window with resize handles, where I expected it would not
have handles.
Nosing around with xprop etc I believe Tk::OlWm is applying the relevant
properties to the main window which is only an application child, not
the actual toplevel window, in the Tk 8.x wrapper window scheme.
The diff below works for me to have the properties on the wrapper
window. That change fixes foo.pl to now have resize handles.
Did Tk::OlWm pre-date the wrapper window thing? I had a suspicion at
one time that Tk::Mwm might be suffering similarly. At any rate the
check with can() can let it work on both older and newer tk.
#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::OlWm;
my $mw = MainWindow->new;
$mw->OL_DECOR(RESIZE => 0);
MainLoop;
exit 0;
--- OlWm.pm.orig 1998-09-22 07:02:17.000000000 +1000
+++ OlWm.pm 2012-02-10 09:09:59.000000000 +1100
@@ -10,6 +10,19 @@
#
# CLOSE FOOTER HEADER RESIZE PIN ICON_NAME
+# Return an XID integer, or no values if not applicable.
+# The wrapper window of toplevels is new in Tk 8.x, allow for past versions
+# without it..
+sub _xid {
+ my ($mw) = @_;
+ if ($mw->can('wrapper')) {
+ my ($xid, $menuheight) = $mw->wrapper;
+ return $xid;
+ } else {
+ return;
+ }
+}
+
sub ADDDEL
{
my ($mw,$atom,$to,$from) = @_;
@@ -23,16 +36,18 @@
{
my $mw = shift;
my $data = $mw->privateData;
+ my @xid = _xid($mw);
foreach my $kind (keys %$data)
{
- $mw->property('set',"_OL_DECOR_$kind",'ATOM',32,[keys %{$data->{$kind}}]);
+ $mw->property('set',"_OL_DECOR_$kind",'ATOM',32,[keys %{$data->{$kind}}],
+ @xid);
}
}
sub Flag
{
my ($name,$mw,$state) = @_;
- $mw->property('set',"_OL_$name",'INTEGER',32,$state);
+ $mw->property('set',"_OL_$name",'INTEGER',32,$state,_xid($mw));
$mw->update if ($mw->IsMapped);
}