Prima::Notebooks - multipage widgets

	my $nb = Prima::TabbedNotebook-> create(
		tabs => [ 'First page', 'Second page', 'Second page' ],
	);
	$nb-> insert_to_page( 1, 'Prima::Button' );
	$nb-> insert_to_page( 2, [
		[ 'Prima::Button', bottom => 10  ],
		[ 'Prima::Button', bottom => 150 ],
	]);
	$nb-> Notebook-> backColor( cl::Green );

	$notebook-> pageIndex(1);
	my $widget = $notebook-> insert_to_page( 0, ... );
	$widget-> visible(0);
	$notebook-> pageIndex(0);

	$widget-> visible(0);

	$notebook-> widget_set( $widget, visible => 0);

#
#  Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
#  All rights reserved.
#
#  Redistribution and use in source and binary forms, with or without
#  modification, are permitted provided that the following conditions
#  are met:
#  1. Redistributions of source code must retain the above copyright
#     notice, this list of conditions and the following disclaimer.
#  2. Redistributions in binary form must reproduce the above copyright
#     notice, this list of conditions and the following disclaimer in the
#     documentation and/or other materials provided with the distribution.
#
#  THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
#  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
#  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
#  ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
#  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
#  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
#  OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
#  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
#  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
#  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
#  SUCH DAMAGE.
#
#  Created by Dmitry Karasik <dk@plab.ku.dk>
#
#  $Id$
use strict;
use Prima::Const;
use Prima::Classes;
use Prima::IntUtils;

package Prima::TabSet;
use vars qw(@ISA);
@ISA = qw(Prima::Widget Prima::MouseScroller);


{
my %RNT = (
	%{Prima::Widget-> notification_types()},
	DrawTab     => nt::Action,
	MeasureTab  => nt::Action,
);

sub notification_types { return \%RNT; }
}

use constant DefGapX   => 10;
use constant DefGapY   => 5;
use constant DefLeftX  => 5;
use constant DefArrowX => 25;

my @warpColors = (
	0x50d8f8, 0x80d8a8, 0x8090f8, 0xd0b4a8, 0xf8fca8,
	0xa890a8, 0xf89050, 0xf8d850, 0xf8b4a8, 0xf8d8a8,
);

sub profile_default
{
	my $def = $_[ 0]-> SUPER::profile_default;
	my $font = $_[ 0]-> get_default_font;
	my %prf = (
		colored          => 1,
		firstTab         => 0,
		focusedTab       => 0,
		height           => $font-> { height} > 14 ? $font-> { height} * 2 : 28,
		ownerBackColor   => 1,
		selectable       => 1,
		selectingButtons => 0,
		tabStop          => 1,
		topMost          => 1,
		tabIndex         => 0,
		tabs             => [],
	);
	@$def{keys %prf} = values %prf;
	return $def;
}


sub init
{
	my $self = shift;
	$self-> {tabIndex} = -1;
	for ( qw( colored firstTab focusedTab topMost lastTab arrows)) { $self-> {$_} = 0; }
	$self-> {tabs}     = [];
	$self-> {widths}   = [];
	my %profile = $self-> SUPER::init(@_);
	for ( qw( colored topMost tabs focusedTab firstTab tabIndex)) { $self-> $_( $profile{ $_}); }
	$self-> recalc_widths;
	$self-> reset;
	return %profile;
}


sub reset
{
	my $self = $_[0];
	my @size = $self-> size;
	my $w = DefLeftX * 2 + DefGapX;
	for ( @{$self-> {widths}}) { $w += $_ + DefGapX; }
	$self-> {arrows} = (( $w > $size[0]) and ( scalar( @{$self-> {widths}}) > 1));
	if ( $self-> {arrows}) {
		my $ft = $self-> {firstTab};
		$w  = DefLeftX * 2 + DefGapX;
		$w += DefArrowX if $ft > 0;
		my $w2 = $w;
		my $la = $ft > 0;
		my $i;
		my $ra = 0;
		my $ww = $self-> {widths};
		for ( $i = $ft; $i < scalar @{$ww}; $i++) {
			$w += DefGapX + $$ww[$i];
			if ( $w + DefGapX + DefLeftX >= $size[0]) {
				$ra = 1;
				$i-- if 
					$i > $ft && 
					$w - $$ww[$i] >= $size[0] - DefLeftX - DefArrowX - DefGapX;
				last;
			}
		}
		$i = scalar @{$self-> {widths}} - 1 
			if $i >= scalar @{$self-> {widths}};
		$self-> {lastTab} = $i;
		$self-> {arrows} = ( $la ? 1 : 0) | ( $ra ? 2 : 0);
	} else {
		$self-> {lastTab} = scalar @{$self-> {widths}} - 1;
	}
}

sub recalc_widths
{
	my $self = $_[0];
	my @w;
	my $i;
	my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(MeasureTab));
	$self-> begin_paint_info;
	$self-> push_event;

	for ( $i = 0; $i < scalar @{$self-> {tabs}}; $i++) {
		my $iw = 0;
		$notifier-> ( @notifyParms, $i, \$iw);
		push ( @w, $iw);
	}

	$self-> pop_event;
	$self-> end_paint_info;
	$self-> {widths}    = [@w];
}

sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return if $self-> {mouseTransaction};
	$self-> clear_event;
	my ( $a, $ww, $ft, $lt) = (
		$self-> {arrows}, $self-> {widths}, $self-> {firstTab}, $self-> {lastTab}
	);

	if (( $a & 1) and ( $x < DefLeftX + DefGapX * 2 + DefArrowX)) {
		$self-> firstTab( $self-> firstTab - 1);
		$self-> capture(1);
		$self-> {mouseTransaction} = -1;
		$self-> scroll_timer_start;
		$self-> scroll_timer_semaphore(0);
		return;
	}

	my @size = $self-> size;
	if (( $a & 2) and ( $x >= $size[0] - DefLeftX - DefGapX * 2 - DefArrowX)) {
		$self-> firstTab( $self-> firstTab + 1);
		$self-> capture(1);
		$self-> {mouseTransaction} = 1;
		$self-> scroll_timer_start;
		$self-> scroll_timer_semaphore(0);
		return;
	}

	my $w = DefLeftX;
	$w += DefGapX + DefArrowX if $a & 1;
	my $i;
	my $found = undef;
	for ( $i = $ft; $i <= $lt; $i++) {
		$found = $i, last if $x < $w + $$ww[$i] + DefGapX;
		$w += $$ww[$i] + DefGapX;
	}
	return unless defined $found;
	
	if ( $found == $self-> {tabIndex}) {
		$self-> focusedTab( $found);
		$self-> focus;
	} else {
		$self-> tabIndex( $found);
	}
}

sub on_mousewheel
{
	my ( $self, $mod, $x, $y, $z) = @_;
	$self-> tabIndex( $self-> tabIndex + (( $z < 0) ? -1 : 1));
	$self-> clear_event;
}

sub on_mouseup
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	return unless $self-> {mouseTransaction};
	
	$self-> capture(0);
	$self-> scroll_timer_stop;
	$self-> {mouseTransaction} = undef;
}


sub on_mousemove
{
	my ( $self, $mod, $x, $y) = @_;
	return unless $self-> {mouseTransaction};
	return unless $self-> scroll_timer_semaphore;

	$self-> scroll_timer_semaphore(0);
	my $ft = $self-> firstTab;
	$self-> firstTab( $ft + $self-> {mouseTransaction});
	$self-> notify(q(MouseUp),1,0,0,0) if $ft == $self-> firstTab;
}

sub on_mouseclick
{
	my $self = shift;
	$self-> clear_event;
	return unless pop;

	$self-> clear_event unless $self-> notify( "MouseDown", @_);
}

sub on_keydown
{
	my ( $self, $code, $key, $mod) = @_;

	if ( $key == kb::Left || $key == kb::Right) {
		$self-> focusedTab( $self-> focusedTab + (( $key == kb::Left) ? -1 : 1));
		$self-> clear_event;
		return;
	}
	
	if ( $key == kb::PgUp || $key == kb::PgDn) {
		$self-> tabIndex( $self-> tabIndex + (( $key == kb::PgUp) ? -1 : 1));
		$self-> clear_event;
		return;
	}

	if ( $key == kb::Home || $key == kb::End) {
		$self-> tabIndex(( $key == kb::Home) ? 0 : scalar @{$self-> {tabs}});
		$self-> clear_event;
		return;
	}
	if ( $key == kb::Space || $key == kb::Enter) {
		$self-> tabIndex( $self-> focusedTab);
		$self-> clear_event;
		return;
	}
}

sub on_paint
{
	my ($self,$canvas) = @_;
	my @clr  = ( $self-> color, $self-> backColor);
	@clr = ( $self-> disabledColor, $self-> disabledBackColor) if ( !$self-> enabled);
	my @c3d  = ( $self-> dark3DColor, $self-> light3DColor);
	my @size = $canvas-> size;

	$canvas-> color( $clr[1]);
	$canvas-> bar( 0, 0, @size);
	my ( $ft, $lt, $a, $ti, $ww, $tm) =
		( $self-> {firstTab}, $self-> {lastTab}, $self-> {arrows}, $self-> {tabIndex},
		$self-> {widths}, $self-> {topMost}
	);
	my $i;
	
	my ( $notifier, @notifyParms) = $self-> get_notify_sub(q(DrawTab));
	$self-> push_event;

	my $atX = DefLeftX;
	$atX += DefArrowX + DefGapX if $a & 1;
	my $atXti = undef;
	for ( $i = $ft; $i <= $lt; $i++) {
		$atX += $$ww[$i] + DefGapX;
	}
	my @colorSet = ( @clr, @c3d);

	$canvas-> clipRect( 0, 0, $size[0] - DefArrowX - DefGapX - DefLeftX, $size[1]) if $a & 2;

	for ( $i = $lt; $i >= $ft; $i--) {
		$atX -= $$ww[$i] + DefGapX;
		$atXti = $atX, next if $i == $ti;
		my @poly = (
			$atX, DefGapY, 
			$atX + DefGapX, $size[1] - DefGapY - 1,
			$atX + DefGapX + $$ww[$i], $size[1] - DefGapY - 1,
			$atX + DefGapX * 2 + $$ww[$i], DefGapY
		);
		@poly[1,3,5,7] = @poly[3,1,7,5] unless $tm;
		$notifier-> ( @notifyParms, $canvas, $i, \@colorSet, \@poly);
	}

	my $swapDraw = ( $ti == $lt) && ( $a & 2);

	goto PaintSelTabBefore if $swapDraw;
PaintEarsThen:
	$canvas-> clipRect( 0, 0, @size) if $a & 2;
	if ( $a & 1) {
		my $x = DefLeftX;
		my @poly = (
			$x, DefGapY, 
			$x + DefGapX, $size[1] - DefGapY - 1,
			$x + DefGapX + DefArrowX, $size[1] - DefGapY - 1,
			$x + DefGapX * 2 + DefArrowX, DefGapY
		);
		@poly[1,3,5,7] = @poly[3,1,7,5] unless $tm;
		$notifier-> ( @notifyParms, $canvas, -1, \@colorSet, \@poly);
	}
	if ( $a & 2) {
		my $x = $size[0] - DefLeftX - DefArrowX - DefGapX * 2;
		my @poly = (
			$x, DefGapY, 
			$x + DefGapX, $size[1] - DefGapY - 1,
			$x + DefGapX + DefArrowX, $size[1] - DefGapY - 1,
			$x + DefGapX * 2 + DefArrowX, DefGapY
		);
		@poly[1,3,5,7] = @poly[3,1,7,5] unless $tm;
		$notifier-> ( @notifyParms, $canvas, -2, \@colorSet, \@poly);
	}

	$canvas-> color( $c3d[0]);
	my @ld = $tm ? ( 0, DefGapY) : ( $size[1] - 0, $size[1] - DefGapY - 1);
	$canvas-> line( $size[0] - 1, $ld[0], $size[0] - 1, $ld[1]);
	
	if ($tm) {
		$canvas-> color( $c3d[1]);
		$canvas-> line( 0, $ld[1], $size[0] - 1, $ld[1]);
		$canvas-> line( 0, $ld[0], 0, $ld[1]);
	} else {
		$canvas-> line( 0, $ld[1], $size[0] - 1, $ld[1]);
		$canvas-> color( $c3d[1]);
		$canvas-> line( 0, $ld[0], 0, $ld[1]);
	}
	
	$canvas-> color( $clr[0]);

	goto EndOfSwappedPaint if $swapDraw;

PaintSelTabBefore:
	if ( defined $atXti) {
		my @poly = (
			$atXti, DefGapY, 
			$atXti + DefGapX, $size[1] - DefGapY - 1,
			$atXti + DefGapX + $$ww[$ti], $size[1] - DefGapY - 1,
			$atXti + DefGapX * 2 + $$ww[$ti], DefGapY
		);
		@poly[1,3,5,7] = @poly[3,1,7,5] unless $tm;
		
		my @poly2 = $tm ? (
			$atXti, DefGapY, 
			$atXti + DefGapX * 2 + $$ww[$ti], DefGapY,
			$atXti + DefGapX * 2 + $$ww[$ti] - 4, 0, 
			$atXti + 4, 0
		) : (
			$atXti, $size[1] - 1 - DefGapY, 
			$atXti + DefGapX * 2 + $$ww[$ti], $size[1] - 1 - DefGapY,
			$atXti + DefGapX * 2 + $$ww[$ti] - 4, $size[1]-1, 
			$atXti + 4, $size[1]-1
		);
		$canvas-> clipRect( 
			0, 0, 
			$size[0] - DefArrowX - DefGapX - DefLeftX, $size[1]
		) if $a & 2;
		$notifier-> ( 
			@notifyParms, $canvas, $ti, \@colorSet, \@poly, 
			$swapDraw ? undef : \@poly2
		);
	}
	goto PaintEarsThen if $swapDraw;

EndOfSwappedPaint:
	$self-> pop_event;
}

sub on_size
{
	my ( $self, $ox, $oy, $x, $y) = @_;
	
	if ( $x > $ox && (( $self-> {arrows} & 2) == 0)) {
		my $w  = DefLeftX * 2 + DefGapX;
		my $ww = $self-> {widths};
		$w += DefArrowX + DefGapX if $self-> {arrows} & 1;
		my $i;
		my $set = 0;
		
		for ( $i = scalar @{$ww} - 1; $i >= 0; $i--) {
			$w += $$ww[$i] + DefGapX;
			$set = 1, $self-> firstTab( $i + 1), last if $w >= $x;
		}
		$self-> firstTab(0) unless $set;
	}
	$self-> reset;
}

sub on_fontchanged { $_[0]-> reset; $_[0]-> recalc_widths; }
sub on_enter       { $_[0]-> repaint; }
sub on_leave       { $_[0]-> repaint; }

sub on_measuretab
{
	my ( $self, $index, $sref) = @_;
	$$sref = $self-> get_text_width( $self-> {tabs}-> [$index]) + DefGapX * 4;
}

# see L<DrawTab> below for more info

sub on_drawtab
{
	my ( $self, $canvas, $i, $clr, $poly, $poly2) = @_;
	
	$canvas-> color(( $self-> {colored} && ( $i >= 0)) ?
		( $warpColors[ $i % scalar @warpColors]) : $$clr[1]);
		
	$canvas-> fillpoly( $poly);
	$canvas-> fillpoly( $poly2) if $poly2;
	$canvas-> color( $$clr[3]);
	$canvas-> polyline( [@{$poly}[0..($self-> {topMost}?5:3)]]);
	$canvas-> color( $$clr[2]);
	$canvas-> polyline( [@{$poly}[($self-> {topMost}?4:2)..7]]);
	$canvas-> line( $$poly[4]+1, $$poly[5], $$poly[6]+1, $$poly[7]);
	$canvas-> color( $$clr[0]);
	
	if ( $i >= 0) {
		my  @tx = (
			$$poly[0] + ( $$poly[6] - $$poly[0] - $self-> {widths}-> [$i]) / 2 + DefGapX * 2,
			$$poly[1] + ( $$poly[3] - $$poly[1] - $canvas-> font-> height) / 2
		);
		$canvas-> text_out( $self-> {tabs}-> [$i], @tx);
		$canvas-> rect_focus( $tx[0] - 1, $tx[1] - 1,
			$tx[0] + $self-> {widths}-> [$i] - DefGapX * 4 + 1, $tx[1] + $canvas-> font-> height + 1)
				if ( $i == $self-> {focusedTab}) && $self-> focused;
	} elsif ( $i == -1) {
		$canvas-> fillpoly([
			$$poly[0] + ( $$poly[6] - $$poly[0]) * 0.6,
			$$poly[1] + ( $$poly[3] - $$poly[1]) * 0.2,
			$$poly[0] + ( $$poly[6] - $$poly[0]) * 0.6,
			$$poly[1] + ( $$poly[3] - $$poly[1]) * 0.6,
			$$poly[0] + ( $$poly[6] - $$poly[0]) * 0.4,
			$$poly[1] + ( $$poly[3] - $$poly[1]) * 0.4,
		]);
	} elsif ( $i == -2) {
		$canvas-> fillpoly([
			$$poly[0] + ( $$poly[6] - $$poly[0]) * 0.4,
			$$poly[1] + ( $$poly[3] - $$poly[1]) * 0.2,
			$$poly[0] + ( $$poly[6] - $$poly[0]) * 0.4,
			$$poly[1] + ( $$poly[3] - $$poly[1]) * 0.6,
			$$poly[0] + ( $$poly[6] - $$poly[0]) * 0.6,
			$$poly[1] + ( $$poly[3] - $$poly[1]) * 0.4,
		]);
	}
}

sub get_item_width
{
	return $_[0]-> {widths}-> [$_[1]];
}

sub tab2firstTab
{
	my ( $self, $ti) = @_;
	
	if (
		( $ti >= $self-> {lastTab}) and 
		( $self-> {arrows} & 2) and 
		( $ti != $self-> {firstTab})
	) {
		my $w = DefLeftX;
		$w += DefArrowX + DefGapX if $self-> {arrows} & 1;
		my $i;
		my $W = $self-> width;
		my $ww = $self-> {widths};
		my $moreThanOne = ( $ti - $self-> {firstTab}) > 0;
		
		for ( $i = $self-> {firstTab}; $i <= $ti; $i++) {
			$w += $$ww[$i] + DefGapX;
		}
		
		my $lim = $W - DefLeftX - DefArrowX - DefGapX * 2;
		$lim -= DefGapX * 2 if $moreThanOne;

		if ( $w >= $lim) {
			my $leftw = DefLeftX * 2 + DefGapX + DefArrowX;
			$leftw += DefArrowX + DefGapX if $self-> {arrows} & 1;
			$leftw = $W - $leftw;
			$leftw -= $$ww[$ti] if $moreThanOne;
			$w = 0;
			for ( $i = $ti; $i >= 0; $i--) {
				$w += $$ww[$i] + DefGapX;
				last if $w > $leftw;
			}
			return $i + 1;
		}
	} elsif ( $ti < $self-> {firstTab}) {
		return $ti;
	}
	return undef;
}

sub set_tab_index
{
	my ( $self, $ti) = @_;
	$ti = 0 if $ti < 0;
	my $mx = scalar @{$self-> {tabs}} - 1;
	$ti = $mx if $ti > $mx;
	return if $ti == $self-> {tabIndex};
	
	$self-> {tabIndex} = $ti;
	$self-> {focusedTab} = $ti;
	my $newFirstTab = $self-> tab2firstTab( $ti);
	
	defined $newFirstTab ?
		$self-> firstTab( $newFirstTab) :
		$self-> repaint;
	$self-> notify(q(Change));
}

sub set_first_tab
{
	my ( $self, $ft) = @_;
	$ft = 0 if $ft < 0;
	unless ( $self-> {arrows}) {
		$ft = 0;
	} else {
		my $w = DefLeftX * 2 + DefGapX * 2;
		$w += DefArrowX if $ft > 0;
		my $haveRight = 0;
		my $i;
		my @size = $self-> size;
		for ( $i = $ft; $i < scalar @{$self-> {widths}}; $i++) {
			$w += DefGapX + $self-> {widths}-> [$i];
			$haveRight = 1, last if $w >= $size[0];
		}
		unless ( $haveRight) {
			$w += DefGapX;
			for ( $i = $ft - 1; $i >= 0; $i--) {
				$w += DefGapX + $self-> {widths}-> [$i];
				if ( $w >= $size[0]) {
					$i++;
					$ft = $i if $ft > $i;
					last;
				}
			}
		}
	}
	return if $self-> {firstTab} == $ft;
	$self-> {firstTab} = $ft;
	$self-> reset;
	$self-> repaint;
}

sub set_focused_tab
{
	my ( $self, $ft) = @_;
	$ft = 0 if $ft < 0;
	my $mx = scalar @{$self-> {tabs}} - 1;
	$ft = $mx if $ft > $mx;
	$self-> {focusedTab} = $ft;

	my $newFirstTab = $self-> tab2firstTab( $ft);
	defined $newFirstTab ?
		$self-> firstTab( $newFirstTab) :
		( $self-> focused ? $self-> repaint : 0);
}

sub set_tabs
{
	my $self = shift;
	my @tabs = ( scalar @_ == 1 && ref( $_[0]) eq q(ARRAY)) ? @{$_[0]} : @_;
	$self-> {tabs} = \@tabs;
	$self-> recalc_widths;
	$self-> reset;
	$self-> lock;
	$self-> firstTab( $self-> firstTab);
	$self-> tabIndex( $self-> tabIndex);
	$self-> unlock;
	$self-> update_view;
}

sub set_top_most
{
	my ( $self, $tm) = @_;
	return if $tm == $self-> {topMost};
	$self-> {topMost} = $tm;
	$self-> repaint;
}

sub colored      {($#_)?($_[0]-> {colored}=$_[1],$_[0]-> repaint)         :return $_[0]-> {colored}}
sub focusedTab   {($#_)?($_[0]-> set_focused_tab(    $_[1]))             :return $_[0]-> {focusedTab}}
sub firstTab     {($#_)?($_[0]-> set_first_tab(    $_[1]))               :return $_[0]-> {firstTab}}
sub tabIndex     {($#_)?($_[0]-> set_tab_index(    $_[1]))               :return $_[0]-> {tabIndex}}
sub topMost      {($#_)?($_[0]-> set_top_most (    $_[1]))               :return $_[0]-> {topMost}}
sub tabs         {($#_)?(shift-> set_tabs     (    @_   ))               :return $_[0]-> {tabs}}

package Prima::Notebook;
use vars qw(@ISA);
@ISA = qw(Prima::Widget);

sub profile_default
{
	my $def = $_[ 0]-> SUPER::profile_default;
	my %prf = (
		defaultInsertPage => undef,
		pageCount         => 0,
		pageIndex         => 0,
		tabStop           => 0,
		ownerBackColor    => 1,
	);
	@$def{keys %prf} = values %prf;
	return $def;
}

sub init
{
	my $self = shift;
	$self-> {pageIndex} = -1;
	$self-> {pageCount} = 0;
	
	my %profile = $self-> SUPER::init(@_);
	
	$self-> {pageCount} = $profile{pageCount};
	$self-> {pageCount} = 0 if $self-> {pageCount} < 0;
	my $j = $profile{pageCount};
	push (@{$self-> {widgets}},[]) while $j--;
	for ( qw( pageIndex defaultInsertPage)) { $self-> $_( $profile{ $_}); }
	return %profile;
}

sub set_page_index
{
	my ( $self, $pi) = @_;
	$pi = 0 if $pi < 0;
	$pi = $self-> {pageCount} - 1 if $pi > $self-> {pageCount} - 1;
	my $sel = $self-> selected;
	return if $pi == $self-> {pageIndex};
	
	$self-> lock;
	
	my $cp = $self-> {widgets}-> [$self-> {pageIndex}];
	if ( defined $cp) {
		for ( @$cp) {
			$$_[1] = $$_[0]-> enabled;
			$$_[2] = $$_[0]-> visible;
			$$_[3] = $$_[0]-> current;
			$$_[4] = $$_[0]-> geometry;
			$$_[0]-> visible(0);
			$$_[0]-> enabled(0);
			$$_[0]-> geometry(gt::Default);
		}
	}
	
	$cp = $self-> {widgets}-> [$pi];
	if ( defined $cp) {
		my $hasSel;
		for ( @$cp) {
			$$_[0]-> geometry($$_[4]);
			$$_[0]-> enabled($$_[1]);
			$$_[0]-> visible($$_[2]);
			if ( !defined $hasSel && $$_[3]) {
				$hasSel = 1;
				$$_[0]-> select if $sel;
			}
			$$_[0]-> current($$_[3]);
		}
	}
	
	my $i = $self-> {pageIndex};
	$self-> {pageIndex} = $pi;
	$self-> notify(q(Change), $i, $pi);
	$self-> unlock;
	$self-> update_view;
}

sub insert_page
{
	my ( $self, $at) = @_;
	
	$at = -1 unless defined $at;
	$at = $self-> {pageCount} if $at < 0 || $at > $self-> {pageCount};
	
	splice( @{$self-> {widgets}}, $at, 0, []);
	$self-> {pageCount}++;
	$self-> pageIndex(0) if $self-> {pageCount} == 1;
}

sub delete_page
{
	my ( $self, $at, $removeChildren) = @_;
	
	$removeChildren = 1 unless defined $removeChildren;
	$at = -1 unless defined $at;
	$at = $self-> {pageCount} - 1 if $at < 0 || $at >= $self-> {pageCount};
	
	my $r = splice( @{$self-> {widgets}}, $at, 1);
	$self-> {pageCount}--;
	$self-> pageIndex( $self-> pageIndex);
	if ( $removeChildren) {
		$_-> destroy for @$r;
	}
}

sub attach_to_page
{
	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);
	return unless defined $page;
	$ctrl-> destroy;
}

sub move_widget
{
	my ( $self, $widget, $newPage) = @_;
	my ( $page, $number) = $self-> contains_widget( $widget);
	return unless defined $page and $page != $newPage;
	push @{$self-> {widgets}-> [$newPage]}, splice( @{$self-> {widgets}-> [$page]}, $number, 1);
	$self-> repaint if $self-> {pageIndex} == $page || $self-> {pageIndex} == $newPage;
}


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

	if ( $pageCount < $self-> {pageCount}) {
		splice(@{$self-> {widgets}}, $pageCount);
		$self-> {pageCount} = $pageCount;
		$self-> pageIndex($pageCount - 1) if $self-> {pageIndex} < $pageCount - 1;
	} else {
		my $i = $pageCount - $self-> {pageCount};
		push (@{$self-> {widgets}},[]) while $i--;
		$self-> {pageCount} = $pageCount;
		$self-> pageIndex(0) if $self-> {pageIndex} < 0;
	}
}

my %virtual_properties = (
	enabled => 1,
	visible => 2,
	current => 3,
	geometry => 4,
);

sub widget_get
{
	my ( $self, $widget, $property) = @_;
	return $widget-> $property() if ! $virtual_properties{$property};
	
	my ( $page, $number) = $self-> contains_widget( $widget);
	return $widget-> $property() 
		if ! defined $page || $page == $self-> {pageIndex};

	return $self-> {widgets}-> [$page]-> [$number]-> [$virtual_properties{$property}];
}

sub widget_set
{
	my ( $self, $widget) = ( shift, shift );
	my ( $page, $number) = $self-> contains_widget( $widget);

	if ( ! defined $page || $page == $self-> {pageIndex} ) {
		$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::TabbedNotebook;
use vars qw(@ISA %notebookProps);
@ISA = qw(Prima::Widget);

use constant DefBorderX   => 11;
use constant DefBookmarkX => 32;

%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::Notebook-> profile_default},
		%{$_[ 0]-> SUPER::profile_default},
		ownerBackColor      => 1,
		tabs                => [],
		tabIndex            => 0,
		style               => tns::Standard,
		orientation         => tno::Top,
		tabsetClass         => 'Prima::TabSet',
		tabsetProfile       => {},
		tabsetDelegations   => ['Change'],
		notebookClass       => 'Prima::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] - 1,
		growMode  => gm::Ceiling,
		height    => $maxh > 28 ? $maxh : 28,
		buffered  => 1,
		designScale => undef,
		delegations => $profile{tabsetDelegations},
		%{$profile{tabsetProfile}},
	);
	
	$self-> {notebook} = $profile{notebookClass}-> create(
		owner      => $self,
		name       => 'Notebook',
		origin     => [ DefBorderX + 1, DefBorderX + 1],
		size       => [ $size[0] - DefBorderX * 2 - 5,
			$size[1] - DefBorderX * 2 - $self-> {tabSet}-> height - DefBookmarkX - 4],
		growMode   => gm::Client,
		scaleChildren => $scaleChildren,
		(map { $_  => $profile{$_}} keys %notebookProps),
		designScale => undef,
		pageCount  => scalar @{$profile{tabs}},
		delegations => $profile{notebookDelegations},
		%{$profile{notebookProfile}},
	);
	
	$self-> {notebook}-> designScale( $self-> designScale); # propagate designScale
	$self-> tabs( $profile{tabs});
	$self-> pageIndex( $profile{pageIndex});
	$self-> style($profile{style});
	$self-> orientation($profile{orientation});
	$self-> visible( $visible);

	return %profile;
}

sub Notebook_Change
{
	my ( $self, $book) = @_;
	return if $self-> {changeLock};
	$self-> pageIndex( $book-> pageIndex);
}

sub on_paint
{
	my ($self,$canvas) = @_;
	my @clr  = ( $self-> color, $self-> backColor);
	@clr = ( $self-> disabledColor, $self-> disabledBackColor) if ( !$self-> enabled);
	my @c3d  = ( $self-> dark3DColor, $self-> light3DColor);
	my @size = $canvas-> size;
	my $on_top = ($self-> {orientation} == tno::Top);
	$canvas-> color( $clr[1]);
	$canvas-> bar( 0, 0, @size);

	if ($self-> {style} == tns::Standard) {
		if ($on_top) {
			$size[1] -= $self-> {tabSet}-> height;
		} else {
			$size[1] -= 5;
		}

		$canvas-> rect3d( 
			0, 0, $size[0] - 1, $size[1] - 1 + Prima::TabSet::DefGapY, 
			1, reverse @c3d
		);
		$canvas-> rect3d( 
			DefBorderX, $on_top ? 
				DefBorderX : $self-> {notebook}-> bottom - 1, 
			$size[0] - 1 - DefBorderX,
			$size[1] - DefBorderX + Prima::TabSet::DefGapY, 
			1, @c3d
		);

		my $y = $size[1] - DefBorderX + Prima::TabSet::DefGapY;
		my $x  = $size[0] - DefBorderX - DefBookmarkX;
		return if $y < DefBorderX * 2 + DefBookmarkX;

		$canvas-> color( $c3d[0]);
		$canvas-> line( 
			DefBorderX + 2,  $y - 2, 
			$x - 2,          $y - 2
		);
		$canvas-> line( 
			$x + DefBookmarkX - 4, $y - DefBookmarkX + 1, 
			$x + DefBookmarkX - 4, $on_top ? 
						(DefBorderX + 2) : 
						($self-> {notebook}-> bottom + 1)
		);

		my $fh = 24;
		my $a  = 0;
		my ($pi, $mpi) = ( 
			$self-> {notebook}-> pageIndex, 
			$self-> {notebook}-> pageCount - 1
		);
		$a |= 1 if $pi > 0;
		$a |= 2 if $pi < $mpi;
		
		$canvas-> line( 
			DefBorderX + 4, $y - $fh * 1.6, 
			$x - 6, $y - $fh * 1.6
		);
		$canvas-> polyline([ 
			$x - 2, $y - 2, 
			$x - 2, $y - DefBookmarkX, 
			$x + DefBookmarkX - 4, $y - DefBookmarkX
		]);
		$canvas-> line( $x - 1, $y - 3, $x + DefBookmarkX - 5, $y - DefBookmarkX + 1);
		$canvas-> line( $x - 1, $y - 4, $x + DefBookmarkX - 6, $y - DefBookmarkX + 1);
		$canvas-> line( $x - 0, $y - 2, $x + DefBookmarkX - 4, $y - DefBookmarkX + 2);
		$canvas-> line( $x + 5, $y - DefBookmarkX - 2, $x + DefBookmarkX - 5, $y - DefBookmarkX - 2);

		$canvas-> polyline([
			$x + 4, $y - DefBookmarkX + 6,
			$x + 10, $y - DefBookmarkX + 6,
			$x + 10, $y - DefBookmarkX + 8]) if $a & 1;

		my $dx = DefBookmarkX / 2;
		my ( $x1, $y1) = ( $x + $dx, $y - $dx);
		$canvas-> line( $x1 + 1, $y1 + 4, $x1 + 3, $y1 + 4) if $a & 2;
		$canvas-> line( $x1 + 5, $y1 + 6, $x1 + 5, $y1 + 8) if $a & 2;
		$canvas-> polyline([ $x1 + 3, $y1 + 2, $x1 + 5, $y1 + 2,
			$x1 + 5, $y1 + 4, $x1 + 7, $y1 + 4, $x1 + 7, $y1 + 6]) if $a & 2;
		$canvas-> color( $c3d[1]);
		$canvas-> line( $x - 1, $y - 7, $x + DefBookmarkX - 9, $y - DefBookmarkX + 1);
		$canvas-> line( DefBorderX + 4, $y - $fh * 1.6 - 1, $x - 6, $y - $fh * 1.6 - 1);
		$canvas-> polyline([ $x + 4, $y1 - 9, $x + 4, $y1 - 8, $x + 10, $y1 - 8]) if $a & 1;
		$canvas-> line( $x1 + 3, $y1 + 2, $x1 + 3, $y1 + 3) if $a & 2;
		$canvas-> line( $x1 + 6, $y1 + 6, $x1 + 7, $y1 + 6) if $a & 2;
		$canvas-> polyline([ $x1 + 1, $y1 + 4, $x1 + 1, $y1 + 6,
			$x1 + 3, $y1 + 6, $x1 + 3, $y1 + 8, $x1 + 5, $y1 + 8]) if $a & 2;
		$canvas-> color( cl::Black);
		$canvas-> line( $x - 1, $y - 2, $x + DefBookmarkX - 4, $y - DefBookmarkX + 1);
		$canvas-> line( $x + 5, $y - DefBookmarkX - 1, $x + DefBookmarkX - 5, $y - DefBookmarkX - 1);
		$canvas-> color( $clr[0]);

		my $t = $self-> {tabs};
		if ( scalar @{$t}) {
			my $tx = $self-> {tabSet}-> tabIndex;
			my $t1 = $$t[ $tx * 2];
			my $yh = $y - $fh * 0.8 - $self-> font-> height / 2;
			$canvas-> clipRect( DefBorderX + 1, $y - $fh * 1.6 + 1, $x - 4, $y - 3);
			$canvas-> text_out( $t1, DefBorderX + 4, $yh);
			if ( $$t[ $tx * 2 + 1] > 1) {
				$t1 = sprintf("Page %d of %d ", $self-> pageIndex - $self-> tab2page( $tx) + 1, $$t[ $tx * 2 + 1]);
				my $tl1 = $size[0] - DefBorderX - 3 - DefBookmarkX - $self-> get_text_width( $t1);
				$canvas-> text_out( $t1, $tl1, $yh) if $tl1 > 4 + DefBorderX + $fh * 3;
			}
		}
	} else {	
		# tns::Simple
		$canvas-> rect3d(0, 0, $size[0]-1, $size[1]-1, 1, reverse @c3d);
	}
}

sub event_in_page_flipper
{
	my ( $self, $x, $y) = @_;

	return if $self-> {style} != tns::Standard;
	
	my @size = $self-> size;
	my $th = ($self-> {orientation} == tno::Top) ? $self-> {tabSet}-> height : 5;
	$x -= $size[0] - DefBorderX - DefBookmarkX - 1;
	$y -= $size[1] - DefBorderX - $th - DefBookmarkX + 4;
	return if $x < 0 || $x > DefBookmarkX || $y < 0 || $y > DefBookmarkX;

	return ( $x, $y);
}

sub on_mousedown
{
	my ( $self, $btn, $mod, $x, $y) = @_;
	$self-> clear_event;
	return unless ( $x, $y) = $self-> event_in_page_flipper( $x, $y);
	$self-> pageIndex( $self-> pageIndex + (( -$x + DefBookmarkX < $y) ? 1 : -1));
}

sub on_mousewheel
{
	my ( $self, $mod, $x, $y, $z) = @_;
	$self-> clear_event;
	return unless ( $x, $y) = $self-> event_in_page_flipper( $x, $y);
	$self-> pageIndex( $self-> pageIndex + (( $z < 0) ? -1 : 1));
}

sub on_mouseclick
{
	my $self = shift;
	$self-> clear_event;
	return unless pop;
	$self-> clear_event unless $self-> notify( "MouseDown", @_);
}


sub page2tab
{
	my ( $self, $index) = @_;
	my $t = $self-> {tabs};
	return 0 unless scalar @$t;
	my $i = $$t[1] - 1;
	my $j = 0;
	while( $i < $index) {
		$j++;
		$i += $$t[ $j*2 + 1];
	}
	return $j;
}

sub tab2page
{
	my ( $self, $index) = @_;
	my $t = $self-> {tabs};
	my $i;
	my $j = 0;
	for ( $i = 0; $i < $index; $i++) { $j += $$t[ $i * 2 + 1]; }
	return $j;
}

sub TabSet_Change
{
	my ( $self, $tabset) = @_;
	return if $self-> {changeLock};
	$self-> pageIndex( $self-> tab2page( $tabset-> tabIndex));
}


sub set_tabs
{
	my $self = shift;
	my @tabs = ( scalar @_ == 1 && ref( $_[0]) eq q(ARRAY)) ? @{$_[0]} : @_;
	my @nTabs;
	my @loc;
	my $prev  = undef;
	for ( @tabs) {
		if ( defined $prev && $_ eq $prev) {
			$loc[-1]++;
		} else {
			push( @loc,   $_);
			push( @loc,   1);
			push( @nTabs, $_);
		}
		$prev = $_;
	}
	my $pages = $self-> {notebook}-> pageCount;
	$self-> {tabs} = \@loc;
	$self-> {tabSet}-> tabs( \@nTabs);
	my $i;
	if ( $pages > scalar @tabs) {
		for ( $i = scalar @tabs; $i < $pages; $i++) {
			$self-> {notebook}-> delete_page( $i);
		}
	} elsif ( $pages < scalar @tabs) {
		for ( $i = $pages; $i < scalar @tabs; $i++) {
			$self-> {notebook}-> insert_page;
		}
	}
}

sub get_tabs
{
	my $self = $_[0];
	my $i;
	my $t = $self-> {tabs};
	my @ret;
	for ( $i = 0; $i < scalar @{$t} / 2; $i++) {
		my $j;
		for ( $j = 0; $j < $$t[$i*2+1]; $j++) { push( @ret, $$t[$i*2]); }
	}
	return \@ret;
}

sub set_page_index
{
	my ( $self, $pi) = @_;
	
	my ($pix, $mpi) = ( $self-> {notebook}-> pageIndex, $self-> {notebook}-> pageCount - 1);
	$self-> {changeLock} = 1;
	$self-> {notebook}-> pageIndex( $pi);
	$self-> {tabSet}-> tabIndex( $self-> page2tab( $self-> {notebook}-> pageIndex));
	delete $self-> {changeLock};
	
	my @size = $self-> size;
	my $th = ($self-> {orientation} == tno::Top) ? $self-> {tabSet}-> height : 5;
	my $a  = 0;
	$a |= 1 if $pix > 0;
	$a |= 2 if $pix < $mpi;
	my $newA = 0;
	$pi = $self-> {notebook}-> pageIndex;
	$newA |= 1 if $pi > 0;
	$newA |= 2 if $pi < $mpi;

	$self-> invalidate_rect(
		DefBorderX + 1, $size[1] - DefBorderX - $th - DefBookmarkX - 1,
		$size[0] - DefBorderX - (( $a == $newA) ? DefBookmarkX + 2 : 0),
		$size[1] - DefBorderX - $th + 3
	);
	$self-> notify(q(Change), $pix, $pi);
}

sub orientation 
{
	my ($self, $tno) = @_;
	return $self-> {orientation} unless (defined $tno);

	$self-> {orientation} = $tno;
	$self-> {tabSet}-> topMost($tno == tno::Top);
	$self-> {tabSet}-> growMode(($tno == tno::Top) ? gm::Ceiling : gm::Floor);
	$self-> adjust_widgets;

	return $tno;
}

sub style 
{
	my ($self, $style) = @_;
	return $self-> {style} unless (defined $style);

	$self-> {style} = $style;
	$self-> adjust_widgets;

	return $style;
}

sub adjust_widgets 
{
	my ($self) = @_;
	my $nb = $self-> {notebook};
	my $ts = $self-> {tabSet};

	my @size = $self-> size;
	my @pos = (0,0);

	$size[1] -= $ts-> height;
	if ($self-> {style} == tns::Standard) {
		$size[0] -= 2 * DefBorderX + 6;
		$size[1] -= 2 * DefBorderX + DefBookmarkX + 4;
		$pos[0] += DefBorderX + 1;
		$pos[1] += DefBorderX + 1;
	}
	else {
		$size[0] -= 2;
		$size[1] -= 2;
		$pos[0]++;
		$pos[1]++;
	}

	if ($self-> {orientation} == tno::Top) {
		$ts-> top($self-> height);
	}
	else {
		$ts-> bottom(0);
		$pos[1] += $ts-> height - 5;
	}

	$nb-> size(@size);
	$nb-> origin(@pos);

	$self-> repaint;
}

sub tabIndex     {($#_)?($_[0]-> {tabSet}-> tabIndex( $_[1]))   :return $_[0]-> {tabSet}-> tabIndex}
sub pageIndex    {($#_)?($_[0]-> set_page_index   ( $_[1]))    :return $_[0]-> {notebook}-> pageIndex}
sub tabs         {($#_)?(shift-> set_tabs     (    @_   ))     :return $_[0]-> get_tabs}

package Prima::ScrollNotebook::Client;
use vars qw(@ISA);
@ISA = qw(Prima::Notebook);

sub profile_default
{
	my $def = $_[0]-> SUPER::profile_default;
	my %prf = (
		geometry  => gt::Pack,
		packInfo  => { expand => 1, fill => 'both'},
	);
	@$def{keys %prf} = values %prf;
	return $def;
}

sub geomSize
{
	return $_[0]-> SUPER::geomSize unless $#_;

	my $self = shift;
	$self-> SUPER::geomSize( @_);
	$self-> owner-> owner-> ClientWindow_geomSize( $self, @_);
}

package Prima::ScrollNotebook;
use vars qw(@ISA);
@ISA = qw(Prima::ScrollGroup);

for ( qw(pageIndex insert_page delete_page), 
		keys %Prima::TabbedNotebook::notebookProps) {
		eval <<GENPROC;
	sub $_ { return shift-> {client}-> $_(\@_); }
GENPROC
}

sub profile_default
{
	return {
		%{Prima::Notebook-> profile_default},
		%{$_[ 0]-> SUPER::profile_default},
		clientClass  => 'Prima::ScrollNotebook::Client',
	}
}

package Prima::TabbedScrollNotebook::Client;
use vars qw(@ISA);
@ISA = qw(Prima::ScrollNotebook);

sub update_geom_size
{
	my ( $self, $x, $y) = @_;
	my $owner = $self-> owner;
	return unless $owner-> packPropagate;
	my @o = $owner-> size;
	my @s = $self-> get_virtual_size;
	$owner-> geomSize( $o[0] - $s[0] + $x, $o[1] - $s[1] + $y);
}

package Prima::TabbedScrollNotebook;
use vars qw(@ISA);
@ISA = qw(Prima::TabbedNotebook);

sub profile_default
{
	return {
		%{$_[ 0]-> SUPER::profile_default},

		notebookClass => 'Prima::TabbedScrollNotebook::Client',
		clientProfile => {},
		clientDelegations => [],
		clientSize    => [ 100, 100],
	}
}

sub profile_check_in
{
	my ( $self, $p, $default) = @_;
	$self-> SUPER::profile_check_in( $p, $default);
	$p-> {notebookProfile}-> {clientSize} = $p-> {clientSize}
		if exists $p-> {clientSize} and not exists $p-> {notebookProfile}-> {clientSize};
	if ( exists $p-> {clientProfile}) {
		%{$p-> {notebookProfile}-> {clientProfile}} = (
			($default-> {notebookProfile}-> {clientProfile} ?
				%{$default-> {notebookProfile}-> {clientProfile}} : ()),
			%{$p-> {clientProfile}},
		);
	}
	if ( exists $p-> {clientDelegations}) {
		@{$p-> {notebookProfile}-> {clientDelegations}} = (
			( $default-> {notebookProfile}-> {clientDelegations} ?
				@{$default-> {notebookProfile}-> {clientDelegations}} : ()),
			@{$p-> {clientDelegations}},
		);
	}
}

sub client { shift-> {notebook}-> client }

sub packPropagate
{
	return shift-> SUPER::packPropagate unless $#_;
	my ( $self, $pack_propagate) = @_;
	$self-> SUPER::packPropagate( $pack_propagate);
	$self-> propagate_size if $pack_propagate;
}

sub propagate_size
{
	my $self = $_[0];
	$self-> {notebook}-> propagate_size
		if $self-> {notebook};
}

sub clientSize
{
	return $_[0]-> {notebook}-> clientSize unless $#_;
	shift-> {notebook}-> clientSize(@_);
}

sub use_current_size
{
	$_[0]-> {notebook}-> use_current_size;
}

1;

__DATA__