sync

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

2 files changed, 68 insertions, 11 deletions

diff --git a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
index 3e17208190d..9cbc743cc4b 100755
--- a/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
+++ b/Build/source/texk/texlive/linked_scripts/texlive/tlmgr.pl
@@ -1,12 +1,12 @@
 #!/usr/bin/env perl
-# $Id: tlmgr.pl 51555 2019-07-04 22:23:27Z karl $
+# $Id: tlmgr.pl 51716 2019-07-24 04:58:04Z preining $
 #
 # Copyright 2008-2019 Norbert Preining
 # This file is licensed under the GNU General Public License version 2
 # or any later version.
 
-my $svnrev = '$Revision: 51555 $';
-my $datrev = '$Date: 2019-07-05 00:23:27 +0200 (Fri, 05 Jul 2019) $';
+my $svnrev = '$Revision: 51716 $';
+my $datrev = '$Date: 2019-07-24 06:58:04 +0200 (Wed, 24 Jul 2019) $';
 my $tlmgrrevision;
 my $tlmgrversion;
 my $prg;
@@ -4798,7 +4798,8 @@ sub action_platform {
                            dviout.win32 wintools.win32/;
   if ($^O =~ /^MSWin/i) {
     warn("action `platform' not supported on Windows\n");
-    return ($F_WARNING);
+    # return an error here so that we don't go into post-actions
+    return ($F_ERROR);
   }
   if ($opts{"usermode"}) {
     tlwarn("$prg: action `platform' not supported in usermode\n");
@@ -6877,6 +6878,7 @@ sub setup_one_remotetlpdb {
   # - if that does not work assume we are offline or target not reachable,
   #   so warn the user and use saved, but note that installation will
   #   not work
+  info("start load $location\n") if ($::machinereadable);
 
   my $local_copy_tlpdb_used = 0;
   if ($location =~ m;^(https?|ftp)://;) {
@@ -6959,9 +6961,11 @@ END_NO_INTERNET
     }
   }
   if (!defined($remotetlpdb)) {
+    info("fail load $location\n") if ($::machinereadable);
     return(undef, $loadmediasrcerror . $location);
   }
   if ($opts{"require-verification"} && !$remotetlpdb->is_verified) {
+    info("fail load $location\n") if ($::machinereadable);
     tldie("Remote TeX Live database ($location) is not verified, exiting.\n");
   }
 
@@ -6981,6 +6985,7 @@ END_NO_INTERNET
   my $texlive_minrelease = $remotetlpdb->config_minrelease;
   my $rroot = $remotetlpdb->root;
   if (!defined($texlive_release)) {
+    info("fail load $location\n") if ($::machinereadable);
     return(undef, "The installation repository ($rroot) does not specify a "
           . "release year for which it was prepared, goodbye.");
   }
@@ -6988,6 +6993,7 @@ END_NO_INTERNET
   my $texlive_release_year = $texlive_release;
   $texlive_release_year =~ s/^(....).*$/$1/;
   if ($texlive_release_year !~ m/^[1-9][0-9][0-9][0-9]$/) {
+    info("fail load $location\n") if ($::machinereadable);
     return(undef, "The installation repository ($rroot) does not specify a "
           . "valid release year, goodbye: $texlive_release");
   }
@@ -6997,12 +7003,14 @@ END_NO_INTERNET
     my $texlive_minrelease_year = $texlive_minrelease;
     $texlive_minrelease_year =~ s/^(....).*$/$1/;
     if ($texlive_minrelease_year !~ m/^[1-9][0-9][0-9][0-9]$/) {
+      info("fail load $location\n") if ($::machinereadable);
       return(undef, "The installation repository ($rroot) does not specify a "
             . "valid minimal release year, goodbye: $texlive_minrelease");
     }
     # ok, all numeric and fine, check for range
     if ($TeXLive::TLConfig::ReleaseYear < $texlive_minrelease_year
         || $TeXLive::TLConfig::ReleaseYear > $texlive_release_year) {
+      info("fail load $location\n") if ($::machinereadable);
       return (undef, "The TeX Live versions supported by the repository
 $rroot
   ($texlive_minrelease_year--$texlive_release_year)
@@ -7014,6 +7022,7 @@ do not include the version of the local installation
     # of the main remote repository, then
     # warn that one needs to call update-tlmgr-latest.sh --update
     if ($is_main && $TeXLive::TLConfig::ReleaseYear < $texlive_release_year) {
+      info("fail load $location\n") if ($::machinereadable);
       return (undef, "Local TeX Live ($TeXLive::TLConfig::ReleaseYear)"
               . " is older than remote repository ($texlive_release_year).\n"
               . "Cross release updates are only supported with\n"
@@ -7023,6 +7032,7 @@ do not include the version of the local installation
   } else {
     # $texlive_minrelease not defined, so only one year is valid
     if ($texlive_release_year != $TeXLive::TLConfig::ReleaseYear) {
+      info("fail load $location\n") if ($::machinereadable);
       return(undef, "The TeX Live versions of the local installation
 and the repository are not compatible:
       local: $TeXLive::TLConfig::ReleaseYear
@@ -7065,6 +7075,7 @@ FROZEN
     }
   }
 
+  info("finish load $location\n") if ($::machinereadable);
   return($remotetlpdb);
 }
 
@@ -9848,7 +9859,7 @@ This script and its documentation were written for the TeX Live
 distribution (L<https://tug.org/texlive>) and both are licensed under the
 GNU General Public License Version 2 or later.
 
-$Id: tlmgr.pl 51555 2019-07-04 22:23:27Z karl $
+$Id: tlmgr.pl 51716 2019-07-24 04:58:04Z preining $
 =cut
 
 # test HTML version: pod2html --cachedir=/tmp tlmgr.pl >/tmp/tlmgr.html
diff --git a/Build/source/texk/texlive/linked_scripts/tlshell/tlshell.tcl b/Build/source/texk/texlive/linked_scripts/tlshell/tlshell.tcl
index cc7f43e5e28..e9bedea6890 100755
--- a/Build/source/texk/texlive/linked_scripts/tlshell/tlshell.tcl
+++ b/Build/source/texk/texlive/linked_scripts/tlshell/tlshell.tcl
@@ -756,29 +756,69 @@ proc abort_load {} {
 # it should disappear if loading finishes
 proc splash_loading {} {
 
-  #toplevel .loading
   create_dlg .loading .
 
-  wm title .loading ""
+  wm title .loading [__ "Loading"]
 
   # wallpaper
   pack [ttk::frame .loading.bg -padding 3] -fill both -expand 1
 
-  set lbl [__ "Trying to load %s.
+  set ::do_track_loading \
+      [expr {[dict get $::pkgs texlive.infra localrev] >= 51676}]
+
+  if $::do_track_loading {
+    set lbl [__ \
+                 "If loading takes too long, press Abort and choose another repository."]
+  } else {
+    set lbl [__ "Trying to load %s.
 
 If this takes too long, press Abort and choose another repository." \
               $::repos(main)]
+  }
   append lbl "\n([__ "Options"] \/ [__ "Repositories"] ...)"
   ppack [ttk::label .loading.l0 -text $lbl \
              -wraplength [expr {60*$::cw}] -justify left] \
       -in .loading.bg -anchor w
+
+  if $::do_track_loading {
+    pack [ttk::frame .loading.tfr] -in .loading.bg -expand 1 -fill x
+    pack [ttk::scrollbar .loading.scroll -command ".loading.tx yview"] \
+        -in .loading.tfr -side right -fill y
+    ppack [text .loading.tx -height 5 -wrap word \
+              -yscrollcommand ".loading.scroll set"] \
+        -in .loading.tfr -expand 1 -fill both
+  }
   pack [ttk::frame .loading.buttons] -in .loading.bg -expand 1 -fill x
-  ttk::button .loading.y -text [__ "Abort"] -command abort_load
-  ppack .loading.y -in .loading.buttons -side right
+  if $::do_track_loading {
+    ttk::button .loading.close -text [__ "Close"] -command {end_dlg "" .loading}
+    ppack .loading.close -in .loading.buttons -side right
+    .loading.close configure -state disabled
+  }
+  ttk::button .loading.abo -text [__ "Abort"] -command abort_load
+  ppack .loading.abo -in .loading.buttons -side right
   wm resizable .loading 0 0
   place_dlg .loading .
 } ; # splash_loading
 
+proc track_err {} {
+  if $::do_track_loading {
+    set inx0 [llength $::err_log]
+    #puts stderr "track_err: $inx0"
+    read_err_tempfile
+    .loading.tx configure -state normal
+    for {set i $inx0} {$i < [llength $::err_log]} {incr i} {
+      .loading.tx insert end "[lindex $::err_log $i]\n"
+    }
+    .loading.tx configure -state disabled
+    if {![info exists ::loaded]} {
+      after 500 track_err
+    } else {
+      .loading.close state !disabled
+      .loading.abo state disabled
+    }
+  }
+}
+
 # remote: preserve information on installed packages
 proc get_packages_info_remote {} {
   # remove non-local database entries
@@ -792,6 +832,9 @@ proc get_packages_info_remote {} {
   set ::tlshell_updatable 0
 
   splash_loading
+
+  unset -nocomplain ::loaded
+  track_err ; # is a no-op unless $::do_track_loading
   if [catch {run_cmd \
     "info --data name,localrev,remoterev,cat-version,category,shortdesc"}] {
     do_debug [get_stacktrace]
@@ -799,7 +842,10 @@ proc get_packages_info_remote {} {
     return 0
   }
   vwait ::done_waiting
-  destroy .loading
+  set ::loaded 1
+  if {! $::do_track_loading} {
+    destroy .loading
+  } ; # otherwise, .loading destroyed by close button of track_err
   set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),([^,]*),(.*)$}
   foreach l $::out_log {
     if [regexp $re $l m nm lrev rrev rcatv catg pdescr] {