#!/usr/bin/env perl
# $Id: tlmgrgui.pl 15823 2009-10-18 01:41:28Z preining $
#
# Copyright 2008 Tomasz Luczak
# Copyright 2008, 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 TeXLive::Splashscreen;

use TeXLive::TLUtils qw(setup_programs platform_desc win32 debug);
use TeXLive::TLConfig;

our $Master;
our $tlmediatlpdb;
our $tlmediasrc;
our $location;
#
# translation facility, not fully functional by now
#
our %opts;

sub update_status_window {
  update_status(join(" ", @_));
  $mw->update;
  $::sww->update;
}

sub init_hooks {
  push @::info_hook, \&update_status_window;
  push @::warn_hook, \&update_status_window;
  push @::debug_hook, \&update_status_window;
  push @::ddebug_hook, \&update_status_window;
  push @::dddebug_hook, \&update_status_window;
}

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;

# create a progress bar window
$::sww = $mw->Toplevel(-title => "log window",
                       -width => 400);
$::sww->transient($mainwindow);
#$::sww->grab();
$::sww->Label(-text => "Log output")->pack;
$::progressw = $::sww->Scrolled("ROText", -scrollbars => "e", -height => 16);
$::progressw->pack(-expand => 1, -fill => "both");


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 @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
our @updatepackages;
setup_programs("$Master/tlpkg/installer", $localtlmedia->platform);

my $loc = $localtlpdb->option("location");
if (defined($loc)) {
  $location = $loc;
}
if (defined($opts{"location"})) {
  $location = $opts{"location"};
}

our @allpackages;

our $balloon = $mw->Balloon();


push @update_function_list, \&check_location_on_ctan;
push @update_function_list, \&init_install_media;
push @update_function_list, \&create_update_list;

#
# 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 $quit = $top->Button(-text => __("Quit"),
                         -command => sub { $mw->destroy; exit(0); });

my $tlmgrrev = give_version();
chomp($tlmgrrev);
our $about = $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(-padx => "3m", -pady => "3m");
    $sw->Show;
    });

$about->pack(-side => 'right');
$quit->pack(-side => 'right');

$mw->bind('<Escape>', [ $quit, 'Invoke' ]);

$top->Label(-text => __("Current package repository:") . " ")->pack(-side => 'left');
$top->Label(-textvariable => \$location,  -relief => "sunken")->pack(-side => 'left');

$balloon->attach(
  $top->Button(-text => __("Load"), -command => sub { run_update_functions(); })->pack(-side => 'left'),
  -balloonmsg => __("Press this button to load the database from the package repository."));

$balloon->attach(
  $top->Button(-text => __("Change"), -command => sub { menu_edit_location(); })->pack(-side => 'left'),
  -balloonmsg => __("Change package repository from where packages are fetched at installation and update time."));

# 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->Checkbutton(-text => __("Debug"), 
                    -onvalue => ($::opt_verbosity == 0 ? 1 : $::opt_verbosity),
                    -variable => \$::opt_verbosity)->pack(-side => 'left'),
  -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(-side => 'top', -fill => 'x', -expand => 0);
$back->pack(-side => 'top', -fill => 'both', -expand => 1);

require ("do_listframe.pl");
# install screen
our $back_f1 = $back->add("install",-label => __("Installation"), -justify => "left");
$screens{"install"} = $back_f1;
my ($install_win, $install_lb) = do_listframe($back_f1,
             __("Adding packages"),
             \@allpackages,
             { install => { -text => __("Install selected"),
                            -command => \&install_selected_packages}},
             1,1
            );
set_text_win($install_win, __("The database of the package repository has not been loaded.\n\nPlease use the \"Load\" (and possibly \"Change\") button to do so."));
# update screen
our $back_up = $back->add("update", -label => __("Update"), -justify => "left");
$screens{"update"} = $back_up;
my $critical_updates_present = 0;
my ($update_win, $update_lb) = do_listframe($back_up,
             __("Updating packages"),
             \@updatepackages,
             { updateall => { -text => __("Update all"),
                              -command => \&update_selected_packages,
                              -args => [ "--all" ]
                            },
               updatesel => { -text => __("Update selected"),
                              -command => \&update_selected_packages
                            }},
             1,0
            );
set_text_win($update_win, __("The database of the package repository has not been loaded.\n\nPlease use the \"Load\" (and possibly \"Change\") button to do so."));
# remove screen
our $back_f2 = $back->add("remove", -label => __("Remove"), -justify => "left");
$screens{"remove"} = $back_f2;
my ($remove_win, $remove_lb) = do_listframe($back_f2,
             __("Removing packages"),
             \@alllocalpackages,
             { remove => { -text => __("Remove selected"),
                           -command => \&remove_selected_packages}},
             1,1
            );
set_text_win($remove_win, __("Please click on an item on the left for details"));
# 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...");
      @allpackages = ();
    } else {
      $tlmediatlpdb = $tlmediasrc->tlpdb;
      @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
      set_text_win($install_win, __("Please click on an item on the left for details"));
      set_text_win($remove_win,  __("Please click on an item on the left for details"));
      set_text_win($update_win,  __("Please click on an item on the left for details"));
    }
  }
}

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));
  @alllocalpackages = setup_list(0,$localtlpdb->list_packages);
  if (defined($tlmediatlpdb)) {
    @allpackages = setup_list(1,$tlmediatlpdb->list_packages);
  }
  create_update_list();
  $mw->Unbusy;
}

#
# create_update_list
# checks for updates and builds up the list @updatepackages which
# is shown on the update screen
#
# if critical packages do have a pending update *only* those packages
# are shown in the list so that pressing the --all will succeed
sub create_update_list {
  my @ret = ();
  my @archret = ();
  my @critical = $localtlpdb->expand_dependencies("-no-collections",
    $localtlpdb, @TeXLive::TLConfig::CriticalPackagesList);
  if (defined($tlmediatlpdb)) {
    foreach my $lp ($localtlpdb->list_packages) {
      next if ($lp =~ m/00texlive.installation/);
      my $lrev = $localtlpdb->get_package($lp)->revision;
      my $up = $tlmediatlpdb->get_package($lp);
      my $urev;
      if ($up) {
        $urev = $up->revision;
      } else {
        $urev = 0;
      }
      if ($urev > $lrev) {
        if ($lp =~ m/\./) {
          push @archret, $lp;
        } else {
          push @ret, $lp;
        }
      }
    }
    foreach my $p (@archret) {
      my $foundparent = 0;
      foreach my $q (@ret) {
        $foundparent = 1 if ($p =~ m/^$q\./);
      }
      push @ret, $p unless $foundparent;
    }
    # issue a warning if no updates are available, the tlmediatlpdb is loaded
    # and is not from the net
    if ($#ret < 0) {
      if ($tlmediasrc->media ne "NET") {
        set_text_win($update_win, __("No updates found.\n\nYour installation is set up to look on the disk for updates.\n\nIf you want to install from the Internet for this one time only, click on the \"Change\" button above and select \"Default net package repository\" (or any other package repository you know to be working).\n\nIf you want to change it permanently, go to the \"Configuration\" Tab and change the default package repository."));
      } else {
        set_text_win($update_win, __("Everything up-to-date!"));
      }
    }
  } else {
    @ret = ();
  }
  # sort the critical packages out
  my @critupd = ();
  OUTER: for my $p (@ret) {
    for my $cp (@critical) {
      if ($p =~ m/^$cp/) {
        push @critupd, $p;
        next OUTER;
      }
    }
  }
  if (@critupd) {
    @updatepackages = @critupd;
    # set background of critical packages to red
    for my $i (0..$#updatepackages) {
      $update_lb->itemconfigure($i, -background => "red", 
                                    -selectforeground => "red");
    }
    $critical_updates_present = 1;
  } else {
    @updatepackages = @ret;
    $critical_updates_present = 0;
  }
  if ($critical_updates_present) {
    my $sw = $mw->DialogBox(-title => __("Warning"), -buttons => [ __("Ok") ]);
    my $t = __("Updates for the tlmgr are present.\nInstallation and upgrades won't work without being forced.\nPlease go to the update screen and press the \"update all\" button.\nThe program will terminate after the update.\nThen you can restart the program for further updates.");
    $t .= "\n\n" . __("Please wait a bit after the program has terminated so that the update can be completed.") if win32();
    $sw->add("Label", -text => $t)->pack(-padx => "3m", -pady => "3m");
    $sw->Show;
  }
}

sub setup_list {
  my $addi = shift;
  my @ret;
  my @colls;
  my @other;
  foreach my $p (@_) {
    if ($p !~ m;\.;) {
      my $pushstr = "";
      if ($addi) {
        if (defined($localtlpdb->get_package($p))) {
          $pushstr = "(i) ";
        } else {
          $pushstr = "    ";
        }
      }
      $pushstr .= "$p";
      if ($p =~ m;^scheme-;) {
        push @ret, $pushstr;
      } elsif ($p =~ m;^collection-;) {
        push @colls, $pushstr;
      } else {
        push @other, $pushstr;
      }
    }
  }
  push @ret, @colls, @other;
  return(@ret);
}


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(-padx => "2m", -pady => "2m");
  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(-side => "left", -padx => "2m", -pady => "2m");
  $f1->Button(-text => __("Default net package repository"),
    -command => sub {
                      $entry->delete(0,"end");
                      $entry->insert(0,$TeXLiveURL);
                    })->pack(-side => "left", -padx => "2m", -pady => "2m");
  $f1->pack;
  my $f = $sw->Frame;
  my $okbutton = $f->Button(-text => __("Ok"),
    -command => sub { $location = $entry->get;
                      run_update_functions();
                      $sw->destroy;
                    })->pack(-side => 'left', -padx => "2m", -pady => "2m");
  my $cancelbutton = $f->Button(-text => __("Cancel"),
          -command => sub { $sw->destroy })->pack(-side => 'right', -padx => "2m", -pady => "2m");
  $f->pack(-expand => 'x');
  $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"), -padx => "3m", -pady => "3m",
  #                      -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(-padx => "3m", -pady => "3m");
  $sw->Show;
}

1;

__END__


### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #
