view release on metacpan or  search on metacpan

MDI/Menu.bad.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 Horizontal', -command => [\&_tile, 'h', $obj]);
	$obj->{CASCADEMENU}->command(-label => 'Tile Vertical',   -command => [\&_tile, 'v', $obj]);
	$obj->{CASCADEMENU}->command(-label => 'Cascade',         -command => [\&_cascade,   $obj]);
	$obj->{CASCADEMENU}->command(-label => 'Iconify All',     -command => [\&_iconifyAll,   $obj]);
	$obj->{CASCADEMENU}->command(-label => 'Restore All',     -command => [\&_restoreAll,   $obj]);
	$obj->{CASCADEMENU}->separator;

	$obj->{INDEX} = 1;
}

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

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

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

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