File Coverage

blib/lib/Tk/OlWm.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

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__