give warning on critical updates and allow only update --self

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

1 files changed, 43 insertions, 13 deletions

diff --git a/Master/tlpkg/dev/tlmgrgui2.pl b/Master/tlpkg/dev/tlmgrgui2.pl
index e5370175f2d..195fec26d5d 100644
--- a/Master/tlpkg/dev/tlmgrgui2.pl
+++ b/Master/tlpkg/dev/tlmgrgui2.pl
@@ -8,12 +8,10 @@
 # GUI for tlmgr
 # version 2, completely rewritten GUI
 #
-# TODO: move the check for critical updates from old create_update_list
-#       to here!!
 # TODO: details window for a package should have a "Details" button
 #       to show the list of files etc (like --list on tlmgr cmd line)
-# TODO: warning window from execute_action_gui if something failed, and also
-#       from some other commands that have been run
+# TODO: Fix return codes of execute_action sub items and execute_action
+#       so that we can give a decent warning window
 
 $^W = 1;
 use strict;
@@ -107,7 +105,7 @@ $::progressw = $mw->Scrolled("ROText", -scrollbars => "e", -height => 4);
 $::progressw->pack(-fill => "x", @bot);
 
 
-my $critical_updates_present = 0;
+my @critical_updates = ();
 
 
 init_hooks();
@@ -501,8 +499,18 @@ sub update_grid {
   }
   $g->delete('all');
   my $i = 0;
-  for my $p (@schemes, @colls, @packs) {
-    if (MatchesFilters($p)) {
+  my @displist;
+  my $crit_match = 0;
+  if (@critical_updates) {
+    @displist = @critical_updates;
+    $crit_match = 1;
+    $lighttext->configure(-foreground => 'red');
+    $darktext->configure(-foreground => 'red');
+  } else {
+    @displist = (@schemes, @colls, @packs);
+  }
+  for my $p (@displist) {
+    if ($crit_match || MatchesFilters($p)) {
       if (defined($selectcode)) {
         if ($selectcode == 1) {
           $Packages{$p}{'selected'} = 1;
@@ -1298,13 +1306,13 @@ sub SelectedPackages {
 
 sub update_all_packages {
   my @args = qw/update/;
-  if ($critical_updates_present) {
+  if (@critical_updates) {
     $opts{"self"} = 1;
   } else {
     $opts{"all"} = 1;
   }
   execute_action_gui(qw/update/);
-  if ($critical_updates_present) {
+  if (@critical_updates) {
     # terminate here immediately so that we are sure the auto-updater
     # is run immediately
     # make sure we exit in finish(0)
@@ -1321,12 +1329,12 @@ sub update_selected_packages {
     # 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) {
+    if (@critical_updates) {
       $opts{"self"} = 1;
     }
     push @args, @foo;
     execute_action_gui(@args);
-    if ($critical_updates_present) {
+    if (@critical_updates) {
       # terminate here immediately so that we are sure the auto-updater
       # is run immediately
       # make sure we exit in finish(0)
@@ -1432,7 +1440,6 @@ sub setup_list {
 
 sub update_list_remote {
   my @do_later_media;
-  print "TODO move the check from critical_updates_present from the old sub create_update_list here!!!";
   # clear old info from remote media
   for my $p (keys %Packages) {
     if (!$Packages{$p}{'installed'}) {
@@ -1492,6 +1499,26 @@ sub update_list_remote {
       }
     }
   }
+  #
+  # check for critical updates
+  my @critical = $localtlpdb->expand_dependencies("-no-collections",
+    $localtlpdb, @TeXLive::TLConfig::CriticalPackagesList);
+  @critical_updates = ();
+  for my $p (@critical) {
+    if (defined($Packages{$p}) &&
+        defined($Packages{$p}{'localrevision'}) &&
+        defined($Packages{$p}{'remoterevision'}) &&
+        $Packages{$p}{'localrevision'} < $Packages{$p}{'remoterevision'}) {
+      push @critical_updates, $p;
+    }
+  }
+  if (@critical_updates) {
+    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 select \"Update all\" button below.\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;
+  }
   # change display names
   for my $p (keys %Packages) {
     if ($p =~ m/^collection-documentation-(.*)$/) {
@@ -1562,7 +1589,10 @@ sub check_location_on_ctan {
 sub execute_action_gui {
   $mw->Busy(-recurse => 1);
   info ("Executing action @_\n");
-  execute_action(@_);
+  my $error_code = execute_action(@_);
+  if ($error_code) {
+    give_warning_window(@_);
+  }
   info(__("Completed") . "\n");
   $mw->Unbusy;
 }