Abort option when loading a repository

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

5 files changed, 553 insertions, 340 deletions

diff --git a/Master/install-tl b/Master/install-tl
index 58858b3a9a2..1326f82d042 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -703,6 +703,7 @@ if ($opt_profile eq "") {
   }
   read_profile($opt_profile);
   if ($from_ext_gui) {
+    print STDOUT "endload\n\n";
     print STDOUT "startinst\n";
   }
 }
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 130b4ffe265..85598ad7e7f 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -130,6 +130,11 @@ if [catch {ttk::style lookup TFrame -background} ::default_bg] {
   set ::default_bg white
 }
 
+# NOTE
+# text widgets aren't ttk widgets:
+# state disabled  => configure -state disabled
+# state !disabled => configure -state normal
+
 # dialog with textbox
 proc long_message {str type {p "."}} {
   # alternate messagebox implemented as custom dialog
@@ -252,18 +257,15 @@ proc total_dis_enable {y_n} {
     set ::busy [__ "Running"]
     . configure -menu .mn_empty
     foreach c [winfo children .] {
-      if {$c ne ".showlogs" && [winfo class $c] in \
-              [list TButton TCheckbutton TRadiobutton TEntry Treeview]} {
+      if {$c ne ".showlogs" && [winfo class $c] in $::active_cls} {
         # this should cover all relevant widgets in the main window
         $c state disabled
       }
     }
-    set ::busy [__ "Running"]
   } else { ; # enable
     . configure -menu .mn
     foreach c [winfo children .] {
-      if {[winfo class $c] in \
-              [list TButton TCheckbutton TRadiobutton TEntry Treeview]} {
+      if {[winfo class $c] in $::active_cls} {
         $c state !disabled
       }
     }
@@ -284,7 +286,8 @@ set ::procid [pid]
 array unset ::repos
 
 # mirrors: dict of dicts of lists of urls per country per continent
-set ::mirrors [dict create]
+# moved to tltcl.tcl
+#set ::mirrors [dict create]
 
 # dict of (local and global) package dicts
 set ::pkgs [dict create]
@@ -334,9 +337,12 @@ proc read_err_tempfile {} {
   }
 } ; # read_err_tempfile
 
-proc err_exit {} {
+proc err_exit {{m ""}} {
   do_debug "error exit"
-  read_err_tempfile
+  if [info exists ::err] read_err_tempfile
+  if {$m ne ""} {
+    set ::err_log [linsert $::err_log 0 $m]
+  }
   any_message [join $::err_log "\n"] "ok"
   exit
 } ; # err_exit
@@ -350,9 +356,8 @@ proc start_tlmgr {{args ""}} {
   # to process initial tlmgr output before continuing.
   unset -nocomplain ::done_waiting
   do_debug "opening tlmgr"
-  if [catch \
-          {open "|tlmgr $args --machine-readable shell 2>>$::err_file" w+} \
-          ::tlshl] {
+  set cmd [list "|tlmgr" {*}$args "--machine-readable" "shell" 2>>$::err_file]
+  if [catch {open $cmd w+} ::tlshl] {
     tk_messageBox -message [get_stacktrace]
     exit
   }
@@ -374,9 +379,10 @@ proc read_line {} {
   # if it wants to wait for the command to finish
   set l "" ; # will contain the line to be read
   if {([catch {chan gets $::tlshl l} len] || [chan eof $::tlshl])} {
+    # copy as much of stderr as possible to ::err_log
+    catch {read_err_tempfile ; chan close $::err}
     if [chan eof $::tlshl] {
       catch {chan close $::tlshl}
-      catch {chan close $:err}
       unset -nocomplain ::tlshl
       unset -nocomplain ::err
       set ::perlpid 0
@@ -433,8 +439,8 @@ proc show_err_log {} {
 
 proc log_widget_init {} {
   show_logs ; # create the logs dialog
-  .tllg.status configure -text [__ "Running"]
-  .tllg.close configure -state disabled
+  set ::busy [__ "Running"]
+  .tllg.close state disabled
 }
 
 proc log_widget_add l {
@@ -453,8 +459,8 @@ proc log_widget_finish {} {
   if {$::tcl_platform(os) ne "Darwin"} {
     .tllg.log.tx configure -state disabled
   }
-  .tllg.status configure -text [__ "Idle"]
-  .tllg.close configure -state !disabled
+  set ::busy [__ "Idle"]
+  .tllg.close state !disabled
   bind .tllg <Escape> {.tllg.close invoke}
 }
 
@@ -470,10 +476,13 @@ proc run_cmds {cmds {show 0}} {
   if $show {
     show_logs
     .tllg.status configure -text [__ "Running"]
-    .tllg.close configure -state disabled
+    .tllg.close state disabled
   }
   set l [llength $cmds]
   for {set i 0} {$i<$l} {incr i} {
+    if {! [info exists ::tlshl]} {
+      err_exit "Back end gone. Last command: \n  $::last_cmd"
+    }
     set cmd [lindex $cmds $i]
     set ::last_cmd $cmd
     unset -nocomplain ::done_waiting
@@ -519,27 +528,28 @@ proc run_cmd_waiting {cmd} {
 
 # The repositories play a small part in this front end. Tlmgr mostly works
 # with a virtual repository, which is the combined set of repositories,
-# with pinning applied. But get_packages_info_remote must invoke
+# with pinning applied if there is more than one repository.
+# But get_packages_info_remote must invoke
 # show_repositories to display updated verification info.
-# This proc is also invoked by initialize.
+# show_repositories is also invoked by initialize.
 
 # get_packages_info_local is invoked only once, at initialization.  After
 # installations and removals, the collected information is updated by
 # update_local_revnumbers.
 # Both procs also invoke get_platforms
 
-# get_packages_info_remote will be invoked by collect_filtered if
-# ::have_remote is false. Afterwards, ::have_remote will be true, and
-# therefore get_packages_info_remote will not be called again.
-# get_packages_info_remot also invokes get_platforms
-# get_packages_info_remote invokes update_globals and show_repos.
+# get_packages_info_remote should be invoked before collect_filtered if
+# ::have_remote is false. Afterwards, ::have_remote will be true.
+# There will be no need to invoke get_packages_info_remote again except
+# at a change of repository by repos_commit.
+# get_packages_info_remote invokes update_globals, show_repos
+# and get_platforms.
 
 # update_local_revnumbers will be invoked after any updates. It also
 # invokes update_globals.
 
 # collect_filtered does not only filter, but also organize the
-# information to be displayed.  If necessary, it invokes
-# get_packages_info_remote and always invokes display_packages_info.
+# information to be displayed. It invokes display_packages_info.
 # It is invoked at initialization, when filtering options change and
 # at the end of install-, remove- and update procs.
 
@@ -614,8 +624,9 @@ proc display_packages_info {} {
 proc collect_filtered {} {
   do_debug \
       "collect_filtered for $::stat_opt and $::dtl_opt"
+  # test this beforehand
   if {$::stat_opt ne "inst" && ! $::have_remote} {
-    get_packages_info_remote
+    err_exit "collect_filtered should not have been invoked at this time"
   }
   foreach nm [dict keys $::filtered] {
     dict unset ::filtered $nm
@@ -717,6 +728,57 @@ proc get_packages_info_local {} {
   get_platforms
 } ; # get_packages_info_local
 
+proc abort_load {} {
+  # try to close back end forcibly
+  catch {chan close $::tlshl}
+  if {$::tcl_platform(platform) eq "windows"} {
+    catch {exec -ignorestderr taskkill /pid $::perlpid /t /f}
+  } else {
+    catch {exec -ignorestderr kill -9 $::perlpid}
+    # should also be ok for darwin
+  }
+  # start new tlshell process
+  exec $::progname &
+
+  # end current tlshell process nicely
+  exit
+  # kill current tlshell process forcibly if necessary
+  if {$::tcl_platform(platform) eq "windows"} {
+    catch {exec -ignorestderr taskkill /pid [pid] /t /f}
+  } else {
+    catch {exec -ignorestderr kill -9 [pid]}
+    # kill -9 should also be ok for darwin
+  }
+} ; # abort load
+
+# activate abort button
+# toplevel with abort button in case loading of a repository takes too long.
+# it should disappear if loading finishes
+proc splash_loading {} {
+
+  #toplevel .loading
+  create_dlg .loading .
+
+  wm title .loading ""
+
+  # wallpaper
+  pack [ttk::frame .loading.bg -padding 3] -fill both -expand 1
+
+  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
+  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
+  wm resizable .loading 0 0
+  place_dlg .loading .
+} ; # splash_loading
+
 # remote: preserve information on installed packages
 proc get_packages_info_remote {} {
   # remove non-local database entries
@@ -729,12 +791,15 @@ proc get_packages_info_remote {} {
   set ::updatable 0
   set ::tlshell_updatable 0
 
-  if [catch {run_cmd_waiting \
+  splash_loading
+  if [catch {run_cmd \
     "info --data name,localrev,remoterev,cat-version,category,shortdesc"}] {
     do_debug [get_stacktrace]
     tk_messageBox -message [__ "A configured repository is unavailable."]
     return 0
   }
+  vwait ::done_waiting
+  destroy .loading
   set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),([^,]*),(.*)$}
   foreach l $::out_log {
     if [regexp $re $l m nm lrev rrev rcatv catg pdescr] {
@@ -804,7 +869,8 @@ proc show_logs {} {
   pack [ttk::frame .tllg.bottom] -in .tllg.bg -side bottom -fill x
   ttk::button .tllg.close -text [__ "Close"] -command {end_dlg 0 .tllg}
   ppack .tllg.close -in .tllg.bottom -side right -anchor e
-  ppack [ttk::label .tllg.status -anchor w] -in .tllg.bottom -side left
+  ppack [ttk::label .tllg.status -textvariable ::busy -anchor w] \
+      -in .tllg.bottom -side left
   bind .tllg <Escape> {.tllg.close invoke}
   wm protocol .tllg WM_DELETE_WINDOW {.tllg.close invoke}
 
@@ -871,123 +937,21 @@ proc show_logs {} {
 ##### repositories ###############################################
 
 ### mirrors
-
-# turn name into a string suitable for a widget name
-proc mangle_name {n} {
-  set n [string tolower $n]
-  set n [string map {" "  "_"} $n]
-  return $n
-} ; # mangle_name
-
-set mirrors [dict create]
-proc read_mirrors {} {
-  if [catch {open [file join [exec kpsewhich -var-value SELFAUTOPARENT] \
-                   "tlpkg/installer/ctan-mirrors.pl"] r} fm] {
-    do_debug "cannot open mirror list"
-    return 0
-  }
-  set re_geo {^\s*'([^']+)' => \{\s*$}
-  set re_url {^\s*'(.*)' => ([0-9]+)}
-  set re_clo {^\s*\},?\s*$}
-  set starting 1
-  set lnum 0 ; # line number for error messages
-  set ok 1 ; # no errors encountered yet
-  set countries {} ; # aggregate list of countries
-  set urls {} ; # aggregate list of urls
-  set continent ""
-  set country ""
-  set u ""
-  set in_cont 0
-  set in_coun 0
-  while {! [catch {chan gets $fm} line] && ! [chan eof $fm]} {
-    incr lnum
-    if $starting {
-      if {[string first "\$mirrors =" $line] == 0} {
-        set starting 0
-        continue
-      } else {
-        set ok 0
-        set msg "Unexpected line '$line' at start"
-        break
-      }
-    }
-    # starting is now dealt with.
-    if [regexp $re_geo $line dummy c] {
-      if {! $in_cont} {
-        set in_cont 1
-        set continent $c
-        set cont_dict [dict create]
-        if {$continent in [dict keys $::mirrors]} {
-          set ok 0
-          set msg "Duplicate continent $c at line $lnum"
-          break
-        }
-      } elseif {! $in_coun} {
-        set in_coun 1
-        set country $c
-        if {$country in $countries} {
-          set ok 0
-          set msg "Duplicate country $c at line $lnum"
-          break
-        }
-        lappend countries $country
-        dict set cont_dict $country {}
-      } else {
-        set ok 0
-        set msg "Unexpected continent- or country line $line at line $lnum"
-        break
-      }
-    } elseif [regexp $re_url $line dummy u n] {
-      if {! $in_coun} {
-        set ok 0
-        set msg "Unexpected url line $line at line $lnum"
-        break
-      } elseif {$n ne "1"} {
-        continue
-      }
-      append u "systems/texlive/tlnet"
-      if {$u in $urls} {
-          set ok 0
-          set msg "Duplicate url $u at line $lnum"
-          break
-      }
-      dict lappend cont_dict $country $u
-      lappend urls $u
-      set u ""
-    } elseif [regexp $re_clo $line] {
-      if $in_coun {
-        set in_coun 0
-        set country ""
-      } elseif $in_cont {
-        set in_cont 0
-        dict set ::mirrors $continent $cont_dict
-        set continent ""
-      } else {
-        break ; # should close mirror list
-      }
-    } ; # ignore other lines
-  }
-  close $fm
-  if {! $ok} {do_debug $msg}
-} ; # read_mirrors
+#mangle_name {n} {} ; moved to tltcl.tcl
+#proc read_mirrors {} {} ; moved to tltcl.tcl
 
 proc pick_local_repo {} {
-  set tail "tlpkg/texlive.tlpdb"
   set nw_repo [.tlr.cur cget -text]
-  if {! [file exists [file join $nw_repo $tail]]} {
-    # not local, try originally configured main repository
-    set nw_repo $::repos(main)
-    if {! [file exists [file join $nw_repo $tail]]} {
-      # again, not local
-      set nw_repo $::env(HOME) ; # HOME also o.k. for windows
-    }
+  if {! [file isdirectory $nw_repo]} {
+    set nw_repo $::env(HOME) ; # HOME also o.k. for windows
   }
   while 1 {
     set nw_repo [browse4dir $nw_repo .tlr]
-    if {$nw_repo ne "" && ! [file exists [file join $nw_repo $tail]]} {
+    if {$nw_repo ne "" && ! [possible_repository $nw_repo]} {
       tk_messageBox -message [__ "%s not a repository" $nw_repo] -parent .tlr
       continue
     } else {
+      .tlr.save state !disabled
       break
     }
   }
@@ -998,7 +962,6 @@ proc pick_local_repo {} {
 } ; # pick_local_repo
 
 proc get_repos_from_tlmgr {} {
-  #puts stderr "get_repos start"
   array unset ::repos
   run_cmd_waiting "option repository"
   set rps ""
@@ -1026,7 +989,6 @@ proc get_repos_from_tlmgr {} {
       array unset ::repos
     }
   }
-  #puts stderr "get_repos end"
 }; # get_repos_from_tlmgr
 
 proc set_repos_in_tlmgr {} {
@@ -1034,7 +996,6 @@ proc set_repos_in_tlmgr {} {
   # we need to compose a string for opt_location ourselves from $::repos.
   # a single repository should not get a tag.
   # apparently, we can safely ignore bogus pinning data.
-  #puts stderr "set_repos start"
   set nr [array size ::repos]
   set opt_repos ""
   set rp ""
@@ -1043,8 +1004,7 @@ proc set_repos_in_tlmgr {} {
       if {$nm ne "main"} {
         err_exit "Internal error"
       } else {
-        # pinning only supported for multiple repositories
-        run_cmd_waiting "pinning remove $nm --all"
+        # pinning command only supported for multiple repositories
         set rp $::repos(main)
       }
     } else {
@@ -1061,12 +1021,9 @@ proc set_repos_in_tlmgr {} {
     append opt_repos " $rp"
   }
   run_cmd_waiting "repository set [string range $opt_repos 1 end]"
-  #puts stderr [string range $opt_repos 1 end]
-  #puts stderr "set_repos end"
 }; # set_repos_in_tlmgr
 
 proc show_repos {} {
-  #puts stderr "show_repos start"
   set w .toprepo
   foreach ch [winfo children $w] {destroy $ch}
   set nms [array names ::repos]
@@ -1085,19 +1042,13 @@ proc show_repos {} {
     pgrid [ttk::label $w.load -text [__ "Not loaded"]] \
         -sticky nw -row 0 -column 1
   }
-  set do_veri 0
-  if {$::have_remote && [dict get $::pkgs texlive.infra localrev] >= 51140} {
-    set do_veri 1
-  }
   set repodict [dict create]
-  if $do_veri {
+  if $::have_remote {
     run_cmd_waiting "repository status"
     set re {^(\S+) (\S+)/tlpkg/texlive.tlpdb (-?\d+) (.*)$}
     foreach l $::out_log {
-      #puts stderr $l
       if [regexp $re $l dum nm rp n d] {
         # dummy tag repository verification_code description
-        #puts stderr "scanning..."
         # restore spaces and percent characters in nm and rp
         set nm [string map {"%20" " "} $nm]
         set nm [string map {"%25" "%"} $nm]
@@ -1106,18 +1057,15 @@ proc show_repos {} {
         dict set repodict $nm "url" $rp
         dict set repodict $nm "vericode" $n
         dict set repodict $nm "veridescr" $d
-        #puts stderr "${nm}: $rp"
       }
     }
-  } else {
-    #puts stderr "No veri"
   }
   set rw 0
   foreach nm [array names ::repos] {
     incr rw
     pgrid [ttk::label $w.u$nm -text $::repos($nm) -justify left] \
         -sticky nw -row $rw -column 0
-    if {$::repos($nm) eq $::any_mirror && $do_veri} {
+    if {$::repos($nm) eq $::any_mirror && $::have_remote} {
       set s $::repos($nm)
       append s "\n[__ "Actual repository"]:\n"
       append s [dict get $repodict $nm "url"]
@@ -1127,17 +1075,15 @@ proc show_repos {} {
       pgrid [ttk::label $w.n$nm -text "($nm)"] \
         -sticky nw -row $rw -column 1
     }
-    if $do_veri {
+    if $::have_remote {
       pgrid [ttk::label $w.v$nm -text \
                 "verification: [dict get $repodict $nm "veridescr"]"] \
             -sticky nw -row $rw -column 2
     }
   }
-  #puts stderr "show_repos end"
 } ; # show_repos
 
 proc repos_commit {} {
-  #puts stderr "repos_commit start"
   set changes 0
   # set repositories then add pinning if appropriate
   if {! [regexp {^\s*$} [.tlr.new get]]} {
@@ -1150,7 +1096,6 @@ proc repos_commit {} {
   set had_contrib 0
   if $::toggle_contrib {
     set changes 1
-    #puts stderr "handle tlcontrib"
     foreach nm [array names ::repos] {
       if {$::repos($nm) eq $::tlcontrib} {
         set had_contrib 1
@@ -1171,15 +1116,31 @@ proc repos_commit {} {
     if {$::toggle_contrib && ! $had_contrib} {
       run_cmd_waiting "pinning add tlcontrib \"*\""
     }
-    # reload remote package information
-    set ::have_remote 0
-    get_packages_info_remote
-    collect_filtered
-    #puts stderr "done committing"
   }
-  #puts stderr "really done committing"
 } ; # repos_commit
 
+proc dis_enable_reposave {} {
+  if [possible_repository [.tlr.new get]] {
+    .tlr.save state !disabled
+  } else {
+    .tlr.save state disabled
+  }
+}
+
+proc save_load_repo {} {
+  repos_commit
+  end_dlg "" .tlr
+  # reload remote package information
+  set ::have_remote 0
+  get_packages_info_remote
+  collect_filtered
+}
+
+proc select_mir {m} {
+  .tlr.new delete 0 end; .tlr.new insert end $m
+  .tlr.save state !disabled
+}
+
 # main repository dialog
 proc repository_dialog {} {
 
@@ -1211,6 +1172,8 @@ proc repository_dialog {} {
       -in .tlr.info -row $row -column 0 -sticky w
   pgrid [ttk::entry .tlr.new] \
       -in .tlr.info -row $row -column 1 -columnspan 2 -sticky ew
+  .tlr.new insert 0 $::repos(main)
+  bind .tlr.new <KeyRelease> dis_enable_reposave
 
   ### three ways to specify a repository ###
   pack [ttk::frame .tlr.mirbuttons] -in .tlr.bg -fill x
@@ -1218,32 +1181,12 @@ proc repository_dialog {} {
   ttk::button .tlr.ctan -text [__ "Any CTAN mirror"] -command {
     .tlr.new delete 0 end
     .tlr.new insert end $::any_mirror
+    .tlr.save state !disabled
   }
   ppack .tlr.ctan -in .tlr.mirbuttons -side left -fill x
   # 2. specific repository: create a cascading dropdown menu of mirrors
-  destroy .tlr.mir.m
-  if {[dict size $::mirrors] == 0} read_mirrors
-  do_debug "[dict size $::mirrors] mirrors"
-  if {[dict size $::mirrors] > 0} {
-    ttk::menubutton .tlr.mir -text [__ "Specific mirror..."] \
-        -direction below -menu .tlr.mir.m
-    ppack .tlr.mir -in .tlr.mirbuttons -side left -fill x
-    menu .tlr.mir.m
-    dict for {cont d_cont} $::mirrors {
-      set c_ed [mangle_name $cont]
-      menu .tlr.mir.m.$c_ed
-      .tlr.mir.m add cascade -label $cont -menu .tlr.mir.m.$c_ed
-      dict for {cntr urls} $d_cont {
-        set n_ed [mangle_name $cntr]
-        menu .tlr.mir.m.$c_ed.$n_ed
-        .tlr.mir.m.$c_ed add cascade -label $cntr -menu .tlr.mir.m.$c_ed.$n_ed
-        foreach u $urls {
-          .tlr.mir.m.$c_ed.$n_ed add command -label $u \
-              -command ".tlr.new delete 0 end; .tlr.new insert end $u"
-        }
-      }
-    }
-  }
+  mirror_menu .tlr.mir select_mir
+  ppack .tlr.mir -in .tlr.mirbuttons -side left -fill x
   # 3. local repository
   ttk::button .tlr.browse -text [__ "Local directory..."] -command {
     .tlr.new delete 0 end; .tlr.new insert end [pick_local_repo]}
@@ -1275,18 +1218,14 @@ proc repository_dialog {} {
 
   # two ways to close the dialog
   pack [ttk::frame .tlr.closebuttons] -pady [list 10 0] -in .tlr.bg -fill x
-  ttk::button .tlr.save -text [__ "Save and Load"] -command {
-    #puts stderr "save and load invoked"
-    repos_commit
-    end_dlg "" .tlr
-    #puts stderr "save and load done"
-  }
+  ttk::button .tlr.save -text [__ "Save and Load"] -command save_load_repo
   ppack .tlr.save -in .tlr.closebuttons -side right
-  ttk::button .tlr.abort -text [__ "Abort"] -command {end_dlg "" .tlr}
-  ppack .tlr.abort -in .tlr.closebuttons -side right
-  bind .tlr <Escape> {.tlr.abort invoke}
+  dis_enable_reposave
+  ttk::button .tlr.cancel -text [__ "Cancel"] -command {end_dlg "" .tlr}
+  ppack .tlr.cancel -in .tlr.closebuttons -side right
+  bind .tlr <Escape> {.tlr.cancel invoke}
 
-  #wm protocol .tlr WM_DELETE_WINDOW {.tlr.abort invoke}
+  wm protocol .tlr WM_DELETE_WINDOW {.tlr.cancel invoke}
   wm resizable .tlr 1 0
   place_dlg .tlr .
 } ; # repository_dialog
@@ -1315,10 +1254,10 @@ if {$::tcl_platform(platform) ne "windows"} {
     } else {
       .tlpl.pl set $pl "sup" "[mark_sym $m0] \u21d2 [mark_sym $m1]"
     }
-    .tlpl.do configure -state disabled
+    .tlpl.do state disabled
     dict for {p mrks} $::platforms {
       if {[dict get $mrks "fut"] ne [dict get $mrks "cur"]} {
-        .tlpl.do configure -state !disabled
+        .tlpl.do state !disabled
         break
       }
     }
@@ -1367,12 +1306,14 @@ if {$::tcl_platform(platform) ne "windows"} {
     # buttons
     pack [ttk::frame .tlpl.but] -in .tlpl.bg -side bottom -fill x
     ttk::button .tlpl.do -text [__ "Apply and close"] -command {
-      platforms_commit; end_dlg "" .tlpl
+      disable_dlg .tlpl
+      platforms_commit
+      end_dlg "" .tlpl
     }
     ttk::button .tlpl.dont -text [__ "Close"] -command \
         {end_dlg "" .tlpl}
     ppack .tlpl.do -in .tlpl.but -side right
-    .tlpl.do configure -state disabled
+    #.tlpl.do state disabled
     ppack .tlpl.dont -in .tlpl.but -side right
     bind .tlpl <Escape> {.tlpl.dont invoke}
 
@@ -1421,8 +1362,8 @@ set bks {}
 proc enable_restore {y_n} {
   set st [expr {$y_n ? !disabled : disabled}]
   .tlbk.bklist state $st
-  .tlbk.all configure -state $st
-  .tlbk.done configure -state $st
+  .tlbk.all state $st
+  .tlbk.done state $st
 } ; # enable_restore
 
 proc finish_restore {} {
@@ -1993,9 +1934,12 @@ proc run_external {cmd mess} {
   set ::err_log {}
   lappend ::out_log $mess
   unset -nocomplain ::done_waiting
-  # dont understand why, on windows, start_tlmgr does not trigger
-  # a console window but this proc does
-  if [catch {open "|$cmd 2>&1" "r"} ::capt] {
+  # treat cmd as a list, possibly of one element
+  # using a list enables a direct invocation, bypassing a shell
+  set cmd0 [lindex $cmd 0]
+  set cmd [lreplace $cmd 0 0 "|$cmd0"]
+  set cmd [list {*}$cmd 2>@1]
+  if [catch {open $cmd r} ::capt] {
     tk_messageBox -message "Failure to launch $cmd"
   }
   chan configure $::capt -buffering line -blocking 0
@@ -2026,6 +1970,18 @@ proc show_help {} {
 
 ##### main window #####
 
+proc try_loading_remote {} {
+  if {[possible_repository $::repos(main)]} {
+    get_packages_info_remote
+    collect_filtered
+  } else {
+    set mes [__ "%s is not a local or remote repository.
+Please configure a valid repository" $::repos(main)]
+    append mes "\n([__ "Options"] \/ [__ "Repositories"] ...)"
+    tk_messageBox -message $mes -title [__ "Error"] -type ok -icon error
+  }
+}
+
 proc populate_main {} {
 
   wm withdraw .
@@ -2063,18 +2019,19 @@ proc populate_main {} {
     }
   }
 
-  .mn add cascade -label [__ "File"] -menu .mn.file -underline 0
-  menu .mn.file
-  .mn.file add command -label [__ "Load default repository"] \
-      -command {get_packages_info_remote; collect_filtered}
-  .mn.file add command -command {destroy .} -label [__ "Exit"] -underline 1
-
   # inx: keeping count to record indices where needed,
   # i.e. when an entry needs to be referenced.
   # not all submenus need this.
 
+  .mn add cascade -label [__ "File"] -menu .mn.file -underline 0
+  menu .mn.file
+  .mn.file add command -label [__ "Load repository"] \
+      -command try_loading_remote
+  .mn.file add command -command {destroy .} -label [__ "Exit"] -underline 1
+
   .mn add cascade -label [__ "Actions"] -menu .mn.act -underline 0
   menu .mn.act
+  set inx -1
   incr inx
   .mn.act add command -label [__ "Regenerate filename database"] -command \
       {run_external "mktexlsr" [__ "Regenerating filename database..."]}
@@ -2162,7 +2119,7 @@ proc populate_main {} {
   # subframe for repositories, to be filled by show_repos
   pack [ttk::frame .toprepo] -in .topfl -side top -anchor w
 
-  # various info
+  # various info, left frame
   pack [ttk::frame .topfll] -in .topfl -side top -anchor nw -pady [list 6 0]
   ttk::label .topfll.lluptodate -text [__ "TL Manager up to date?"] -anchor w
   pgrid .topfll.lluptodate -row 2 -column 0 -sticky w
@@ -2176,7 +2133,7 @@ proc populate_main {} {
       -wraplength [expr {60*$::cw}] -justify left -anchor w
   pgrid .topfll.lcmd -row 3 -column 1 -sticky w
 
-  # right frame
+  # various info, right frame
   ppack [ttk::frame .topfr] -in .topf -side right -anchor ne
   if {$::tcl_platform(platform) eq "windows"} {
     pack [ttk::label .topfr.ladmin] -side top -anchor e
@@ -2203,9 +2160,15 @@ proc populate_main {} {
   ttk::radiobutton .pkfilter.inst -text [__ "Installed"] -value inst \
       -variable ::stat_opt -command collect_filtered
   ttk::radiobutton .pkfilter.alls -text [__ "All"] -value all \
-      -variable ::stat_opt -command collect_filtered
+      -variable ::stat_opt -command {
+        if {! $::have_remote} get_packages_info_remote
+        collect_filtered
+      }
   ttk::radiobutton .pkfilter.upd -text [__ "Updatable"] -value upd \
-      -variable ::stat_opt -command collect_filtered
+      -variable ::stat_opt -command {
+        if {! $::have_remote} get_packages_info_remote
+        collect_filtered
+      }
   grid .pkfilter.lstat -column 0 -row 0 -sticky w -padx {3 50}
   pgrid .pkfilter.inst -column 0 -row 1 -sticky w
   pgrid .pkfilter.alls -column 0 -row 2 -sticky w
diff --git a/Master/tlpkg/installer/install-menu-extl.pl b/Master/tlpkg/installer/install-menu-extl.pl
index 8c3d129ad70..926141cf36b 100644
--- a/Master/tlpkg/installer/install-menu-extl.pl
+++ b/Master/tlpkg/installer/install-menu-extl.pl
@@ -61,9 +61,11 @@ $::deskintdesc[0] = "None";
 $::deskintdesc[1] = "Menu shortcuts";
 $::deskintdesc[2] = "Launcher";
 
+do_remote_init();
+print STDOUT "endload\n\n";
+
 # %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:
 
diff --git a/Master/tlpkg/installer/install-tl-gui.tcl b/Master/tlpkg/installer/install-tl-gui.tcl
index acdac9923a4..4882f749b61 100755
--- a/Master/tlpkg/installer/install-tl-gui.tcl
+++ b/Master/tlpkg/installer/install-tl-gui.tcl
@@ -63,6 +63,35 @@ if {$::tcl_platform(platform) eq "windows"} {
 set ::advanced 0
 set ::alltrees 0
 
+proc kill_perl {} {
+  if $::perlpid {
+    catch {
+      if {$::tcl_platform(platform) eq "unix"} {
+        exec -ignorestderr kill $::perlpid
+      } else {
+        exec -ignorestderr taskkill /pid $::perlpid /t /f
+      }
+    }
+  }
+}
+
+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 {
+    catch {
+      if {$::tcl_platform(platform) eq "unix"} {
+        exec -ignorestderr kill $::perlpid
+      } else {
+        exec -ignorestderr taskkill "/pid" $::perlpid
+      }
+    }
+  }
+  exit
+} ; # err_exit
+
 # warning about non-empty target tree
 set ::td_warned 0
 
@@ -101,19 +130,19 @@ proc show_time {s} {
 # write to a logfile which is shared with the backend.
 # both parties open, append and close every time.
 
-#if {$::tcl_platform(os) eq "Darwin"} {
-#  set ::dblfile "$::env(TMPDIR)/dblog"
-#} elseif {$::tcl_platform(platform) eq "unix"} {
-#  set ::dblfile "/tmp/dblog"
-#} else {
-#  set ::dblfile "$::env(TEMP)/dblog.txt"
-#}
-#proc dblog {s} {
-#  set db [open $::dblfile a]
-#  set t [get_stacktrace]
-#  puts $db "TCL: $s\n$t"
-#  close $db
-#}
+if {$::tcl_platform(os) eq "Darwin"} {
+  set ::dblfile "$::env(TMPDIR)/dblog"
+} elseif {$::tcl_platform(platform) eq "unix"} {
+  set ::dblfile "/tmp/dblog"
+} else {
+  set ::dblfile "$::env(TEMP)/dblog.txt"
+}
+proc dblog {s} {
+  set db [open $::dblfile a]
+  set t [get_stacktrace]
+  puts $db "TCL: $s\n$t"
+  close $db
+}
 
 proc maybe_print_welcome {} {
   # if the last non-empty line was "All done", then installation is completed.
@@ -124,7 +153,7 @@ proc maybe_print_welcome {} {
   for {set i [.log.tx count -lines 1.0 end]} {$i > 0} {incr i -1} {
     set l  [.log.tx get ${i}.0 ${i}.end]
     if {$l ne ""} {
-      puts $l
+      #puts $l
       if {[string range $l 0 11] eq "Installed on"} {
         set all_done 1
       }
@@ -195,13 +224,30 @@ This should not have happened!"
   return $l
 }; # read_line_no_eof
 
+# non-blocking i/o: callback for "readable" while the splash screen is up
+# and the back end tries to contact the repository
+proc read_line_loading {} {
+  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 normal way to terminate is terminating the GUI shell.
+    # This closes stdin of the child
+  } elseif {$len >= 0} {
+    if {$l eq "endload"} {
+      chan configure $::inst -blocking 1
+      chan event $::inst readable {}
+      set ::loaded 1
+    }
+  }
+}; # read_line_loading
+
 # 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.
+    # note. the normal way to terminate is terminating the GUI shell.
     # This closes stdin of the child
     .close state !disabled
     if [winfo exists .abort] {.abort state disabled}
@@ -215,14 +261,49 @@ proc read_line_cb {} {
   }
 }; # read_line_cb
 
+proc maybe_abort {} {
+  set ans [tk_messageBox -message [__ "Really abort?"] -type yesno \
+               -default no]
+  if {$ans eq "no"} {
+    return
+  }
+  catch {chan close $::inst}
+  kill_perl
+  exit
+}
+
+# restart installer with chosen repository
+proc select_mir {m} {
+  # edit original command line by removing any repository parameter
+  # and adding a repository parameter $m
+  set i $::argc
+  while {$i > 0} {
+    incr i -1
+    set p [lindex $::argv $i]
+    if {$p eq "-repository"} {
+      set ::argv [lreplace $::argv $i [expr {$i+1}] ""]
+    }
+  }
+  # compose command line string from $::argv
+  set i -1
+  lappend ::argv "-repository" $m
+  set cmd [linsert $::argv 0 [info nameofexecutable] [info script] "--"]
+
+  # terminate back end
+  catch {chan close $::inst}
+  kill_perl
+
+  # restart install-tl with edited command-line
+  exec {*}$cmd &
+  exit
+} ; # select_mir
+
 ##############################################################
 
 ##### special-purpose uses of main window: splash, log #####
 
 proc make_splash {} {
 
-  # wm overrideredirect . true
-
   # picture and logo
   catch {
     image create photo tlimage -file \
@@ -235,9 +316,19 @@ proc make_splash {} {
   # wallpaper
   pack [ttk::frame .bg -padding 3] -fill both -expand 1
 
+  # buttons: abort button, mirrors dropdown menu
+  pack [ttk::frame .splfb] -in .bg -side bottom -fill x
+  ppack [ttk::button .spl_a -text [__ "Abort"] -command maybe_abort] \
+      -side right -in .splfb
+  ppack [mirror_menu .spl_o select_mir] -side right -in .splfb
+
+  # some text
   ppack [ttk::label .text -text [__ "TeX Live Installer"] \
              -font bigfont] -in .bg
-  ppack [ttk::label .loading -text [__ "Loading..."]] -in .bg
+  ppack [ttk::label .loading -text [__ "Trying to load %s.
+
+If this takes too long, press Abort and choose another repository." \
+                                        $::prelocation]] -in .bg
 
   wm attributes . -topmost
   update
@@ -249,7 +340,7 @@ proc make_splash {} {
 proc show_log {{do_abort 0}} {
   wm withdraw .
   foreach c [winfo children .] {
-    destroy $c
+    catch {destroy $c}
   }
 
   # wallpaper
@@ -260,16 +351,7 @@ proc show_log {{do_abort 0}} {
   ttk::button .close -text [__ "Close"] -command exit
   ppack .close -in .bottom -side right
   if $do_abort {
-    ttk::button .abort -text [__ "Cancel"]  -command {
-      set ans [tk_messageBox -message [__ "Really abort?"] -type yesno \
-                   -default no]
-      if {$ans eq "no"} return
-      catch {chan close $::inst}
-      if {$::tcl_platform(platform) eq "windows"} {
-        catch {exec  taskkill /pid $::perlpid /t /f}
-      }
-      exit
-    }
+    ttk::button .abort -text [__ "Abort"]  -command maybe_abort
     ppack .abort -in .bottom -side right
   }
   bind . <Escape> {
@@ -1133,8 +1215,8 @@ if {$::tcl_platform(platform) ne "windows"} {
     wm protocol .edsyms  WM_DELETE_WINDOW {.edsyms.cancel invoke}
     wm resizable .edsyms 1 0
     place_dlg .edsyms .
-  }
-}
+  } ; # edit_symlinks
+} ; # $::tcl_platform(platform) ne "windows"
 
 #############################################################
 
@@ -1149,12 +1231,12 @@ if {$::tcl_platform(platform) ne "windows"} {
 
 proc run_menu {} {
   if [info exists ::env(dbgui)] {
-    puts "\ndbgui: run_menu: advanced is now $::advanced"
-    puts "dbgui: run_menu: alltrees is now $::alltrees"
+    #puts "\ndbgui: run_menu: advanced is now $::advanced"
+    #puts "dbgui: run_menu: alltrees is now $::alltrees"
   }
   wm withdraw .
   foreach c [winfo children .] {
-    destroy $c
+    catch {destroy $c}
   }
 
   # wallpaper
@@ -1181,13 +1263,14 @@ proc run_menu {} {
   if {!$::advanced} {
     ppack [ttk::button .adv -text [__ "Advanced"] -command {
       set ::menu_ans "advanced"
-      if [info exists ::env(dbgui)] {puts "dbgui: requested advanced"}
+      #if [info exists ::env(dbgui)] {puts "dbgui: requested advanced"}
     }] -in .final -side left
   }
   pack [ttk::separator .seph1 -orient horizontal] \
       -in .bg -side bottom -pady 3 -fill x
 
   # directories, selections
+  # advanced and basic have different frame setups
   if $::advanced {
     pack [ttk::frame .left] -in .bg -side left -fill both -expand 1
     set curf .left
@@ -1196,8 +1279,6 @@ proc run_menu {} {
     set curf .main
   }
 
-  # labelframes do not look quite right on macos
-
   # directory section
   pack [ttk::frame .dirf] -in $curf -fill x
   grid columnconfigure .dirf 1 -weight 1
@@ -1205,6 +1286,8 @@ proc run_menu {} {
 
   if $::advanced {
     incr rw
+    # labelframes do not look quite right on macos,
+    # instead, separate label widget for title
     pgrid [ttk::label .dirftitle -text [__ "Installation root"] \
                -font hfont] \
         -in .dirf -row $rw -column 0 -columnspan 3 -sticky w
@@ -1288,7 +1371,7 @@ proc run_menu {} {
     if {!$::alltrees} {
       ttk::button .tmoreb -text [__ "More ..."] -command {
         set ::menu_ans "alltrees"
-        if [info exists ::env(dbgui)] {puts "dbgui: requested alltrees"}
+        #if [info exists ::env(dbgui)] {puts "dbgui: requested alltrees"}
       }
       pgrid .tmoreb -in .dirf -row $rw -column 2 -sticky ne
     }
@@ -1363,7 +1446,7 @@ proc run_menu {} {
   incr rw
   ttk::label .lsize -text [__ "Disk space required (in MB):"]
   ttk::label .size_req -textvariable ::vars(total_size)
-  pgrid .lsize -in $curf -row $rw -column 0 -sticky e
+  pgrid .lsize -in $curf -row $rw -column 0 -sticky w
   pgrid .size_req -in $curf -row $rw -column 1 -sticky w
 
   ########################################################
@@ -1536,10 +1619,10 @@ proc run_menu {} {
   if {[is_nonempty $::vars(TEXDIR)] && ! $::td_warned} {
     td_warn $::vars(TEXDIR)
   }
-  if [info exists ::env(dbgui)] {puts "dbgui: unsetting menu_ans"}
+  #if [info exists ::env(dbgui)] {puts "dbgui: unsetting menu_ans"}
   unset -nocomplain ::menu_ans
   vwait ::menu_ans
-  if [info exists ::env(dbgui)] {puts "dbgui0: menu_ans is $::menu_ans"}
+  #if [info exists ::env(dbgui)] {puts "dbgui0: menu_ans is $::menu_ans"}
   return $::menu_ans
 }; # run_menu
 
@@ -1733,42 +1816,44 @@ proc main_prog {} {
   wm title . [__ "TeX Live Installer"]
   wm protocol . WM_DELETE_WINDOW whataboutclose
 
-  # check for profile argument whether to put up a splash screen
+  if {[file exists $::dblfile]} {file delete $::dblfile}
+
+  # handle some command-line arguments.
+  # the argument list should already be normalized: '--' => '-', "=" => ' '
   set i 0
   set do_splash 1
+  set ::prelocation "..."
   while {$i < $::argc} {
     set p [lindex $::argv $i]
     incr i
-    if {[string range $p 0 7] eq "-profile" || \
-            [string range $p 0 8] eq "--profile"} {
+    if {$p eq "-profile"} {
+      # check for profile argument: no splash screen if present
       set do_splash 0
-      break
+      incr i
+    } elseif {$p in [list "-location" "-url" "-repository" "-repos" "-repo"]} {
+      # check for repository argument: bail out if obviously invalid
+      if {$i<$::argc} {
+        set p [lindex $::argv $i]
+        if {$p ne "ctan" && ! [possible_repository $p]} {
+          tk_messageBox -message [__ "%s not a local or remote repository" $p] \
+              -title [__ "Error"] -type ok -icon error
+          exit
+        }
+        set ::prelocation $p
+      }
+      incr i
     }
   }
   unset i
+
   if $do_splash make_splash
   unset do_splash
 
   # start install-tl-[tcl] via a pipe.
-  # the command must be a string, not a list.
-  # therefore, arguments with spaces must be quoted.
-  # although we build the command at first as a list,
-  # it will be joined into a string at a second step
-  set cmd [list ${::perlbin} "${::instroot}/install-tl" \
-               "-from_ext_gui" {*}$::argv]
-  set i 0
-  while {$i<[llength $cmd]} {
-    set c [lindex $cmd $i]
-    if {[string first " " $c] >= 0} {
-      lset cmd $i "\"$c\""
-    }
-    incr i
-  }
-  unset i
-  # tk_messageBox -message [join $cmd " "] -title "debugging"
+  set cmd [list "|${::perlbin}" "${::instroot}/install-tl" \
+               "-from_ext_gui" {*}$::argv 2>@1]
   show_time "opening pipe"
-  if [catch {open "|[join $cmd " "] 2>@1" r+} ::inst] {
-    # "2>@1" ok under Windows >= XP
+  if [catch {open $cmd r+} ::inst] {
     err_exit "Error starting Perl backend"
   }
   show_time "opened pipe"
@@ -1777,40 +1862,69 @@ proc main_prog {} {
   # for windows < 10: make sure the main window is still on top
   wm attributes . -topmost
 
-  # 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
-  # - location (=repository)
+  # - location (actual repository)
   # - menu data, help, version, print-platform
   set ::did_gui 0
   set answer ""
-  while 1 {
+  unset -nocomplain ::loaded
+  while 1 { ; # initial perl output
     set ll [read_line]
-    if {[lindex $ll 0] < 0} break
+    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,
-      # which may take a while
+    } elseif [string match "location: ?*" $l] {
+      # this one comes straight from install-tl, rather than
+      # from install-tl-extl.pl
+      # installer about to contact repository, which may
+      # fail and cause an indefinite delay
+      chan configure $::inst -blocking 0
+      chan event $::inst readable read_line_loading
+      if [winfo exists .loading] {
+        .loading configure -text [__ "Trying to load %s.
+
+If this takes too long, press Abort and choose another repository." \
+                                      [string range $l 10 end]]
+        update
+      }
+      break
+    }
+  }
+  # waiting till the repository has been loaded
+  vwait ::loaded
+  unset ::loaded
+  #puts stderr "done loading"
+  # resume reading from back end in blocking mode
+  while 1 {
+    set ll [read_line]
+    if {[lindex $ll 0] < 0} {
+      break
+    }
+    set l [lindex $ll 1]
+    if {$l eq "menudata"} {
+      # so we do want a menu and expect menu data,
+      # parsing which may take a while
       read_menu_data
       show_time "read menu data from perl"
       set ::advanced 0
       set ::alltrees 0
       set answer [run_menu]
-      if [info exists ::env(dbgui)] {puts "dbgui1: menu_ans is $::menu_ans"}
+      #if [info exists ::env(dbgui)] {puts "dbgui1: menu_ans is $::menu_ans"}
       if {$answer eq "advanced"} {
         # this could only happen if $::advanced was 0
         set ::advanced 1
-        if [info exists ::env(dbgui)] {puts "dbgui: Setting advanced to 1"}
+        #if [info exists ::env(dbgui)] {puts "dbgui: Setting advanced to 1"}
         set answer [run_menu]
         if {$answer eq "alltrees"} {
           set ::alltrees 1
-          if [info exists ::env(dbgui)] {puts "dbgui: Setting alltrees to 1"}
+          #if [info exists ::env(dbgui)] {puts "dbgui: Setting alltrees to 1"}
           set answer [run_menu]
         }
       }
@@ -1821,13 +1935,6 @@ proc main_prog {} {
       set ::out_log {}
       set answer "startinst"
       break
-    } elseif [string match "location: ?*" $l] {
-      # this one comes straight from install-tl, rather than
-      # from install-tl-extl.pl
-      if [winfo exists .loading] {
-        .loading configure -text [__ "Loading from %s" [string range $l 10 end]]
-        update
-      }
     } else {
       lappend ::out_log $l
     }
diff --git a/Master/tlpkg/tltcl/tltcl.tcl b/Master/tlpkg/tltcl/tltcl.tcl
index c7e4fedb481..db0157a6d84 100644
--- a/Master/tlpkg/tltcl/tltcl.tcl
+++ b/Master/tlpkg/tltcl/tltcl.tcl
@@ -12,11 +12,156 @@ if {$::tcl_platform(platform) eq "unix" && $::tcl_platform(os) ne "Darwin"} {
   set ::plain_unix 1
 }
 
+if $::plain_unix {
+  # plain_unix: avoid a RenderBadPicture error on quitting.
+  # 'send' changes the shutdown sequence,
+  # which avoids triggering the bug.
+  # 'tk appname <something>' restores 'send' and avoids the bug
+  bind . <Destroy> {
+    catch {tk appname appname}
+  }
+}
+
 # process ID of the perl program that will run in the background
 set ::perlpid 0
 
+# mirrors
+
 set any_mirror "http://mirror.ctan.org/systems/texlive/tlnet"
 
+# turn name into a string suitable for a widget name
+proc mangle_name {n} {
+  set n [string tolower $n]
+  set n [string map {" "  "_"} $n]
+  return $n
+} ; # mangle_name
+
+set mirrors [dict create]
+proc read_mirrors {} {
+  if [catch {open [file join $::instroot \
+                   "tlpkg/installer/ctan-mirrors.pl"] r} fm] {
+    return 0
+  }
+  set re_geo {^\s*'([^']+)' => \{\s*$}
+  set re_url {^\s*'(.*)' => ([0-9]+)}
+  set re_clo {^\s*\},?\s*$}
+  set starting 1
+  set lnum 0 ; # line number for error messages
+  set ok 1 ; # no errors encountered yet
+  set countries {} ; # aggregate list of countries
+  set urls {} ; # aggregate list of urls
+  set continent ""
+  set country ""
+  set u ""
+  set in_cont 0
+  set in_coun 0
+  while {! [catch {chan gets $fm} line] && ! [chan eof $fm]} {
+    incr lnum
+    if $starting {
+      if {[string first "\$mirrors =" $line] == 0} {
+        set starting 0
+        continue
+      } else {
+        set ok 0
+        set msg "Unexpected line '$line' at start"
+        break
+      }
+    }
+    # starting is now dealt with.
+    if [regexp $re_geo $line dummy c] {
+      if {! $in_cont} {
+        set in_cont 1
+        set continent $c
+        set cont_dict [dict create]
+        if {$continent in [dict keys $::mirrors]} {
+          set ok 0
+          set msg "Duplicate continent $c at line $lnum"
+          break
+        }
+      } elseif {! $in_coun} {
+        set in_coun 1
+        set country $c
+        if {$country in $countries} {
+          set ok 0
+          set msg "Duplicate country $c at line $lnum"
+          break
+        }
+        lappend countries $country
+        dict set cont_dict $country {}
+      } else {
+        set ok 0
+        set msg "Unexpected continent- or country line $line at line $lnum"
+        break
+      }
+    } elseif [regexp $re_url $line dummy u n] {
+      if {! $in_coun} {
+        set ok 0
+        set msg "Unexpected url line $line at line $lnum"
+        break
+      } elseif {$n ne "1"} {
+        continue
+      }
+      append u "systems/texlive/tlnet"
+      if {$u in $urls} {
+          set ok 0
+          set msg "Duplicate url $u at line $lnum"
+          break
+      }
+      dict lappend cont_dict $country $u
+      lappend urls $u
+      set u ""
+    } elseif [regexp $re_clo $line] {
+      if $in_coun {
+        set in_coun 0
+        set country ""
+      } elseif $in_cont {
+        set in_cont 0
+        dict set ::mirrors $continent $cont_dict
+        set continent ""
+      } else {
+        break ; # should close mirror list
+      }
+    } ; # ignore other lines
+  }
+  close $fm
+} ; # read_mirrors
+
+# cascading dropdown mirror menu
+# parameter cmd should be a proc which does something with the selected url
+proc mirror_menu {wnd cmd} {
+  destroy $wnd.m
+  if {[dict size $::mirrors] == 0} read_mirrors
+  if {[dict size $::mirrors] > 0} {
+    ttk::menubutton $wnd -text [__ "Specific mirror..."] \
+        -direction below -menu $wnd.m
+    menu $wnd.m
+    dict for {cont d_cont} $::mirrors {
+      set c_ed [mangle_name $cont]
+      menu $wnd.m.$c_ed
+      $wnd.m add cascade -label $cont -menu $wnd.m.$c_ed
+      dict for {cntr urls} $d_cont {
+        set n_ed [mangle_name $cntr]
+        menu $wnd.m.$c_ed.$n_ed
+        $wnd.m.$c_ed add cascade -label $cntr -menu $wnd.m.$c_ed.$n_ed
+        foreach u $urls {
+          $wnd.m.$c_ed.$n_ed add command -label $u -command "$cmd $u"
+        }
+      }
+    }
+  } else {
+    ttk::label $wnd -text [__ "No mirror list available"]
+  }
+  return $wnd
+}
+
+proc possible_repository {s} {
+  if [regexp {^(https?|ftp):\/\/.+} $s] {return 1}
+  if {[string first {file://} $s] == 0} {set s [string range $s 7 end]}
+  if [file isdirectory [file join $s "archive"]] {return 1}
+  if [file isdirectory [file join $s "texmf-dist/web2c"]] {return 1}
+  return 0
+}
+
 proc get_stacktrace {} {
   set level [info level]
   set s ""
@@ -26,31 +171,29 @@ proc get_stacktrace {} {
   return $s
 } ; # get_stacktrace
 
-proc err_exit {{mess ""}} {
-  if {$mess eq ""} {set mess "Error"}
-  append mess "\n" [get_stacktrace]
-  if $::plain_unix {
-    # plain_unix: avoid a RenderBadPicture error on quitting.
-    # 'send' changes the shutdown sequence,
-    # which avoids triggering the bug.
-    # 'tk appname <something>' restores 'send' and avoids the bug
-    bind . <Destroy> {
-      catch {tk appname appname}
-    }
-  }
-  tk_messageBox -icon error -message $mess
-  # kill perl process, just in case
-  if $::perlpid {
-    catch {
-      if {$::tcl_platform(platform) eq "unix"} {
-        exec -ignorestderr "kill" $::perlpid
-      } else {
-        exec -ignorestderr "taskkill" "/pid" $::perlpid
-      }
+proc normalize_argv {} {
+  # work back to front, to not disturb indices of unscanned list elements
+  set i $::argc
+  while 1 {
+    incr i -1
+    if {$i<0} break
+    set s [lindex $::argv $i]
+    if {[string range $s 0 1] eq "--"} {
+      set s [string range $s 1 end]
+      set ::argv [lreplace $::argv $i $i $s]
     }
+    set j [string first "=" $s]
+    if {$j > 0} {
+      set s0 [string range $s 0 [expr {$j-1}]]
+      set s1 [string range $s [expr {$j+1}] end]
+      set ::argv [lreplace $::argv $i $i $s0 $s1]
+    } elseif {$j==0} {
+      err_exit "Command-line argument $s starting with \"=\""
+    } ; # else leave alone
   }
-  exit
-} ; # err_exit
+  set ::argc [llength $::argv]
+}
+normalize_argv
 
 # localization support
 
@@ -69,24 +212,11 @@ proc load_translations {} {
   while {$i < $::argc} {
     set p [lindex $::argv $i]
     incr i
-    if {$p eq "-lang" || $p eq "--lang" || $p eq "-gui-lang" || \
-            $p eq "--gui-lang"} {
+    if {$p eq "-lang" || $p eq "-gui-lang"} {
       if {$i < $::argc} {
         set ::lang [lindex $::argv $i]
         break
       }
-    } elseif {[string range $p 0 5] eq "-lang="} {
-      set ::lang [string range $p 6 end]
-      break
-    } elseif {[string range $p 0 6] eq "--lang="} {
-      set ::lang [string range $p 7 end]
-      break
-    } elseif {[string range $p 0 9] eq "-gui-lang="} {
-      set ::lang [string range $p 10 end]
-      break
-    } elseif {[string range $p 0 11] eq "--gui-lang="} {
-      set ::lang [string range $p 12 end]
-      break
     }
   }
   unset i
@@ -316,6 +446,11 @@ set ::env(NOPERLDOC) 1
 
 # for example code, look at dialog.tcl, part of Tk itself
 
+# widget classes which can be enabled and disabled.
+# The text widget class is not included here.
+
+set ::active_cls [list TButton TCheckbutton TRadiobutton TEntry Treeview]
+
 # global variable for dialog return value, in case the outcome
 # must be handled by the caller rather than by the dialog itself:
 set ::dialog_ans {}
@@ -358,11 +493,16 @@ proc place_dlg {wnd {p "."}} {
   grab set $wnd
 } ; # place_dlg
 
-proc end_dlg {ans wnd} {
+# in case pressing the closing button leads to lengthy processing:
+proc disable_dlg {wnd} {
   foreach c [winfo children $wnd] {
-    # alternative to catch: check type with [winfo class $wnd]
-    catch {$c state disabled}
+    if {[winfo class $c] in $::active_cls} {
+      catch {$c state disabled}
+    }
   }
+}
+
+proc end_dlg {ans wnd} {
   set ::dialog_ans $ans
   set p [winfo parent $wnd]
   if {$p eq ""} {set p "."}