view release on metacpan or  search on metacpan

Tk/Frame.pm  view on Meta::CPAN

# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package Tk::Frame;
require Tk::Widget;
require Tk::Derived;
use AutoLoader;
use strict qw(vars);
use Carp;

use base qw(Tk::Derived Tk::Widget);

Construct Tk::Widget 'Frame';

use vars qw($VERSION);
$VERSION = '4.010'; # $Id: //depot/Tkutf8/Tk/Frame.pm#10 $

sub Tk_cmd { \&Tk::frame }

sub CreateOptions
{
 return (shift->SUPER::CreateOptions,'-colormap','-visual','-container')
}

sub Default
{
 my ($cw,$name,$widget)  = @_;
 confess 'No name' unless (defined $name);
 croak 'No widget' unless (defined $widget);
 $cw->Delegates(DEFAULT => $widget);
 $cw->ConfigSpecs(DEFAULT => [$widget]);
 $widget->pack('-expand' => 1, -fill => 'both') unless ($widget->manager);  # Suspect
 $cw->Advertise($name,$widget);
}

sub ConfigDelegate
{
 my ($cw,$name,@skip) = @_;
 my $sw = $cw->Subwidget($name);
 my $sc;
 my %skip = ();
 foreach $sc (@skip)
  {
   $skip{$sc} = 1;
  }
 foreach $sc ($sw->configure)
  {
   my (@info) = @$sc;
   next if (@info == 2);
   my $option = $info[0];
   unless ($skip{$option})
    {
     $option =~ s/^-(.*)/-$name\u$1/;
     $info[0] = Tk::Configure->new($sw,$info[0]);
     pop(@info);
     $cw->ConfigSpecs($option => \@info);
    }
  }
}

sub bind
{my ($cw,@args) = @_;
 $cw->Delegate('bind',@args);
}

sub menu
{my ($cw,@args) = @_;
 $cw->Delegate('menu',@args);
}

sub focus