CPANPLUS-Shell-Tk

 view release on metacpan or  search on metacpan

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

  my $CP        = $self->{CP};

  my $left = $leftframe->NoteBook(
                                  -background => 'white',
                                 );
  my $search_tab    = $left->add('search',    -label => 'Search');
  my $installed_tab = $left->add('installed', -label => 'Installed');
  my $update_tab    = $left->add('update',    -label => 'Update');
  $left->pack(-fill => 'both', -expand => 1);

  $self->_setup_update_tab($update_tab);
  $self->_setup_installed_tab($installed_tab);
  $self->_setup_search_tab($search_tab);

}

#------------------------------------------------------------------------
# setup listbox with modules not up to date
#
sub _setup_update_tab {
  my $self       = shift;
  my $update_tab = shift;
  my $MW         = $self->{MW};
  my $CP         = $self->{CP};

  my $update     = $update_tab->Scrolled('MListbox',
                                         -scrollbars => 'osow',
                                         -selectmode => 'extended',
                                         -moveable   => 0,
                                         -background => 'white',
                                        );
  $update->Subwidget("yscrollbar")->configure(-width => 6);
  $update->Subwidget("xscrollbar")->configure(-width => 6);
  $update->columnInsert(0, -text => 'Module', -width => 35);
  $update->columnGet(0)->Subwidget('heading')->configure(-pady  => -1);
  $update->pack(-fill => 'both', -expand => 1);

#---- on click, fill details into right frame
  $update->bindRows('<ButtonPress-1>',
                      [ sub {
                          $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                          $self->{INFO}->pack(-fill => 'both', -expand => 1);
                          my @sel = $update->curselection;
                          my (@mods) = map {$update->columnGet(0)->get($_, $_)} @sel;
                          $self->{INFO}->delete('0.0', 'end');
                          return if @mods > 1;
                          my $rv = $CP->details(modules => [$mods[0]]);
                          foreach (sort keys %{$rv->{rv}->{$mods[0]}}) {
                            $self->{INFO}->insert('end', "\n$_:\n\t" . $rv->{rv}->{$mods[0]}->{$_});
                          }
                        }
                      ]
                     );

#---- on right click show popup menu
  my $button3_menu = $self->_create_button3_menu($update);
  $update->bindRows('<ButtonPress-3>',
                      [ sub {
                          my @sel = $update->curselection;
                          @{$self->{MODS}} = map {$update->columnGet(0)->get($_, $_)} @sel;
                          $button3_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
                        },
                      ]
                   );

  $update->insert(0, map { [$_, 1] } sort keys %{$self->{NOT_UPTODATE}});
}

#------------------------------------------------------------------------
# setup listbox with installed modules
#
sub _setup_installed_tab {
  my $self          = shift;
  my $installed_tab = shift;
  my $MW            = $self->{MW};
  my $CP            = $self->{CP};

  my $installed = $installed_tab->Scrolled('MListbox',
                                           -scrollbars => 'osow',
                                           -selectmode => 'extended',
                                           -moveable   => 0,
                                           -background => 'white',
                                          );
  $installed->Subwidget("yscrollbar")->configure(-width => 6);
  $installed->Subwidget("xscrollbar")->configure(-width => 6);
  $installed->columnInsert(0, -text => 'Module', -width => 35);
  $installed->columnGet(0)->Subwidget('heading')->configure(-pady  => -1);
  $installed->pack(-fill => 'both', -expand => 1);

#---- on click, fill details into right frame
  $installed->bindRows('<ButtonPress-1>',
                      [ sub {
                          $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                          $self->{INFO}->pack(-fill => 'both', -expand => 1);
                          my @sel = $installed->curselection;
                          my (@mods) = map {$installed->columnGet(0)->get($_, $_)} @sel;
                          $self->{INFO}->delete('0.0', 'end');
                          return if @mods > 1;
                          my $rv = $CP->details(modules => [$mods[0]]);
                          foreach (sort keys %{$rv->{rv}->{$mods[0]}}) {
                            $self->{INFO}->insert('end', "\n$_:\n\t" . $rv->{rv}->{$mods[0]}->{$_});
                          }
                        }
                      ]
                     );

#---- on right click show popup menu
  my $button3_menu = $self->_create_button3_menu($installed);
  $installed->bindRows('<ButtonPress-3>',
                      [ sub {
                          my @sel = $installed->curselection;
                          @{$self->{MODS}} = map {$installed->columnGet(0)->get($_, $_)} @sel;
                          $button3_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
                        },
                      ]
                   );

  $installed->insert(0, map { [$_, 1] } sort keys %{$self->{INSTALLED}});
}

#------------------------------------------------------------------------
# setup search tab
#
sub _setup_search_tab {
  my $self       = shift;
  my $search_tab = shift;
  my $MW         = $self->{MW};
  my $CP         = $self->{CP};

  my $search;
  my $searchtype = 'module';
  my $searchtext;

#---- frame for search form, searchtype (module/author), text and button
  my $sf = $search_tab->Frame(
                              -background => 'white',
                             );
  $sf->pack(-side => 'top', -fill => 'both', -expand => 0);
  my $search_type = $sf->BrowseEntry(-variable   => \$searchtype,
                                     -state      => 'readonly',
                                     -background => 'white',
                                    )->pack(-side => 'top', -anchor => 'w')->insert(0, (qw (module author)));
  my $search_entry = $sf->Entry(-relief       => 'sunken',
                                -textvariable => \$searchtext,
                               );
  $search_entry->pack(-side => 'left');
  my $search_button = $sf->Button(-text    => 'Search',
                                  -pady    => -1,
                                  -command => sub {
                                                my $rv = $CP->search(type => $searchtype,
                                                                     list => [$searchtext],
                                                                    );
                                                $search->delete(0,'end');
                                                foreach (reverse sort keys %$rv) {
                                                  $search->insert(0, [$_]);
                                                }
                                              }
                                 );
  $search_button->pack(-side => 'right');
  $search_entry->bind('<Key-Return>', sub { $search_button->invoke });
  $search_entry->focus;

#---- listbox with searchresult
  $search = $search_tab->Scrolled('MListbox',
                                  -scrollbars => 'osow',
                                  -selectmode => 'extended',
                                  -moveable   => 0,
                                  -background => 'white',
                                 );
  $search->Subwidget("yscrollbar")->configure(-width => 6);
  $search->Subwidget("xscrollbar")->configure(-width => 6);
  $search->columnInsert(0, -text => 'Module', -width => 35);
  $search->columnGet(0)->Subwidget('heading')->configure(-pady  => -1);
  
  $search->bindRows('<ButtonPress-1>',
                      [ sub {
                          $self->{$_}->packForget foreach qw(HISTORY POD INFO);
                          $self->{INFO}->pack(-fill => 'both', -expand => 1);
                          my @sel = $search->curselection;
                          my (@mods) = map {$search->columnGet(0)->get($_, $_)} @sel;
                          $self->{INFO}->delete('0.0', 'end');
                          return if @mods > 1;
                          my $rv = $CP->details(modules => [$mods[0]]);
                          foreach (sort keys %{$rv->{rv}->{$mods[0]}}) {
                            $self->{INFO}->insert('end', "\n$_:\n\t" . $rv->{rv}->{$mods[0]}->{$_});
                          }
                        }
                      ]
                     );

  my $button3_menu = $self->_create_button3_menu($search);
  $search->bindRows('<ButtonPress-3>',
                      [ sub {
                          my @sel = $search->curselection;
                          @{$self->{MODS}} = map {$search->columnGet(0)->get($_, $_)} @sel;
                          $button3_menu->Popup(-popover => 'cursor', -popanchor => 'nw');
                        },
                      ]
                   );
  $search->pack(-side => 'bottom', -fill => 'both', -expand => 1);
}

#------------------------------------------------------------------------
# right frame contains three text widgets, two are always hidden
# 1. history editor
# 2. module info
# 3. module pod
# the actual contents depends on the last action in popup or history menu
#
sub _setup_right_frame {
  my $self       = shift;
  my $rightframe = shift;

#---- setting history widget
  my $hist = $rightframe->Scrolled('Text',
                                -scrollbars => 'osow',
                                -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',



( run in 1.409 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )