home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Configure.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.1 KB  |  56 lines
  1. # Class that handles cget/configure for options that 
  2. # need translating from public form 
  3. # e.g. $cw->configure(-label => 'fred')
  4. # into $cw->subwiget('label')->configure(-text => 'fred')
  5. # Should probably do something clever with regexp's here
  6.  
  7. package Tk::Configure;
  8. use Carp;
  9. use Tk::Pretty;
  10.  
  11. sub new
  12. {
  13.  my ($class,@args) = @_;
  14.  unshift(@args,'configure','cget') if (@args < 3);
  15.  return bless \@args,$class;
  16. }
  17.  
  18. sub cget
  19. {
  20.  croak("Wrong number of args to cget") unless (@_ == 2);
  21.  my ($alias,$key) = @_;
  22.  my ($set,$get,$widget,@args) = @$alias;
  23.  my @result = $widget->$get(@args);
  24.  return (wantarray) ? @result : $result[0];
  25. }
  26.  
  27. sub configure
  28. {
  29.  my $alias = shift;
  30.  shift if (@_);
  31.  my ($set,$get,$widget,@args) = @$alias;
  32.  my @results;
  33.  eval { @results = $widget->$set(@args,@_) };
  34.  croak($@) if $@;
  35.  return @results;
  36. }
  37.  
  38. *TIESCALAR = \&new;
  39. *TIEHASH   = \&new;
  40.  
  41. sub FETCH
  42. {
  43.  my $alias = shift;
  44.  my ($set,$get,$widget,@args) = @$alias;
  45.  return $widget->$get(@args,@_);
  46. }
  47.  
  48. sub STORE
  49. {
  50.  my $alias = shift;
  51.  my ($set,$get,$widget,@args) = @$alias;
  52.  $widget->$set(@args,@_);
  53. }
  54.  
  55. 1;
  56.