texlive[48074] Master/install-tl: Modifications for tcl installer

[commits+siepo at tug.org]

Revision: 48074
          http://tug.org/svn/texlive?view=revision&revision=48074
Author:   siepo
Date:     2018-06-23 09:50:44 +0200 (Sat, 23 Jun 2018)
Log Message:
-----------
Modifications for tcl installer

Modified Paths:
--------------
    trunk/Master/install-tl

Modified: trunk/Master/install-tl
===================================================================
--- trunk/Master/install-tl	2018-06-23 07:47:59 UTC (rev 48073)
+++ trunk/Master/install-tl	2018-06-23 07:50:44 UTC (rev 48074)
@@ -95,6 +95,15 @@
 # global list of warnings
 @::WARNLINES = ();
 
+# debugging communication with external gui: use shared logfile
+# (assumes unix)
+sub dblog {
+  my $s = shift;
+  open(my $dbf, ">>", "/tmp/dblog");
+  print $dbf "PERL: $s\n";
+  close $dbf;
+}
+
 # we play around with the environment, place to keep original
 my %origenv = ();
 
@@ -200,15 +209,38 @@
 $::fileassocdesc[1] = "Only new";
 $::fileassocdesc[2] = "All";
 
+# before we try to interact with the user, we need to know whether or not
+# install-tl was called from an external gui. This gui will start install-tl
+# with "-from_ext_gui" as its first command-line option.
+
+my $from_ext_gui = 0;
+if ((defined $ARGV[0]) && $ARGV[0] eq "-from_ext_gui") {
+  shift @ARGV;
+  $from_ext_gui = 1;
+
+  # do not buffer output to the frontend
+  select(STDERR);
+  $| = 1;
+  select(STDOUT);
+  $| = 1;
+
+  # ___, defined in this file, replaces the GUI translating function
+  *__ = \&::___;
+}
+
 # if we find a file installation.profile we ask the user whether we should
 # continue with the installation
 # note, we are in the directory from which the aborted installation was run.
 my %profiledata;
 if (-r "installation.profile") {
+  if ($from_ext_gui) { # prepare for dialog interaction
+    print "mess_yesno\n";
+  }
   my $pwd = Cwd::getcwd();
   print "ABORTED TL INSTALLATION FOUND: installation.profile (in $pwd)\n";
   print
     "Do you want to continue with the exact same settings as before (y/N): ";
+  print "\nendmess\n" if $from_ext_gui;
   my $answer = <STDIN>;
   if ($answer =~ m/^y(es)?$/i) {
     $opt_profile = "installation.profile";
@@ -251,6 +283,9 @@
 if ($opt_gui eq "expert") {
   $opt_gui = "perltk";
 }
+if ($from_ext_gui) {
+  $opt_gui = "extl";
+}
 
 if ($opt_help) {
   # theoretically we could make a subroutine with all the same
@@ -347,8 +382,6 @@
 my $localtlpdb;
 my $location;
 
-# $finished == 1 if the menu call already did the installation
-my $finished = 0;
 @::info_hook = ();
 
 our $media;
@@ -396,7 +429,8 @@
 
 # check as soon as possible for GUI functionality to give people a chance
 # to interrupt.
-if (($opt_gui ne "text") && !$opt_no_gui && ($opt_profile eq "")) {
+# not needed for extl, because in this case install-tl is invoked by external gui
+if (($opt_gui ne "extl") && ($opt_gui ne "text") && !$opt_no_gui && ($opt_profile eq "")) {
   # try to load Tk.pm, but don't die if it doesn't work
   eval { require Tk; };
   if ($@) {
@@ -511,7 +545,6 @@
   our $MENU_INSTALL = 0;
   our $MENU_ABORT   = 1;
   our $MENU_QUIT    = 2;
-  our $MENU_ALREADYDONE = 3;
   $opt_gui = "text" if ($opt_no_gui);
   # finally do check for additional screens in the $opt_gui setting:
   # format:
@@ -562,9 +595,15 @@
     flushlog();
     exit(2);
   }
-  if (!$finished && ($ret != $MENU_INSTALL)) {
+  if ($ret != $MENU_INSTALL) {
     tlwarn("Unknown return value of run_menu: $ret\n");
     exit(3);
+  } elsif (win32() && $from_ext_gui) {
+    create_profile($ENV{'tmpprofile'});
+    exit;
+    # the external gui will do the actual installation
+    # from a temporary batchfile using this temporary profile,
+    # this to prevent hundreds of dosboxes popping up
   }
 } else { # no interactive setting of options
   *__ = \&::___;
@@ -571,7 +610,15 @@
   if (!do_remote_init()) {
     die ("Exiting installation.\n");
   }
+  if (win32() && $from_ext_gui) {
+    # copy profile and let the gui restart the installation
+    TeXLive::copy("-f", $opt_profile, $ENV{'tmpprofile'});
+    exit;
+  }
   read_profile($opt_profile);
+  if ($from_ext_gui) {
+    print STDOUT "startinst\n";
+  }
 }
 
 my $varsdump = "";
@@ -590,7 +637,7 @@
 $::env_warns = "";
 create_welcome();
 my $status = 1;
-if ($opt_gui eq 'text' or $opt_profile ne "" or
+if ($opt_gui eq 'text' or $opt_gui eq 'extl' or $opt_profile ne "" or
       !(-r "$::installerdir/tlpkg/installer/tracked-install.pl")) {
   $status = do_installation();
   if (@::WARNLINES) {
@@ -2296,21 +2343,23 @@
 
 # to be called at exit when the installation did not complete
 sub flushlog {
-  my $fh;
-  my $logfile = "install-tl.log";
-  if (open (LOG, ">$logfile")) {
-    my $pwd = Cwd::getcwd();
-    $logfile = "$pwd/$logfile";
-    print "$0: Writing log in current directory: $logfile\n";
-    $fh = \*LOG;
-  } else {
-    $fh = \*STDERR;
-    print "$0: Could not write to $logfile, so flushing messages to stderr.\n";
+  if (!defined($::LOGFILENAME)) {
+    my $fh;
+    my $logfile = "install-tl.log";
+    if (open (LOG, ">$logfile")) {
+      my $pwd = Cwd::getcwd();
+      $logfile = "$pwd/$logfile";
+      print "$0: Writing log in current directory: $logfile\n";
+      $fh = \*LOG;
+    } else {
+      $fh = \*STDERR;
+      print
+        "$0: Could not write to $logfile, so flushing messages to stderr.\n";
+    }
+    foreach my $l (@::LOGLINES) {
+      print $fh $l;
+    }
   }
-
-  foreach my $l (@::LOGLINES) {
-    print $fh $l;
-  }
 } # flushlog
 
 sub do_cleanup {