view release on metacpan or  search on metacpan

MDI/Menu.ala.pm  view on Meta::CPAN

package Tk::MDI::Menu;

use strict;

sub new {
    my $self  = shift;
    my $class = ref($self) || $self;

    my $obj = bless {} => $class;

    my %args = @_;
    $obj->{PARENT}    = $args{-parent};
    $obj->{PARENTOBJ} = $args{-parentobj};
    $obj->{MW}        = $args{-mw};

    $obj->_createMenuBar;
    $obj->_populateMenuBar;

    return $obj;
}

sub _createMenuBar {
    my $obj = shift;

    if (defined (my $menu = $obj->{MW}->cget('-menu'))) {
	$obj->{MENU} = $menu;
    } else {
	$obj->{MENU} = $obj->{MW}->Menu(qw/-type menubar/);
	$obj->{MW}->configure(-menu => $obj->{MENU});
    }
}

sub _populateMenuBar {
    my $obj = shift;

    $obj->{CASCADEMENU} = $obj->{MW}->Menu(-tearoff => 0,
					   -postcommand => sub { $obj->_menuPostCommand });

    $obj->{MENU}->add('cascade',
		      -label => 'Window',
		      -menu  => $obj->{CASCADEMENU},
		     );

    $obj->{CASCADEMENU}->command(-label => 'Tile Horizontally', -command => [\&_tile, 'h', $obj]);
    $obj->{CASCADEMENU}->command(-label => 'Tile Vertically',   -command => [\&_tile, 'v', $obj]);
    $obj->{CASCADEMENU}->command(-label => 'Cascade',           -command => [\&_cascade,   $obj]);
    $obj->{CASCADEMENU}->command(-label => 'Minimize All',     -command => [\&_minimizeAll,   $obj]);
    $obj->{CASCADEMENU}->command(-label => 'Restore All',     -command => [\&_restoreAll,   $obj]);
    $obj->{CASCADEMENU}->separator;

    $obj->{INDEX}          = 1;   # why do I start from 1 not 0???
    $obj->{WINDOWSLISTED}  = 0;
}

sub _newWindow {
    $_[0]->newWindow;
}

sub _tile {
    $_[1]->{PARENTOBJ}->_tile($_[0]);
}

sub _cascade {
    $_[0]->{PARENTOBJ}->_cascade($_[0]);
}

sub _minimizeAll {
    $_[0]->{PARENTOBJ}->_minimizeAll($_[0]);
}