tlmgr2: many fixes for gui and interaction

git-svn-id: svn://tug.org/texlive/trunk@11543 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 100 insertions, 13 deletions

diff --git a/Master/texmf/scripts/texlive/tlmgr2.pl b/Master/texmf/scripts/texlive/tlmgr2.pl
index 4628af0abbb..a867befc720 100755
--- a/Master/texmf/scripts/texlive/tlmgr2.pl
+++ b/Master/texmf/scripts/texlive/tlmgr2.pl
@@ -1556,9 +1556,17 @@ sub action_install {
   my $tlmediatlpdb = $tlmediasrc->tlpdb;
 
   # check for updates to tlmgr itself, and die unless --force is given
-  if(check_for_critical_updates( $localtlpdb, $tlmediatlpdb, !$opt_force)) {
-    die "not continuing, please see warning above!"
-      unless $::gui_mode;
+  if (check_for_critical_updates( $localtlpdb, $tlmediatlpdb)) {
+    if ($opt_force) {
+      tlwarn("Continuing due to --force\n");
+    } else {
+      if ($::gui_mode) {
+        # return here and don't do any updates
+        return;
+      } else {
+        die "not continuing, please see warning above!";
+      }
+    }
   }
 
   $opt_nodepends = 1 if $opt_reallynodepends;
diff --git a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl
index 9a33f93dd15..f1ad2d85e8a 100755
--- a/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl
+++ b/Master/texmf/scripts/texlive/tlmgrgui/tlmgrgui2.pl
@@ -110,11 +110,13 @@ sub update_status_window {
   $mw->update;
 }
 
-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 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) = @_;
@@ -199,6 +201,9 @@ $::sww->Label(-text => "Log output")->pack;
 $::progressw = $::sww->Scrolled("ROText", -scrollbars => "e", -height => 16);
 $::progressw->pack(-expand => 1, -fill => "both");
 
+
+init_hooks();
+
 info(___("loadtlpdbwait") . "\n");
 
 our $localtlpdb = TeXLive::TLPDB->new ("root" => "$Master");
@@ -287,7 +292,7 @@ my $install_win = do_listframe($back_f1,
              \@allpackages,
              { install => { -text => ___"installsel",
                             -command => \&install_selected_packages}},
-             0,1
+             1,1
             );
 set_text_win($install_win, ___"warningtxt");
 # update screen
@@ -303,7 +308,7 @@ my $update_win = do_listframe($back_up,
                updatesel => { -text => ___"updatesel",
                               -command => \&update_selected_packages
                             }},
-             0,0
+             1,0
             );
 set_text_win($update_win, ___"warningtxt");
 # remove screen
@@ -434,8 +439,21 @@ sub run_program_show_output {
 
 sub install_selected_packages {
   if (@_) {
-    execute_action("install", @_);
+    my @args = qw/install/;
+    push @args, "-force" if $opt_force;
+    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(___"install", @_) if $do_warn;
   }
 }
 
@@ -458,7 +476,10 @@ sub update_selected_packages {
         }
       }
     }
-    execute_action("update", @_);
+    my @args = qw/update/;
+    push @args, "-force" if $opt_force;
+    push @args, @_;
+    execute_action_gui(@args);
     if (win32() && $updater_needed) {
       my $t = ___"runupdater";
       $t =~ s/TEXROOT/$Master/;
@@ -470,13 +491,26 @@ sub update_selected_packages {
       #  -buttons => [ ___"ok" ])->Show;
     }
     reinit_local_tlpdb();
+    # TODO TODO TODO
+    # we should give a warning window when something didn't work out!!!
   }
 }
 
 sub remove_selected_packages {
   if (@_) {
-    execute_action("remove", @_);
+    my @args = qw/remove/;
+    push @args, "-force" if $opt_force;
+    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;
   }
 }
 
@@ -532,6 +566,27 @@ sub create_update_list {
     @ret = ();
   }
   @updatepackages = @ret;
+  # check for presence of critical packages and if there are updates 
+  # give a warning window
+  my @critical = $localtlpdb->expand_dependencies("-no-collections",
+    $localtlpdb, @TeXLive::TLConfig::CriticalPackagesList);
+  my $criticalupdate = 0;
+  OUTER: for my $p (@updatepackages) {
+    for my $cp (@critical) {
+      if ($p =~ m/^$cp/) {
+        $criticalupdate = 1;
+        # terminate the whole checking here
+        last OUTER;
+      }
+    }
+  }
+  if ($criticalupdate) {
+    my $sw = $mw->DialogBox(-title => ___"warning", -buttons => [ ___"ok" ]);
+    $sw->add("Label", -text => "Updates for the tlmgr are present.
+Installation and upgrades won't work without being forced."
+      )->pack(-padx => "3m", -pady => "3m");
+    $sw->Show;
+  }
 }
 
 sub setup_list {
@@ -612,6 +667,30 @@ sub check_location_on_ctan {
   }
 }
 
+sub execute_action_gui {
+  # my $td = $mw->Toplevel(-title => ___"info 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;
+  execute_action(@_);
+  info(___("completed") . "\n");
+  # my $labb = $td->Label(-text => ___"finished");
+  # $labb->pack;
+  # $ok->pack;
+}
+
+sub give_warning_window {
+  my ($act, @args) = @_;
+  my $sw = $mw->DialogBox(-title => ___"info window", -buttons => [ ___"ok" ]);
+  $sw->add("Label", -text => "Executing action $act on @args failed.
+Please consult the log window for details."
+    )->pack(-padx => "3m", -pady => "3m");
+  $sw->Show;
+}
+
 1;
 
 __END__