view release on metacpan or  search on metacpan

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

  delete $self->{NOT_UPTODATE}->{$_} foreach map { $self->{NOT_UPTODATE}->{$_}->{uptodate} ? $_ : () } keys %{$self->{NOT_UPTODATE}};

#---- setup main window
  $text = 'Setting up main window . . .';
  $splash->update;
  $self->_setup_contents();

#---- if available install inputhandler
  if ($self->{CP}->can('set_input_handler')) {
    $self->{CP}->set_input_handler( sub { $self->_get_input } );
  }

#---- take off
  $splash->Destroy;
  $self->{MW}->deiconify;

  MainLoop;
}


#------------------------------------------------------------------------
# use by cpui -H Tk
#
sub help {
  print "
    Tk user interface for CPANPLUS

    No help available at the moment.

    Start the gui and try.
  \n";
}

#------------------------------------------------------------------------
# setup main window
#
sub _setup_main {
  my $self = shift;

  my $MW = MainWindow->new;
  $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(

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

                                -background => 'white',
                                -wrap       => 'none',
                                -font       => '{Helvetica} -12 {normal}',
                               );
  $hist->Subwidget("yscrollbar")->configure(-width => 6);
  $hist->Subwidget("xscrollbar")->configure(-width => 6);
  $hist->pack(-fill => 'both', -expand => 1);
  $hist->packForget;

#---- read old history, ignore comments and blank lines, set commands to comments
  $hist->insert('end', "# Command history\n\n");
  open HISTORY, "<$ENV{HOME}/.cpui.hist" or warn $!;
  while (<HISTORY>) {
    next if /^#/;
    next if /^\s*$/;
    $hist->insert('end', "# $_");
  }
  close HISTORY;

  $self->{HISTORY} = $hist;

#---- setting pod widget
  my $pod = $rightframe->Scrolled('PodText',
                                   -scrollbars => 'w',
                                   -background => 'white',
                                   -wrap       => 'word',
                                   -font       => '{Helvetica} -12 {normal}',
                                   -poddone    => sub { $self->{MW}->title('CPANPLUS') }   # PodText changes title, we change it back
                                 );
  $pod->Subwidget("yscrollbar")->configure(-width => 6);
  $pod->Subwidget("xscrollbar")->configure(-width => 6);
  $pod->Subwidget("scrolled")->configure(-scrollbars => '');
  $pod->pack(-fill => 'both', -expand => 1);
  $pod->packForget;

  $self->{POD} = $pod;

#---- setting info widget
  my $info = $rightframe->Scrolled('ROText',
                                -scrollbars => 'osow',
                                -background => 'white',
                                -wrap       => 'none',
                                -font       => '{Helvetica} -12 {normal}',
                               );
  $info->Subwidget("yscrollbar")->configure(-width => 6);
  $info->Subwidget("xscrollbar")->configure(-width => 6);
  $info->pack(-fill => 'both', -expand => 1);

  $self->{INFO} = $info;
}

#------------------------------------------------------------------------
# popup menu for button 3 in listbox
#
sub _create_button3_menu {
  my ($self, $list) = @_;
  my $MW   = $self->{MW};
  my $CP   = $self->{CP};


  my $menu = $list->Menu(-tearoff   => 0,
                            -menuitems => [
                              [Button => 'Install',
                              -command => sub {
                                            $MW->Busy;
                                            $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                                            $self->{INFO}->pack(-fill => 'both', -expand => 1);
                                            $self->{INFO}->delete('0.0', 'end');
                                            $CP->install(modules => $self->{MODS});
                                            $self->{HISTORY}->insert('end', "install\t" . join(' ', @{$self->{MODS}}) . "\n");
                                            $MW->Unbusy;
                                          }],
                              [Button => 'Uninstall',
                              -command => sub {
                                            $MW->Busy;
                                            $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                                            $self->{INFO}->pack(-fill => 'both', -expand => 1);
                                            $self->{INFO}->delete('0.0', 'end');
                                            $CP->uninstall(modules => $self->{MODS});
                                            $self->{HISTORY}->insert('end', "uninstall\t" . join(' ', @{$self->{MODS}}) . "\n");
                                            $MW->Unbusy;
                                          }],
                              [Button => 'Fetch',
                              -command => sub {
                                            $MW->Busy;
                                            $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                                            $self->{INFO}->pack(-fill => 'both', -expand => 1);
                                            $self->{INFO}->delete('0.0', 'end');
                                            $CP->fetch(modules => $self->{MODS});
                                            $self->{HISTORY}->insert('end', "fetch\t" . join(' ', @{$self->{MODS}}) . "\n");
                                            $MW->Unbusy;
                                          }],
                              [Button => 'Extract',
                              -command => sub {
                                            $MW->Busy;
                                            $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                                            $self->{INFO}->pack(-fill => 'both', -expand => 1);
                                            $self->{INFO}->delete('0.0', 'end');
                                            $CP->extract(modules => $self->{MODS});
                                            $self->{HISTORY}->insert('end', "extract\t" . join(' ', @{$self->{MODS}}) . "\n");
                                            $MW->Unbusy;
                                          }],
                              [Button => 'Make',
                              -command => sub {
                                            $MW->Busy;
                                            $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                                            $self->{INFO}->pack(-fill => 'both', -expand => 1);
                                            $self->{INFO}->delete('0.0', 'end');
                                            $CP->make(modules => $self->{MODS});
                                            $self->{HISTORY}->insert('end', "make\t" . join(' ', @{$self->{MODS}}) . "\n");
                                            $MW->Unbusy;
                                          }],
                              [Button => 'Pod',
                              -command => sub {
                                            $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                                            $self->{POD}->configure(-file => $self->{MODS}->[0]);
                                            print $self->{MODS}->[0], "\n";
                                            $self->{POD}->pack(-fill => 'both', -expand => 1);
                                          }],
                            ],
                          );