view release on metacpan or  search on metacpan

Multi/Manager.pm  view on Meta::CPAN

package Tk::Multi::Manager;

use strict;
use vars qw($VERSION @ISA $errno);

use Carp ;
use Tk::Derived;
use Tk::Frame;
use Tk::Adjuster ;
use Tie::IxHash ;
use Tk::Multi::Any ;

@ISA = qw(Tk::Derived Tk::Frame);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

$VERSION = sprintf "%d.%03d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/;

Tk::Widget->Construct('MultiManager');

my $title_num = 0;

sub Populate
  {
    my ($cw,$args) = @_ ;
    Tk::Multi::Any::normalize($cw,$args) ;

    require Tk::Menubutton;

    my $title =  delete $args->{'-title'} || 'display';

    $cw->{trace} = delete $args->{'-trace'};

    my $userMenu = delete $args->{-menu} ;

    unless (defined $userMenu)
      {
        $userMenu = $cw->Frame(-relief => 'raised', -borderwidth => 2);
        $userMenu->pack(-fill => 'x');
      }

    $cw->{menu}= $userMenu -> Menubutton (-text => $title) 
      -> pack(-side => 'left' );

    # add help menu on the right side
    $cw->{help}= $userMenu -> Menubutton (-text => 'Help') 
      -> pack(-side => 'right') ;
 
    # add global help if defined 
    my $help = delete $args->{'-help'} ||
      "If you read this text and if the help menu has no other entry ".
        "than 'global', it means that the user of Tk::Multi did not provide ".
          "any help for the application you're using. Shame on him.";

    $cw->addHelp('global', $help);

    #$cw->{slave} = Tie::IxHash -> new () ;
    my %sHash ;
    $cw->{tiedSlave} = tie %sHash,  'Tie::IxHash' ;
    $cw->{slave} = \%sHash ;

    #my $obj = $cw->{windowFrame} = $cw -> Frame(bg => 'red')
    #  ->pack(qw(-fill both));

    $cw->ConfigSpecs(DEFAULT => [$cw],
                    '-width' => ['SELF'],
                    '-height' => ['SELF'],
) ;
    #$cw->Delegates(DEFAULT => 'SELF' ) ;
    #print "args: ",keys %args,"\n";
    $cw->SUPER::Populate($args) ;
  }