Tk::Multi::Manager - Tk composite widget managing Tk::Multi slaves

 use Tk::Multi::Manager ;
 use Tk::Multi::Text ; # if you use MultiText as a slave

 my $manager = yourWindow -> MultiManager 
  (
   menu => $menu_ref , # optionnal
   title => "windows", # optionnal
   help => "Explain what your set of widget do" #optionnal
  ) -> pack ();

 # Don't pack it, the managet will do it
 my $w1 = $manager -> newSlave
  (
   'type' => 'MultiText', 
   'title' => 'a_label',
   help => "Explain what your slave widget does" #optionnal
  );

package Tk::Multi::Manager;

use strict;
use vars qw($VERSION @ISA $errno);

use Carp ;
use Tk::Derived;
use Tk::Frame;
use Tk::Adjuster ;
use Tie::IxHash ;
use Tk::Multi::Any ;

@ISA = qw(Tk::Derived Tk::Frame);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

$VERSION = sprintf "%d.%03d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/;

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

my $title_num = 0;

sub Populate
  {
    my ($cw,$args) = @_ ;
    Tk::Multi::Any::normalize($cw,$args) ;

    require Tk::Menubutton;

    my $title =  delete $args->{'-title'} || 'display';

    $cw->{trace} = delete $args->{'-trace'};

    my $userMenu = delete $args->{-menu} ;

    unless (defined $userMenu)
      {
        $userMenu = $cw->Frame(-relief => 'raised', -borderwidth => 2);
        $userMenu->pack(-fill => 'x');
      }

    $cw->{menu}= $userMenu -> Menubutton (-text => $title) 
      -> pack(-side => 'left' );

    # add help menu on the right side
    $cw->{help}= $userMenu -> Menubutton (-text => 'Help') 
      -> pack(-side => 'right') ;
 
    # add global help if defined 
    my $help = delete $args->{'-help'} ||
      "If you read this text and if the help menu has no other entry ".
        "than 'global', it means that the user of Tk::Multi did not provide ".
          "any help for the application you're using. Shame on him.";

    $cw->addHelp('global', $help);

    #$cw->{slave} = Tie::IxHash -> new () ;
    my %sHash ;
    $cw->{tiedSlave} = tie %sHash,  'Tie::IxHash' ;
    $cw->{slave} = \%sHash ;

    #my $obj = $cw->{windowFrame} = $cw -> Frame(bg => 'red')
    #  ->pack(qw(-fill both));

    $cw->ConfigSpecs(DEFAULT => [$cw],
                    '-width' => ['SELF'],
                    '-height' => ['SELF'],
) ;
    #$cw->Delegates(DEFAULT => 'SELF' ) ;
    #print "args: ",keys %args,"\n";
    $cw->SUPER::Populate($args) ;
  }

# may add a new Note to the note book
# or create a separate sub-window to see windows side by side
# or move a Note to a separate window 
# and vice-versa ?
sub newSlave
  {
    my $cw = shift ;
    my %args = Tk::Multi::Any::normalize($cw,@_) ;

    my $title = $args{'-title'} ||= $cw->Class . "-" . $title_num++ ;

    my $slaveType = delete $args{'-type'};
    croak("No type specified\n") unless defined $slaveType ;

    # add button if it doesn't exist
    if (defined $cw->{slave}{$title})
      {
        # display error message
        $cw->BackTrace("Window $title already exists\n");
      }
    elsif (defined $args{-before})
      {
        my $bef = delete $args{-before} ;
        my $idx = $cw->{tiedSlave}->Indices($bef);
        # create the new entry in the tied hash and place it before
        # $bef widget
        $cw->{tiedSlave}->Splice($idx,0,$title => {})
      }
    elsif (defined $args{-side} and delete $args{-side} eq 'top')
      {
        # create the new entry in the tied hash and put it on top
        $cw->{tiedSlave}->Unshift($title => {}) ; 
      } 
    else
      {
        # create the new entry in the tied hash and put it on bottom
        $cw->{tiedSlave}->Push($title => {}) ; 
      } 

    $cw->{slave}{$title}{show} = 1 ;

    if (defined $args{'-hidden'} )
      {
        $cw->{slave}{$title}{'show'} = 0 if $args{'-hidden'} == 1 ;
        delete $args{'-hidden'} ;
      }

    # add help button if help is defined 
    $cw->addHelp('on '.$title, delete $args{-help}) if defined $args{'-help'} ;

    # add control button
    my $topmenu = $cw->{menu}->menu ;
    $topmenu ->insert($cw->{tiedSlave}->Indices($title) + 1,
                                'cascade', -label => $title ) ;

    my $menu = $topmenu->Menu;
    $topmenu->entryconfigure($title, -menu => $menu);

    # checkButton does not work if I get the ref from inside the tied hash
    # hence the use of the intermediate reference
    my $var = $cw->{slave}{$title}{'show'} ;
    $cw->{slave}{$title}{'showRef'} = \$var ;
    $menu->checkbutton
      (
       -label => 'show', 
       -variable => \$var,
       -command => sub {$cw->updateVisi($title) ;}
      );

    $cw->{slave}{$title}{submenu} = $menu ;

    my $destroyable = delete $args{'-destroyable'} ;

    # add widget and adjuster
    my $wd = $cw->{slave}{$title}{widget} = 
      $cw -> $slaveType ('menu_button' => $menu, 
                            qw/-relief raised -borderwidth 4/,
                            %args);
    $cw->{slave}{$title}{adjuster} = $cw -> Adjuster (-widget => $wd);


    if (defined $destroyable and $destroyable)
      {
        $menu->command(-label=>'destroy', 
                       -command => sub{$cw->destroySlave($title);} );
      }

    # bottom slave must not use the packAdjust method
    $cw->updateVisi($title);

    return $cw->{slave}{$title}{widget} ;
  }

sub getSlave
  {
    my $cw = shift ;
    my $title = shift ;
    return defined $cw->{slave}{$title} ? $cw->{slave}{$title}{widget} : undef;
  }

sub addHelp
  {
    my $cw = shift ;
    my $label = shift ;
    my $help = shift ;
    
    my $sub = ref($help) eq 'CODE' ? $help :
      sub 
        {
          require Tk::Dialog ;
          $cw ->Dialog('-title'=> "$label help", -text => $help ) -> Show();
        } ;

    $cw->{'help'} -> command (-label => $label, -command => $sub);
  }

sub hide 
  {
    my $cw = shift ;
    my $title = shift ;
    $cw-> updateVisi($title,0) ;
  }

sub show 
  {
    my $cw = shift ;
    my $title = shift ;
    $cw-> updateVisi($title,1) ;
  }

sub updateVisi
  {
    my $cw = shift ;
    my $title = shift ;
    my $show = shift ;

    my $ref = $cw->{slave}{$title}{'showRef'};
    if (defined $show)
      {
        # update value used by the check Button
        $$ref = $cw->{slave}{$title}{'show'} = $show ;
      }
    else
      {
        $show = $cw->{slave}{$title}{'show'} = $$ref ;
      }


    my $slave = $cw->{slave}{$title} ;
    # NB tiedSlave and slave are a tied IxHash
    my $idx = $cw->{tiedSlave} -> Indices($title) ;
    my $nextShowed ;
    my $prevShowed ;
    my $l = $cw->{tiedSlave}->Length() ;
    print "$title index is $idx out of $l\n" if $cw->{trace} ;
    for (my $i=0; $i<$l; $i++)
      {
        my $item = $cw->{tiedSlave}-> Values($i) ;
        $prevShowed = $i if ($i<$idx && $item->{'show'}) ;
        if ($i>$idx && $item->{'show'})
          {
            $nextShowed = $i ;
            last ;
          }
      }
 
    print "$title show is $show\n" if $cw->{trace} ;
    print "$title previous showed is index $prevShowed\n" if $cw->{trace} ;
    print "$title next showed is index $nextShowed\n" if $cw->{trace} ;

    my @pargs = qw/-fill both -expand 1 -anchor n/;
    my $currentW = $cw->{slave}{$title}{widget};

    # so that the master window update its size when a slave is hidden
    # or shown
    $cw->packPropagate(1);

    if ($show)
      {
        if (defined $nextShowed)
          {
            print "$title uses packAdjust\n" if $cw->{trace} ;

            my $nextWidget = $cw->{tiedSlave}-> Values($nextShowed)->{widget} ;
            $currentW->pack(@pargs, -before => $nextWidget );
            $cw->{slave}{$title}{adjuster}-> packAfter($currentW );
          }
        else
          {
            print "$title uses pack\n" if $cw->{trace} ;
            if (defined $prevShowed)
              {
                print "index $prevShowed uses packAjust\n" if $cw->{trace} ;
                my $prevWidget = 
                  $cw->{tiedSlave}-> Values($prevShowed)->{widget} ;

                $cw->{tiedSlave}-> Values($prevShowed)->{adjuster}->
                  packAfter($prevWidget );
              }
            $currentW -> pack(@pargs) ;
          }
      }
    else
      {
        if (defined $prevShowed and not defined $nextShowed)
          {
            print "index $prevShowed uses pack\n" if $cw->{trace} ;
            my $w = $cw->{tiedSlave}-> Values($prevShowed)->{adjuster} ;
            $w->packForget(1);
            $cw->{tiedSlave}-> Values($prevShowed)->{widget}->
              pack(@pargs);
          }
        #hide it
        print "$title uses packForget\n" if $cw->{trace} ;
        $cw->{slave}{$title}{adjuster} -> packForget(1) ;
      }
  }

sub destroySlave
  {
    my $cw = shift ;
    my $title = shift ;

    die "Slave $title does not exist\n" 
      unless defined $cw->{slave}{$title}{widget} ;

    # first remove the display from the window
    $cw->updateVisi($title,0);

    # retrieve actual menu object from the MenuButtom
    my $cm = $cw->{menu} -> cget(-menu);

    $cw->{slave}{$title}{widget}->destroy;
    $cw->{slave}{$title}{submenu}->destroy;
    
    my $idx = $cw->{tiedSlave}->Indices($title);
    $cw->{tiedSlave}->Splice($idx,1);

    # delete the actual Menu entry from topmenu
    $cm -> delete($title) ;

    #delete $cw->{slave}{$title};
  }

1;

__END__

#'