Puppet::VcsTools::GraphWidget - TreeGraph and node list widget

 use Tk::Multi::Manager;

 use Puppet::VcsTools::GraphWidget;

 my $wmgr = $mw -> MultiManager 
  (
   'title' => 'log test' ,
   'menu' => $w_menu 
  ) -> pack ();

 $toto = $wmgr -> newSlave
  (
   'type'=>'MultiVcsGraph', 
   title => 'graph try',
   'list' => [1 .. 5 ]
  ) ;

 my $ref = [1000..1005];
 my ($ox,$oy) = (100,100);

 $tg -> addNode 
   (
    nodeId => '1.0', 
    text => $ref, 
    xref => \$ox, 
    yref => \$oy
   ) ;

package Puppet::VcsTools::GraphWidget ;

use strict;
use Sort::Versions ;
require Tk::Derived;
require Tk::Frame;

use vars qw(@ISA $printCmd $defaultPrintCmd $VERSION);

@ISA = qw(Tk::Derived Tk::Frame);

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

# 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.

$printCmd = $defaultPrintCmd = 'lp -opostscript';

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

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

sub Populate
  {
    my ($cw,$args) = @_ ;

    require Tk::Label;
    require Tk::ROText;
    require Tk::TreeGraph ;

    # must add a canvas and a text window in the Multi manager
    $cw->{_printCmdRef} = \$printCmd ;
    
    my $title = delete $args->{'title'} || delete $args->{'-title'} || 
      'anonymous';
    $cw ->{'title'} = $title ;

    my $menu = delete $args->{'menu_button'} || delete $args->{'-menu_button'};
    die "Multi window $title: missing menu_button argument\n" 
      unless defined $menu ;

    my $titleLabel = $cw->Label(text => $title.' display')-> pack(qw/fill x/) ;
    my $frame = $cw -> Frame ->pack(-expand => 1, -fill => 'both');

    $menu->command(-label=>'print', command => [$cw, 'print' ]) ;
    $menu->command(-label=>'clear', command => [$cw, 'clear' ]);

    $cw->Advertise(menu => $menu) ;

    my $list = delete $args->{'list'} ;

    my $listW = $frame -> Scrolled(qw/Listbox -scrollbars osoe width 14/)->
        pack(-side => 'right', -expand => 0, -fill => 'y');
    $cw->Advertise(list => $listW) ;

    # causes problems during destruction, may be due to nested frames all using
    # Adjuster
    #    $cw->{adjuster} = $cw->Adjuster()->packAfter($listW,-side => 'right');

    my $slaveWindow = $frame -> 
      Scrolled(qw/TreeGraph relief sunken bd 2/,
                       -scrollregion => [0,0,400 , 200]
                     )->
        pack(-side => 'right', -expand => 1, -fill => 'both');
    $cw->Advertise(graph => $slaveWindow) ;

    
    $cw->Delegates(
                   'clear' => $slaveWindow,
                   DEFAULT => $slaveWindow) ;

    my $subref = sub {$menu->Popup(-popover => 'cursor', -popanchor => 'nw')};
    #$slaveWindow-> bind('<Button-3>', $subref);
    $titleLabel -> bind('<Button-3>', $subref);

    $cw->{menu}=$menu ;

    $cw->ConfigSpecs(
                     'relief' => [$cw],
                     'borderwidth' => [$cw],
                     'scrollbars'=> [$slaveWindow, undef, undef,'osoe'],
                     'width' => [$slaveWindow, undef, undef, 80],
                     'height' => [$slaveWindow, undef, undef, 5],
                     'DEFAULT' => [$slaveWindow]
                    ) ;

    $cw->SUPER::Populate($args);

    $listW->insert(0,@$list) if defined $list ;
  }

sub resetPrintCmd
  {
    my $cw=shift ;
    $printCmd=$defaultPrintCmd ;
  }

sub printableDump
  {
    my $cw= shift ;
    my $array = $cw->cget('scrollregion') ;

    return  $cw-> postscript
      (qw/-colormode gray pageheight 29c pagewidth 21c/,
       -width        => $array->[2],
       -height       => $array->[3]);
  }

sub addRev
  {
    my $cw = shift ;
    my $l = $cw->Subwidget('list') ;
    
    my @full = $l -> get (0, 'end') ;
    $l -> delete (0, 'end') ;

    foreach my $rev (sort {versioncmp $a,$b } (@_,@full))
      {
        $l->insert('end',$rev) ;
      }
  }

sub command
  {
    my $cw =shift ;
    my %args = @_ ;

    # sort the destination
    if (defined $args{on} and $args{on} eq 'menu')
      {
        delete $args{on} ;
        $args{-label}= delete $args{label} if defined $args{label};
        $cw->{menu}->command(%args);
      }
    elsif (defined $args{on})
      {
        $cw->Subwidget('graph')->command(%args);
      }
    else
      {
        $cw->BackTrace("No 'on' parameter for GraphWidget::command method\n");
      }
  }

1;

__END__

# Below is the stub of documentation for your module. You better edit it!