3 files changed, 1089 insertions, 0 deletions

diff --git a/Master/tlpkg/installer/install-menu-extl.pl b/Master/tlpkg/installer/install-menu-extl.pl
new file mode 100644
index 00000000000..ece82c2c608
--- /dev/null
+++ b/Master/tlpkg/installer/install-menu-extl.pl
@@ -0,0 +1,172 @@
+#!/usr/bin/env perl
+# install-menu-tcl.pl
+
+# tell tcl about all configurable options
+# and terminate this output with an agreed-upon termination string.
+# tcl will read the package database itself. From this, it can deduce
+# collections, schemes and platforms, but not the names of platforms.
+
+# needed info:
+
+# binaries + descriptions
+# schemes
+# collections, probably per scheme
+# maybe directories to be configured
+
+# current option values:
+
+# paper size a4 | letter
+# allow restricted toggle
+# generate formats
+# install docs
+# install sources
+# create symlinks | 2 aspects of desktop integration
+# switch to online CTAN
+
+# then read the selected options back from tcl
+
+# and finally, tee installer output to tcl to be tracked there
+# inside the log toplevel
+
+our %vars; # onlys contain simple scalars
+# from install-tl:
+
+# The global variable %vars is an associative list which contains all
+# variables and their values which can be changed by the user.
+# needs to be our since TeXLive::TLUtils uses it
+
+
+our $opt_in_place;
+our $tlpdb;
+our @media_available;
+our $media;
+our $previoustlpdb;
+our @collections_std;
+our $texlive_release;
+
+our $MENU_INSTALL = 0;
+our $MENU_ABORT   = 1; # no cleanup afterwards
+our $MENU_QUIT    = 2;
+
+my $RETURN = $MENU_INSTALL;
+
+# @fileassocdesc also defined in install-tl
+$::fileassocdesc[0] = "None";
+$::fileassocdesc[1] = "Only new";
+$::fileassocdesc[2] = "All";
+
+$::deskintdesc[0] = "None";
+$::deskintdesc[1] = "Menu shortcuts";
+if (win32() && is_seven()) { $::deskintdesc[2] = "Launcher"; }
+
+# %vars hash should eventually include each binary, collection and scheme
+# as individual schalars.
+
+do_remote_init();
+# the above sub adds all platforms and collections to %vars
+# but maybe not schemes so we add these now:
+
+foreach my $pkg ($tlpdb->schemes) {
+  $vars{$pkg}=($vars{'selected_scheme'} eq $pkg)? 1:0;
+}
+$vars{'scheme-custom'} = 0 unless defined $vars{'scheme-custom'};
+
+sub read_vars {
+  my $l = <STDIN>;
+  chomp $l;
+  if ($l ne 'vars') {
+    return 0;
+  }
+  while (1) {
+    $l = <STDIN>;
+    chomp $l;
+    if ($l =~ /^([^:]+): (.*)$/) {
+      $vars{$1} = $2;
+    } elsif ($l eq 'endvars') {
+      return 1;
+    } else {
+      return 0;
+    }
+  }
+  return 0;
+}
+
+sub print_vars {
+  print "vars\n";
+  foreach my $key (sort keys %vars) {
+    print $key, ': ', $vars{$key}, "\n";
+  }
+  print "endvars\n";
+}
+
+# run_menu_tcl should be invoked by install-tl.
+sub run_menu_extl {
+  # make sure we have a value for total_size:
+  calc_depends();
+  print "menudata\n";
+  print_vars();
+
+  # tell the frontend the preferred order for schemes
+  my @schemes = schemes_ordered_for_presentation();
+  push @schemes, "scheme-custom";
+  print "schemes_order: ", join(' ', @schemes), "\n";
+  # binaries
+  print "binaries\n";
+
+  # binaries aren't packages; list their descriptions here
+  my @binaries = $tlpdb->available_architectures;
+  @binaries=sort TeXLive::TLUtils::sort_archs @binaries;
+  foreach my $b (@binaries) {
+    print $b, ': ', platform_desc($b), "\n";
+  }
+  print "endbinaries\n";
+
+  print "endmenudata\n"; # this triggers the tcl menu
+
+  # read input from install-tl-gui.tcl.
+  # Three cases to consider:
+  # 'calc': the frontend wants to update its ::vars array
+  #   after some menu choices
+  # 'startinst': done with choices, tell install-tl[-tcl] to
+  #   start installation
+  # 'quit': tell install-tl to clean up and quit
+  # read from frontend
+  while (1) {
+    my $l = <STDIN>;
+    chomp($l);
+    if ($l eq 'quit') {
+      return $MENU_QUIT;
+    } elsif ($l eq 'calc') {
+      if (read_vars()) {
+        if ($vars{'selected_scheme'} eq 'scheme-custom') {
+          calc_depends();
+        } else {
+          select_scheme($vars{'selected_scheme'});
+        }
+        $vars{'n_collections_selected'} = 0;
+        foreach my $v (keys %vars) {
+          if (substr($v, 0, 11) eq 'collection-' && $vars{$v}) {
+            $vars{'n_collections_selected'} += 1;
+          }
+        }
+        print_vars();
+      } else {
+        log("Illegal input '$l' from frontend");
+        return $MENU_ABORT;
+      }
+    } elsif ($l eq 'startinst') {
+      if (read_vars()) {
+        calc_depends();
+        return $MENU_INSTALL;
+      } else {
+        return $MENU_ABORT;
+      }
+    } else {
+      return $MENU_ABORT;
+    }
+  }
+} # run_menu_extl
+
+$::run_menu = \&run_menu_extl;
+
+1;
diff --git a/Master/tlpkg/installer/install-tl-gui.tcl b/Master/tlpkg/installer/install-tl-gui.tcl
new file mode 100755
index 00000000000..55b37756613
--- /dev/null
+++ b/Master/tlpkg/installer/install-tl-gui.tcl
@@ -0,0 +1,917 @@
+#!/usr/bin/env wish
+
+# Copyright 2018 Siep Kroonenberg
+
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+
+# Tcl/Tk wrapper for TeX Live installer
+
+# Installation can be divided into three stages:
+#
+# 1. preliminaries. This stage may involve some interaction with the user,
+#    which can be channeled through message boxes
+# 2. a menu
+# 3. the actual installation
+#
+# During stage 1. and 3. this wrapper collects stdout and stderr from
+# the perl installer, with stderr being redirected to stdout.
+# This output will be displayed in a text widget during stage 3,
+# and in debug mode also in stage 1.
+# During stage 3, we shall use event-driven, non-blocking I/O, which is
+# needed for a scrolling display of installer output.
+#
+# Main window:
+# filled successively with:
+# - a logo, and 'loading...' label, by way of splash
+# - a menu for stage 2
+# - a log text widget for tracking stage 3
+#   ::out_log should be cleared before stage 3.
+#
+# In profile mode, the menu stage is skipped.
+
+package require Tk
+
+# security: disable send
+catch {rename send {}}
+
+# menus: disable tearoff feature
+option add *Menu.tearOff 0
+
+# no bold text for messages; `userDefault' indicates priority
+option add *Dialog.msg.font TkDefaultFont userDefault
+
+## italicized items; not used
+#font create it_font {*}[font configure TkDefaultFont]
+#font configure it_font -slant italic
+
+### initialize some globals ###
+
+# perl installer process id
+set ::perlpid 0
+
+# global variable for dialogs
+set ::dialog_ans {}
+
+set ::plain_unix 0
+if {$::tcl_platform(platform) eq "unix" && $::tcl_platform(os) ne "Darwin"} {
+  set ::plain_unix 1
+}
+
+# for help output
+set ::env(NOPERLDOC) 1
+
+set ::out_log {}; # list of strings
+
+# this file should be in $::instroot/tlpkg/installer.
+# at the next release, it may be better to start the installer, perl or tcl,
+# from a shell wrapper, also on unix-like platforms
+# this allows automatic inclusion of '--' parameter to separate
+# tcl parameters from script parameters
+set ::instroot [file normalize [info script]]
+set ::instroot [file dirname [file dirname [file dirname $::instroot]]]
+
+set ::perlbin "perl"
+if {$::tcl_platform(platform) eq "windows"} {
+  set ::perlbin "${::instroot}/tlpkg/tlperl/bin/perl.exe"
+
+  # shall need to run the actual installation from a batchfile,
+  # to prevent hundreds of dosboxes popping up.
+  # need to tell perl where to write profile for noninteractive install
+  set ::env(tmpprofile) ""
+  for {set i 0} {$i<10} {incr i} {
+    if [file exists [file join $::env(tmp) "temp${i}.profile"]] {
+      continue
+    } else {
+      set ::env(tmpprofile) "temp${i}.profile"
+      break
+    }
+  }
+  if {$::env(tmpprofile) eq ""} {
+    err_exit "Cannot create required tempfile"
+  }
+}
+
+### procedures, mostly organized bottom-up ###
+
+proc get_stacktrace {} {
+  set level [info level]
+  set s ""
+  for {set i 1} {$i < $level} {incr i} {
+    append s [format "Level %u: %s\n" $i [info level $i]]
+  }
+  return $s
+} ; # get_stacktrace
+
+# for debugging frontend-backend communication:
+# write to a logfile which is shared with the backend.
+# both parties open, append and close every time.
+proc dblog {s} {
+  set db [open "/tmp/dblog" a]
+  set t [get_stacktrace]
+  puts $db "TCL: $s\n$t"
+  close $db
+}
+
+# what exit procs do we need?
+# - plain error exit with messagebox and stacktrace
+# - plain messagebox exit
+# - showing log output, maybe with appended message,
+#   use log toplevel for lengthy output
+# is closing the pipe $::inst guaranteed to kill perl? It should be
+
+proc err_exit {{mess ""}} {
+  if {$mess eq ""} {set mess "Error"}
+  append mess "\n" [get_stacktrace]
+  tk_messageBox -icon error -message $mess
+  # kill perl process, just in case
+  if $::perlpid {
+    if {$::tcl_platform(platform) eq "unix"} {
+      exec -ignorestderr "kill" $::perlpid
+    } else {
+      exec -ignorestderr "taskkill" "/pid" $::perlpid
+    }
+  }
+  exit
+} ; # err_exit
+
+# regular read_line
+proc read_line {} {
+  if [catch {chan gets $::inst l} len] {
+    # catch [chan close $::inst]
+    err_exit "Error while reading from Perl backend"
+  } elseif {$len < 0} {
+    # catch [chan close $::inst]
+    return [list -1 ""]
+  } else {
+    return [list $len $l]
+  }
+}; # read_line
+
+proc read_line_no_eof {} {
+  set ll [read_line]
+  if {[lindex $ll 0] < 0} {
+    log_exit "Unexpected closed backend"
+  }
+  set l [lindex $ll 1]
+  # TODO: test under debug mode
+  return $l
+}; # read_line_no_eof
+
+# non-blocking i/o: callback for "readable" during stage 3, installation
+# ::out_log should no longer be needed
+proc read_line_cb {} {
+  set l "" ; # will contain the line to be read
+  if {([catch {chan gets $::inst l} len] || [chan eof $::inst])} {
+    catch {chan close $::inst}
+    # note. the right way to terminate is terminating the GUI shell.
+    # This closes stdin of the child
+    puts stderr "read_line_cb: pipe no longer readable"
+    .close configure -state !disabled
+  } elseif {$len >= 0} {
+    # regular output
+    .log.tx configure -state normal
+    .log.tx insert end "$l\n"
+    .log.tx yview moveto 1
+    if {$::tcl_platform(os) ne "Darwin"} {.log.tx configure -state disabled}
+  }
+}; # read_line_cb
+
+# general gui utilities
+
+# width of '0', as a rough estimate of average character width
+# assume height == width*2
+set ::cw [font measure TkTextFont "0"]
+
+# unicode symbols as fake checkboxes in ttk::treeview widgets
+proc mark_sym {mrk} {
+  if $mrk {
+    return "\u25A3" ; # 'white square containing black small square'
+  } else {
+    return "\u25A1" ; # 'white square'
+  }
+} ; # mark_sym
+
+proc ppack {wdg args} { ; # pack command with padding
+  pack $wdg {*}$args -padx 3 -pady 3
+}
+
+proc pgrid {wdg args} { ; # grid command with padding
+  grid $wdg {*}$args -padx 3 -pady 3
+}
+
+# start new toplevel with settings appropriate for a dialog
+proc create_dlg {wnd {p .}} {
+  catch {destroy $wnd} ; # no error if it does not exist
+  toplevel $wnd -class Dialog
+  wm withdraw $wnd
+  if [winfo viewable $p] {wm transient $wnd $p}
+  if $::plain_unix {wm attributes $wnd -type dialog}
+  wm protocol $wnd WM_DELETE_WINDOW {destroy $wnd}
+}
+
+# Place a dialog centered wrt its parent.
+# If its geometry is somehow not yet available,
+# its upperleft corner will be centered.
+
+proc place_dlg {wnd {p "."}} {
+  set g [wm geometry $p]
+  scan $g "%dx%d+%d+%d" pw ph px py
+  set hcenter [expr {$px + $pw / 2}]
+  set vcenter [expr {$py + $ph / 2}]
+  set g [wm geometry $wnd]
+  set wh [winfo reqheight $wnd]
+  set ww [winfo reqwidth $wnd]
+  set wx [expr {$hcenter - $ww / 2}]
+  if {$wx < 0} { set wx 0}
+  set wy [expr {$vcenter - $wh / 2}]
+  if {$wy < 0} { set wy 0}
+  wm geometry $wnd [format "+%d+%d" $wx $wy]
+  wm state $wnd normal
+  raise $wnd $p
+} ; # place_dlg
+
+proc end_dlg {ans wnd {p "."}} {
+  set ::dialog_ans $ans
+  raise $p
+  destroy $wnd
+} ; # end_dlg
+
+# ATM ::out_log will be shown only at the end
+proc show_log {{do_abort 0}} {
+  wm withdraw .
+  foreach c [winfo children .] {
+    destroy $c
+  }
+
+  # wallpaper
+  pack [ttk::frame .bg] -fill both -expand 1
+
+  pack [ttk::frame .log] -in .bg -fill both -expand 1
+  pack [ttk::scrollbar .log.scroll -command ".log.tx yview"] \
+      -side right -fill y
+  ppack [text .log.tx -height 10 -wrap word -font TkDefaultFont \
+      -yscrollcommand ".log.scroll set"] \
+      -expand 1 -fill both
+  .log.tx configure -state normal
+  .log.tx delete 1.0 end
+  foreach l $::out_log {
+    .log.tx insert end "$l\n"
+  }
+  if {$::tcl_platform(os) ne "Darwin"} {.log.tx configure -state disabled}
+  .log.tx yview moveto 1
+
+  pack [ttk::frame .bottom] -in .bg -side bottom -fill x
+  ttk::button .close -text "close" -command exit
+  ppack .close -in .bottom -side right; # -anchor e
+  if $do_abort {
+    ttk::button .abort -text "abort" \
+        -command {catch {chan close $::inst}; exit}
+    ppack .abort -in .bottom -side right
+  }
+
+  set h [expr {40 * $::cw}]
+  set w [expr {80 * $::cw}]
+  wm geometry . "${w}x${h}"
+  wm state . normal
+}; # show_log
+
+proc log_exit {{mess ""}} {
+  if {$mess ne ""} {lappend ::out_log $mess}
+  catch {chan close $::inst} ; # should terminate perl
+  if {[llength $::out_log] > 0} {
+    if {[llength $::out_log] < 10} {
+      tk_messageBox -icon info -message [join $::out_log "\n"]
+      exit
+    } else {
+      show_log ; # its close button exits
+    }
+  } else {
+    exit
+  }
+}; # log_exit
+
+proc make_splash {} {
+  # picture and logo
+  catch {
+    image create photo tlimage -file \
+        [file join $::instroot "tlpkg" "installer" "texlion.png"]
+    pack [frame .white -background white] -fill x -expand 1
+    label .image -image tlimage -background white
+    pack .image -in .white
+  }
+  # wallpaper
+  pack [ttk::frame .bg] -fill both -expand 1
+
+  ppack [ttk::label .text -text "TeX Live 2018" -font bigfont] \
+    -in .bg
+  ppack [ttk::label .loading -text "Loading..."] -in .bg
+
+  wm state . normal
+  raise .
+  update
+}; # make_splash
+
+# short descriptions for collections and schemes from texlive.tlpdb
+# not from the backend
+proc get_short_descs {} {
+  set dbfile [file join $::instroot "tlpkg/texlive.tlpdb"]
+  set fid [open $dbfile r]
+  # add some error checking
+  chan configure $fid -translation auto
+  set blob [read $fid]
+  chan close $fid
+  set lines [split $blob "\n"]
+  set nm ""
+  set shortdesc ""
+  set category ""
+  # make sure there is a terminator empty line for the last entry
+  lappend lines ""
+  set nm ""
+  foreach l $lines {
+    if {$l eq ""} {
+      # end of entry
+      if {$nm ne ""} {
+        if {$category eq "Collection"} {
+          set ::coll_descs($nm) $shortdesc
+        } elseif {$category eq "Scheme"} {
+          set ::scheme_descs($nm) $shortdesc
+        }
+      }
+      set nm ""
+      set category ""
+      set shortdesc ""
+    } elseif [string equal -length 5 "name " $l] {
+      set nm [string range $l 5 end]
+      if {$nm eq ""} {err_exit "Empty name in database"}
+    } elseif {$nm eq ""} {
+      err_exit "No database entry defined"
+    } elseif [string equal -length 9 "category " $l] {
+      set category [string range $l 9 end]
+    } elseif [string equal -length 10 "shortdesc " $l] {
+      set shortdesc [string range $l 10 end]
+    } else {
+      # disregard other database info
+      continue
+    }
+  }
+  set ::scheme_descs(scheme-custom) "Custom scheme"
+}; # get_short_descs
+
+# toggle platform in treeview widget, but not in underlying data
+proc toggle_bin {b} {
+  if {$b eq $::vars(this_platform)} {
+    tk_messageBox -message "Cannot deselect own platform"
+    return
+  }
+  set m [.tlbin.lst set $b "mk"]
+  if {$m eq [mark_sym 0]} {
+    .tlbin.lst set $b "mk" [mark_sym 1]
+  } else {
+    .tlbin.lst set $b "mk" [mark_sym 0]
+  }
+}; # toggle_bin
+
+### binaries ###
+
+proc save_bin_selections {} {
+  set ::vars(n_systems_selected) 0
+  foreach b [.tlbin.lst children {}] {
+    set bb "binary_$b"
+    if {[.tlbin.lst set $b "mk"] ne [mark_sym 0]} {
+      incr ::vars(n_systems_selected)
+      set ::vars($bb) 1
+    } else {
+      set ::vars($bb) 0
+    }
+    if {$b eq "win32"} {
+      set ::vars(collection-wintools) $::vars($bb)
+    }
+  }
+  update_vars
+  if {$::vars(n_systems_selected) > 1} {
+    .binlm configure -text \
+        [format "%d additional platform(s)" \
+             [expr {$::vars(n_systems_selected) - 1}]]
+  } else {
+    .binlm configure -text ""
+  }
+}; # save_bin_selections
+
+proc select_binaries {} {
+  create_dlg .tlbin .
+  wm title .tlbin "Binaries"
+
+  # wallpaper
+  pack [ttk::frame .tlbin.bg] -expand 1 -fill both
+
+  set max_width 0
+  foreach b [array names ::bin_descs] {
+    set bl [font measure TkTextFont $::bin_descs($b)]
+    if {$bl > $max_width} {set max_width $bl}
+  }
+  incr max_width 10
+
+  # treeview for binaries, with checkbox column and vertical scrollbar
+  pack [ttk::frame .tlbin.binsf] -in .tlbin.bg -expand 1 -fill both
+
+  ttk::treeview .tlbin.lst -columns {mk desc} -show {} \
+      -height 15 -selectmode extended -yscrollcommand {.tlbin.binsc set}
+
+  ttk::scrollbar .tlbin.binsc -orient vertical -command {.tlbin.lst yview}
+  .tlbin.lst column mk -width [expr {$::cw * 3}]
+  .tlbin.lst column desc -width $max_width
+  foreach b [array names ::bin_descs] {
+    set bb "binary_$b"
+    .tlbin.lst insert {}  end -id $b -values \
+        [list [mark_sym $::vars($bb)] $::bin_descs($b)]
+  }
+  ppack .tlbin.lst -in .tlbin.binsf -side left -expand 1 -fill both
+  ppack .tlbin.binsc -in .tlbin.binsf -side right -expand 1 -fill y
+  bind .tlbin.lst <space> {toggle_bin [.tlbin.lst focus]}
+  bind .tlbin.lst <Return> {toggle_bin [.tlbin.lst focus]}
+  bind .tlbin.lst <ButtonRelease-1> \
+      {toggle_bin [.tlbin.lst identify item %x %y]}
+
+  # ok, cancel buttons
+  pack [ttk::frame .tlbin.buts] -in .tlbin.bg -expand 1 -fill x
+  ttk::button .tlbin.ok -text "Ok" -command \
+      {save_bin_selections; update_vars; end_dlg 1 .tlbin .}
+  ppack .tlbin.ok -in .tlbin.buts -side right
+  ttk::button .tlbin.cancel -text "Cancel" -command {end_dlg 0 .tlbin .}
+  ppack .tlbin.cancel -in .tlbin.buts -side right
+
+  place_dlg .tlbin .
+  tkwait window .tlbin
+  return $::dialog_ans
+}; # select_binaries
+
+### scheme ###
+proc select_scheme {} {
+  create_dlg .tlschm .
+  wm title .tlschm "Schemes"
+
+  # wallpaper
+  pack [ttk::frame .tlschm.bg] -fill both -expand 1
+
+  set max_width 0
+  foreach s $::schemes_order {
+    set sl [font measure TkTextFont $::scheme_descs($s)]
+    if {$sl > $max_width} {set max_width $sl}
+  }
+  incr max_width 10
+  ttk::treeview .tlschm.lst -columns {desc} -show {} -selectmode browse \
+      -height [llength $::schemes_order]
+  .tlschm.lst column "desc" -width $max_width -stretch 1
+  ppack .tlschm.lst -in .tlschm.bg -fill x -expand 1
+  foreach s $::schemes_order {
+    .tlschm.lst insert {} end -id $s -values [list $::scheme_descs($s)]
+  }
+  # we already made sure that $::vars(selected_scheme) has a valid value
+  .tlschm.lst selection set [list $::vars(selected_scheme)]
+  pack [ttk::frame .tlschm.buts] -in .tlschm.bg -expand 1 -fill x
+  ttk::button .tlschm.ok -text "Ok" -command {
+    # tree selection is a list:
+    set ::vars(selected_scheme) [lindex [.tlschm.lst selection] 0]
+    foreach v [array names ::vars] {
+      if {[string range $v 0 6] eq "scheme-"} {
+        if {$v eq $::vars(selected_scheme)} {
+          set ::vars($v) 1
+        } else {
+          set ::vars($v) 0
+        }
+      }
+    }
+    update_vars
+    end_dlg 1 .tlschm .
+  }
+  ppack .tlschm.ok -in .tlschm.buts -side right
+  ttk::button .tlschm.cancel -text "Cancel" -command {end_dlg 0 .tlschm .}
+  ppack .tlschm.cancel -in .tlschm.buts -side right
+
+  place_dlg .tlschm .
+  tkwait window .tlschm
+  return $::dialog_ans
+}; # select_scheme
+
+### collections ###
+
+# toggle collection in treeview widget, but not in underlying data
+proc toggle_coll {cs c} {
+  # cs: treeview widget; c: selected child item
+  set m [$cs set $c "mk"]
+  if {$m eq [mark_sym 0]} {
+    $cs set $c "mk" [mark_sym 1]
+  } else {
+    $cs set $c "mk" [mark_sym 0]
+  }
+}; # toggle_coll
+
+proc save_coll_selections {} {
+  foreach wgt {.tlcoll.other .tlcoll.lang} {
+    foreach c [$wgt children {}] {
+      if {[$wgt set $c "mk"] eq [mark_sym 0]} {
+        set ::vars($c) 0
+      } else {
+        set ::vars($c) 1
+      }
+    }
+  }
+  set ::vars(selected_scheme) "scheme-custom"
+  update_vars
+}; # save_coll_selections
+
+proc select_collections {} {
+  # 2017: more than 40 collections
+  # The tcl installer acquires collections from the database file,
+  # but install-tl also has an array of collections.
+  # Use treeview for checkbox column and collection descriptions
+  # rather than names.
+  # buttons: select all, select none, ok, cancel
+  # should some collections be excluded? Check install-menu-* code.
+  create_dlg .tlcoll .
+  wm title .tlcoll "Collections"
+
+  # wallpaper
+  pack [ttk::frame .tlcoll.bg]
+
+  # Treeview and scrollbar for non-language- and language collections resp.
+  pack [ttk::frame .tlcoll.both] -in .tlcoll.bg -expand 1 -fill y
+
+  set max_width 0
+  foreach c [array names ::coll_descs] {
+    set cl [font measure TkTextFont $::coll_descs($c)]
+    if {$cl > $max_width} {set max_width $cl}
+  }
+  incr max_width 10
+  foreach t {"lang" "other"} {
+    set wgt ".tlcoll.$t"
+    pack [ttk::frame ${wgt}f] \
+        -in .tlcoll.both -side left -fill y
+
+    ttk::treeview $wgt -columns {mk desc} -show {headings} \
+        -height 20 -selectmode extended -yscrollcommand "${wgt}sc set"
+    $wgt heading "mk" -text ""
+    if {$t eq "lang"} {
+      $wgt heading "desc" -text "Languages"
+    } else {
+      $wgt heading "desc" -text "Other collections"
+    }
+
+    ttk::scrollbar ${wgt}sc -orient vertical -command "$wgt yview"
+    $wgt column mk -width [expr {$::cw * 3}]
+    $wgt column desc -width $max_width
+    ppack $wgt -in ${wgt}f -side left
+    ppack ${wgt}sc -in ${wgt}f -side left -fill y
+
+    bind $wgt <space> {toggle_coll %W [%W focus]}
+    bind $wgt <Return> {toggle_coll %W [%W focus]}
+    bind $wgt <ButtonRelease-1> {toggle_coll %W [%W identify item %x %y]}
+  }
+
+  foreach c [array names ::coll_descs] {
+    if [string equal -length 15 "collection-lang" $c] {
+      set wgt ".tlcoll.lang"
+    } else {
+      set wgt ".tlcoll.other"
+    }
+    $wgt insert {} end -id $c -values \
+        [list [mark_sym $::vars($c)] $::coll_descs($c)]
+  }
+
+  # select none, select all, ok and cancel buttons
+  pack [ttk::frame .tlcoll.butf] -fill x
+  ttk::button .tlcoll.all \
+      -text "Select all" \
+      -command \
+      {foreach wgt {.tlcoll.other .tlcoll.lang} {
+        foreach c [$wgt children {}] {$wgt set $c "mk" [mark_sym 1]}
+        }
+      }
+  ppack .tlcoll.all -in .tlcoll.butf -side left
+  ttk::button .tlcoll.none \
+      -text "Select none" \
+      -command \
+      {foreach wgt {.tlcoll.other .tlcoll.lang} {
+        foreach c [$wgt children {}] {$wgt set $c "mk" [mark_sym 0]}
+        }
+      }
+  ppack .tlcoll.none -in .tlcoll.butf -side left
+  # the final two buttons close the menu toplevel
+  ttk::button .tlcoll.ok -text "Ok" -command \
+      {save_coll_selections; end_dlg 1 .tlcoll .}
+  ppack .tlcoll.ok -in .tlcoll.butf -side right
+  ttk::button .tlcoll.cancel -text "Cancel" -command {end_dlg 0 .tlcoll .}
+  ppack .tlcoll.cancel -in .tlcoll.butf -side right
+
+  place_dlg .tlcoll .
+  wm resizable .tlcoll 0 0
+  tkwait window .tlcoll
+  return $::dialog_ans
+}; # select_collections
+
+# the main menu interface will at certain events send the current values of
+# the ::vars array to install-tl[-tcl], which will send back an updated version
+# of this array.
+# We still use blocking i/o: frontend and backend wait for each other.
+
+proc run_menu {} {
+  wm withdraw .
+  # destroy .splash
+  foreach c [winfo children .] {
+    destroy $c
+  }
+
+  # wallpaper and grid
+  pack [ttk::frame .bg] -fill both -expand 1
+  pack [ttk::frame .gridf] -in .bg -fill x -expand 1
+  set rw -1
+
+  # platforms
+  incr rw
+  pgrid [ttk::label .binl -text $::bin_descs($::vars(this_platform))] \
+      -in .gridf -row $rw -column 0 -sticky w
+  if {$::tcl_platform(platform) ne "windows"} {
+    grid [ttk::frame .plf] -in .gridf -row $rw -column 1 -sticky ew
+    ttk::button .binb -text "More platforms.." -command select_binaries
+    ppack .binb -in .plf -side right
+    ppack [ttk::label .binlm -text ""] -in .plf -side left
+  }
+
+  # schemes
+  incr rw
+  ttk::label .schml -textvariable ::vars(selected_scheme)
+  pgrid .schml -in .gridf -row $rw -column 0 -sticky w
+  ttk::button .schmb -text "Schemes" -command select_scheme
+  pgrid .schmb -in .gridf -row $rw -column 1 -sticky e
+
+  # collections
+  incr rw
+  grid [ttk::frame .collf] -in .gridf -row $rw -column 0 -sticky w
+  ttk::label .ncolls -textvariable ::vars(n_collections_selected)
+  ppack .ncolls -in .collf -side left
+  ttk::label .lcoll -text \
+      [format "out of %d collection(s)" $::vars(n_collections_available)]
+  ppack .lcoll -in .collf -side left
+  ttk::button .collb -text "Customize selection" -command select_collections
+  pgrid .collb -in .gridf -row $rw -column 1 -sticky e
+
+  # total size
+  incr rw
+  grid [ttk::frame .sizef] -in .gridf -row $rw -column 0
+  ttk::label .lsize -text "Disk space required (in MB): "
+  ppack .lsize -in .sizef -side left
+  ttk::label .size_req -textvariable ::vars(total_size)
+  ppack .size_req -in .sizef -side left
+
+
+  # directory setup
+
+  # options
+
+  # required disk space
+  incr rw
+
+  # final buttons
+  pack [ttk::frame .final] -in .bg -side bottom -fill x -expand 1
+  ttk::button .install -text "Install" -command {
+    set ::menu_ans "startinst"
+  }
+  ppack .install -in .final -side right
+  ttk::button .quit -text "Quit" -command {
+    set ::out_log {}
+    set ::menu_ans "no_inst"
+  }
+  ppack .quit -in .final -side right
+
+  wm state . normal
+  unset -nocomplain ::menu_ans
+  vwait ::menu_ans
+  return $::menu_ans
+}; # run_menu
+
+# we need data from the backend.
+# choices of schemes, platforms and options impact choices of
+# collections and required disk space.
+# the vars array contains all this variable information.
+# the calc_depends proc communicates with the backend update this array.
+
+proc read_vars {} {
+  set l [read_line_no_eof]
+  if {$l ne "vars"} {
+    err_exit "'vars' expected but $l found"
+  }
+  while 1 {
+    set l [read_line_no_eof]
+    if [regexp {^([^:]+): (.*)$} $l m k v] {
+      set ::vars($k) $v
+    } elseif {$l eq "endvars"} {
+      break
+    } else {
+      err_exit "Illegal line $l in vars section"
+    }
+  }
+  if {"total_size" ni [array names ::vars]} {
+    set ::vars(total_size) 0
+  }
+}; # read_vars
+
+proc write_vars {} {
+  chan puts $::inst "vars"
+  foreach v [array names ::vars] {chan puts $::inst "$v: $::vars($v)"}
+  chan puts $::inst "endvars"
+  chan flush $::inst
+}
+
+proc update_vars {} {
+  chan puts $::inst "calc"
+  write_vars
+  read_vars
+}
+
+proc read_menu_data {} {
+  # the expected order is: vars, schemes (one line), binaries
+  # note. lindex returns an empty string if the index argument is too high.
+  # empty lines result in an err_exit.
+
+  read_vars
+
+  # schemes order (one line)
+  set l [read_line_no_eof]
+  if [regexp {^schemes_order: (.*)$} $l m sl] {
+    set ::schemes_order $sl
+  } else {
+    err_exit "schemes_order expected but $l found"
+  }
+  if {"selected_scheme" ni [array names ::vars] || \
+        $::vars(selected_scheme) ni $::schemes_order} {
+    set ::vars(selected_scheme) [lindex $::schemes_order 0]
+  }
+
+  # binaries
+  set l [read_line_no_eof]
+  if {$l ne "binaries"} {
+    err_exit "'binaries' expected but $l found"
+  }
+  while 1 {
+    set l [read_line_no_eof]
+    if [regexp {^([^:]+): (.*)$} $l m k v] {
+      #if [info exists ::bin_descs($k)] {
+      #  puts stderr "Duplicate key $k in binaries section"
+      #}
+      set ::bin_descs($k) $v
+    } elseif {$l eq "endbinaries"} {
+      break
+    } else {
+      err_exit "Illegal line $l in binaries section"
+    }
+  }
+
+  set l [read_line_no_eof]
+  if {$l ne "endmenudata"} {
+    err_exit "'endmenudata' expected but $l found"
+  }
+}; # read_menu_data
+
+proc answer_to_perl {} {
+  # we just got a line "mess_yesno" from perl
+  # finish reading the message text, put it in a message box
+  # and write back the answer
+  set mess {}
+  while 1 {
+    set ll [read_line]
+    if {[lindex $ll 0] < 0} {
+      err_exit "Error while reading from Perl backend"
+    } else {
+      set l [lindex $ll 1]
+    }
+    if  {$l eq "endmess"} {
+      break
+    } else {
+      lappend mess $l
+    }
+  }
+  set m [join $mess "\n"]
+  set ans [tk_messageBox -type yesno -icon question -message $m]
+  chan puts $::inst [expr {$ans eq yes ? "y" : "n"}]
+  chan flush $::inst
+}; # answer_to_perl
+
+proc run_installer {} {
+  set ::out_log {}
+  show_log 1; # 1: with abort button
+  .close configure -state disabled
+  # startinst: does not makes sense for a profile installation
+  if $::did_gui {
+    chan puts $::inst "startinst"
+    write_vars
+  }
+  # windows: do profile installation via a batchfile,
+  # to prevent hundreds of dosboxes popping up.
+  # for simplicity, use install-tl-windows.bat
+  # with the original command-line arguments minus
+  # gui- and old profile command-line arguments
+  if {$::tcl_platform(platform) eq "windows"} {
+    # do not want to be asked again about aborted installation:
+    file delete "installation.profile"
+    catch {chan close $::inst}; # should already have been closed by backend
+    set newargs {}
+    set i 0
+    while {$i<$::argc} {
+      set a [lindex $::argv $i]
+      # gui-related?
+      if [string equal -length 2 $a "--"] {
+        set a [string range $a 1 end]
+      }
+      if [string equal -length 4 $a "-gui"] {
+        incr $i
+        if {$i < $::argc} {
+          set b [lindex $::argv $i]
+          if {[string index $b 0] ne "-"} {
+            # gui parameter; skip too
+            incr $i
+          }
+        }
+      } elseif [string equal -length 8 $a "-profile"] {
+        incr $i
+        if {$i < $::argc} {
+          set b [lindex $::argv $i]
+          if {[string index $b 0] ne "-"} {
+            # profile parameter; skip too
+            incr $i
+          }
+        }
+      } else {
+        lappend newargs $a
+        incr $i
+      }
+    }
+    set cmd [list "${::instroot}/install-tl-windows.bat" {*}$newargs \
+                 "-profile" $::env(tmpprofile)]
+    if [catch {open "|[join $cmd " "] 2>@1" r+} ::inst] {
+      err_exit "Error starting actual installation"
+    }
+  }
+  # - non-blocking i/o
+  chan configure $::inst -buffering line -blocking 0
+  chan event $::inst readable read_line_cb
+}; # run_installer
+
+proc main_prog {} {
+
+  wm title . "TeX Live 2018 Installer"
+  make_splash
+
+  # start install-tl-[tcl] via a pipe
+  set cmd [list ${::perlbin} "${::instroot}/install-tl" \
+               "-from_ext_gui" {*}$::argv]
+  if [catch {open "|[join $cmd " "] 2>@1" r+} ::inst] {
+    # "2>@1" ok under Windows >= XP
+    err_exit "Error starting Perl backend"
+  }
+  set ::perlpid [pid $::inst]
+
+  # do not start event-driven, non-blocking io
+  # until the actual installation starts
+  chan configure $::inst -buffering line -blocking 1
+
+  # possible input from perl until the menu starts:
+  # - question about prior canceled installation
+  # - menu data, help, version, print-platform
+  set ::did_gui 0
+  set answer ""
+  while 1 {
+    set ll [read_line]
+    if {[lindex $ll 0] < 0} break
+    set l [lindex $ll 1]
+    # There may be occasion for a dialog
+    if {$l eq "mess_yesno"} {
+      answer_to_perl
+    } elseif {$l eq "menudata"} {
+      # we do want a menu, so we expect menu data
+      # this may take a while, so we put up a splash screen
+      #make_splash
+      read_menu_data
+      get_short_descs ; # read short descriptions from TL package database
+      set answer [run_menu]
+      set ::did_gui 1
+      break
+    } elseif {$l eq "startinst"} {
+      # use an existing profile:
+      set ::out_log {}
+      set answer "startinst"
+      break
+    } else {
+      lappend ::out_log $l
+    }
+  }
+  if {$answer eq "startinst"} {
+    run_installer
+    # invokes show_log which first destroys previous children
+  } else {
+    log_exit
+  }
+}
+
+#file delete "/tmp/dblog"
+main_prog
diff --git a/Master/tlpkg/installer/texlion.png b/Master/tlpkg/installer/texlion.png
new file mode 100644
index 00000000000..4040faddf7e
--- /dev/null
+++ b/Master/tlpkg/installer/texlion.png