view release on metacpan or  search on metacpan

Multi/Toplevel.pm  view on Meta::CPAN

############################################################
#
# $Header: /var/lib/cvs/Tk_Multi/Multi/Toplevel.pm,v 1.9 2004/10/11 14:54:00 domi Exp $
#
# $Source: /var/lib/cvs/Tk_Multi/Multi/Toplevel.pm,v $
# $Revision: 1.9 $
# $Locker:  $
# 
############################################################

package Tk::Multi::Toplevel ;

use Carp ;

use strict ;
use Tk::Multi::Any ;
require Tk::Toplevel;
require Tk::Derived;

use vars qw(@ISA $VERSION) ;
$VERSION = sprintf "%d.%03d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;

@ISA = qw(Tk::Derived Tk::Toplevel);

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


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

    require Tk::Multi::Manager ;
    require Tk::Multi::Frame ;
    require Tk::Multi::Text ;
    require Tk::ObjScanner ;
    
    $cw->{manager} = delete $args->{-manager} || $cw ;
    $cw->{podName} = delete $args->{-podName} ;
    $cw->{podSection} = delete $args->{-podSection} ;

    my $showDebug = sub 
      { 
        # must not create 2 scanner windows
        my $t = 'internals' ;
        unless (defined $cw->getSlave($t))
          {
            my $f = $cw -> newSlave(type => 'MultiFrame', 
                                    title => $t, 
                                    destroyable => 1);
            $f -> ObjScanner('caller' => $cw->{manager}, destroyable => 0) 
              -> pack(-expand => 1);
          }
      } ;

    # create common menu bar
    my $w_menu = $cw ->
      Frame(-relief => 'raised', -borderwidth => 2) -> pack(-fill => 'x');

    my $fmenu= $w_menu->Menubutton(-text => 'File', -underline => 0) ;
    $fmenu-> pack(-side => 'left' );

    $cw->Advertise('fileMenu' => $fmenu->menu);

    $fmenu->command
      (
       -label => 'close',  
       -command => sub{$cw->destroy;}
      );

    $fmenu->command
      (
       -label => 'show internals...',  
       -command => $showDebug 
      );

    $cw->Advertise('menubar' => $w_menu);

    # load MultiText::manager
    my $mmgr = $cw -> MultiManager 
      ( 
       'title' => 'windows' , 
       'menu' => $w_menu ,