view release on metacpan or  search on metacpan

lib/Prima/CodeManager/Notebooks.pm  view on Meta::CPAN

	my $self  = shift;
	my $page  = shift;

	$self-> insert_page if $self-> {pageCount} == 0;
	$page = $self-> {pageCount} - 1 if $page > $self-> {pageCount} - 1 || $page < 0;
	my $cp = $self-> {widgets}-> [$page];

	for ( @_) {
		next unless $_-> isa('Prima::Widget');
		# $_->add_notification( Enable  => \&_enable  => $self);
		# $_->add_notification( Disable => \&_disable => $self);
		# $_->add_notification( Show    => \&_show    => $self);
		# $_->add_notification( Hide    => \&_hide    => $self);
		my @rec = ( $_, $_-> enabled, $_-> visible, $_-> current, $_-> geometry);
		push( @{$cp}, [@rec]);
		next if $page == $self-> {pageIndex};
		$_-> visible(0);
		$_-> autoEnableChildren(0);
		$_-> enabled(0);
		$_-> geometry(gt::Default);
	}
}

#-----------------------------------------------------------------------------------

sub insert
{
	my $self = shift;
	my $page = defined $self-> {defaultInsertPage} ?

		$self-> {defaultInsertPage} :

		$self-> pageIndex;

	return $self-> insert_to_page( $page, @_);
}

#-----------------------------------------------------------------------------------

sub insert_to_page
{
	my $self  = shift;
	my $page  = shift;
	my $sel   = $self-> selected;
	$page = $self-> {pageCount} - 1 if $page > $self-> {pageCount} - 1 || $page < 0;

	$self-> lock;
	my @ctrls = $self-> SUPER::insert( @_);

	$self-> attach_to_page( $page, @ctrls);
	$ctrls[0]-> select if $sel && scalar @ctrls && $page == $self-> {pageIndex} &&

		$ctrls[0]-> isa('Prima::Widget');
	$self-> unlock;

	return wantarray ? @ctrls : $ctrls[0];
}

#-----------------------------------------------------------------------------------

sub insert_transparent
{
	shift-> SUPER::insert( @_);
}

#-----------------------------------------------------------------------------------

sub contains_widget
{
	my ( $self, $ctrl) = @_;
	my $i;
	my $j;
	my $cptr = $self-> {widgets};

	for ( $i = 0; $i < $self-> {pageCount}; $i++) {
		my $cp = $$cptr[$i];
		my $j = 0;
		for ( @$cp) {
			return ( $i, $j) if $$_[0] == $ctrl;
			$j++;
		}
	}
	return;
}

#-----------------------------------------------------------------------------------

sub widgets_from_page
{
	my ( $self, $page) = @_;
	return if $page < 0 or $page >= $self-> {pageCount};

	my @r;
	push( @r, $$_[0]) for @{$self-> {widgets}-> [$page]};
	return @r;
}

#-----------------------------------------------------------------------------------

sub on_childleave
{
	my ( $self, $widget) = @_;
	$self-> detach_from_page( $widget);
}

#-----------------------------------------------------------------------------------

sub detach_from_page
{
	my ( $self, $ctrl)   = @_;
	my ( $page, $number) = $self-> contains_widget( $ctrl);
	return unless defined $page;
	splice( @{$self-> {widgets}-> [$page]}, $number, 1);
}

#-----------------------------------------------------------------------------------

sub delete_widget
{
	my ( $self, $ctrl)   = @_;
	my ( $page, $number) = $self-> contains_widget( $ctrl);

lib/Prima/CodeManager/Notebooks.pm  view on Meta::CPAN

		$widget-> set( @_ );
		return;
	}
	$number = $self-> {widgets}-> [$page]-> [$number];
	my %profile;
	my $clear_current_flag = 0;

	while ( @_ ) {
		my ( $property, $value) = ( shift, shift );
		if ( $virtual_properties{$property} ) {
			$number-> [ $virtual_properties{ $property } ] = ( $value ? 1 : 0 );
			$clear_current_flag = 1 if $property eq 'current' && $value;
		} else {
			$profile{$property} = $value;
		}
	}

	if ( $clear_current_flag) {
		for ( @{$self-> {widgets}-> [$page]} ) {
			$$_[3] = 0 if $$_[0] != $widget;
		}
	}
	$widget-> set( %profile ) if scalar keys %profile;
}

#-----------------------------------------------------------------------------------

sub defaultInsertPage
{
	$_[0]-> {defaultInsertPage} = $_[1];
}

#-----------------------------------------------------------------------------------

sub pageIndex     {($#_)?($_[0]-> set_page_index   ( $_[1]))    :return $_[0]-> {pageIndex}}
sub pageCount     {($#_)?($_[0]-> set_page_count   ( $_[1]))    :return $_[0]-> {pageCount}}

################################################################################
# TabbedNotebook styles
package tns;
use constant Simple   => 0;
use constant Standard => 1;

################################################################################
# TabbedNotebook orientations
package tno;
use constant Top    => 0;
use constant Bottom => 1;

################################################################################
package Prima::CodeManager::TabbedNotebook;
use vars qw(@ISA %notebookProps);
@ISA = qw(Prima::Widget Prima::CodeManager::Notebook);

use constant DefBorderX		=>	10;
use constant DefBookmarkX	=>	30;
use constant DefTabMultiply	=>	1.4;

%notebookProps = (
	pageCount      => 1, defaultInsertPage=> 1,
	attach_to_page => 1, insert_to_page   => 1, insert         => 1, insert_transparent => 1,
	delete_widget  => 1, detach_from_page => 1, move_widget    => 1, contains_widget    => 1,
	widget_get     => 1, widget_set       => 1, widgets_from_page => 1,
);

for ( keys %notebookProps) {
	eval <<GENPROC;
   sub $_ { return shift-> {notebook}-> $_(\@_); }
GENPROC
}

#-----------------------------------------------------------------------------------

sub profile_default
{
	return {
		%{Prima::CodeManager::Notebook-> profile_default},
		%{$_[ 0]-> SUPER::profile_default},
#		ownerBackColor      => 0,
		ownerBackColor      => 1,
		tabs                => [],
		tabIndex            => 0,
		style               => tns::Standard,
		orientation         => tno::Top,
		tabsetClass         => 'Prima::CodeManager::TabSet',
		tabsetProfile       => {},
		tabsetDelegations   => ['Change'],
		notebookClass       => 'Prima::CodeManager::Notebook',
		notebookProfile     => {},
		notebookDelegations => ['Change'],
	}
}

#-----------------------------------------------------------------------------------

sub init
{
	my $self = shift;
	my %profile = @_;

	my $visible       = $profile{visible};
	my $scaleChildren = $profile{scaleChildren};
	$profile{visible} = 0;
	$self-> {style}    = tns::Standard;
	$self-> {orientation} = tno::Top;
	$self-> {tabs}     = [];

	%profile = $self-> SUPER::init(%profile);

	my @size = $self-> size;
	my $maxh = $self-> font-> height * 2;

	$self-> {tabSet} = $profile{tabsetClass}-> create(
		owner     => $self,
		name      => 'TabSet',
		left      => 0,
		width     => $size[0],
		top       => $size[1],
		growMode  => gm::Ceiling,
		height    => 2 * int (DefTabMultiply * $self-> font-> height),
		buffered  => 1,