tools/perl-5.8.0/lib/site_perl/5.8.0/sun4-solaris/Tk/Configure.pm

package Tk::Configure;
use vars qw($VERSION);
$VERSION = '3.010'; # $Id: //depot/Tk8/Tk/Configure.pm#10 $

use Carp;
use Tk::Pretty;


# Class that handles cget/configure for options that
# need translating from public form
# e.g. $cw->configure(-label => 'fred')
# into $cw->subwiget('label')->configure(-text => 'fred')
# Should probably do something clever with regexp's here


sub new
{
 my ($class,@args) = @_;
 unshift(@args,'configure','cget') if (@args < 3);
 return bless \@args,$class;
}

sub cget
{
 croak('Wrong number of args to cget') unless (@_ == 2);
 my ($alias,$key) = @_;
 my ($set,$get,$widget,@args) = @$alias;
 $widget->$get(@args);
}

sub configure
{
 my $alias = shift;
 shift if (@_);
 my ($set,$get,$widget,@args) = @$alias;
 if (wantarray)
  {
   my @results;
   eval { @results = $widget->$set(@args,@_) };
   croak($@) if $@;
   return @results;
  }
 else
  {
   my $results;
   eval { $results = $widget->$set(@args,@_) };
   croak($@) if $@;
   return $results;
  }
}

*TIESCALAR = \&new;
*TIEHASH   = \&new;

sub FETCH
{
 my $alias = shift;
 my ($set,$get,$widget,@args) = @$alias;
 return $widget->$get(@args,@_);
}

sub STORE
{
 my $alias = shift;
 my ($set,$get,$widget,@args) = @$alias;
 $widget->$set(@args,@_);
}

1;