view release on metacpan or  search on metacpan

lib/Tcl/pTk/Frame.pm  view on Meta::CPAN

#
# Dummy Frame.pm
#  Needed so 'use base('Tcl::pTk::Frame') works in megawidgets (e.g. SlideSwitch.pm)

package Tcl::pTk::Frame;

our ($VERSION) = ('1.11');

use base ('Tcl::pTk::Derived', 'Tcl::pTk::Widget');

use strict;

# 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.
use strict qw(vars);
use Carp;

#Construct Tcl::pTk::Widget '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');
 $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] = Tcl::pTk::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);