summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2009-11-21 18:45:46 +0000
committerNorbert Preining <preining@logic.at>2009-11-21 18:45:46 +0000
commitb11d5be54cdce9d4207c3bf3482526378ac9fd3e (patch)
tree74d55d60a5d3d9869ef9eb7d76f2f7dd9954c077
parent0fd42ef6a4411404e70e4170c381a6c6bf018772 (diff)
add the current status of tlmgrgui2
git-svn-id: svn://tug.org/texlive/trunk@16110 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Master/tlpkg/dev/tlmgrgui2.pl744
1 files changed, 744 insertions, 0 deletions
diff --git a/Master/tlpkg/dev/tlmgrgui2.pl b/Master/tlpkg/dev/tlmgrgui2.pl
new file mode 100644
index 00000000000..ac14e7c1cfe
--- /dev/null
+++ b/Master/tlpkg/dev/tlmgrgui2.pl
@@ -0,0 +1,744 @@
+#!/usr/bin/env perl
+# $Id: tlmgrgui2.pl 15823 2009-10-18 01:41:28Z preining $
+#
+# Copyright 2009 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# GUI for tlmgr
+
+use Tk;
+use Tk::Dialog;
+use Tk::NoteBook;
+use Tk::BrowseEntry;
+use Tk::ROText;
+use Tk::Balloon;
+use Tk::TixGrid;
+use TeXLive::Splashscreen;
+
+use TeXLive::TLUtils qw(setup_programs platform_desc win32 debug);
+use TeXLive::TLConfig;
+
+our $Master;
+our $tlmediatlpdb;
+our $tlmediasrc;
+our $location;
+#
+our %opts;
+#
+# the list of packages as shown by TixGrid
+#
+my %Packages;
+
+sub update_status_box {
+ update_status(join(" ", @_));
+ $mw->update;
+}
+
+sub init_hooks {
+ push @::info_hook, \&update_status_box;
+ push @::warn_hook, \&update_status_box;
+ push @::debug_hook, \&update_status_box;
+ push @::ddebug_hook, \&update_status_box;
+ push @::dddebug_hook, \&update_status_box;
+}
+
+sub update_status {
+ my ($p) = @_;
+ $::progressw->insert("end", "$p");
+ $::progressw->see("end");
+}
+
+my $opt_screen = $::guiscreen;
+
+
+# prepare for loading of lang.pl which expects $::lang and $::opt_lang
+$::opt_lang = $opts{"gui-lang"} if (defined($opts{"gui-lang"}));
+
+require("TeXLive/trans.pl");
+
+our @update_function_list;
+
+our $mw = MainWindow->new;
+$mw->title("TeX Live Manager $TeXLive::TLConfig::ReleaseYear");
+$mw->withdraw;
+
+#
+# default layout definitions
+#
+# priority 20 = widgetDefault
+# see Mastering Perl/Tk, 16.2. Using the Option Database
+$mw->optionAdd("*Button.Relief", "ridge", 20);
+#
+# does not work, makes all buttons exactely 10, which is not a good idea
+# I would like to have something like MinWidth 10...
+#$mw->optionAdd("*Button.Width", "10", 20);
+#
+# shortcuts for padding, expand/fill, and pack sides, anchors
+my @p_ii = qw/-padx 2m -pady 2m/;
+my @p_iii= qw/-padx 3m -pady 3m/;
+my @x_x = qw/-expand 1 -fill x/;
+my @x_y = qw/-expand 1 -fill y/;
+my @x_xy= qw/-expand 1 -fill both/;
+my @left = qw/-side left/;
+my @right= qw/-side right/;
+my @bot = qw/-side bottom/;
+my @a_w = qw/-anchor w/;
+my @a_c = qw/-anchor c/;
+
+
+# create a progress bar window
+$::progressw = $mw->Scrolled("ROText", -scrollbars => "e", -height => 4);
+$::progressw->pack(-fill => "x", @bot);
+
+
+init_hooks();
+
+info(__("Loading local TeX Live Database\nThis may take some time, please wait!") . "\n");
+
+our $localtlmedia = TeXLive::TLMedia->new ( $Master );
+die("cannot setup TLMedia in $Master") unless (defined($localtlmedia));
+$localtlpdb = $localtlmedia->tlpdb;
+die("cannot find tlpdb!") unless (defined($localtlpdb));
+
+our @main_list;
+
+my $loc = $localtlpdb->option("location");
+if (defined($loc)) {
+ $location = $loc;
+}
+if (defined($opts{"location"})) {
+ $location = $opts{"location"};
+}
+
+our $balloon = $mw->Balloon();
+
+
+push @update_function_list, \&check_location_on_ctan;
+push @update_function_list, \&init_install_media;
+
+#
+# check that we can actually save the database
+#
+if (check_on_writable()) {
+ $::we_can_save = 1;
+} else {
+ $::we_can_save = 0;
+ # here we should pop up a warning window!!!
+}
+$::action_button_state = ($::we_can_save ? "normal" : "disabled");
+
+our $top = $mw->Frame;
+
+our $top_top = $top->Frame;
+our $top_bot = $top->Frame;
+$top_top->pack(@x_x);
+$top_bot->pack(@x_x);
+
+our $quit = $top_top->Button(-text => __("Quit"),
+ -command => sub { $mw->destroy; exit(0); });
+
+my $tlmgrrev = give_version();
+chomp($tlmgrrev);
+our $about = $top_top->Button(-text => __("About"),
+ -command => sub {
+ my $sw = $mw->DialogBox(-title => __("About"),
+ -buttons => [ __("Ok") ]);
+ $sw->add("Label", -text => "TeX Live Manager
+$tlmgrrev
+Copyright 2008 Tomasz Luczak
+Copyright 2008, 2009 Norbert Preining
+
+Licensed under the GNU General Public License version 2 or higher
+In case of problems, please contact: texlive\@tug.org"
+ )->pack(@p_iii);
+ $sw->Show;
+ });
+
+$about->pack(@right);
+$quit->pack(@right);
+
+$mw->bind('<Escape>', [ $quit, 'Invoke' ]);
+
+
+$top_top->Label(-text => __("Repository to use") . " ")->pack(@left);
+$top_bot->Button(-text => __("Load default"),
+ -command => sub { run_update_functions(); })->pack(@left);
+$top_bot->Button(-text => __("Load other"),
+ -command => sub { menu_edit_location(); })->pack(@left);
+$top_bot->Label(-text => __("Loaded repository:") . " ")->pack(@left);
+$top_bot->Label(-textvariable => \$location)->pack(@left);
+
+
+
+# here we add a bit of trickery to make sure that the verbosity level
+# as set on the cmd line (-v or -v -v) is kept during pressing the
+# debug button on and off. If -v is *not* given activating it afterwards
+# defaults to one -v, while if -v -v is given on the cmd line, we keep
+# it that way
+$balloon->attach(
+ $top_bot->Checkbutton(-text => __("Debug"),
+ -onvalue => ($::opt_verbosity == 0 ? 1 : $::opt_verbosity),
+ -variable => \$::opt_verbosity)->pack(@right),
+ -balloonmsg => __("Turn on debug mode."));
+
+# frame .back -borderwidth 2
+our $back = $mw->NoteBook(-borderwidth => 2, -dynamicgeometry => 1);
+
+
+# pack .top .back -side top -fill both -expand 1
+$top->pack(-fill => 'x', @p_ii);
+$back->pack(@x_xy);
+
+#require ("do_listframe.pl");
+
+######### SHOULD GO INTO A SEPARTE FILE ########################
+# install screen
+our $back_f1 = $back->add("packages",-label => __("Package management"), -justify => "left");
+
+$screens{"packages"} = $back_f1;
+
+my $top_frame = $back_f1->Labelframe(-text => "Display configuration");
+$top_frame->pack(@x_x, @p_ii);
+
+my $filter_frame = $top_frame->Frame();
+$filter_frame->pack;
+
+my $filter_status = $filter_frame->Labelframe(-text => "Status");
+$filter_status->pack(@left, @p_ii);
+
+my $status_all = 0;
+my $status_only_installed = 1;
+my $status_only_not_installed = 2;
+my $status_only_updated = 3;
+my $status_value = 0;
+$filter_status->Radiobutton(-text => "all",
+ -variable => \$status_value, -value => $status_all)->pack(@a_w);
+$filter_status->Radiobutton(-text => "only installed",
+ -variable => \$status_value, -value => $status_only_installed)->pack(@a_w);
+$filter_status->Radiobutton(-text => "only not installed",
+ -variable => \$status_value, -value => $status_only_not_installed)->pack(@a_w);
+$filter_status->Radiobutton(-text => "only updated",
+ -variable => \$status_value, -value => $status_only_updated)->pack(@a_w);
+
+my $filter_category = $filter_frame->Labelframe(-text => "Category");
+$filter_category->pack(@left, @p_ii);
+my $show_packages = 1;
+my $show_collections = 1;
+my $show_schemes = 1;
+my $show_tlcore = 1;
+$filter_category->Checkbutton(-text => "packages",
+ -variable => \$show_packages)->pack(@a_w);
+$filter_category->Checkbutton(-text => "collections",
+ -variable => \$show_collections)->pack(@a_w);
+$filter_category->Checkbutton(-text => "schemes",
+ -variable => \$show_schemes)->pack(@a_w);
+$filter_category->Checkbutton(-text => "tlcore",
+ -variable => \$show_tlcore)->pack(@a_w);
+
+my $filter_match = $filter_frame->Labelframe(-text => "Match");
+$filter_match->pack(@left, @x_y, @p_ii);
+my $match_value = 0;
+$filter_match->Radiobutton(-text => "all",
+ -variable => \$match_value, -value => 0)->pack(@a_w);
+$filter_match->Radiobutton(-text => "matching:",
+ -variable => \$match_value, -value => 1)->pack(@a_w);
+$filter_match->Entry(-width => 15)->pack(@a_w, -padx => '2m', @x_x);
+
+my $filter_selection = $filter_frame->Labelframe(-text => "Selection");
+$filter_selection->pack(@left, @x_y, @p_ii);
+my $selection_value = 0;
+$filter_selection->Radiobutton(-text => "all",
+ -variable => \$selection_value, -value => 0)->pack(@a_w);
+$filter_selection->Radiobutton(-text => "only selected",
+ -variable => \$selection_value, -value => 1)->pack(@a_w);
+$filter_selection->Radiobutton(-text => "only not selected",
+ -variable => \$selection_value, -value => 2)->pack(@a_w);
+
+
+my $filter_button = $filter_frame->Labelframe(-text => "Action");
+$filter_button->pack(@left, @x_y, @p_ii);
+$filter_button->Button(-text => "Apply filters",
+ -command => sub { update_grid(); })->pack(@a_c, @p_ii);
+$filter_button->Button(-text => "Reset filters",
+ -command => sub { $status_value = $status_all;
+ $show_packages = 1; $show_collections = 1;
+ $show_schemes = 1; $show_tlcore = 1;
+ $selection_value = 0;
+ $match_value = 0;
+ update_grid();
+ })->pack(@a_c, @p_ii);
+
+########## Packages #######################
+my $list_frame = $back_f1->Labelframe(-text => "Packages");
+$list_frame->pack(@x_xy, @p_ii);
+my $g = $list_frame->Scrolled('TixGrid', -scrollbars => "se", -bd => 0,
+ -floatingrows => 0, -floatingcols => 0,
+ -leftmargin => 2, # selection and label
+ -topmargin => 1, # top labels
+ -selectmode => "none",
+ -selectunit => "row");
+
+$g->pack(qw/-expand 1 -fill both -padx 3 -pady 3/);
+$g->configure(-formatcmd=>[\&AlternatingLineColoring, $g]);
+$g->size(qw/col 4 -size 10char/);
+$g->size(qw/col 5 -size 10char/);
+$g->size(qw/col default -size auto/);
+$g->size(qw/row default -size 1.1char -pad0 3/);
+
+setup_list();
+update_grid();
+
+sub update_grid {
+ # fill the header
+ #$g->set(0,0, -itemtype => 'window', -widget => $g->Checkbutton());
+ $g->set(1,0, -itemtype => 'text', -text => "Package");
+ $g->set(2,0, -itemtype => 'text', -text => "Local Rev");
+ $g->set(3,0, -itemtype => 'text', -text => "Remote Rev");
+ $g->set(4,0, -itemtype => 'text', -text => "Local Ver");
+ $g->set(5,0, -itemtype => 'text', -text => "Remote Ver");
+ $g->set(6,0, -itemtype => 'text', -text => "Short Desc");
+
+ my @schemes;
+ my @colls;
+ my @packs;
+ for my $p (sort keys %Packages) {
+ if ($p =~ m;^scheme-;) {
+ push @schemes, $p;
+ } elsif ($p =~ m;^collection-;) {
+ push @colls, $p;
+ } else {
+ push @packs, $p;
+ }
+ }
+ my $i = 1;
+ # the number of current lines:
+ my (undef, $curlines) = $g->index(0, 'max');
+ for my $p (@rrr, @colls, @packs) {
+ if (MatchesFilters($p)) {
+ if (!$g->infoExists(0,$i)) {
+ $g->set(0,$i, -itemtype => 'window', -widget => $g->Checkbutton);
+ }
+ $g->set(1,$i, -itemtype => 'text', -text => $Packages{$p}{'displayname'});
+ $g->set(2,$i, -itemtype => 'text', -text => $Packages{$p}{'localrevision'})
+ if defined($Packages{$p}{'localrevision'});
+ $g->set(3,$i, -itemtype => 'text', -text => $Packages{$p}{'remoterevision'})
+ if defined($Packages{$p}{'remoterevision'});
+ $g->set(4,$i, -itemtype => 'text', -text => $Packages{$p}{'localcatalogueversion'})
+ if defined($Packages{$p}{'localcatalogueversion'});
+ $g->set(5,$i, -itemtype => 'text', -text => $Packages{$p}{'remotecatalogueversion'})
+ if defined($Packages{$p}{'remotecatalogueversion'});
+ $g->set(6,$i, -itemtype => 'text', -text => $Packages{$p}{'shortdesc'});
+ $i++;
+ }
+ }
+ if ($i <= $curlines) {
+ # remove the rest of the lines
+ $g->deleteRow($i, $curlines);
+ }
+}
+
+sub MatchesFilters {
+ my $p = shift;
+ # status
+ if (( ($status_value == $status_all) ) ||
+ ( ($status_value == $status_only_installed) &&
+ (defined($Packages{$p}{'installed'})) &&
+ ($Packages{$p}{'installed'} == 1) ) ||
+ ( ($status_value == $status_only_not_installed) &&
+ ( !defined($Packages{$p}{'installed'}) ||
+ ($Packages{$p}{'installed'} == 0)) ) ||
+ ( ($status_value == $status_only_updated) &&
+ (defined($Packages{$p}{'localrevision'})) &&
+ (defined($Packages{$p}{'remoterevision'})) &&
+ ($Packages{$p}{'localrevision'} < $Packages{$p}{'remoterevision'}))) {
+ # do nothing, more checks have to be done
+ } else {
+ return 0;
+ }
+ # category
+ if (($show_packages && ($Packages{$p}{'category'} eq 'Package')) ||
+ ($show_collections && ($Packages{$p}{'category'} eq 'Collection')) ||
+ ($show_schemes && ($Packages{$p}{'category'} eq 'Scheme')) ||
+ ($show_tlcore && ($Packages{$p}{'category'} eq 'TLCore')) ) {
+ # do nothing, more checks have to be done
+ } else {
+ return 0;
+ }
+ # match
+ # TO BE DONE!!!
+ # selection
+ # TO BE DONE!!!
+ #
+ # if we come down to here the package matches
+ return 1;
+}
+
+
+sub AlternatingLineColoring {
+ my ($w, $area, @entbox) = @_;
+ if ($area eq 'main') {
+ # first format all cells
+ # no select background -selectbackground => 'lightblue',
+ $w->formatGrid( @entbox, -selectbackground => 'gray70',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 0,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray70');
+ # format odd lines 1,3,5,7, ... (counting starts at 0!!!)
+ $w->formatGrid( @entbox, -selectbackground => 'gray90',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 1,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray90');
+ }
+ if ($area eq 'y_margin') {
+ my ($ulx, $uly, $lrx, $lry) = @entbox;
+ # format the checkbuttons backgrounds
+ for my $i ($uly..$lry) {
+ if ($w->infoExists(0,$i)) {
+ $cb = $w->entrycget(0, $i, "-window");
+ $cb->configure(-background => (($i-$uly)%2 ? 'gray70' : 'gray90'));
+ }
+ }
+ # first format all cells
+ # no select background -selectbackground => 'lightblue',
+ $w->formatBorder( @entbox, -selectbackground => 'gray70',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 0,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray70');
+ # format odd lines 1,3,5,7, ... (counting starts at 0!!!)
+ $w->formatBorder( @entbox, -selectbackground => 'gray90',
+ -xon => 1, -xoff => 0, -yon => 1, -yoff => 1,
+ -relief => 'raised', -bd => 0, -filled => 1, -bg => 'gray90');
+ }
+}
+
+####### actions frame
+
+my $bot_frame = $back_f1->Labelframe(-text => "Actions");
+$bot_frame->pack(@x_x, @p_ii);
+
+my $actions_frame = $bot_frame->Frame;
+$actions_frame->pack();
+
+my $with_sel_frame = $actions_frame->Labelframe(-text => "with selected");
+$with_sel_frame->pack(@left, @p_ii);
+my $action_apply_filter = 1;
+$with_sel_frame->Label(-text => "with filters")->pack(@left, @p_ii);
+
+$with_sel_frame->Radiobutton(-text => "applied",
+ -variable => \$action_apply_filter, -value => 1)->pack(@left, @p_ii);
+$with_sel_frame->Radiobutton(-text => "not applied",
+ -variable => \$action_apply_filter, -value => 0)->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Install')->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Upgrade')->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Remove')->pack(@left, @p_ii);
+$with_sel_frame->Button(-text => 'Backup')->pack(@left, @p_ii);
+
+my $with_all_frame = $actions_frame->Labelframe(-text => "with all");
+$with_all_frame->pack(@left, @p_ii);
+$with_all_frame->Button(-text => 'Update all')->pack(@a_c,@left,@p_ii);
+
+######################## UNINSTALL ###########################
+# uninstall screen
+require("gui-uninstall.pl");
+# arch support not be done via tlmgr on win32
+if (!win32()) {
+ require("gui-arch.pl");
+}
+# config screen
+require("gui-config.pl");
+
+if ($opt_load) {
+ run_update_functions();
+}
+
+
+if (defined($opt_screen)) {
+ $back->raise("$opt_screen");
+}
+
+info(__("Completed") . "\n");
+$mw->deiconify;
+
+
+if (!$::we_can_save) {
+ my $no_write_warn = $mw->Dialog(-title => "warning",
+ -text => __("You don't have permissions to change the installation in any way,\nspecifically, the directory %s is not writable.\nPlease run this program as administrator, or contact your local admin.\n\nMost buttons will be disabled.", "$Master/tlpkg/"),
+ -buttons => [ __("Ok") ])->Show();
+}
+
+Tk::MainLoop();
+
+
+sub init_install_media {
+ my $newroot = $location;
+ if (defined($tlmediatlpdb) && ($tlmediatlpdb->root eq $newroot)) {
+ # nothing to be done
+ } else {
+ $mw->Busy(-recurse => 1);
+ info(__("Loading remote TeX Live Database\nThis may take some time, please wait!") . "\n");
+ $tlmediasrc = TeXLive::TLMedia->new($newroot);
+ info(__("Completed") . "\n");
+ $mw->Unbusy;
+ if (!defined($tlmediasrc)) {
+ # something went badly wrong, maybe the newroot is wrong?
+ $mw->Dialog(-title => "warning",
+ -text => __("Could not load the TeX Live Database from %s\nIf you want to install or update packages, please try with a different package repository!\n\nFor configuration and removal you don\'t have to do anything.", $newroot),
+ -buttons => [ __("Ok") ])->Show;
+ $location = __("...please change me...");
+ } else {
+ $tlmediatlpdb = $tlmediasrc->tlpdb;
+ setup_list();
+ update_grid();
+ }
+ }
+}
+
+sub set_text_win {
+ my ($w, $t) = @_;
+ $w->delete("0.0", "end");
+ $w->insert("0.0", "$t");
+ $w->see("0.0");
+}
+
+sub install_selected_packages {
+ if (@_) {
+ my @args = qw/install/;
+ push @args, @_;
+ execute_action_gui(@args);
+ reinit_local_tlpdb();
+ # now we check that the installation has succeeded by checking that
+ # all packages in @_ are installed. Otherwise we pop up a warning window
+ my $do_warn = 0;
+ for my $p (@_) {
+ if (!defined($localtlpdb->get_package($p))) {
+ $do_warn = 1;
+ last;
+ }
+ }
+ give_warning_window(__("Installation"), @_) if $do_warn;
+ }
+}
+
+sub update_selected_packages {
+ if (@_) {
+ my @args = qw/update/;
+ # argument processing
+ # in case we have critical updates present we do put the list of
+ # critical updates into the argument instead of --all
+ if ($critical_updates_present) {
+ $opts{"self"} = 1;
+ } else {
+ if ($_[0] eq "--all") {
+ $opts{"all"} = 1;
+ # shift away the --all
+ shift;
+ }
+ }
+ push @args, @_;
+ execute_action_gui(@args);
+ if ($critical_updates_present) {
+ # terminate here immediately so that we are sure the auto-updater
+ # is run immediately
+ # make sure we exit in finish(0)
+ $::gui_mode = 0;
+ finish(0);
+ }
+ reinit_local_tlpdb();
+ }
+}
+
+sub remove_selected_packages {
+ if (@_) {
+ my @args = qw/remove/;
+ push @args, @_;
+ execute_action_gui(@args);
+ reinit_local_tlpdb();
+ my $do_warn = 0;
+ for my $p (@_) {
+ if (defined($localtlpdb->get_package($p))) {
+ $do_warn = 1;
+ last;
+ }
+ }
+ give_warning_window(__("Remove"), @_) if $do_warn;
+ }
+}
+
+sub reinit_local_tlpdb {
+ $mw->Busy(-recurse => 1);
+ $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
+ die("cannot find tlpdb!") unless (defined($localtlpdb));
+ setup_list();
+ update_grid();
+ $mw->Unbusy;
+}
+
+
+#
+# creates/updates the list of packages as shown in tix grid
+#
+sub setup_list {
+ my @do_later;
+ my @do_later_media;
+ for my $p ($localtlpdb->list_packages()) {
+ # collect packages containing a . for later
+ # we want to ignore them in most cases but those where there is
+ # no father package (without .)
+ if ($p =~ m;\.;) {
+ push @do_later, $p;
+ next;
+ }
+ my $tlp = $localtlpdb->get_package($p);
+ # collect information about that package we will show
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'localrevision'} = $tlp->revision;
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'installed'} = 1;
+ $Packages{$p}{'category'} = $tlp->category;
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'localcatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ if (defined($tlmediatlpdb)) {
+ for my $p ($tlmediatlpdb->list_packages()) {
+ if ($p =~ m;\.;) {
+ push @do_later_media, $p;
+ next;
+ }
+ my $tlp = $tlmediatlpdb->get_package($p);
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'remoterevision'} = $tlp->revision;
+ # overwrite, we assume that the remove version is better ;-)
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'category'} = $tlp->category;
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'remotecatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ }
+ #
+ for my $p (@do_later) {
+ my $s = $p;
+ $s =~ s!\.[^.]*$!!;
+ if (!defined($Packages{$s})) {
+ my $tlp = $localtlpdb->get_package($p);
+ # collect information about that package we will show
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'localrevision'} = $tlp->revision;
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'installed'} = 1;
+ $Packages{$p}{'category'} = $tlp->category;
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'localcatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ }
+ for my $p (@do_later_media) {
+ my $s = $p;
+ $s =~ s!\.[^.]*$!!;
+ if (!defined($Packages{$s})) {
+ my $tlp = $tlmediatlpdb->get_package($p);
+ # collect information about that package we will show
+ $Packages{$p}{'displayname'} = $p;
+ $Packages{$p}{'remoterevision'} = $tlp->revision;
+ $Packages{$p}{'shortdesc'} = $tlp->shortdesc;
+ $Packages{$p}{'category'} = $tlp->category;
+ if (defined($tlp->cataloguedata->{'version'})) {
+ $Packages{$p}{'remotecatalogueversion'} = $tlp->cataloguedata->{'version'};
+ }
+ }
+ }
+ # change display names
+ for my $p (keys %Packages) {
+ if ($p =~ m/^collection-documentation-(.*)$/) {
+ $Packages{$p}{'displayname'} = "collection-doc-$1";
+ }
+ }
+}
+
+
+sub menu_edit_location {
+ my $key = shift;
+ my $val;
+ my $sw = $mw->Toplevel(-title => __("Change package repository"));
+ $sw->transient($mw);
+ $sw->grab();
+ $sw->Label(-text => __("New package repository:"))->pack(@p_ii);
+ my $entry = $sw->Entry(-text => $location, -width => 30);
+ $entry->pack();
+ my $f1 = $sw->Frame;
+ $f1->Button(-text => __("Choose Directory"),
+ -command => sub {
+ my $var = $sw->chooseDirectory;
+ if (defined($var)) {
+ $entry->delete(0,"end");
+ $entry->insert(0,$var);
+ }
+ })->pack(@left, @p_ii);
+ $f1->Button(-text => __("Default net package repository"),
+ -command => sub {
+ $entry->delete(0,"end");
+ $entry->insert(0,$TeXLiveURL);
+ })->pack(@left, @p_ii);
+ $f1->pack;
+ my $f = $sw->Frame;
+ my $okbutton = $f->Button(-text => __("Ok"),
+ -command => sub { $location = $entry->get;
+ run_update_functions();
+ $sw->destroy;
+ })->pack(@left, @p_ii);
+ my $cancelbutton = $f->Button(-text => __("Cancel"),
+ -command => sub { $sw->destroy })->pack(@right, @p_ii);
+ $f->pack(-expand => 1);
+ $sw->bind('<Return>', [ $okbutton, 'Invoke' ]);
+ $sw->bind('<Escape>', [ $cancelbutton, 'Invoke' ]);
+}
+
+sub run_update_functions {
+ foreach my $f (@update_function_list) {
+ &{$f}();
+ }
+}
+
+sub check_location_on_ctan {
+ # we want to check that if mirror.ctan.org
+ # is used that we select a mirror once
+ if ($location =~ m/$TeXLive::TLConfig::TeXLiveServerURL/) {
+ $location = TeXLive::TLUtils::give_ctan_mirror();
+ }
+}
+
+sub execute_action_gui {
+ # my $td = $mw->Toplevel(-title => __("Status Window"));
+ # $td->transient($mw);
+ # $td->grab();
+ # my $ok = $td->Button(-text => __("Ok"), @p_iii,
+ # -command => sub { $td->destroy; });
+ # my $lab = $td->Label(-text => __("Starting") . " @_\n");
+ # $lab->pack;
+ $mw->Busy(-recurse => 1);
+ execute_action(@_);
+ info(__("Completed") . "\n");
+ $mw->Unbusy;
+ # my $labb = $td->Label(-text => __("Completed"));
+ # $labb->pack;
+ # $ok->pack;
+}
+
+sub give_warning_window {
+ my ($act, @args) = @_;
+ my $sw = $mw->DialogBox(-title => __("Warning Window"), -buttons => [ __("Ok") ]);
+ $sw->add("Label", -text => __("Running %s failed.\nPlease consult the log window for details.", "$act @args")
+ )->pack(@p_iii);
+ $sw->Show;
+}
+
+1;
+
+__END__
+
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #