#!/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 => __("Packages"), -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 uninstalled", 
  -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, @x_y, @p_ii);
my $show_packages = 1;
my $show_collections = 1;
my $show_schemes = 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);

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 ($Packages{$p}{'category'} eq "Scheme") {
      push @schemes, $p;
    } elsif ($Packages{$p}{'category'} eq "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 (@schemes, @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 'Other')) ||
      ($show_collections && ($Packages{$p}{'category'} eq 'Collection')) ||
      ($show_schemes     && ($Packages{$p}{'category'} eq 'Scheme')) ) {
    # 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;
    if (($tlp->category eq "Collection") ||
        ($tlp->category eq "Scheme")) {
      $Packages{$p}{'category'}      = $tlp->category;
    } else {
      $Packages{$p}{'category'}      = "Other";
    }
    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;
      if (($tlp->category eq "Collection") ||
          ($tlp->category eq "Scheme")) {
        $Packages{$p}{'category'}      = $tlp->category;
      } else {
        $Packages{$p}{'category'}      = "Other";
      }
      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;
      if (($tlp->category eq "Collection") ||
          ($tlp->category eq "Scheme")) {
        $Packages{$p}{'category'}      = $tlp->category;
      } else {
        $Packages{$p}{'category'}      = "Other";
      }
      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;
      if (($tlp->category eq "Collection") ||
          ($tlp->category eq "Scheme")) {
        $Packages{$p}{'category'}      = $tlp->category;
      } else {
        $Packages{$p}{'category'}      = "Other";
      }
      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: #