package Tk::NoteBook;
#
# Implementation of NoteBook widget.
# Derived from NoteBook.tcl in Tix 4.0

# Contributed by Rajappa Iyer <rsi@earthling.net>
# Hacked by Nick for 'menu' traversal.
# Restructured by Nick 

use vars qw($VERSION @ISA);

$VERSION = '3.011'; # $Id: //depot/Tk8/Tixish/NoteBook.pm#11$
require Tk::NBFrame;

@ISA = qw(Tk::Derived Tk::NBFrame);
Tk::Widget->Construct("NoteBook");
use strict;

use Tk qw(Ev);

use Carp;
require Tk::Frame;

sub TraverseToNoteBook;

sub ClassInit 
{
 my ($class,$mw) = @_;
 # class binding does not work right due to extra level of
 # widget hierachy
 $mw->bind($class,"<ButtonPress-1>", ['MouseDown',Ev('x'),Ev('y')]);
 $mw->bind($class,"<ButtonRelease-1>", ['MouseUp',Ev('x'),Ev('y')]);
 
 $mw->bind($class,"<B1-Motion>", ['MouseDown',Ev('x'),Ev('y')]);
 $mw->bind($class,"<Left>", ['FocusNext','prev']);
 $mw->bind($class,"<Right>", ['FocusNext','next']);
 
 $mw->bind($class,"<Return>", 'SetFocusByKey');
 $mw->bind($class,"<space>", 'SetFocusByKey');
 return $class;
}            

sub raised 
{
 return shift->{"topchild"};
}
       
sub Populate 
{      
 my ($w, $args) = @_;
 
 $w->SUPER::Populate($args);
 $w->{"pad-x1"} = 0;
 $w->{"pad-x2"} = 0;
 $w->{"pad-y1"} = 0;
 $w->{"pad-y2"} = 0;
 
 $w->{"nWindows"} = 0;
 $w->{"minH"} = 1;
 $w->{"minW"} = 1;
 
 $w->{"counter"} = 0;
 $w->{"resize"} = 0;
 
 $w->ConfigSpecs(-ipadx => ["PASSIVE", "ipadX", "Pad", 0],
                 -ipady => ["PASSIVE", "ipadY", "Pad", 0],
                 -takefocus => ["SELF", "takeFocus", "TakeFocus", 0],
                 -dynamicgeometry => ["PASSIVE", "dynamicGeometry", "DynamicGeometry", 0]);
 
 # SetBindings
 $w->bind("<Configure>", sub {$w->MasterGeomProc;});
 
 $args->{-slave} = 1;
 $args->{-takefocus} = 1;
 $args->{-relief} = 'raised';
 
 $w->QueueResize;
}

#---------------------------
# Public methods
#---------------------------                   

sub page_widget
{
 my $w = shift;
 $w->{'_pages_'} = {} unless exists $w->{'_pages_'};
 my $h = $w->{'_pages_'};
 if (@_)
  {
   my $name = shift;
   if (@_)
    {
     my $cw = shift;
     if (defined $cw)
      {
       $h->{$name} = $cw;
      }
     else
      {
       return delete $h->{$name};
      }
    }
   return $h->{$name};
  }
 else
  {
   return (values %$h);
  }
}

sub add 
{
 my ($w, $child, %args) = @_; 
 
 croak("$child already exists") if defined $w->page_widget($child);
 
 my $f = Tk::Frame->new($w,Name => $child,-relief => 'raised');
 
 my $ccmd = delete $args{-createcmd};
 my $rcmd = delete $args{-raisecmd};
 $f->{-createcmd} = $ccmd if (defined $ccmd);
 $f->{-raisecmd} = $rcmd if (defined $rcmd);
 
 # manage our geometry
 $w->ManageGeometry($f);
 # create default bindings
 $f->bind("<Configure>", sub {$w->ClientGeomProc('-configure', $f)});
 $f->bind("<Destroy>", sub {$w->delete($child,1);}); # XXX
 $w->page_widget($child,$f);
 $w->{"nWindows"}++;
 push(@{$w->{"windows"}}, $child);
 $w->SUPER::add($child,%args);
 return $f;
}

sub raise 
{
 my ($w, $child) = @_;
 return unless defined $child;
 if ($w->pagecget($child, -state) eq "normal") 
  {
   $w->activate($child);
   $w->focus($child);
   my $childw = $w->page_widget($child);
   if ($childw) 
    {
     if (defined $childw->{-createcmd}) 
      {
       &{$childw->{-createcmd}}($childw);
       delete $childw->{-createcmd};
      }
     # hide the original visible window
     my $oldtop = $w->{"topchild"};
     if (defined($oldtop) && ($oldtop ne $child)) 
      {        
       $w->page_widget($oldtop)->UnmapWindow;
      }
     $w->{"topchild"} = $child;
     my $myW = $w->Width;
     my $myH = $w->Height;
   
     my $cW = $myW - $w->{"pad-x1"} - $w->{"pad-x2"} - 2 * (defined $w->{-ipadx} ? $w->{-ipadx} : 0);
     my $cH = $myH - $w->{"pad-y1"} - $w->{"pad-y2"} - 2 * (defined $w->{-ipady} ? $w->{-ipady} : 0);
     my $cX = $w->{"pad-x1"} + (defined $w->{-ipadx} ? $w->{-ipadx} : 0);
     my $cY = $w->{"pad-y1"} + (defined $w->{-ipady} ? $w->{-ipady} : 0);
   
     if ($cW > 0 && $cH > 0) 
      {    
       $childw->MoveResizeWindow($cX, $cY, $cW, $cH);
       $childw->MapWindow;
       $childw->raise;
      }
     if ((not defined $oldtop) || ($oldtop ne $child)) 
      {
       if (defined $childw->{-raisecmd}) 
        {
         &{$childw->{-raisecmd}}($childw);
        }
      }
    }
  }
}          

sub pageconfigure 
{
 my ($w, $child, %args) = @_;
 my $childw = $w->page_widget($child);
 if (defined $childw) 
  {
   my $ccmd = delete $args{-createcmd};
   my $rcmd = delete $args{-raisecmd};
   $childw->{-createcmd} = $ccmd if (defined $ccmd);
   $childw->{-raisecmd} = $rcmd if (defined $rcmd);
   $w->SUPER::pageconfigure($child, %args) if (keys %args);
  }
}

sub pages {
    my ($w) = @_;
    return @{$w->{"windows"}};
}

sub pagecget 
{
 my ($w, $child, $opt) = @_;
 my $childw = $w->page_widget($child);
 if (defined $childw)
  {
   return $childw->{-createcmd} if ($opt =~ /-createcmd/);
   return $childw->{-raisecmd} if ($opt =~ /-raisecmd/);
   return $w->SUPER::pagecget($child, $opt);
  } 
 else 
  {
   carp "page $child does not exist";
  }
}

sub delete 
{
 my ($w, $child, $destroy) = @_;          
 my $childw = $w->page_widget($child,undef);
 if (defined $childw) 
  {         
   $childw->bind("<Destroy>", undef);
   $childw->destroy;
   @{$w->{"windows"}} = grep($_ !~ /$child/, @{$w->{"windows"}});
   $w->{"nWindows"}--;
   $w->SUPER::delete($child);
   # see if the child to be deleted was the top child
   if ((defined $w->{"topchild"}) && ($w->{"topchild"} eq $child)) 
    {                             
     delete $w->{"topchild"};
     if ( @{$w->{'windows'}}) 
      {
       $w->raise($w->{'windows'}[0]);
      }
    }
  } 
 else 
  {
   carp "page $child does not exist" unless $destroy;
  }
}

#---------------------------------------
# Private methods
#---------------------------------------

sub MouseDown {
    my ($w, $x, $y) = @_;
    my $name = $w->identify($x, $y);
    $w->focus($name);
    $w->{"down"} = $name;
}

sub MouseUp {
    my ($w, $x, $y) = @_;
    my $name = $w->identify($x, $y);
    if ((defined $name) &&
        ($name eq $w->{"down"}) &&
        ($w->pagecget($name, -state) eq "normal")) {
        $w->raise($name);
    } else {
        $w->focus($name);
    }
}

sub FocusNext {
    my ($w, $dir) = @_;
    my $name;

    if (not defined $w->info("focus")) {
        $name = $w->info("active");
        $w->focus($name);
    } else {
        $name = $w->info("focus" . $dir);
        $w->focus($name);
    }
}

sub SetFocusByKey {
    my ($w) = @_;

    my $name = $w->info("focus");
    if (defined $name) {
        if ($w->pagecget($name, -state) eq "normal") {
            $w->raise($name);
            $w->activate($name);
        }
    }
}

sub NoteBookFind {
    my ($w, $char) = @_;
 
    my $page;
    foreach $page (@{$w->{"windows"}}) {
        my $i = $w->pagecget($page, -underline);
        my $c = substr($page, $i, 1);
        if ($char =~ /$c/) {
            if ($w->pagecget($page, -state) ne "disabled") {
                return $page;
            }
        }
    }
    return undef;
}

# This is called by TraveseToMenu when an <Alt-Keypress> occurs
# See the code in Tk.pm
sub FindMenu {
    my ($w, $char) = @_;

    my $page; 
    foreach $page (@{$w->{"windows"}}) {
        my $i = $w->pagecget($page, -underline);
        my $l = $w->pagecget($page, -label);
        next if (not defined $l);
        my $c = substr($l, $i, 1);
        if ($char =~ /$c/i) {
            if ($w->pagecget($page, -state) ne "disabled") {
                $w->{"keypage"} = $page;
                return $w;
            }
        }
    }
    return undef;
}

#
# This is called to post the supposed 'menu'
# when we have returned ourselves as a 'menu' matching
# and <Alt-KeyPress>,  See the code in Tk.pm
#
sub PostFirst {
    my ($w) = @_;
    my $page = delete $w->{"keypage"};
    if (defined $page) {
        $w->raise($page);
    }
}   

sub MasterGeomProc 
{
 my ($w) = @_;
 if (Tk::Exists($w)) 
  {
   $w->{"resize"} = 0 unless (defined $w->{"resize"}); 
   $w->QueueResize;
  }
}

sub SlaveGeometryRequest 
{
 my $w = shift;
 if (Tk::Exists($w)) 
  {
   $w->QueueResize;
  }
}

sub LostSlave {
    my ($w, $s) = @_;
    print "Loosing $s\n";
    $s->UnmapWindow;
}

sub ClientGeomProc 
{
 my ($w, $flag, $client) = @_;
 $w->QueueResize if (Tk::Exists($w));
 if ($flag =~ /-lostslave/) 
  {
   carp "Geometry Management Error: Another geometry manager has taken control of $client. This error is usually caused because a widget has been created in the wrong frame: it should have been created inside $client instead of $w";
  }
}

sub QueueResize 
{
 my $w = shift;
 $w->DoWhenIdle(['Resize', $w]) unless ($w->{"resize"}++);
}   

sub Resize {

    my ($w) = @_;

    return unless Tk::Exists($w) && $w->{"nWindows"} && $w->{"resize"};

    my ($tW, $tH) = split(" ", $w->geometryinfo);
    $w->{"pad-x1"} = 2;
    $w->{"pad-x2"} = 2;
    $w->{"pad-y1"} = $tH + (defined $w->{"-ipadx"} ? $w->{"-ipadx"} : 0) + 1;
    $w->{"pad-y2"} = 2;
    $w->{"minW"} = $tW;
    $w->{"minH"} = $tH;

    $w->{"resize"} = 0;
    my $reqW = $w->{-width} || 0;
    my $reqH = $w->{-height} || 0;

    if ($reqW * $reqH == 0) 
     {
        if ((not defined $w->{-dynamicgeometry}) ||
            ($w->{-dynamicgeometry} == 0)) {
            $reqW = 1;
            $reqH = 1;
            
            my $childw;
            foreach $childw ($w->page_widget) 
             {
                my $cW = $childw->ReqWidth;
                my $cH = $childw->ReqHeight;
                $reqW = $cW if ($reqW < $cW);
                $reqH = $cH if ($reqH < $cH);
            }
        } else {
            if (defined $w->{"topchild"}) {
                my $topw = $w->page_widget($w->{"topchild"});
                $reqW = $topw->ReqWidth;
                $reqH = $topw->ReqHeight;
            } else {
                $reqW = 1;
                $reqH = 1;
            }
        }
        $reqW += $w->{"pad-x1"} + $w->{"pad-x2"} + 2 * (defined $w->{-ipadx} ? $w->{-ipadx} : 0);
        $reqH += $w->{"pad-y1"} + $w->{"pad-y2"} + 2 * (defined $w->{-ipady} ? $w->{-ipady} : 0);
        $reqW = ($reqW > $w->{"minW"}) ? $reqW : $w->{"minW"};
        $reqH = ($reqH > $w->{"minH"}) ? $reqH : $w->{"minH"};
    }
    if (($w->ReqWidth != $reqW) ||
        ($w->ReqHeight != $reqH)) {
        $w->{"counter"} = 0 if (not defined $w->{"counter"});
        if ($w->{"counter"} < 50) {
            $w->{"counter"}++;
            $w->GeometryRequest($reqW, $reqH);
            $w->DoWhenIdle(sub {$w->Resize;});
            $w->{"resize"} = 1;
            return;
        }
    }
    $w->{"counter"} = 0;
    $w->raise($w->{"topchild"} || ${$w->{"windows"}}[0]);
    $w->{"resize"} = 0;
}

1;

__END__

=cut
