view release on metacpan or  search on metacpan

lib/CPANPLUS/Shell/Tk.pm  view on Meta::CPAN

  $MW->title('CPANPLUS');
  $MW->minsize(100,100);
  $MW->geometry('900x600+1+1');

  $self->{MW} = $MW;

  return $MW;
}

#------------------------------------------------------------------------
# setup menu
#
sub _setup_menu {
  my $self = shift;
  my $MW   = $self->{MW};
  my $CP   = $self->{CP};

  my $menubar = $MW->Frame(-relief => 'raised', -bd => 1);
  $menubar->pack(-side => 'top', -fill => 'x');

  my $filemenu = $menubar->Menubutton(qw/-tearoff 0 -text File -pady -1 -underline 0 -menuitems/ =>
    [
      [Button => 'Exit', -command => [\&_exit_ui, $self]],
    ])->pack(-side => 'left');

  my $configmenu = $menubar->Menubutton(qw/-tearoff 0 -text Config -pady -1 -underline 0 -menuitems/ =>
    [
#      [Button => 'cpui',     -command => \&_config_cpui],
      [Button => 'CPANPLUS',        -command => [\&_config_cpanplus, $self]],
      [Button => 'package sources', -command => [\&_config_sources, $self]],
    ])->pack(-side => 'left');

  my $perlmenu = $menubar->Menubutton(qw/-tearoff 0 -text Perl -pady -1 -underline 0 -menuitems/ =>
    [
      [Button => 'show full config', -command => [\&_perl_config, $self]],
      $^O =~ /win/i ? () : [Button => 'start with other version', -command => [\&_perl_restart, $self]],   # not for win32 at the moment
    ])->pack(-side => 'left');

  my $histmenu = $menubar->Menubutton(qw/-tearoff 0 -text History -pady -1 -underline 0 -menuitems/ =>
    [
      [Button => 'show', -command => [\&_show_history, $self]],
      [Button => 'load', -command => [\&_load_history, $self]],
      [Button => 'save', -command => [\&_save_history, $self]],
    ])->pack(-side => 'left');

  my $helpmenu = $menubar->Menubutton(qw/-tearoff 0 -text Help -underline 0 -menuitems/ =>
    [
      [Button => 'Help', -command => [\&_help, $self]],
      [Button => 'About', -command => [\&_about, $self]],
    ])->pack(-side => 'right');
}

#------------------------------------------------------------------------
# _setup_contents creates the contents of the main window by calling several methods
#
sub _setup_contents {
  my $self = shift;
  my $MW   = $self->{MW};
  my $CP   = $self->{CP};

  $self->_setup_cpanplus_callbacks;

  my ($topframe, $leftframe, $rightframe) = $self->_setup_frames;

  $self->_setup_perl_info($topframe);
  $self->_setup_left_frame($leftframe);
  $self->_setup_right_frame($rightframe);
}

#------------------------------------------------------------------------
# _setup_cpanplus_callbacks installs callbacks in the Backend to recieve
# print and error messages and put them into the right frame
#
sub _setup_cpanplus_callbacks {
  my $self = shift;
  my $MW   = $self->{MW};
  my $CP   = $self->{CP};

  my $eo = $CP->error_object;
  $eo->set('ECALLBACK' => sub { $self->{INFO}->insert('end', "ERROR: $_[0]\n"); $self->{INFO}->see('end'); $MW->update });
  $eo->set('ICALLBACK' => sub { $self->{INFO}->insert('end', "$_[0]\n"); $self->{INFO}->see('end'); $MW->update });
}

#------------------------------------------------------------------------
# setup top, left and right frame with the adjusters
# the frame setup will be done in three methods called in _setup_contents
#
sub _setup_frames {
  my $self = shift;
  my $MW   = $self->{MW};
  my $CP   = $self->{CP};

  my $topframe    = $MW->Frame;
  my $hadjuster   = $MW->Adjuster;
  my $bottomframe = $MW->Frame;
  $topframe->pack(-side   => 'top',
                  -fill   => 'x', 
                  -expand => 1,
                 );
  $hadjuster->packAfter($topframe, -side => 'top');
  $bottomframe->pack(-side   => 'top',
                     -fill   => 'both', 
                     -expand => 1,
                    );

  my $leftframe  = $bottomframe->Frame(
                                        -background => 'white',
                                      );
  my $vadjuster  = $bottomframe->Adjuster;
  my $rightframe = $bottomframe->Frame(
                                        -background => 'white',
                                      );
  $leftframe->pack(-side   => 'left',
                   -fill   => 'both', 
                   -expand => 1,
                  );
  $vadjuster->packAfter($leftframe, -side => 'left');
  $rightframe->pack(-side   => 'left',
                    -fill   => 'both', 
                    -expand => 1,
                   );

  return $topframe, $leftframe, $rightframe;
}

#------------------------------------------------------------------------
# setup the top frame, showing info about the perl version
#
sub _setup_perl_info {
  my ($self, $topframe) = @_;

  my $perlinfo = $topframe->Scrolled('ROText',
                                     -scrollbars => 'osow',
                                     -height     => 5,