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 )