Tk::OlWm - Interface to OpenLook properties of toplevel windows.

Tk-Contrib documentation Contained in the Tk-Contrib distribution.

Index

Code Index:

NAME

Top

Tk::OlWm - Interface to OpenLook properties of toplevel windows.

SYNOPSIS

Top

   use Tk::OlWm;

   $toplevel->OL_DECOR( 
                        CLOSE  => flag,
                        FOOTER => flag,
                        HEADER => flag, 
                        RESIZE => flag, 
                        PIN => flag, 
                        ICON_NAME => flag, 
                      );

   $toplevel->OL_WIN_BUSY( flag );

   $toplevel->OL_PIN_STATE( flag );

DESCRIPTION

Top

A simple perl-only module that adds a few methods to Tk::Wm (Tk::Wm) class. These methods manipulate properties of the $toplevel (Tk::Toplevel) to communicate with an OpenLook window manager, e.g. Sun's olwm or olvwm.

In the synopsis above flag is a "boolean" value - i.e. an integer with 0 meaning false and other values meaning true.

All the name => flag pairs are optional.

STATUS

Top

Works for me, it is in 'Contrib' because I cannot support something which has been developed just by dumping properties of Sun applications and guessing.

AUTHOR

Top

Nick Ing-Simmons <nik@tiuk.ti.com>

Tk-Contrib documentation Contained in the Tk-Contrib distribution. 
package Tk::OlWm;

use vars qw($VERSION);
$VERSION = substr(q$Revision: 1.3 $, 10) + 1;

use Tk;
use 5.004;

# Decoration that can be added/deleted 
# 
# CLOSE FOOTER HEADER RESIZE PIN ICON_NAME

sub ADDDEL
{
 my ($mw,$atom,$to,$from) = @_;
 my $data = $mw->privateData;
 $data->{$to} = {} unless exists $data->{$to};
 $data->{$to}->{$atom} = 1;
 $data->{$from}->{$atom} if (exists $data->{$from});
}

sub Update
{
 my $mw = shift;
 my $data = $mw->privateData;
 foreach my $kind (keys %$data)
  {
   $mw->property('set',"_OL_DECOR_$kind",'ATOM',32,[keys %{$data->{$kind}}]);
  }
}

sub Flag
{
 my ($name,$mw,$state) = @_;
 $mw->property('set',"_OL_$name",'INTEGER',32,$state);
 $mw->update if ($mw->IsMapped);
}

sub Tk::Wm::OL_WIN_BUSY
{
 Flag('WIN_BUSY',@_);
}

sub Tk::Wm::OL_PIN_STATE
{
 Flag('PIN_STATE',@_);
}


sub Tk::Wm::OL_DECOR
{
 my ($mw,%args) = @_;
 foreach (keys %args)
  {
   my $atom = "_OL_DECOR_$_";
   if ($args{$_})
    {
     ADDDEL($mw,$atom,'ADD','DEL');
    }
   else
    {
     ADDDEL($mw,$atom,'DEL','ADD');
    }
  }
 Update($mw);
}

1;

__END__