File Coverage

blib/lib/Tk/DynaTabFrame.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

#234567890123456789012345678901234567890123456789012345678901234567890
package Tk::DynaTabFrame;

require 5.008;

use Tk;
use Tk ':variables';
use Tk::Balloon;

use base qw (Tk::Derived Tk::Frame);
use vars qw ($VERSION);
use strict;
use Carp;

$VERSION = '0.23';
#
#	indexes of our tab properties
#
use constant DTF_IDX_WIDGET => 0;
use constant DTF_IDX_CAPTION => 1;
use constant DTF_IDX_COLOR => 2;
use constant DTF_IDX_ROW => 3;
use constant DTF_IDX_COL => 4;
use constant DTF_IDX_FRAME => 5;
use constant DTF_IDX_WIDTH => 6;
use constant DTF_IDX_HEIGHT => 7;
use constant DTF_IDX_RAISECOLOR => 8;
use constant DTF_IDX_RAISECMD => 9;
use constant DTF_IDX_LABEL => 10;
use constant DTF_IDX_FLASH_COLOR => 11;
use constant DTF_IDX_FLASH_INTVL => 12;
use constant DTF_IDX_FLASH_TIME => 13;
use constant DTF_IDX_FLASH_ID => 14;
use constant DTF_IDX_FLASHED => 15;
use constant DTF_IDX_HIDDEN => 16;
use constant DTF_IDX_TABTIP => 17;

my $close_xpm = << 'end-of-close-xpm';
/* XPM */
static char * close_xpm[] = {
"8 8 3 1",
" 	s None	c None",
".	c #000000000000",
"X	c #E0E0FFFFE0E0",
"..    ..",
" ..  .. ",
"  ....  ",
"   ..   ",
"   ..   ",
"  ....  ",
" ..  .. ",
"..    .."};

end-of-close-xpm

my $close_xpm_6 = << 'end-of-close-xpm-6';
/* XPM */
static char * close_xpm[] = {
"6 6 3 1",
" 	s None	c None",
".	c #000000000000",
"X	c #E0E0FFFFE0E0",
"..  ..",
" .... ",
"  ..  ",
"  ..  ",
" .... ",
"..  ..",};

end-of-close-xpm-6

#
#	map of tabframe directives based on
#	tab orientation
#
use constant DTF_TAB_TABSIDE => 0;
use constant DTF_TAB_TABFILL => 1;
use constant DTF_TAB_TABANCHOR => 2;
use constant DTF_TAB_TABSIZER => 3;
use constant DTF_TAB_CLIENTSIDE => 4;

my %tabalign = (
#	tabframe -side, tabframe -fill, tabframe -anchor,
#		tabframe sizing option, clientframe -side
	nw => [ 'top', 'x', 'nw', '-height', 'bottom'],
	ne => [ 'top', 'x', 'ne', '-height', 'bottom'],
	sw => [ 'bottom', 'x', 'sw', '-height', 'top'],
	se => [ 'bottom', 'x', 'se', '-height', 'top'],
	en => [ 'right', 'y', 'ne', '-width', 'left'],
	es => [ 'right', 'y', 'se', '-width', 'left'],
	wn => [ 'left', 'y', 'nw', '-width', 'right'],
	ws => [ 'left', 'y', 'sw', '-width', 'right'],
);

#
#	bitmaps for border requirements
#	based on tab orientations
#	bit 0 => Left
#	bit 1 => Right
#	bit 2 => Top
#	bit 3 => Bottom
#	'p' sides are for pseudo tabs
#
my %borders = qw(
nw 7
ne 7
sw 11
se 11
en 14
es 14
wn 13
ws 13
pnw 6
pne 5
psw 10
pse 9
pen 10
pes 6
pwn 9
pws 5
);
#
#	pack directives for the tab contents
#	[ closebtn_side,
#		closebtn_anchor,
#		button_side,
#		button_anchor,
#		pseudo_anchor
#		tab direction
#	]
#
use constant DTF_ORIENT_CLOSESIDE => 0;
use constant DTF_ORIENT_CLOSEANCHOR => 1;
use constant DTF_ORIENT_BTNSIDE => 2;
use constant DTF_ORIENT_BTNANCHOR => 3;
use constant DTF_ORIENT_PSEUDOANCHOR => 4;
use constant DTF_ORIENT_DIRECTION => 5;
use constant DTF_ORIENT_ALIGN => 6;
use constant DTF_ORIENT_DOWNWARD => 7;

use constant DTF_MAX_ROWS => 20;
use constant DTF_DFLT_TIPTIME => 450;

my %taborient = (
'nw', [ 'right', 'ne', 'right', 's', 'e', 1, 0, 1, ],
'ne', [ 'right', 'ne', 'right', 's', 'w', 1, 0, 1, ],
'sw', [ 'right', 'se', 'right', 'n', 'e', 1, 1, 0, ],
'se', [ 'right', 'se', 'right', 'n', 'w', 1, 1, 0, ],
'en', [ 'top', 'ne', 'top', 's', 's', 0, 0, 0, ],
'es', [ 'top', 'ne', 'top', 's', 'n', 0, 0, 0, ],
'wn', [ 'top', 'nw', 'top', 's', 's', 0, 1, 1, ],
'ws', [ 'top', 'nw', 'top', 's', 'n', 0, 1, 1, ],
);
#
#	page options for Tk::Notebook compatibility
#
my %page_opts = (
'-tabcolor', DTF_IDX_COLOR,
'-raisecolor', DTF_IDX_RAISECOLOR,
'-image', '-image',
'-label', DTF_IDX_LABEL,
'-raisecmd', DTF_IDX_RAISECMD,
'-state', '-state',
'-tabtip', DTF_IDX_TABTIP,
'-hidden', DTF_IDX_HIDDEN
);

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

sub Populate {
    my $this = shift;
    $this->ConfigSpecs(
        '-borderwidth' => [['SELF', 'PASSIVE'],
        	'borderwidth', 'BorderWidth', '1'],
        '-tabcurve' => [['SELF', 'PASSIVE'],
        	'tabcurve', 'TabCurve', 2],
        '-padx' => [['SELF', 'PASSIVE'], 'padx', 'padx', 5],
        '-pady' => [['SELF', 'PASSIVE'], 'pady', 'pady', 5],
#
#	for Tk::Notebook compatibility
#
        '-tabpadx' => [['SELF', 'PASSIVE'], 'tabpadx', 'tabpadx', 2],
        '-tabpady' => [['SELF', 'PASSIVE'], 'tabpady', 'tabpady', 2],
        '-font' => ['METHOD', 'font', 'Font', undef],
        '-current' => ['METHOD'],
        '-raised' => ['METHOD'],
        '-raised_name' => ['METHOD'],
        '-tabs' => ['METHOD'],
		'-delay' => [['SELF', 'PASSIVE'], 'delay', 'Delay', '200'],
		'-raisecmd' => [['SELF', 'PASSIVE'], 'raisecmd', 'RaiseCmd', undef],
        '-tablock' => [['SELF', 'PASSIVE'], 'tablock', 'tablock', undef],
        '-tabrotate' => [['SELF', 'PASSIVE'], 'tabrotate', 'tabrotate', 1],
        '-tabside' => ['METHOD'],
        '-tabclose' => ['METHOD'],
        '-tabscroll' => ['METHOD'],
        '-tabcolor' => [['SELF', 'PASSIVE'], 'tabcolor', 'tabcolor', undef],
        '-tabtip' => [['SELF', 'PASSIVE'], 'tabtip', 'tabtip', undef],
        '-tiptime' => ['METHOD'],
        '-tipcolor' => ['METHOD'],
        '-textalign' => [['SELF', 'PASSIVE'], 'textalign', 'textalign', 1],
        '-backpagecolor' => [['SELF', 'PASSIVE'], 'tabcolor', 'tabcolor', undef],
        '-raisecolor' => [['SELF', 'PASSIVE'], 'raisecolor', 'raisecolor', undef],
       );

    $this->SUPER::Populate(@_);
#
#	set default tab orientation
#
	$this->{Side} = 'nw';
	$this->{_tiptime} = DTF_DFLT_TIPTIME;
	$this->{_tipcolor} = 'white';
#
#	get tab alignment info
#
	my ($tabside, $tabfill, $tabanchor, $tabsize, $clientside) =
		@{$tabalign{$this->{Side}}};
#
#	ButtonFrame is where the tabs are
#
    my $ButtonFrame = $this->{ButtonFrame} = $this->Component(
        'Frame' => 'ButtonFrame',
        -borderwidth => 0,
        -relief => 'flat',
        $tabsize => 40,
	)->pack(
        -anchor => $tabanchor,
        -side => $tabside,
        -fill => $tabfill,
	);
#
#	create the frame we return to the app
#
    my $ClientFrame = $this->{ClientFrame} = $this->Component(
        'Frame' => 'TabChildFrame',
        -relief => 'flat',
        -borderwidth => 0,
        -height => 60,
	)->pack(
        -side => $clientside,
        -expand => 1,
        -fill => 'both',
	);
#
#	a pseudo-frame used to make the raised tab smoothly connect
#	to the client frame
#
    my $Connector = $this->Component(
        'Frame' => 'Connector',
        -relief => 'flat'
	);
#
#	list of all our current clients
#
	$this->{ClientList} = [ ];
#
#	a quick lookup by caption
#
	$this->{ClientHash} = {};
#
#	a quick lookup of row numbers
#	so a raise() can just move entire rows around
#	create first empty row
#
	$this->{RowList} = [ [] ];
#
#	plug into the configure event so we get resizes
#
	$this->{OldWidth} = $ButtonFrame->reqwidth();
	$this->{OldHeight} = $ButtonFrame->reqheight();
	$this->bind("" => sub { $this->ConfigDebounce; });
#
#	generate the close button
#
	my $scrwd = $this->screenwidth;
	$this->{CloseImage} = $this->Pixmap(-data => (($scrwd <= 1024) ? $close_xpm_6 : $close_xpm));
    return $this;
}

sub ConfigDebounce {
	my ($this) = @_;
	my $w = $Tk::event->w;
	my $h = $Tk::event->h;
#
#	only post event if we've changed width/height
#
	return 1 if (($this->{OldWidth} == $w) && ($this->{OldHeight} == $h));

	$this->{LastConfig} = Tk::timeofday;
	$this->{LastWidth} = $w;
	$this->{LastHeight} = $h;

	$this->afterCancel($this->{LastAfterID})
		if defined($this->{LastAfterID});

	$this->{LastAfterID} = $this->after(200, # $this->cget('-delay'),
		sub {
			$this->TabReconfig();
			delete $this->{LastAfterID};
		}
	);
	1;
}

sub TabCreate {
    my ($this, $Caption, $Color, $RaiseColor, $Image, $Text, $RaiseCmd) = @_;
#
#	always add at (0,0)
#
	my $clients = $this->{ClientList};
	my $rows = $this->{RowList};
	my $ButtonFrame = $this->{ButtonFrame};
#
#	create some pseudo tabs
#	note we only create DTF_MAX_ROWS, so if we have > DTF_MAX_ROWS+1
#	tab rows, we're in trouble
#
	unless ($this->{PseudoTabs}) {
		$this->{PseudoTabs} = [ undef ];
		push @{$this->{PseudoTabs}}, $this->PseudoCreate($_)
			foreach (1..DTF_MAX_ROWS);
	}
#
#	create default colors
#
	$this->configure(-tabcolor =>
		$this->Darken($this->cget(-background), 75))
		unless $this->cget(-tabcolor);
	$this->configure(-raisecolor =>
		$this->Darken($this->cget(-tabcolor), 130))
		unless $this->cget(-raisecolor);

	$RaiseColor = $Color ? $this->Darken($Color, 130) :
		$this->cget(-raisecolor)
		unless $RaiseColor;

	$Color = $this->cget(-tabcolor)
		unless $Color;

	$RaiseCmd = $this->cget(-raisecmd)
		unless $RaiseCmd;
#
#	create a new frame for the caller
#
    my $Widget = $this->{ClientFrame}->Frame(
		-borderwidth => $this->cget ('-borderwidth'),
        -relief => 'raised');
#
#	create a new frame for a tab
#
    my $TabFrame = $ButtonFrame->Component(
        'Frame' => 'Button_'.$Widget,
        -foreground => $this->cget ('-foreground'),
        -relief => 'flat',
        -borderwidth => 0,
	);
    $TabFrame->configure(-bg => $Color)
        if $Color;

	my $to = $taborient{$this->{Side}};
#
#	build a close tab for it if requested
#
	my $CloseBtn;
    $CloseBtn = $TabFrame->Component(
        'Button' => 'CloseBtn',
        -command => [ $this->{Close}, $this, $Caption ],
        -anchor => $to->[DTF_ORIENT_CLOSEANCHOR],
        -relief => 'raised',
        -borderwidth => 1,
        -takefocus => 1,
        -padx => 0,
        -pady => 0,
        -image => $this->{CloseImage}
	)
		if $this->{Close};
#
#	build the tab for it; in future we may support images
#
	my $font = $this->cget(-font);
	$font = $this->parent()->cget(-font) unless $font;
	my $padx = $this->cget(-tabpadx);
	my $pady = $this->cget(-tabpady);
    my $Button = $TabFrame->Component(
        'Button' => 'Button',
        -command => sub { $this->configure (-current => $Widget);},
        -anchor => 'center',
        -relief => 'flat',
        -borderwidth => 0,
        -takefocus => 1,
        -padx => 1,
        -pady => 1,
	);

    $Button->configure(-bg => $Color);
    if (defined($Image)) {
    	$Button->configure(-image => $Image);
    }
    else {
    	$Button->configure(-font => $font) if $font;
    	$Text = $Caption ||= $Widget->name()
    		unless $Text;
#
#	make it vertical for side tabs
#
	    $Button->configure(-text =>
	    	($this->cget(-textalign) ?
	    		($to->[DTF_ORIENT_DIRECTION] ? $Text : RotateTabText($Text)) :
	    		($to->[DTF_ORIENT_DIRECTION] ? RotateTabText($Text) : $Text))
	    );
	}

    $TabFrame->bind('' => sub {$Button->invoke();});
#
#	someday we'll have to figure out how to configure these
#	events so rolling into a tab brightens and roling out
#	darkens...wo/ repeating the event ad nauseum...
#
#	$TabFrame->bind('', [ \&OnEnter, $Button, $TabFrame ]);
#	$TabFrame->bind('', [ \&OnLeave, $Button, $TabFrame ]);

#	$Button->bind('', [ \&OnEnter, $Button, $TabFrame ]);
#	$Button->bind('', [ \&OnLeave, $Button, $TabFrame ]);

#	$Button->bind('', [ \&OnFocusOut, $TabFrame ]);
#	$Button->bind('', [ \&OnFocusIn, $TabFrame ]);
    $Button->bind('',
    	sub {($this->children())[0]->focus();});
    $Button->bind ('' => sub {$Button->invoke();});
#
#	decorate the tab
#
    $this->TabBorder ($TabFrame);

	my $dark = $Button->Darken($Color, 50);
    $Button->configure(-highlightthickness => 0,
        -activebackground => $dark);

    $CloseBtn->pack(
       	-side => $to->[DTF_ORIENT_CLOSESIDE],
       	-anchor => $to->[DTF_ORIENT_CLOSEANCHOR],
        -expand => 0,
        -fill => 'none',
        -ipadx => 0,
        -ipady => 0,
        -padx => 2,
        -pady => 2,
	)
		if $CloseBtn;

    $Button->pack(
       	-side => $to->[DTF_ORIENT_BTNSIDE],
       	-anchor => $to->[DTF_ORIENT_BTNANCHOR],
        -expand => 0,
        -fill => 'none',
        -ipadx => 0,
        -ipady => 0,
        -padx => $padx,
        -pady => $pady,
	);
#
#	pack tab in our rowframe 0; redraw if needed
#	move everything over 1 column in bottom row
#
	$clients->[$_][DTF_IDX_COL]++
		foreach (@{$rows->[0]});
	unshift @{$rows->[0]}, scalar @$clients;
#
#	save the client frame, the caption, the tabcolor,
#	the current row/column coords of our tab, our tabframe,
#	and the original height of this tab; we'll be stretching
#	the button later during redraws
#
    push @$clients, [
    	$Widget, 		# our client frame
    	$Caption,		# our identifier
    	$Color, 		# unraised color
    	0, 				# row number
    	0, 				# column number
    	$TabFrame, 		# our tab frame
    	($to->[DTF_ORIENT_DIRECTION] ? 	# the tab width
    		$Button->reqwidth() : $Button->reqheight() ),
    	($to->[DTF_ORIENT_DIRECTION] ? 	# the tab height
    		$Button->reqheight() : $Button->reqwidth() ),
    	$RaiseColor,	# raised color
    	$RaiseCmd,		# callback for raise operations
    	$Text,			# tab label text
    	1				# start as visible
    	];
#
#	reqwidht/height don't seem to include the padx/pady
#
	$$clients[-1][DTF_IDX_HEIGHT] += (2 *
		($to->[DTF_ORIENT_DIRECTION] ? $pady : $padx));
	$$clients[-1][DTF_IDX_WIDTH] += (2 *
		($to->[DTF_ORIENT_DIRECTION] ? $padx : $pady));
#
#	map the caption to its position in the client list,
#	so we can raise and delete it by reference
#
    $this->{ClientHash}{$Caption} = $#$clients;
#
#	redraw everything
#
	$this->TabRedraw(1);
#
#	and raise us
#
    $this->TabRaise($Widget);
	return $Widget;
}

sub PseudoCreate {
    my ($this, $row) = @_;
#
#	create a new frame for a pseudotab
#
    my $TabFrame = $this->{ButtonFrame}->Component(
        'Frame' => "Pseudo_$row",
        -foreground => $this->cget ('-foreground'),
        -relief => 'flat',
        -borderwidth => 0,
	);

    $TabFrame->Component(
    	'Label' => 'Button',
        -text => ' ',
        -anchor => $taborient{$this->{Side}}[DTF_ORIENT_PSEUDOANCHOR],
        -relief => 'flat',
        -borderwidth => 0,
        -padx => 2,
        -pady => 2,
	)->pack(
        -expand => 0,
        -fill => 'both',
        -ipadx => 0,
        -ipady => 0,
        -padx => 3,
        -pady => 3,
	);
#
#	decorate the tab
#
    $this->TabBorder ($TabFrame, 1);

	return $TabFrame;
}

sub TabRaise {
    my ($this, $Widget, $silent) = (shift, @_);
#
#	locate the tab row
#	if its not the first row, then we need to move rows around
#	and redraw
#	else just raise it
#
    my $ButtonFrame = $this->{ButtonFrame};
    my $TabFrame = $ButtonFrame->Subwidget('Button_'.$Widget);
    my $rotate = $this->cget(-tabrotate);
#
#	find our client
#
	my $clients = $this->{ClientList};
#
#	strange timing issue sometimes leaves a null
#	entry at our tail
#
	pop @$clients unless defined($clients->[-1]);

	my $client;
#
#	locate the currently raised tab and restore its
#	unraised color
#
	foreach $client (@$clients) {
		last unless $this->{Raised};
		next unless ($client->[DTF_IDX_WIDGET] eq $this->{Raised});
		my $Button = $client->[DTF_IDX_FRAME]->Subwidget('Button');
		$client->[DTF_IDX_FRAME]->configure(-bg => $client->[DTF_IDX_COLOR]);
		$Button->configure(-bg => $client->[DTF_IDX_COLOR],
	        -activebackground => $client->[DTF_IDX_COLOR],
		);
		last;
	}

	my $raised = 0;
	$raised++
		while (($raised <= $#$clients) &&
			($clients->[$raised][DTF_IDX_WIDGET] ne $Widget));

	return 1 unless ($raised <= $#$clients);
	$client = $clients->[$raised];
	my ($r, $c) = ($client->[DTF_IDX_ROW], $client->[DTF_IDX_COL]);
	my $rows = $this->{RowList};
#
#	undraw the Connector
#
    my $Connector = $this->Subwidget('Connector');
	$Connector->placeForget(); # if $Connector->is_mapped;
	delete $this->{Raised};

	if ($rotate) {
#
#	3 cases:
#		we're already at row 0, so just raise
#		else rotate rows off bottom to top until
#			raised row is bottom row
#
		if ($r != 0) {
#
#	middle row, or last row that fills the frame:
#	move the preceding to top, and move the selected row
#	to the bottom
#
			my $rowcnt = $r;
			push(@$rows, (shift @$rows)),
			$rowcnt--
				while ($rowcnt);
#
#	update client coords
#
			foreach my $i (0..$#$rows) {
				$clients->[$_][DTF_IDX_ROW] = $i
					foreach (@{$rows->[$i]});
			}
			$this->TabRedraw;
		}
#
#	first, lower everything below the raised tab
#	in row 0
#
		my $lowest = $raised;
		my $pseudos = $this->{PseudoTabs};
		foreach (@{$rows->[0]}) {
			$clients->[$_][DTF_IDX_FRAME]->lower($clients->[$lowest][DTF_IDX_FRAME]),
			$lowest = $_
				unless ($_ == $raised);
		}
#
#	now lower everything below its left neighbor
#
		foreach my $i (1..$#$rows) {
			$clients->[$_][DTF_IDX_FRAME]->lower($clients->[$lowest][DTF_IDX_FRAME]),
			$lowest = $_
				foreach (@{$rows->[$i]});
		}
#
#	now make all pseudos lower
#
		if ($#$rows > 0) {
			$pseudos->[1]->lower($clients->[$lowest][DTF_IDX_FRAME]);
			$pseudos->[$_]->lower($pseudos->[$_-1])
				foreach (2..$#$rows);
		}
	    $TabFrame->Subwidget('Button')->raise();
	    $TabFrame->raise();
	}	# if rotate
    $TabFrame->Subwidget('Button')->focus();
#
#	lower the current frame, and then raise the new one
#	!!!NOTE: we can't use pack() here, as it tends to
#	expand the area of our container
#
	$Widget->place(-x => 0, -y => 0, -relheight => 1.0, -relwidth => 1.0);
	$this->{CurrentFrame} = $Widget;

	pop @$clients unless defined($clients->[-1]);
	foreach (0..$#$clients) {
		$clients->[$_][DTF_IDX_WIDGET]->lower($Widget)
			if ($clients->[$_] && $clients->[$_][DTF_IDX_WIDGET] &&
				($clients->[$_][DTF_IDX_WIDGET] ne $Widget));
	}

	my $raisecolor = $client->[DTF_IDX_RAISECOLOR];
#
#	used to smoothly connect raised tab to client frame
#	but only if in row 0
#
	if ($client->[DTF_IDX_ROW] == 0) {
	    $this->update;	# make sure the tabs are redrawn

		my ($connectx, $connectw, $connecty, $connecth);
		my $horizontal = $taborient{$this->{Side}}[DTF_ORIENT_DIRECTION];
		my $inside = $taborient{$this->{Side}}[DTF_ORIENT_ALIGN];
	    my $extra = $this->{Close} ? 12 : -3;
		if ($horizontal) { #
		    $connectx = $TabFrame->x + 2;
		    $connectw = $client->[DTF_IDX_WIDTH] + $extra;
#
#	Y location of connector is either at top (for nw/ne)
#	or bottom (for sw/se) of the client frame
#
		    $connecty = $inside ?
		    	$this->{ClientFrame}->height() - 2 : # may need to adjust this offset
		    	$this->{ClientFrame}->rooty() - $this->rooty() - 7;
		    $connecth = $this->{ClientFrame}->cget(-borderwidth) + 3;
		}
		else {	# vertical
#
#	if tabs at left, then position at left edge of client
#	else position at rt edge
#
			$connectx = $inside ?
				$this->{ClientFrame}->rootx() - $this->rootx() - 8 :
				$this->{ClientFrame}->width() - 3;	# may need to adjust this offset
			$connectw = $this->{ClientFrame}->cget(-borderwidth) + 3;

		    $connecty = $TabFrame->y + 3;
		    $connecth = $client->[DTF_IDX_WIDTH] + $extra;
		}
	    $Connector->place(
	        -x => $connectx,
	        -y => $connecty,
	        -height => $connecth,
	        -width => $connectw,
	        -anchor => 'nw',
		);

	    $Connector->configure(-background => $raisecolor);
	    $Connector->raise();
	}	# end if raise in row 0

	$this->{Raised} = $Widget;
#
#	turn off flashing
#
	$this->deflash($client->[DTF_IDX_CAPTION])
		if $client->[DTF_IDX_FLASH_ID];
#
#	set raised color
#
    $TabFrame->configure(-background => $raisecolor),
    $TabFrame->Subwidget('Button')->configure(
    	-bg => $raisecolor,
		-activebackground => $raisecolor);
#
#	callback if defined && allowed
#
	unless ($silent) {
		my $raisecb = $client->[DTF_IDX_RAISECMD];
		&$raisecb($client->[DTF_IDX_CAPTION])
			if ($raisecb && (ref $raisecb) && (ref $raisecb eq 'CODE'));
	}
    return $Widget;
}
#
#	render tab borders
#
sub TabBorder {
    my ($this, $TabFrame, $forpseudo) = @_;
    my $LineWidth = $this->cget(-borderwidth);
    my $Background = $this->cget(-background);
    my $InnerBackground = $TabFrame->Darken($Background, 120),
    my $Curve = $this->cget (-tabcurve);

    my $mask = $forpseudo ? $borders{'p' . $this->{Side}} :
    	$borders{$this->{Side}};
#
#	left border
#	outer:
	$TabFrame->Frame(
        -background => 'white',
        -borderwidth => 0,
   	)->place(
   	    -x => 0,
   	    -y => $Curve - 1,
   	    -width => $LineWidth,
   	    -relheight => 1.0,
	),
#
#	inner:
   	$TabFrame->Frame(
   	    -background => $InnerBackground,
   	    -borderwidth => 0,
	)->place(
   	    -x => $LineWidth,
   	    -y => $Curve - 1,
   	    -width => $LineWidth,
   	    -relheight => 1.0,
	)
		if ($mask & 1);
#
#	right border
#	outer:
   	$TabFrame->Frame(
       	-background => 'black',
       	-borderwidth => 0,
    )->place(
        -x => - ($LineWidth),
        -relx => 1.0,
        -width => $LineWidth,
        -relheight => 1.0,
        -y => $Curve,
	),
#
#	inner:
	$TabFrame->Frame(
       	-background => $TabFrame->Darken($Background, 80),
       	-borderwidth => 0,
    )->place(
        -x => - ($LineWidth * 2),
        -width => $LineWidth,
        -relheight => 1.0,
        -y => $Curve / 2,
        -relx => 1.0,
	)
		if ($mask & 2);
#
#	top border
#	outer:
   	$TabFrame->Frame(
       	-background => 'white',
       	-borderwidth => 0,
    )->place(
        -x => $Curve - 1,
        -y => 0,
        -relwidth => 1.0,
        -height => $LineWidth,
        -width => - ($Curve * 2),
	),
#
#	inner:
   	$TabFrame->Frame(
       	-background => $InnerBackground,
       	-borderwidth => 0,
    )->place(
        -x => $Curve - 1,
        -y => $LineWidth,
        -relwidth => 1.0,
        -height => $LineWidth,
        -width => - ($Curve * 2),
	)
		if ($mask & 4);
#
#	bottom border
#	outer:
   	$TabFrame->Frame(
       	-background => $InnerBackground,
       	-borderwidth => 0,
    )->place(
        -x => $Curve - 1,
#        -y => - ($LineWidth),
        -rely => 1.0,
        -relwidth => 1.0,
        -height => $LineWidth,
        -width => - ($Curve),
	),
#
#	inner:
   	$TabFrame->Frame(
		-background => 'black',
		-borderwidth => 0,
       	-height => $LineWidth,
    )->place(
        -x => $Curve - 1,
        -y => - ($LineWidth),
        -rely => 1.0,
        -relwidth => 1.0,
        -height => $LineWidth,
        -width => - ($Curve),
	)
		if ($mask & 8);
}

sub TabCurrent {
    return defined ($_[1]) ?
        $_[0]->TabRaise($_[1]) :
        $_[0]{Raised};
}
#
#	returns the width of a row
#
sub GetButtonRowWidth {
    my ($Width, $this, $row) = (0, shift, shift);

	return 0
		unless ($this->{RowList} && ($#{$this->{RowList}} >= $row));

	my $rowlist = $this->{RowList}[$row];
	my $tablist = $this->{ClientList};
	my $extra = 5 + ($this->{Close} ? 15 : 0);
	my $horizontal = $taborient{$this->{Side}}[DTF_ORIENT_DIRECTION];
    foreach my $Client (@$rowlist) {
        $Width += $extra + ($tablist->[$Client][DTF_IDX_WIDTH])
	   		if defined($tablist->[$Client]);
	}

    return $Width ? $Width - 10 : 0;
}
#
#	returns the accumulated height of all our rows
#
sub GetButtonRowHeight {
    my ($Height, $this, $row) = (0, shift, shift);

	return 0
		unless ($this->{RowList} && ($#{$this->{RowList}} >= $row));

	my $total_ht = 0;
	$total_ht += $this->GetRowHeight($_)
		foreach (0..$row);
    return $total_ht;
}
#
#	returns the height of a single row
#
sub GetRowHeight {
    my ($Height, $this, $row) = (0, shift, shift);
    my $ButtonFrame = $this->{ButtonFrame};

	return 0
		unless ($this->{RowList} && ($#{$this->{RowList}} >= $row));

	my $rowlist = $this->{RowList}[$row];
	my $tablist = $this->{ClientList};
	my $total_ht = 0;
	my $newht = 0;
   	foreach (@$rowlist) {
   		next unless defined($tablist->[$_]);
   	    $newht = $tablist->[$_][DTF_IDX_HEIGHT];
   	    $Height = $newht if ($newht > $Height);
	}
    return $Height;
}

sub Font {
    my ($this, $Font) = (shift, @_);

	my $font = $this->{Font};
	$font = $this->parent()->cget(-font) unless $font;

    return ($font)
    	unless (defined ($Font));

    my $tablist = $this->{ClientList};

	$_->[DTF_IDX_FRAME]->Subwidget('Button')->configure(-font => $Font)
    	foreach (@$tablist);
#
#	we need to redraw, since this may change our tab layout
#
	$this->TabRedraw(1);
    return ($this->{Font} = $Font);
}
#
#	Reconfigure the tabs on resize event
#
sub TabReconfig {
	my $this = shift;
  	return 1
  		if ($this->{Updating} ||
  			($this->cget(-tablock) && (! $this->cget(-tabclose))));
	my $buttons = $this->{ButtonFrame};
	my $clients = $this->{ClientList};
#
#	if nothing to draw, then just update context
#
  	$this->{OldWidth} = $this->width,
  	$this->{OldHeight} = $this->height,
	return 1
		unless ($#$clients >= 0);
#
#	compute current max row width
#	compare to current frame width
#	if maxrow > frame
#		redraw
#	elsif maxrow - frame > threshold
#		redraw
#
	my $rows = $this->{RowList};
  	my $w = $buttons->width();
	my $h = $buttons->height();

	my $maxw = 0;
	foreach (0..$#$rows) {
		my $rw = $this->GetButtonRowWidth($_);
		$maxw = $rw if ($maxw < $rw);
	}
#
#	return unless significantly different from old size
#
  	$this->{OldWidth} = $this->width,
  	$this->{OldHeight} = $this->height,
	return 1
		unless (($maxw > $w) || ($w - $maxw > 10));
#
#	just redraw everything
#
	$this->{Updating} = 1;
	$this->TabRedraw(1);
	$this->{Updating} = undef;
  	$this->{OldWidth} = $this->width;
  	$this->{OldHeight} = $this->height;
  	return 1;
}
#
#	redraw our tabs
#
sub TabRedraw {
	my ($this, $rearrange) = @_;
#
#	compute new display ordering
#
	return 1 unless ($#{$this->{ClientList}} >= 0);
	my $ButtonFrame = $this->{ButtonFrame};
	my $clients = $this->{ClientList};
	my $rows = $this->{RowList};
#
#	if nothing to draw, bail out
#
	return 1 if (($#$rows < 0) ||
		(($#$rows == 0) && ($#{$rows->[0]} < 0)));

	my $pseudos = $this->{PseudoTabs};
	my $pseudoht;
	my $Raised = $this->{Raised};	# save for later
	my $roww = 0;
	my $raised_row = undef;
	my $horizontal = $taborient{$this->{Side}}[DTF_ORIENT_DIRECTION];
	my $alignment = $taborient{$this->{Side}}[DTF_ORIENT_PSEUDOANCHOR];
	my $downward = $taborient{$this->{Side}}[DTF_ORIENT_DOWNWARD];
	my $extra = $this->{Close} ? 15 : 0;
#
#	tabspace determined based on orientation
#
	my $w = $horizontal ? $ButtonFrame->width() : $ButtonFrame->height();
	$w -= 5;

	if ($rearrange) {
#
#	rearrange tabs to fit new frame width
#
		my @newrows = ([]);
		my @tclients = ();
		foreach my $row (@$rows) {
			foreach (@$row) {
				my $client = $clients->[$_];
				next
					if $client->[DTF_IDX_HIDDEN];

				my $btnw = $extra + $client->[DTF_IDX_WIDTH];
				my $row = $#$rows;

				$roww = 0,
				push @newrows, [ ]
					if (($roww + $btnw > $w) && ($#{$newrows[0]} >= 0));

				$roww += $btnw;
				push @{$newrows[-1]}, $_;
				$tclients[$_] = [ $#newrows, $#{$newrows[-1]} ];
				$raised_row = $#newrows
					if ($Raised && $client->[DTF_IDX_WIDGET] &&
						($client->[DTF_IDX_WIDGET] eq $Raised));
			}
		}
#
#	if number of rows exceeds our limit
#
		return undef
			if ($#newrows > DTF_MAX_ROWS);
#
#	save the new row lists
#
		$this->{RowList} = \@newrows;
		$rows = \@newrows;
		foreach my $row (@$rows) {
			$clients->[$_]->[DTF_IDX_ROW] = $tclients[$_][0],
			$clients->[$_]->[DTF_IDX_COL] = $tclients[$_][1]
				foreach (@$row);
		}
	}
#
#	purge all our pseudotabs
#
	foreach (@$pseudos) {
		next unless $_;
		$_->placeForget()
			if $_->ismapped();
	}
#
#	undraw all our buttons
#
	foreach my $i (0..$#$rows) {
		foreach (@{$rows->[$i]}) {
			$clients->[$_][DTF_IDX_FRAME]->placeForget()
				if $clients->[$_][DTF_IDX_FRAME]->ismapped();
		}
	}
#
#	adjust our frame height to accomodate the rows
#
	my $dim = $horizontal ? '-height' : '-width';
	$ButtonFrame->configure(
		$dim => $this->GetButtonRowHeight($#$rows) +
			($downward ? 5 : 7));
#
#	reconfig tabs to match height of tallest tab in row
#
	my @hts = ();
	push @hts, $this->GetRowHeight($_)
		foreach (0..$#$rows);
#
#	redraw all our buttons, starting from the top row
#	note: we force each button to fully fill the button frame;
#	this improves the visual effect when an upper tab extends
#	to the right of the end of the row below it
#
    my $Connector = $this->Subwidget('Connector');
    $Connector->placeForget(); # if $Connector->is_mapped();
	my ($i, $x, $y, $client, $frame);
	if ($horizontal) {
		if ($downward) {
#
#	top tabs:
#		draw from outermost row to innermost
#
			$i = $#$rows;
			$y = 0;
			$x = 0;
			while ($i >= 0) {
				$x = ($alignment eq 'e') ? 0 : $ButtonFrame->width() - 8;

				foreach (0..$#{$rows->[$i]}) {
					$client = $clients->[$rows->[$i][$_]];
					$frame = $client->[DTF_IDX_FRAME];
					$x -= ($client->[DTF_IDX_WIDTH] + $extra)
						if ($alignment eq 'w');
					$frame->Subwidget('Button')->configure(
						-height => $hts[$i]);
					$frame->place(
						-x => $x,
						-y => $y,
						-height => $hts[$i] + 6
					);

					$x += $client->[DTF_IDX_WIDTH] + $extra
						if ($alignment eq 'e');
				}
#
#	draw pseudotabs if needed
#
				$y = $y + $this->GetRowHeight($i)
					if $i;
				$pseudoht = $this->GetButtonRowHeight($i-1) + 6,
				$pseudos->[$i]->place(
					-x => 0,
					-y => $y + 4,
					-width => $ButtonFrame->width() - 8,
					-height => $pseudoht)
					if $i;
				$i--;
			}
		}
		else {
#
#	bottom tabs:
#		draw from innermost row to innermost
#
			$i = 0;
			$y = 0;
			while ($i <= $#$rows) {
				$x = ($alignment eq 'e') ? 0 : $ButtonFrame->width() - 8;

				foreach (0..$#{$rows->[$i]}) {
					$client = $clients->[$rows->[$i][$_]];
					$frame = $client->[DTF_IDX_FRAME];
					$x -= ($client->[DTF_IDX_WIDTH] + $extra)
						if ($alignment eq 'w');

					$frame->Subwidget('Button')->configure(
						-height => $hts[$i]);
					$frame->place(
						-x => $x,
						-y => $y,
						-height => $hts[$i] + 6
					);

					$x += $client->[DTF_IDX_WIDTH] + $extra
						if ($alignment eq 'e');
				}
#
#	draw pseudotabs if needed
#
				$pseudoht = $this->GetButtonRowHeight($i-1) + 1,
				$pseudos->[$i]->place(
					-x => 0,
					-y => 0,
					-width => $ButtonFrame->width() - 8,
					-height => $pseudoht)
					if $i;

				$y = $y + $this->GetRowHeight($i);
				$i++;
			}	# end while
		}	# end if downward...else...
	}	# end if horizontal
	else { # vertical tabs
		if ($downward) {
#
#	left tabs:
#		draw from outermost row to innermost
#
			$i = $#$rows;
			$x = 0;
			while ($i >= 0) {
				$y = ($alignment eq 's') ? 0 : $ButtonFrame->height() - 8;

				foreach (0..$#{$rows->[$i]}) {
					$client = $clients->[$rows->[$i][$_]];
					$frame = $client->[DTF_IDX_FRAME];
					$y -= ($client->[DTF_IDX_WIDTH] + $extra)
						if ($alignment eq 'n');

					$frame->Subwidget('Button')->configure(-width => $hts[$i]);
					$frame->place(
						-x => $x,
						-y => $y,
						-width => $hts[$i] + 6
					);

					$y +=  $client->[DTF_IDX_WIDTH] + $extra
						if ($alignment eq 's');
				}
#
#	draw pseudotabs if needed
#
				$x += $this->GetRowHeight($i);
				$pseudoht = $this->GetButtonRowWidth($i-1) + 6,
				$pseudos->[$i]->place(
					-x => $x + 4,
					-y => 0,
					-width => $pseudoht,
					-height => $ButtonFrame->height() - 8)
					if $i;
				$i--;
			}
		}
		else {
#
#	right tabs:
#		draw from innermost row to innermost
#
			$i = 0;
			$x = 0;
			while ($i <= $#$rows) {
				$y = ($alignment eq 's') ? 0 : $ButtonFrame->height() - 8;

				foreach (0..$#{$rows->[$i]}) {
					$client = $clients->[$rows->[$i][$_]];
					$frame = $client->[DTF_IDX_FRAME];
					$y -= ($client->[DTF_IDX_WIDTH] + $extra)
						if ($alignment eq 'n');

					$frame->Subwidget('Button')->configure(-width => $hts[$i]);
					$frame->place(
						-x => $x,
						-y => $y,
						-width => $hts[$i] + 6
					);

					$y +=  $client->[DTF_IDX_WIDTH] + $extra
						if ($alignment eq 's');
				}
#
#	draw pseudotabs if needed
#
				$pseudoht = $this->GetButtonRowHeight($i-1),
				$pseudos->[$i]->place(
					-x => $x - $pseudoht,
					-y => 0,
					-width => $pseudoht + 1,
					-height => $ButtonFrame->height() - 8)
					if $i;
				$x += $this->GetRowHeight($i);
				$i++;
			}	# end while
		}	# end if downward...else...
	}	# end if horizontal...else...
#
#	and reapply our tab order
#
	$this->TabOrder;
#
#	and reraise in case raised ended up somewhere other than
#	bottom row
#
	$this->TabRaise($Raised, 1) if $Raised;

	return 1;
}
#
#	remove a single tab and re-org the tabs
#
sub TabRemove {
	my ($this, $Caption) = @_;
	$this->{Updating} = 1;
#
#	remove a tab
#
	return undef
		unless defined($this->{ClientHash}{$Caption});

	my $rows = $this->{RowList};
	my $clients = $this->{ClientList};
	my $listsz = $#$clients;
	my $clientno = $this->{ClientHash}{$Caption};
	my $client = $clients->[$clientno];
	my $Widget = $client->[DTF_IDX_WIDGET];
	my ($r, $c) = ($client->[DTF_IDX_ROW], $client->[DTF_IDX_COL]);
#
#	if its the raised widget, then we need to raise
#	a tab to replace it (unless its the only widget)
#	...whatever is left at 0,0 sounds good to me...
#
	my $row = $rows->[$r];
	my $newcurrent = ($client->[DTF_IDX_WIDGET] eq $this->{Raised}) ? 1 : undef;
#
#	remove client from lists
#
	delete $this->{ClientHash}{$Caption};

	if ($clientno eq $#$clients) {
	# Perl bug ? we seem to not get spliced out at ends
		pop @$clients;
	}
	else {
		splice @$clients, $clientno, 1;
	}
	splice @$row, $c, 1;
#
#	adjust client positions in this row
#
	$clients->[$row->[$_]][DTF_IDX_COL]--
		foreach ($c..$#$row);
#
#	adjust client indices in the hash
#
	foreach (keys %{$this->{ClientHash}}) {
		$this->{ClientHash}{$_} -= 1
			if ($this->{ClientHash}{$_} > $clientno);
	}
#
#	adjust all our row index lists
#
	foreach my $row (@$rows) {
		foreach (0..$#$row) {
			$row->[$_]-- if ($row->[$_] > $clientno);
		}
	}

    my $TabFrame = $client->[DTF_IDX_FRAME];
	$TabFrame->packForget();
	$TabFrame->destroy();
	$Widget->destroy();
#
#	if only tab in row, remove the row
#	and adjust the clients in following rows
#
	if ($#$row < 0) {
		foreach my $i ($r+1..$#$rows) {
			$row = $rows->[$i];
			$clients->[$_][DTF_IDX_ROW] -= 1
				foreach (@$row);
		}
		splice @$rows, $r, 1;
	}

	if ($#$rows < 0) {
#
#	no rows left, clear everything
#
		$this->{Raised} = undef;
		$this->Subwidget('Connector')->placeForget();
		$this->{CurrentFrame} = undef;
	}
	elsif ($newcurrent) {
		$this->{Raised} = $clients->[$rows->[0][0]][DTF_IDX_WIDGET];
	}
#
#	redraw everything
#
	$this->TabRedraw(1);
	$this->{Updating} = undef;
#
#	odd behavior (maybe Resize timing issue):
#	we occasionally end up with an undef entry at the tail
#
	pop @$clients
		unless (($listsz - 1) == $#$clients);
	return 1;
}
#
#	reveal a previously hidden tab and re-org the tabs
#
sub TabReveal {
	my ($this, $Caption) = @_;
	$this->{Updating} = 1;

	return undef
		unless defined($this->{ClientHash}{$Caption});

	my $clients = $this->{ClientList};
	my $rows = $this->{RowList};
	my $clientno = $this->{ClientHash}{$Caption};
	my $client = $clients->[$clientno];
	return 1
		unless $client->[DTF_IDX_HIDDEN];
#
#	make visible and redraw; note we don't
#	make it raised yet
#
	$client->[DTF_IDX_HIDDEN] = undef;
#
#	pack tab in our rowframe 0; redraw if needed
#	move everything over 1 column in bottom row
#
	$clients->[$_][DTF_IDX_COL]++
		foreach (@{$rows->[0]});
	unshift @{$rows->[0]}, $clientno;
#
#	redraw everything
#
	$this->TabRedraw(1);
	$this->{Updating} = undef;
#
#	if nothing is raised, then raise us
#
	$this->raise($Caption)
		unless $this->{Raised};
	return 1;
}
#
#	hide a single tab and re-org the tabs
#
sub TabHide {
	my ($this, $Caption) = @_;
	$this->{Updating} = 1;

	return undef
		unless defined($this->{ClientHash}{$Caption});

	my $rows = $this->{RowList};
	my $clients = $this->{ClientList};
	my $listsz = $#$clients;
	my $clientno = $this->{ClientHash}{$Caption};
	my $client = $clients->[$clientno];
	my $Widget = $client->[DTF_IDX_WIDGET];
	my ($r, $c) = ($client->[DTF_IDX_ROW], $client->[DTF_IDX_COL]);
#
#	if its the raised widget, then we need to raise
#	a tab to replace it (unless its the only widget)
#	...whatever is left at 0,0 sounds good to me...
#
	my $row = $rows->[$r];
	my $newcurrent = ($client->[DTF_IDX_WIDGET] eq $this->{Raised}) ? 1 : undef;
#
#	hide the client
#
	$client->[DTF_IDX_HIDDEN] = 1;
	$client->[DTF_IDX_ROW] = undef;
	$client->[DTF_IDX_COL] = undef;

	splice @$row, $c, 1;
#
#	adjust client positions in this row
#
	$clients->[$row->[$_]][DTF_IDX_COL]--
		foreach ($c..$#$row);
#
#	adjust all our row index lists
#
#	foreach my $row (@$rows) {
#		foreach (0..$#$row) {
#			$row->[$_]-- if ($row->[$_] > $clientno);
#		}
#	}
#
#	force us into unraised color
#
    my $TabFrame = $this->{ButtonFrame}->Subwidget('Button_'.$Widget);
    $TabFrame->configure(-background => $client->[DTF_IDX_COLOR]);
    $TabFrame->Subwidget('Button')->configure(
    	-bg => $client->[DTF_IDX_COLOR],
		-activebackground => $client->[DTF_IDX_COLOR]);

	$client->[DTF_IDX_FRAME]->placeForget()
		if $client->[DTF_IDX_FRAME]->ismapped();
#
#	if only tab in row, remove the row
#	and adjust the clients in following rows
#
	if ($#$row < 0) {
		foreach my $i ($r+1..$#$rows) {
			$row = $rows->[$i];
			$clients->[$_][DTF_IDX_ROW] -= 1
				foreach (@$row);
		}
		splice @$rows, $r, 1;
	}

	if ($#$rows < 0) {
#
#	no rows left, clear everything
#
		$this->{Raised} = undef;
		$this->Subwidget('Connector')->placeForget();
		$this->{CurrentFrame} = undef;
	}
	elsif ($newcurrent) {
		$this->{Raised} = $clients->[$rows->[0][0]][DTF_IDX_WIDGET];
	}
#
#	redraw everything
#
	$this->TabRedraw(1);
	$this->{Updating} = undef;
	return 1;
}
#
#	compute the tabbing traversal order
#	note an anomaly:
#	if the top row doesn't fill the frame, and a top
#	row button is tabbed to, it is automatically moved
#	to the 0,0, and its tab order it recomputed. This
#	means that its impossible to tab to any tab
#	in the top row except the first tab. We may eventually
#	change TabRaise to bring the entire top row down
#	if a top row tab is raised.
#
sub TabOrder {
	my ($this) = @_;

	my $rows = $this->{RowList};
	my $clients = $this->{ClientList};
	my ($prev, $next);

	foreach my $i (0..$#$rows) {
		my $row = $rows->[$i];
		foreach my $j (0..$#$row) {
			if ($j == 0) {
				$prev = ($i == 0) ? $rows->[-1][-1] : $rows->[$i-1][-1];
				$next = ($#$row == 0) ?
					($i == $#$rows) ? $rows->[0][0] : $rows->[$i+1][0] :
					$row->[$j+1];
			}
			elsif ($j == $#$row) {
				$prev = $row->[$j-1];
				$next = ($i == $#$rows) ? $rows->[0][0] : $rows->[$i+1][0];
			}
			else {
				$prev = $row->[$j-1];
				$next = $row->[$j+1];
			}

			my $button = $clients->[$row->[$j]][DTF_IDX_FRAME]->Subwidget('Button');
			my $prevwgt = $clients->[$prev][DTF_IDX_WIDGET];
			my $prevbtn = $clients->[$prev][DTF_IDX_FRAME]->Subwidget('Button');
			my $nextwgt = $clients->[$next][DTF_IDX_WIDGET];
			my $nextbtn = $clients->[$next][DTF_IDX_FRAME]->Subwidget('Button');

			# bind us
	        $button->bind ('', sub {$prevbtn->focus();});
	        $button->bind ('', sub {$this->TabRaise($prevwgt);});
	        $button->bind ('', sub {$nextbtn->focus();});
	        $button->bind ('', sub {$this->TabRaise($nextwgt);});
		}
	}
	return 1;
}
#
#	create a tooltip for the tab
#
sub CreateTabTip {
	my ($this, $w, $btn, $tiptext) = @_;
#
#	create balloon if none exists
#
	$this->{Balloon} = $this->Component(
		'Balloon' => 'Balloon',
		-state => 'balloon',
		-balloonposition => 'widget',
		-initwait => $this->{_tiptime},
		-background => $this->{_tipcolor})
		unless $this->{Balloon};
#
#	attach a balloon if tiptext requested
#
	$w->[DTF_IDX_TABTIP] = $tiptext;
	return $this->{Balloon}->attach($btn, -balloonmsg => $tiptext);
}
#
#	change tab's tip text
#
sub UpdateTabTip {
	my ($this, $w, $btn, $tiptext) = @_;

	return undef unless $this->{Balloon};
#
#	attach a balloon if tiptext requested
#
	$this->{Balloon}->detach($btn)
		if $w->[DTF_IDX_TABTIP];
	$w->[DTF_IDX_TABTIP] = $tiptext;
	return $this->{Balloon}->attach($btn, -balloonmsg => $tiptext);
}

#
#	remove a tooltip from the tab
#
sub RemoveTabTip {
	my ($this, $w, $btn) = shift;

	return 1 unless $this->{Balloon};

	$w->[DTF_IDX_TABTIP] = undef;
	return $this->{Balloon}->detach($btn);
}

sub current {
	shift->TabCurrent (@_);
}

sub add {
    my $this = shift;
#
#	make this Notebook compatible
#
    my $caption;
    $caption = shift
    	unless ($_[0]=~/^-(caption|tabcolor|raisecolor|tabtip|hidden|state|label|image|text)$/);
    my %args = @_;
	$caption = $args{-caption} unless $caption;
	return undef unless defined($caption);
    my $frame = $this->TabCreate(
        $caption,
        delete $args{'-tabcolor'},
        delete $args{'-raisecolor'},
        delete $args{'-image'},
        delete $args{'-label'},
        delete $args{'-raisecmd'},
       );
#
#	pick up any attributes we didn't process during creation
#
    $this->pageconfigure($caption, %args)
    	if ($frame && %args);
	return $frame;
}
#
#	turn off flashing tab
#
sub deflash {
	my ($this, $page) = @_;

	return undef
		unless defined($this->{ClientHash}{$page});

    my $w = $this->{ClientList}[$this->{ClientHash}{$page}];
	my $color = (defined($this->{Raised}) &&
		($w->[DTF_IDX_WIDGET] eq $this->{Raised})) ?
		$w->[DTF_IDX_RAISECOLOR] :
		$w->[DTF_IDX_COLOR];
	my $frame = $w->[DTF_IDX_FRAME];
	$frame->configure(-bg => $color),
	$frame->Subwidget('Button')->configure(
		-bg => $color, -activebackground => $color),
	$frame->afterCancel($w->[DTF_IDX_FLASH_ID]),
	$w->[DTF_IDX_FLASH_ID] = $w->[DTF_IDX_FLASHED] =
		$w->[DTF_IDX_FLASH_TIME] = undef
		if $w->[DTF_IDX_FLASH_ID];
	return $this;
}
#
#	flash a tab
#
sub flash {
	my ($this, $page, %args) = @_;

	return undef
		unless defined($this->{ClientHash}{$page});

    my $w = $this->{ClientList}[$this->{ClientHash}{$page}];
#
#	don't start new flash if we already are
#
    return $this if $w->[DTF_IDX_FLASH_ID];
	$args{-interval} = 300 unless $args{-interval};
	$args{-duration} = 5000 unless $args{-duration};

	$w->[DTF_IDX_FLASH_COLOR] = $args{-color} ||= 'blue';
	$w->[DTF_IDX_FLASH_INTVL] = $args{-interval};
	$w->[DTF_IDX_FLASH_TIME] = Tk::timeofday() + ($args{-duration}/1000);

	$w->[DTF_IDX_FLASH_ID] = $w->[DTF_IDX_FRAME]->repeat(
		$w->[DTF_IDX_FLASH_INTVL],
		sub {
			my $color = (defined($this->{Raised}) &&
				($w->[DTF_IDX_WIDGET] eq $this->{Raised})) ?
				$w->[DTF_IDX_RAISECOLOR] :
				$w->[DTF_IDX_COLOR];
			my $frame = $w->[DTF_IDX_FRAME];
			$frame->afterCancel($w->[DTF_IDX_FLASH_ID]),
			$frame->configure(-bg => $color),
			$frame->Subwidget('Button')->configure(
				-bg => $color, -activebackground => $color),
			$w->[DTF_IDX_FLASH_ID] = $w->[DTF_IDX_FLASHED] =
				$w->[DTF_IDX_FLASH_TIME] = undef,
			return 1
				if (Tk::timeofday() > $w->[DTF_IDX_FLASH_TIME]);

			$color = $w->[DTF_IDX_FLASH_COLOR] unless $w->[DTF_IDX_FLASHED];
			$frame->configure(-bg => $color);
			$frame->Subwidget('Button')->configure(
				-bg => $color, -activebackground => $color);
			$w->[DTF_IDX_FLASHED] = ! $w->[DTF_IDX_FLASHED];
			return 1;
		}
	);
	return $this;
}

sub raised {
	shift->TabCurrent (@_);
}
#
#	return caption of current raised widget
#
sub raised_name {
	my $this = shift;

	return undef unless $this->{Raised};
	my $clients = $this->{ClientList};
	foreach my $client (@$clients) {
		return $client->[DTF_IDX_CAPTION]
			if ($client->[DTF_IDX_WIDGET] eq $this->{Raised});
	}
    return undef;
}
#
#	Notebook compatible methods
#
sub pagecget {
	my ($this, $page, $option) = @_;

	return undef
		unless (defined($this->{ClientHash}{$page}) &&
			defined($page_opts{$option}));

	return $page if ($option eq '-caption');

    my $w = $this->{ClientList}[$this->{ClientHash}{$page}];
	return ($page_opts{$option}=~/^\d+/) ?
		$w->[$page_opts{$option}] :
		$w->[DTF_IDX_FRAME]->Subwidget('Button')->cget($page_opts{$option});
}

sub pageconfigure {
	my ($this, $page, %args) = @_;

	return undef
		unless defined($this->{ClientHash}{$page});
#
#	we're forgiving here if they supply an option we don't
#	support
#
    my $w = $this->{ClientList}[$this->{ClientHash}{$page}];
	my $btn = $w->[DTF_IDX_FRAME]->Subwidget('Button');
	foreach (keys %args) {
		next unless defined($page_opts{$_});

		if ($_ eq '-hidden') {
#
#	check if hiding the page
#
			if ($args{$_}) {
				next if $w->[DTF_IDX_HIDDEN];
				$this->TabHide($page);
			}
			else {
#
#	restore the tab if its hidden
#
				$this->TabReveal($page)
					if $w->[DTF_IDX_HIDDEN];
			}
			next;
		}
#
#	make sure we apply state to the close button too
#
		if ($_ eq '-state') {
		  if ($w->[DTF_IDX_FRAME]->Subwidget('CloseBtn')) {
		    $w->[DTF_IDX_FRAME]->Subwidget('CloseBtn')->configure(-state => $args{$_});
		  }
		  $btn->configure(-state => $args{$_});
		}
		next
			if ($_ eq '-state');

		$btn->configure($page_opts{$_} => $args{$_}), next
			unless ($page_opts{$_}=~/^\d+/);
#
#	create, update, or remove the button balloon
#
		if ($_ eq '-tabtip') {
			if ($w->[DTF_IDX_TABTIP]) {
				if (defined($args{$_})) {
					$this->UpdateTabTip($w, $btn, $args{$_});
				}
				else {
					$this->RemoveTabTip($w, $btn);
				}
			}
			else {	# no current tip, create one if requested
				$this->CreateTabTip($w, $btn, $args{$_})
					if $args{$_};
			}
			next;
		}

		$w->[$page_opts{$_}] = $args{$_};
#
#	update the button text; be sure to rotate if needed
#
		$btn->configure(
			-text => ($taborient{$this->{Side}}[DTF_ORIENT_DIRECTION] ?
				$w->[DTF_IDX_LABEL] : RotateTabText($w->[DTF_IDX_LABEL])) ),
		next
			if ($_ eq '-label');
#
#	reconfig the button and tab colors as needed
#
		$btn->configure(-bg => $args{$_}),
		$w->[DTF_IDX_FRAME]->configure(-bg => $args{$_})
			if ((($_ eq '-tabcolor') &&
				((! defined($this->{Raised})) ||
					($w->[DTF_IDX_WIDGET] ne $this->{Raised}))) ||
				(($_ eq '-raisecolor') &&
					(defined($this->{Raised}) &&
					($w->[DTF_IDX_WIDGET] eq $this->{Raised}))));
	}
	1;
}

sub pages {
	return keys %{shift->{ClientHash}};
}

sub tiptime {
	my ($this, $time) = @_;

	return $this->{_tiptime}
		unless defined($time);
	$this->{_tiptime} = $time;
	return $this->{Balloon} ?
		$this->{Balloon}->configure(-initwait => $time) : 1;
}

sub tipcolor {
	my ($this, $color) = @_;

	return $this->{_tipcolor}
		unless defined($color);
	$this->{_tipcolor} = $color;
	return $this->{Balloon} ?
		$this->{Balloon}->configure(-background => $color) : 1;
}

sub font {
	shift->Font(@_);
}
#
#	programatically raise a tab using its caption
#
sub raise {
	my ($this, $Caption) = @_;
    return defined($this->{ClientHash}{$Caption}) ?
    	$this->TabRaise($this->{ClientList}[$this->{ClientHash}{$Caption}][DTF_IDX_WIDGET]) :
    	undef;
}
#
#	programatically remove a tab using its caption
#
sub delete {
	my ($this, $Caption) = @_;
	return defined($this->{ClientHash}{$Caption}) ?
		$this->TabRemove($Caption) : undef;
}
#
#	return a hash of our tabs keyed by caption, so the
#	app can e.g., attach a Balloon to them
#
sub tabs {
	my ($this) = @_;
	my $tabs = { };
	my $clients = $this->{ClientList};

	$tabs->{$_} = $clients->[$this->{ClientHash}{$_}][DTF_IDX_FRAME]
		foreach (keys %{$this->{ClientHash}});
	return $tabs;
}

sub tabside {
	my ($this, $side) = @_;

	return $this->{Side} unless defined($side);
#
#	if already populated, don't permit change
#
	return undef
		unless ($side=~/^([ns][ew]?)|([ew][ns]?)$/i);
#
#	if already populated, don't permit change
#
	return undef
		if $this->{PseudoTabs};

	$side = lc $side;
	$side .= 'w' if (($side eq 'n') || ($side eq 's'));
	$side .= 'n' if (($side eq 'e') || ($side eq 'w'));
	return $side if ($this->{Side} eq $side);

	my $oldside = $this->{Side};
	$this->{Side} = $side;
#
#	modify all the tabs to move their buttons and closers
#
	my $to = $taborient{$side};
	my $clients = $this->{ClientList};
	my $tab;
	my $padx = $this->cget(-tabpadx);
	my $pady = $this->cget(-tabpady);
	foreach (keys %{$this->{ClientHash}}) {
		$tab = $clients->[$this->{ClientHash}{$_}];
		my $btn = $tab->[DTF_IDX_FRAME]->Subwidget('Button');
		$btn->packForget;
		if ($tab->[DTF_IDX_FRAME]->Subwidget('CloseBtn')) {
#
#	repack close tab
#
			my $closer = $tab->[DTF_IDX_FRAME]->Subwidget('CloseBtn');
			$closer->packForget;
			$closer->configure(
       			-anchor => $to->[DTF_ORIENT_CLOSEANCHOR]);
			$closer->pack(
		       	-side => $to->[DTF_ORIENT_CLOSESIDE],
		       	-anchor => $to->[DTF_ORIENT_CLOSEANCHOR],
		        -expand => 0,
		        -fill => 'none',
		        -ipadx => 0,
		        -ipady => 0,
		        -padx => 1,
		        -pady => 1,
			);
		}
#
#	rotate button text if needed
#
		$btn->configure(-text =>
			($to->[DTF_ORIENT_DIRECTION] ? $tab->[DTF_IDX_LABEL] :
				RotateTabText($tab->[DTF_IDX_LABEL])))
			if defined($btn->cget(-text));
#
#	repack the button
#
	    $btn->pack(
	       	-side => $to->[DTF_ORIENT_BTNSIDE],
	       	-anchor => $to->[DTF_ORIENT_BTNANCHOR],
	        -expand => 0,
	        -fill => 'none',
	        -ipadx => 0,
	        -ipady => 0,
	        -padx => $padx,
	        -pady => $pady,
		);
#
#	record new button size
#
		$tab->[DTF_IDX_HEIGHT] = $to->[DTF_ORIENT_DIRECTION] ?
			$btn->reqheight + (2 * $pady) :
			$btn->reqwidth + (2 * $padx);
		$tab->[DTF_IDX_WIDTH] = $to->[DTF_ORIENT_DIRECTION] ?
			$btn->reqwidth + (2 * $padx) :
			$btn->reqheight + (2 * $pady);
	}
######################################################################
#
#	we must repack the major frame components for this to work;
#	but this process may have some undesirable consequences, and probably
#	requires that we do everything in a specific order...
#
######################################################################
#
#	get tab alignment info
#
	my ($tabside, $tabfill, $tabanchor, $tabsize, $clientside) =
		@{$tabalign{$side}};
#
#	unplace the pseudo tabs,
#	and remove their current border decorations
#	(do we dare to destroy here ???)
#
	foreach (@{$this->{PseudoTabs}}) {
		next unless $_;
		$_->placeForget();
		$_->destroy;
	}
	delete $this->{PseudoTabs};
#
#	repack the buttonframe
#
    $this->{ButtonFrame}->packForget;
    $this->{ClientFrame}->packForget;

    $this->{ButtonFrame}->configure($tabsize => 40);
	$this->{ButtonFrame}->pack(
        -anchor => $tabanchor,
        -side => $tabside,
        -fill => $tabfill,
	);
#
#	repack the client frame
#
	$this->{ClientFrame}->pack(
        -side => $clientside,
        -expand => 'true',
        -fill => 'both',
	);
#
#	prep for reconfig
#
	$this->{OldWidth} = $this->{ButtonFrame}->reqwidth();
	$this->{OldHeight} = $this->{ButtonFrame}->reqheight();
#
#	recreate our pseudotabs
#
#	push @{$this->{PseudoTabs}}, $this->PseudoCreate($_)
#		foreach (1..DTF_MAX_ROWS);
#
#	finally, redraw everyone
#
	$this->TabRedraw(1);
	return $oldside;
}

sub tabscroll {
	my ($this, $scroll) = shift;

	return $this->{Scrolled} unless defined($scroll);
	return 1
		unless ($this->{Scrolled} ^ $scroll);
#
#	set to requested state and redraw
#
	$this->{Scrolled} = $scroll;
	return $this->TabRedraw();
}

sub tabclose {
	my ($this, $close) = @_;

	return $this->{Close} unless defined($close);
	return 1 unless ($this->{Close} || $close);

	my $clients = $this->{ClientList};

	if ($this->{Close} && (! $close)) {
#
#	remove close buttons from everything
#
		delete $this->{Close};

		$_->[DTF_IDX_FRAME]->Subwidget('CloseBtn')->packForget,
		$_->[DTF_IDX_FRAME]->Subwidget('CloseBtn')->Destroy
			foreach (@$clients);
	}
	elsif ($close && (! $this->{Close})) {
#
#	add close buttons to everything
#
 		$this->{Close} = ((ref $close) && (ref $close eq 'CODE')) ?
 			$close : \&TabRemove;

	    $_->[DTF_IDX_FRAME]->Component(
        	'Button' => 'CloseBtn',
        	-command => [ $this->{Close}, $this, $_->[DTF_IDX_CAPTION] ],
        	-anchor => 'ne',
        	-relief => 'raised',
        	-borderwidth => 1,
        	-takefocus => 1,
        	-padx => 0,
        	-pady => 0,
        	-image => $this->{CloseImage}
       	)->pack(
	       	-side => 'top',
	       	-anchor => 'ne',
	        -expand => 0,
	        -fill => 'none',
	        -ipadx => 0,
	        -ipady => 0,
	        -padx => 0,
	        -pady => 0,
	       )
			foreach (@$clients);
 	}
	else {
#
#	reconfig everyone's close button
#
 		$this->{Close} = ((ref $close) && (ref $close eq 'CODE')) ?
 			$close : \&TabRemove;
	    $_->[DTF_IDX_FRAME]->Subwidget('CloseBtn')->configure(
        	-command => [ $this->{Close}, $this, $_->[DTF_IDX_CAPTION] ])
			foreach (@$clients);
	}
	return $this->TabRedraw(1);
}
#
#	for left/right tabs, we must convert text into
#	vertical format
#
sub RotateTabText {
	my $text = shift;
	my @segments = split /\n/, $text;
	my $maxchars = 0;
	foreach (@segments) {
		$maxchars = length($_)
			if ($maxchars < length($_));
	}

	$segments[$_] .= (' ' x ($maxchars - length($segments[$_])))
		foreach (0..$#segments);

	my @lines = ('') x $maxchars;
	my @chars;
	foreach my $segment (@segments) {
		@chars = split('', $segment);
		$lines[$_] .= $chars[$_] . '  '
			foreach (0..$#chars);
	}
	return join("\n", @lines);
}

sub OnEnter {
	my ($widget, $Button, $TabFrame, $Color) = @_;

	$Button->configure(
		-bg => $Button->Darken($Button->cget(-bg), 90));
	$TabFrame->configure(
		-bg => $TabFrame->Darken($TabFrame->cget(-bg), 90));

	$TabFrame->bind('' => undef);
	$TabFrame->bind('' => undef);

	$Button->bind('' => undef);
	$Button->bind('' => undef);
}

sub OnLeave {
	my ($widget, $Button, $TabFrame) = @_;

#print "Leaving\n";

	$Button->configure(
		-bg => $Button->Darken($Button->cget(-bg), 110));
	$TabFrame->configure(
		-bg => $TabFrame->Darken($TabFrame->cget(-bg), 110));

	$TabFrame->bind('' => [ \&OnEnter, $Button, $TabFrame ]);
	$TabFrame->bind('' => undef);

	$Button->bind('' => [ \&OnEnter, $Button, $TabFrame ]);
	$Button->bind('' => undef);
}

sub OnFocusIn {
	my ($Button, $TabFrame) = @_;

print "FocusIn\n";

	$Button->configure(
		-bg => $Button->Darken($Button->cget(-bg), 90));
	$TabFrame->configure(
		-bg => $TabFrame->Darken($TabFrame->cget(-bg), 90));
}

sub OnFocusOut {
	my ($Button, $TabFrame) = @_;

print "FocusOut\n";

	$Button->configure(
		-bg => $Button->Darken($Button->cget(-bg), 110));
	$TabFrame->configure(
		-bg => $TabFrame->Darken($TabFrame->cget(-bg), 110));
}

1;

__END__