path: root/Master/texmf-dist/scripts/tlshell/tlshell.tcl

#!/usr/bin/env wish

# Copyright 2017-2020 Siep Kroonenberg

# This file is licensed under the GNU General Public License version 2
# or any later version.

package require Tk

# security: disable send
catch {rename send {}}

# unix: make sure TL comes first on process searchpath
# on windows, a wrapper takes care of this.
if {$::tcl_platform(platform) ne "windows"} {
  set texbin [file dirname [file normalize [info script]]]
  # prepend texbin to PATH, unless it is already the _first_
  # path component
  set dirs [split $::env(PATH) ":"]
  if {[lindex $dirs 0] ne $texbin} {
    set ::env(PATH) "${texbin}:$::env(PATH)"
  }
  unset texbin
  unset dirs
}

set ::instroot [exec kpsewhich -var-value=TEXMFROOT]

# try to read a configuration variable (gui-lang, tkfontscale)
# from tlmgr config ($TEXMF[SYS]CONFIG/tlmgr/config
# failure results in an empty string.
# this proc will be invoked by tltcl if tlshell is the invoker of tltcl
proc get_config_var {k} {
  set v ""
  set r [join [list {^\s*} $k {\s*=\s*(\S.*)$}] ""]
  foreach tmf {"TEXMFCONFIG" "TEXMFSYSCONFIG"} {
    if [catch {exec kpsewhich -var-value $tmf} d] {
        break; # apparently there is not yet a TL installation
    }

    if [catch {open [file join $d "tlmgr" "config"] r} fid] continue
    while 1 {
      if [chan eof $fid] {
        break
      }
      if [catch {chan gets $fid} l] break
      # we can assume that $k contains no special characters
      if [regexp $r $l m v] {
        set v [regsub {\s*$} $v ""]
        break
      } else {
        # regexp will have unset v
        set v ""
      }
    }
    chan close $fid
    if {$v ne ""} break
  }
  return $v
}

proc save_config_var {k v} {
  if [catch {exec kpsewhich -var-value "TEXMFCONFIG"} d] {return 0}
  set d [file join $d "tlmgr"]
  if [catch {file mkdir $d}] {return 0} ; # mkdir on existing dir is ok
  set fn [file join $d "config"]
  set oldlines [list]
  set r [join [list {^\s*} $k {\s*=\s*(\S.*)$}] ""]
  # read current config file
  if [file exists $fn] {
    if [catch {open $fn r} fid] {return 0}
    set cnt 0
    while 1 {
      if [catch {chan gets $fid} l] break
      if [chan eof $fid] break
      incr cnt
      if {! [regexp $r $l]} {
          lappend oldlines $l
      }
      if {$cnt>40} break
    }
    catch {chan close $fid}
  }
  lappend oldlines "$k = $v"
  if [catch {open $fn w} fid] {return 0}
  foreach l $oldlines {
    if [catch {puts $fid $l}] {
      catch {chan close $fid}
      return 0
    }
  }
  catch {chan close $fid}
  return 1
}

# tltcl: declarations and utilities shared with install-tl-gui.tcl
# tltcl likes to know who was the invoker
set ::invoker [file tail [info script]]
if [string match -nocase ".tcl" [string range $::invoker end-3 end]] {
  set ::invoker [string range $::invoker 0 end-4]
}
source [file join $::instroot "tlpkg" "tltcl" "tltcl.tcl"]

# now is a good time to ask tlmgr for the _TL_ name of our platform
set ::our_platform [exec -ignorestderr tlmgr print-platform]

# searchpath and locale:
# windows: tlshell runs via a wrapper which adjusts the searchpath
# for the current process.
# others: tlshell.tcl should  be run via a symlink in a directory
# which also contains (a symlink to) kpsewhich.
# This directory will be prepended to the searchpath.
# kpsewhich should disentangle symlinks.

# dis/enable the restore dialog
set do_restore 0

# tlcontrib
set tlcontrib "http://contrib.texlive.info/current"

# dis/enable debug output (only for private development purposes)
set ddebug 0

##### general housekeeping ############################################

# menus: disable tearoff feature
option add *Menu.tearOff 0

proc search_nocase {needle haystack} {
  if {$needle eq ""} {return -1}
  if {$haystack eq ""} {return -1}
  return [string first [string tolower $needle] [string tolower $haystack]]
}

# the stderr and stdout of tlmgr are each read into lists of strings
set err_log {}
set out_log {}

#### debug output, ATM only for private development purposes ####

if $ddebug {set dbg_log {}}

proc do_debug {s} {
  if $::ddebug {
    if {$::tcl_platform(platform) ne "windows"} {puts stderr $s}
    # On windows, stderr output goes nowhere.
    # Therefore also debug output for the log dialog.
    lappend ::dbg_log $s
    file mkdir ${::instroot}/temp
    set dbg [open "${::instroot}/temp/mydbglog" a]
    puts $dbg "TCL: $s"
    chan close $dbg
    # Track debug output in the log dialog if it is running:
    if [winfo exists .tllg.dbg.tx] {
      .tllg.dbg.tx configure -state normal
      .tllg.dbg.tx insert end "$s\n"
      if {$::tcl_platform(os) ne "Darwin"} {
        .tllg.dbg.tx configure -state disabled
      }
    }
  }
} ; # do_debug

### temporary files and directories #########################

proc maketemp {ext} {
  set fname ""
  foreach i {0 1 2 3 4 5 6 7 8 9} { ; # ten tries
    set fname [file join $::tempsub "[expr {int(10000.0*rand())}]$ext"]
    if {[file exist $fname]} {set fname ""; continue}
    # create empty file. although we just want a name,
    # we must make sure that it can be created.
    set fid [open $fname w]
    chan close $fid
    if {! [file exists $fname]} {error "Cannot create temporary file"}
    if {$::tcl_platform(platform) eq "unix"} {
      file attributes $fname -permissions 0600
    }
    break
  }
  if {$fname eq ""} {error "Cannot create temporary file"}
  return $fname
} ; # maketemp

set tempsub "" ; # subdir for temp files, set during initialization

### GUI utilities #####################################################

# mouse clicks: deal with MacOS platform differences
if {[tk windowingsystem] eq "aqua"} {
  event add <<RightClick>> <ButtonRelease-2> <Control-ButtonRelease-1>
} else {
  event add <<RightClick>> <ButtonRelease-3>
}

## default_bg color, only used for menus under ::plain_unix
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
  # not all message types are supported
  if {$type ne "ok" && $type ne "okcancel" && $type ne "yesnocancel"} {
    err_exit "Unsupported type $type for long_message"
  }
  create_dlg .tlmg $p
  wm title .tlmg ""

  # wallpaper frame; see populate_main
  pack [ttk::frame .tlmg.bg] -fill both -expand 1

  # buttons
  pack [ttk::frame .tlmg.bts] -in .tlmg.bg -side bottom -fill x
  if {$type eq "ok" || $type eq "okcancel"} {
    ttk::button .tlmg.ok -text [__ "Ok"] -command "end_dlg \"ok\" .tlmg"
    ppack .tlmg.ok -in .tlmg.bts -side right
  }
  if {$type eq "yesnocancel"} {
    ttk::button .tlmg.yes -text [__ "Yes"] -command "end_dlg \"yes\" .tlmg"
    ppack .tlmg.yes -in .tlmg.bts -side right
    ttk::button .tlmg.no -text [__ "No"] -command "end_dlg \"no\" .tlmg"
    ppack .tlmg.no -in .tlmg.bts -side right
  }
  if {$type eq "yesnocancel" || $type eq "okcancel"} {
    ttk::button .tlmg.cancel -text [__ "Cancel"] -command \
        "end_dlg \"cancel\" .tlmg"
    ppack .tlmg.cancel -in .tlmg.bts -side right
  }
  if [winfo exists .tlmg.cancel] {
    bind .tlmg <Escape> {.tlmg.cancel invoke}
    wm protocol .tlmg WM_DELETE_WINDOW {cancel_or_destroy .tlmg.cancel .tlmg}
  } elseif {$type eq "ok"} {
    bind .tlmg <Escape> {.tlmg.ok invoke}
    wm protocol .tlmg WM_DELETE_WINDOW {cancel_or_destroy .tlmg.ok .tlmg}
  }

  ppack [ttk::frame .tlmg.tx] -in .tlmg.bg -side top -fill both -expand 1
  pack [ttk::scrollbar .tlmg.tx.scroll -command ".tlmg.tx.txt yview"] \
      -side right -fill y
  ppack [text .tlmg.tx.txt -height 20 -width 60 -bd 2 -relief groove \
      -wrap word -yscrollcommand ".tlmg.tx.scroll set"] -expand 1 -fill both

  .tlmg.tx.txt insert end $str
  .tlmg.tx.txt configure -state disabled

  # default resizable
  place_dlg .tlmg $p
  tkwait window .tlmg
  return $::dialog_ans
} ; # long_message

proc any_message {str type {p "."}} {
  if {[string length $str] < 400} {
    if {$type ne "ok"} {
      return [tk_messageBox -message $str -type $type -parent $p \
                 -icon question]
    } else {
      return [tk_messageBox -message $str -type $type -parent $p]
    }
  } else {
    # just hope that tcl will do the right thing with multibyte characters
    if {[string length $str] > 500000} {
      set str [string range $str 0 500000]
      append str "\n....."
    }
    return [long_message $str $type $p]
  }
} ; # any_message

##### tl global data ##################################################

set ::last_cmd ""

set ::progname [info script]
regexp {^.*[\\/]([^\\/\.]*)(?:\....)?$} $progname dummy ::progname
set ::procid [pid]

# package repositories
array unset ::repos

# mirrors: dict of dicts of lists of urls per country per continent
# moved to tltcl.tcl
#set ::mirrors [dict create]

# dict of (local and global) package dicts
set ::pkgs [dict create]

# platforms
set ::platforms [dict create]

set ::have_remote 0 ; # remote packages info not yet loaded
set ::need_update_tlmgr 0
set ::n_updates 0
set ::tlshell_updatable 0

## package data to be displayed ##

# sorted display data for packages; package data stored as lists
set ::filtered [dict create]

# selecting packages for display: status and detail
set ::stat_opt "inst"
set ::dtl_opt "all"
# searching packages for display; also search short descriptions?
set ::search_desc 0

### enabling and disabling user interaction based on global data

proc selective_dis_enable {} {
  # disable actions which make no sense at the time

  # buttons in the middle section
  set pkg_buttons [list .mrk_inst .mrk_upd .mrk_rem .upd_tlmgr .upd_all]
  foreach b [list .mrk_inst .mrk_upd .mrk_rem .upd_tlmgr .upd_all] {
    $b state !disabled
  }
  if $::do_restore {.mrk_rest state !disabled}

  if {!$::have_remote} {
    foreach b [list .mrk_inst .mrk_upd .upd_tlmgr .upd_all] {
      $b state disabled
    }
  } elseif {!$::n_updates} {
    foreach b [list .mrk_upd .upd_tlmgr .upd_all] {
      $b state disabled
    }
  } elseif $::need_update_tlmgr {
    foreach b [list .mrk_inst .mrk_upd] {
      $b state disabled
    }
    if {$::tcl_platform(platform) eq "windows"} {
      .upd_all state disabled
    }
  } elseif {!$::need_update_tlmgr} {
    .upd_tlmgr state disabled
  }

  # platforms menu item
  if {$::tcl_platform(platform) ne "windows"} {
    if {!$::have_remote || $::need_update_tlmgr}  {
      .mn.opt entryconfigure $::inx_platforms -state disabled
    } else {
      .mn.opt entryconfigure $::inx_platforms -state normal
    }
  }
}; # selective_dis_enable

proc total_dis_enable {y_n} {
  # to be invoked when tlmgr becomes busy or idle, i.e.
  # if it starts with a tlmgr command through run_cmds
  # or read_line notices the command(s) ha(s|ve) ended.
  # This proc should cover all active interface elements of the main window.
  # But if actions are initiated via a dialog, the main window can instead
  # be deactivated by a grab and focus on the dialog.

  if {!$y_n} { ; # disable
    set ::busy [__ "Running"]
    . configure -menu .mn_empty
    foreach c [winfo children .] {
      if {$c ne ".showlogs" && [winfo class $c] in $::active_cls} {
        # this should cover all relevant widgets in the main window
        $c state disabled
      }
    }
  } else { ; # enable
    . configure -menu .mn
    foreach c [winfo children .] {
      if {[winfo class $c] in $::active_cls} {
        $c state !disabled
      }
    }
    set ::busy [__ "Idle"]
    selective_dis_enable
  }
} ; # total_dis_enable

##### handling tlmgr via pipe and stderr tempfile #####################

set ::prmpt "tlmgr>"
set ::busy [__ "Running"]

# copy logs to log window yes/no
set ::show_output 0

# about [chan] gets:
# if a second parameter, in this case l, is supplied
# then this variable receives the result, with EOL stripped,
# and the return value is the string length, possibly 0
# EOF is indicated by a return value of -1.

proc read_err_tempfile {} {
  if [info exists ::err] {
    set len 0
    while 1 {
      set len [chan gets $::err l]
      if {$len >= 0} {
        lappend ::err_log $l
      } else {
        break
      }
    }
  }
} ; # read_err_tempfile

proc err_exit {{m ""}} {
  do_debug "error exit"
  read_err_tempfile
  if {$m ne ""} {
    set ::err_log [linsert $::err_log 0 $m]
  }
  any_message [join $::err_log "\n"] "ok"
  exit
} ; # err_exit

# Capture stdout of tlmgr into a pipe $::tlshl,
# stderr into a temp file file $::err_file which is set at initialization.

proc start_tlmgr {{args ""}} {
  # Start the TeX Live Manager shell interface.
  # Below, vwait ::done_waiting forces tlshell
  # to process initial tlmgr output before continuing.
  unset -nocomplain ::done_waiting
  do_debug "opening tlmgr"
  # -gui -. -gui-lang
  for {set i 0} {$i < [llength $args]} {incr i} {
    if {[lindex $args $i] eq "-lang"} {
      set args [lreplace $args $i $i "-gui-lang"]
    }
  }
  set cmd [list "|tlmgr" {*}$args "--machine-readable" "shell" 2>>$::err_file]
  if [catch {open $cmd w+} ::tlshl] {
    tk_messageBox -message [get_stacktrace]
    exit
  }
  set ::perlpid [pid $::tlshl]
  do_debug "done opening tlmgr"
  set ::err [open $::err_file r]
  chan configure $::tlshl -buffering line -blocking 0
  chan event $::tlshl readable read_line
  vwait ::done_waiting
} ; # start_tlmgr

proc close_tlmgr {} {
  run_cmd_waiting "quit"
}

# read a line of tlmgr output
proc read_line {} {
  # a caller of run_cmd needs to explicitly invoke 'vwait ::done_waiting'
  # 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}
      unset -nocomplain ::tlshl
      unset -nocomplain ::err
      set ::perlpid 0
      set ::done_waiting 1
    } else {
      #do_debug "read_line: failing to read "
      puts stderr "Read failure; tlmgr command was $::last_cmd"
      # note. the normal way to terminate is terminating the GUI shell.
      # This closes stdin of tlmgr shell.
      err_exit
    }
  } elseif {$len >= 0} {
    # do_debug "read: $l"
    if $::ddebug {puts $::flid $l}
    if {[string first $::prmpt $l] == 0} {
      # prompt line: we are done with the current command
      total_dis_enable 1 ; # this may have to be redone later
      # catch up with stderr
      read_err_tempfile
      if $::show_output {
        do_debug "prompt found, $l"
        log_widget_finish
      }
      # for vwait:
      set ::done_waiting 1
      set ::show_output 0
    } else {
      # regular output
      lappend ::out_log $l
      if $::show_output {
        log_widget_add $l
      }
    }
  }
} ; # read_line

# copy error strings to error page in logs dialog .tllg and send it to top.
# This by itself does not map the logs dialog .tllg

proc show_err_log {} {
  #do_debug "show_err_log"
  .tllg.err.tx configure -state normal
  .tllg.err.tx delete 1.0 end
  if {[llength $::err_log] > 0} {
    foreach l $::err_log {.tllg.err.tx insert end "$l\n"}
    .tllg.err.tx yview moveto 1
    .tllg.logs select .tllg.err
  }
  if {$::tcl_platform(os) ne "Darwin"} {
    # os x: text widget disabled => no selection possible
    .tllg.err.tx configure -state disabled
  }
} ; # show_err_log

proc log_widget_init {} {
  show_logs ; # create the logs dialog
  set ::busy [__ "Running"]
  .tllg.close state disabled
}

proc log_widget_add l {
  .tllg.log.tx configure -state normal
  .tllg.log.tx insert end "$l\n"
  if {$::tcl_platform(os) ne "Darwin"} {
    .tllg.log.tx configure -state disabled
  }
}

proc log_widget_finish {} {
  .tllg.log.tx yview moveto 1
  .tllg.logs select .tllg.log
  # error log on top if it contains anything
  show_err_log
  if {$::tcl_platform(os) ne "Darwin"} {
    .tllg.log.tx configure -state disabled
  }
  set ::busy [__ "Idle"]
  .tllg.close state !disabled
  bind .tllg <Escape> {.tllg.close invoke}
}

##### running tlmgr commands #####

# run a list of commands
proc run_cmds {cmds {show 0}} {
  set ::show_output $show
  do_debug "run_cmds \"$cmds\""
  if $::ddebug {puts $::flid "\n$cmds"}
  set ::out_log {}
  set ::err_log {}
  if $show {
    show_logs
    .tllg.status configure -text [__ "Running"]
    .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
    # disable widgets for each new command,
    # since read_line will re-enable them
    # when a particular command is finished
    total_dis_enable 0
    chan puts $::tlshl $cmd
    chan flush $::tlshl
    if {$i < [expr {$l-1}]} {vwait ::done_waiting}
  }
} ; # run_cmds

# run a single command
proc run_cmd {cmd {show 0}} {
  run_cmds [list $cmd] $show
} ; # run_cmd

proc run_cmd_waiting {cmd} {
  run_cmd $cmd 0
  vwait ::done_waiting
} ; # run_cmd_waiting

##### Handling package info #####

# what invokes what?
# The main 'globals' are (excepting dicts and arrays):

# ::have_remote is initialized to false. It is set to true by
# get_packages_info_remote, and remains true except temporarily at
# a change of repository.

# The other globals ones are ::n_updates, ::need_update_tlmgr and
# ::tlshell_updatable. These are initially set to 0 and re-calculated
# by update_globals.

# update_globals is invoked by get_packages_info_remote and
# update_local_revnumbers. It enables and disables buttons as appropriate.

# displayed global status info is updated by update_globals.
# update button/menu states are set at initialization and updated
# by update_globals, both via the selective_dis_enable proc

# 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 if there is more than one repository.
# But get_packages_info_remote must invoke
# show_repos to display updated verification info.
# show_repos 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 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. It invokes display_packages_info.
# It is invoked at initialization, when filtering options change and
# at the end of install-, remove- and update procs.

# display_packages_info is mostly invoked by collect_filtered, but
# also when the search term or the search option changes.

proc is_updatable {nm} {
  set pk [dict get $::pkgs $nm]
  set lr [dict get $pk localrev]
  set rr [dict get $pk remoterev]
  return [expr {$lr > 0 && $rr > 0 && $rr > $lr}]
}

proc display_updated_globals {} {
  if {$::have_remote && $::need_update_tlmgr} {
    .topfll.luptodate configure -text [__ "Needs updating"]
  } elseif $::have_remote {
    .topfll.luptodate configure -text [__ "Up to date"]
  } else {
    .topfll.luptodate configure -text [__ "Unknown"]
  }
  # ... and status of update buttons
  selective_dis_enable
}

proc update_globals {} {
  if {! $::have_remote} return
  set ::n_updates 0
  foreach nm [dict keys $::pkgs] {
    if [is_updatable $nm] {incr ::n_updates}
  }
  set ::need_update_tlmgr [is_updatable texlive.infra]
  set ::tlshell_updatable [is_updatable tlshell]

  # also update displayed status info
  display_updated_globals
}

# The package display treeview widget in the main window has columns
# for both local and remote revision numbers.
# It gets its data from $::filtered rather than directly from $::pkgs.
# ::pkgs should already be up to date.

# I added a field 'marked' to ::pkgs. It is displayed in the first treeview
# column. This looks better than the treeview tag facilities.
# In ::pkgs, 'marked' is represented as a boolean.
# In ::filtered and .pkglist they are represented as unicode symbols.

# display packages obeying both filter and search string.
# even on a relatively slow system, regenerating .pkglist from ::filtered
# at every keystroke is acceptably responsive.
# with future more advanced search options, this scheme may not suffice.

proc display_packages_info {} {
  # do_debug [get_stacktrace]
  set curr [.pksearch.e get]
  .pkglist delete [.pkglist children {}]
  dict for {nm pk} $::filtered {
    set do_show 0
    if {$curr eq ""} {
      set do_show 1
    } elseif {[search_nocase $curr $nm] >= 0} {
      set do_show 1
    } elseif {$::search_desc && \
          [search_nocase $curr [dict get $::pkgs $nm shortdesc]] >= 0} {
      set do_show 1
    }
    if $do_show {
      .pkglist insert {} end -id $nm -values $pk
    }
  }
} ; # display_packages_info

# (re)create ::filtered dictionary; disregard search string.
# The value associated with each key/package is a list, not another dict.
proc collect_filtered {} {
  do_debug \
      "collect_filtered for $::stat_opt and $::dtl_opt"
  # test this beforehand
  if {$::stat_opt ne "inst" && ! $::have_remote} {
    err_exit "collect_filtered should not have been invoked at this time"
  }
  foreach nm [dict keys $::filtered] {
    dict unset ::filtered $nm
  }
  foreach nm [lsort [dict keys $::pkgs]] {
    set pk [dict get $::pkgs $nm]
    set do_show 1
    set mrk [mark_sym [dict get $pk marked]]
    set lr [dict get $pk localrev]
    set rr [dict get $pk remoterev]
    set ct [dict get $pk category]
    if {$::stat_opt eq "inst" && $lr == 0} {
      set do_show 0
    } elseif {$::stat_opt eq "upd" && ($lr == 0 || $rr == 0 || $rr <= $lr)} {
      set do_show 0
    }
    if {! $do_show} continue
    if {$::dtl_opt eq "schm" && $ct ne "Scheme"} {
      set do_show 0
    } elseif {$::dtl_opt eq "coll" && \
        $ct ne "Scheme" && $ct ne "Collection"} {
      set do_show 0
    }
    if {! $do_show} continue

    # collect data to be displayed for $nm
    dict lappend ::filtered $nm $mrk
    dict lappend ::filtered $nm $nm
    set v [dict get $pk localrev]
    set lv [dict get $pk lcatv]
    if {$v eq "0" || $v == 0} {
      set v ""
    } elseif {$lv != 0 && $lv ne ""} {
      set v "$v ($lv)"
    }
    dict lappend ::filtered $nm $v
    set v [dict get $pk remoterev]
    set rv [dict get $pk rcatv]
    if {$v eq "0" || $v == 0} {
      set v ""
    } elseif {$rv != 0 && $rv ne ""} {
      set v "$v ($rv)"
    }
    dict lappend ::filtered $nm $v
    dict lappend ::filtered $nm [dict get $pk shortdesc]
  }
} ; # collect_filtered

proc collect_and_display_filtered {} {
  collect_filtered
  display_packages_info
}

proc get_platforms {} {
  # guarantee fresh start
  foreach k $::platforms {dict unset ::platforms $k}
  set ::platforms [dict create]
  run_cmd_waiting "platform list"
  foreach l $::out_log {
    if [regexp {^\(i\)\s+(\S+)\s*$} $l dum plname] {
      set pl [dict create "cur" 1 "fut" 1]
      dict set ::platforms $plname $pl
    } elseif [regexp {^\s+(\S+)\s*$} $l dum plname] {
      set pl [dict create "cur" 0 "fut" 0]
      dict set ::platforms $plname $pl
    }
  }
}

# get fresh package list. invoked at program start
# some local packages may not be available online.
# to test, create local dual-platform installation from dvd, try to update
# from more recent linux-only installation

proc get_packages_info_local {} {
  # start from scratch; see also update_local_revnumbers
  foreach nm [dict keys $::pkgs] {
    dict unset ::pkgs $nm
  }
  set ::have_remote 0
  set ::need_update_tlmgr 0
  set ::updatable 0
  set ::tlshell_updatable 0

  run_cmd_waiting \
    "info --only-installed --data name,localrev,cat-version,category,shortdesc"
  set re {^([^,]+),([0-9]+),([^,]*),([^,]*),(.*)$}
  foreach l $::out_log {
    if [regexp $re $l m nm lrev lcatv catg pdescr] {
      # double-quotes in short description: remove outer, unescape inner
      if {[string index $pdescr 0] eq "\""} {
        set pdescr [string range $pdescr 1 end-1]
      }
      set pdescr [string map {\\\" \"} $pdescr]
      dict set ::pkgs $nm \
          [list "marked" 0 "localrev" $lrev "lcatv" $lcatv "remoterev" 0 \
               "rcatv" 0 "category" $catg shortdesc $pdescr]
    }
  }
  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]}
  }
} ; # abort load

# toplevel with abort button in case loading of a repository takes too long.
# it can be closed when loading finishes
proc splash_loading {} {

  create_dlg .loading .

  wm title .loading [__ "Loading"]

  # wallpaper
  pack [ttk::frame .loading.bg -padding 3] -fill both -expand 1

  set lbl [__ \
       "If loading takes too long, press Abort and choose another repository."]
  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.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.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 protocol .loading {cancel_or_destroy .loading.abo .loading}
  wm resizable .loading 0 0
  place_dlg .loading .
} ; # splash_loading


proc track_err {} {
  set inx0 [llength $::err_log]
  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
  update idletasks
  if {![info exists ::loaded]} {
    after 500 track_err
  } else {
    .loading.close state !disabled
    .loading.abo state disabled
    .loading.tx configure -state normal
    .loading.tx insert end [__ "Done loading"]
    .loading.tx configure -state disabled
  }
}

# remote: preserve information on installed packages
proc get_packages_info_remote {} {
  # remove non-local database entries
  foreach k [dict keys $::pkgs] {
    if {! [dict get $::pkgs $k localrev]} {
      dict unset ::pkgs $k
    }
  }
  set ::need_update_tlmgr 0
  set ::updatable 0
  set ::tlshell_updatable 0

  splash_loading

  unset -nocomplain ::loaded
  track_err
  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
  set ::loaded 1
  set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),([^,]*),(.*)$}
  foreach l $::out_log {
    if [regexp $re $l m nm lrev rrev rcatv catg pdescr] {
      # double-quotes in short description: remove outer, unescape inner
      if {[string index $pdescr 0] eq "\""} {
        set pdescr [string range $pdescr 1 end-1]
      }
      set pdescr [string map {\\\" \"} $pdescr]
      if [catch {dict get $::pkgs $nm} pk] {
        # package entry does not yet exist, create it
        dict set ::pkgs $nm [list "marked" 0 "localrev" 0 "lcatv" 0]
      }
      dict set ::pkgs $nm "remoterev" $rrev
      dict set ::pkgs $nm "rcatv" $rcatv
      dict set ::pkgs $nm "category" $catg
      dict set ::pkgs $nm "shortdesc" $pdescr
    }
  }
  get_platforms ; # derive from $::pkgs

  set ::have_remote 1
  update_globals
  show_repos
  return 1
} ; # get_packages_info_remote

## update ::pkgs after installing packages without going online again.
proc update_local_revnumbers {} {
  do_debug "update_local_revnumbers"
  run_cmd_waiting "info --only-installed --data name,localrev,cat-version"
  set re {^([^,]+),([0-9]+),(.*)$}
  dict for {pk pk_dict} $::pkgs {
    do_debug "zeroing local data for $pk"
    dict set pk_dict "localrev" 0
    dict set pk_dict "lcatv" 0
    dict set ::pkgs $pk $pk_dict
  }
  foreach l $::out_log {
    if [regexp $re $l m pk lr lv] {
      set pk_dict [dict get $::pkgs $pk]
      dict set pk_dict "localrev" $lr
      dict set pk_dict "lcatv" $lv
      dict set ::pkgs $pk $pk_dict
    }
  }
  get_platforms
  update_globals
} ; # update_local_revnumbers

##### Logs notebook ##############################

# if invoked via run_cmds, it tracks progress of (a) tlmgr command(s).
# run_cmds will temporarily disable the close button
# and set .tllg.status to busy via total_dis_enable 0.
# otherwise, it shows the output of the last completed (list of) command(s).

# Note that run_cmds clears ::out_log and ::err_log, but not ::dbg_log.

proc show_logs {} {
  create_dlg .tllg .
  wm title .tllg Logs

  # wallpaper
  pack [ttk::frame .tllg.bg] -fill both -expand 1

  # close button and busy label
  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 -textvariable ::busy -anchor w] \
      -in .tllg.bottom -side left
  bind .tllg <Escape> {.tllg.close invoke}
  wm protocol .tllg WM_DELETE_WINDOW \
      {cancel_or_destroy .tllg.close .tllg}

  # notebook pages and scrollbars
  ttk::frame .tllg.log
  pack [ttk::scrollbar .tllg.log.scroll -command ".tllg.log.tx yview"] \
      -side right -fill y
  ppack [text .tllg.log.tx -height 10 -wrap word \
      -yscrollcommand ".tllg.log.scroll set"] \
      -expand 1 -fill both
  .tllg.log.tx configure -state normal
  foreach l $::out_log {
    .tllg.log.tx insert end "$l\n"
  }
  if {$::tcl_platform(os) ne "Darwin"} {.tllg.log.tx configure -state disabled}
  .tllg.log.tx yview moveto 1

  ttk::frame .tllg.err
  pack [ttk::scrollbar .tllg.err.scroll -command ".tllg.err.tx yview"] \
      -side right -fill y
  ppack [text .tllg.err.tx -height 10 -wrap word \
      -yscrollcommand ".tllg.err.scroll set"] \
      -expand 1 -fill both
  .tllg.err.tx configure -state normal
  foreach l $::err_log {
    .tllg.err.tx configure -state normal
    .tllg.err.tx insert end "$l\n"
  }
  if {$::tcl_platform(os) ne "Darwin"} {.tllg.err.tx configure -state disabled}
  .tllg.err.tx yview moveto 1

  if $::ddebug {
    ttk::frame .tllg.dbg
    pack [ttk::scrollbar .tllg.dbg.scroll -command ".tllg.dbg.tx yview"] \
        -side right -fill y
    ppack [text .tllg.dbg.tx -height 10 -bd 2 -relief groove -wrap word \
        -yscrollcommand ".tllg.dbg.scroll set"] \
        -expand 1 -fill both
    .tllg.dbg.tx configure -state normal
    foreach l $::dbg_log {
      .tllg.dbg.tx insert end "$l\n"
    }
    if {$::tcl_platform(os) ne "Darwin"} {
      .tllg.dbg.tx configure -state disabled
    }
    .tllg.dbg.tx yview moveto 1
  }

  # collect pages in notebook widget
  pack [ttk::notebook .tllg.logs] -in .tllg.bg -side top -fill both -expand 1
  .tllg.logs add .tllg.log -text [__ "Output"]
  .tllg.logs add .tllg.err -text [__ "Other"]
  if $::ddebug {
    .tllg.logs add .tllg.dbg -text "Debug"
    raise .tllg.dbg .tllg.logs
  }
  raise .tllg.err .tllg.logs
  raise .tllg.log .tllg.logs

  # default resizable
  place_dlg .tllg .
} ; # show_logs

##### repositories ###############################################

### mirrors
#mangle_name {n} {} ; moved to tltcl.tcl
#proc read_mirrors {} {} ; moved to tltcl.tcl

proc pick_local_repo {} {
  set nw_repo [.tlr.cur cget -text]
  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 "" && ! [possible_repository $nw_repo]} {
      tk_messageBox -message [__ "%s not a repository" $nw_repo] -parent .tlr
      continue
    } else {
      .tlr.save state !disabled
      break
    }
  }
  if {$nw_repo ne ""} {
    .tlr.new delete 0 end
    .tlr.new insert end $nw_repo
  }
} ; # pick_local_repo

proc get_repos_from_tlmgr {} {
  array unset ::repos
  run_cmd_waiting "option repository"
  set rps ""
  foreach l $::out_log {
    if [regexp {repository\t(.*)$} $l dum rps] break
  }
  if {$rps ne ""} {
    set reps [split $rps " "]
    set nr [llength $reps]
    foreach rp $reps {
      # decode spaces and %
      set rp [string map {"%20" " "} $rp]
      set rp [string map {"%25" "%"} $rp]
      if {! [regexp {^(.+)#(.+)$} $rp dum r t]} {
        # no tag; use repository as its own tag
        set r $rp
        set t $rp
      }
      if {$nr == 1} {
        set t "main"
      }
      set ::repos($t) $r
    }
    if {"main" ni [array names ::repos]} {
      array unset ::repos
    }
  }
}; # get_repos_from_tlmgr

proc set_repos_in_tlmgr {} {
  # tlmgr has no command to replace a single repository;
  # 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.
  set nr [array size ::repos]
  set opt_repos ""
  set rp ""
  foreach nm [array names ::repos] {
    if {$nr==1} {
      if {$nm ne "main"} {
        err_exit "Internal error"
      } else {
        # pinning command only supported for multiple repositories
        set rp $::repos(main)
      }
    } else {
      if {$nm eq $::repos($nm)} {
        set rp $nm
      } else {
        set rp $::repos($nm)
        append rp "#$nm"
      }
    }
    # encode % and spaces
    set rp [string map {"%" "%25"} $rp]
    set rp [string map {" " "%20"} $rp]
    append opt_repos " $rp"
  }
  run_cmd_waiting "repository set [string range $opt_repos 1 end]"
}; # set_repos_in_tlmgr

proc show_repos {} {
  # this proc lists the configured repository/ies
  # in the upper left portion of the main window.
  # it makes one call to the back end, but no need to go online.
  set w .toprepo
  foreach ch [winfo children $w] {destroy $ch}
  set nms [array names ::repos]
  set c [llength $nms]
  grid [ttk::label $w.head -font TkHeadingFont] \
      -row 0 -column 0 -columnspan 2 -sticky w
  if {$c <= 0} {
    $w.head configure -text [__ "No repositories"]
     return
  } elseif {$c == 1} {
    $w.head configure -text [__ "Repository"]
  } else {
    $w.head configure -text [__ "Multiple repositories"]
  }
  if {! $::have_remote} {
    pgrid [ttk::label $w.load -text [__ "Not loaded"]] \
        -sticky nw -row 0 -column 1
  }
  set repodict [dict create]
  if $::have_remote {
    run_cmd_waiting "repository status"
    set re {^(\S+) (\S+)/tlpkg/texlive.tlpdb (-?\d+) (.*)$}
    foreach l $::out_log {
      if [regexp $re $l dum nm rp n d] {
        # dummy tag repository verification_code description
        # restore spaces and percent characters in nm and rp
        set nm [string map {"%20" " "} $nm]
        set nm [string map {"%25" "%"} $nm]
        set rp [string map {"%20" " "} $rp]
        set rp [string map {"%25" "%"} $rp]
        dict set repodict $nm "url" $rp
        dict set repodict $nm "vericode" $n
        dict set repodict $nm "veridescr" $d
      }
    }
  }
  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 && $::have_remote} {
      set s $::repos($nm)
      append s "\n[__ "Actual repository"]:\n"
      append s [dict get $repodict $nm "url"]
      $w.u$nm configure -text $s
    }
    if {[array size ::repos] > 1 && $nm ne $::repos($nm)} {
      pgrid [ttk::label $w.n$nm -text "($nm)"] \
        -sticky nw -row $rw -column 1
    }
    if $::have_remote {
      pgrid [ttk::label $w.v$nm -text \
                "verification: [dict get $repodict $nm "veridescr"]"] \
            -sticky nw -row $rw -column 2
    }
  }
} ; # show_repos

proc repos_commit {} {
  set changes 0
  # set repositories then add pinning if appropriate
  set new_repo [forward_slashify [.tlr.new get]]
  if {! [regexp {^\s*$} $new_repo]} {
    # repository entry widget non-empty: use it
    if {$::repos(main) ne $new_repo} {
      set ::repos(main) $new_repo
      set changes 1
    }
  }
  set had_contrib 0
  if $::toggle_contrib {
    set changes 1
    foreach nm [array names ::repos] {
      if {$::repos($nm) eq $::tlcontrib} {
        set had_contrib 1
        run_cmds [list "pinning remove $nm --all" \
                      "pinning remove $::repos($nm) --all"] 0
        vwait ::done_waiting
        array unset ::repos $nm
      }
    }
    if {! $had_contrib} {
      set ::repos(tlcontrib) $::tlcontrib
    }
  }
  if $changes {
    set_repos_in_tlmgr
    close_tlmgr
    start_tlmgr
    if {$::toggle_contrib && ! $had_contrib} {
      run_cmd_waiting "pinning add tlcontrib \"*\""
    }
  }
} ; # 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_and_display_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 {} {

  # dialog with
  # - popup menu of mirrors (parse tlpkg/installer/ctan-mirrors.pl)
  # - text entry box
  # - directory browser button
  # - ok and cancel buttons

  create_dlg .tlr .
  wm title .tlr [__ "Main Repository"]

  # wallpaper frame; see populate_main
  pack [ttk::frame .tlr.bg] -expand 1 -fill x

  pack [ttk::frame .tlr.info] -in .tlr.bg -expand 1 -fill x
  grid columnconfigure .tlr.info 1 -weight 1
  set row -1

  # current repository
  incr row
  pgrid [ttk::label .tlr.lcur -text [__ "Current:"]] \
      -in .tlr.info -row $row -column 0 -sticky w
  pgrid [ttk::label .tlr.cur -text $::repos(main)] \
      -in .tlr.info -row 0 -column 1 -sticky w
  # proposed new repository
  incr row
  pgrid [ttk::label .tlr.lnew -text [__ "New"]] \
      -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
  # 1. default remote repository
  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
  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]}
  ppack .tlr.browse -in .tlr.mirbuttons -side left -fill x

  ### add/remove tlcontrib ###
  ttk::label .tlr.contribt -text [__ "tlcontrib additional repository"] \
      -font bfont
  pack .tlr.contribt -in .tlr.bg -anchor w -padx 3 -pady [list 10 3]
  pack [ttk::label .tlr.contribl] -in .tlr.bg -anchor w -padx 3 -pady 3
  ttk::checkbutton .tlr.contribb -variable ::toggle_contrib
  pack .tlr.contribb -in .tlr.bg -anchor w -padx 3 -pady [list 3 10]
  set ::toggle_contrib 0
  set has_contrib 0
  foreach nm [array names ::repos] {
    if {$::repos($nm) eq $::tlcontrib} {
      set has_contrib 1
      set contrib_tag $nm
      break
    }
  }
  if $has_contrib {
    .tlr.contribl configure -text [__ "tlcontrib repository is included"]
    .tlr.contribb configure -text [__ "Remove tlcontrib repository"]
  } else {
    .tlr.contribl configure -text [__ "tlcontrib repository is not included"]
    .tlr.contribb configure -text [__ "Add tlcontrib repository"]
  }

  # 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 save_load_repo
  ppack .tlr.save -in .tlr.closebuttons -side right
  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 \
      {cancel_or_destroy .tlr.cancel .tlr}
  wm resizable .tlr 1 0
  place_dlg .tlr .
} ; # repository_dialog

### platforms

if {$::tcl_platform(platform) ne "windows"} {

  proc toggle_pl_marked {pl cl} {
    # toggle_pl_marked is triggered by a mouse click only in column #1.
    # 'fut'[ure] should get updated in ::platforms _and_ in .tlpl.pl.

    if {$cl ne "#1"} return
    if {$pl eq $::our_platform} {
      tk_messageBox -message \
          [__ "Cannot remove own platform %s" $::our_platform] \
          -parent .tlpl
      return
    }
    # $mrk: negation of current value of marked for $pl
    set m1 [expr {[dict get $::platforms $pl "fut"] ? 0 : 1}]
    dict set ::platforms $pl "fut" $m1
    set m0 [dict get $::platforms $pl "cur"]
    if {$m0 == $m1} {
      .tlpl.pl set $pl "sup" [mark_sym $m0]
    } else {
      .tlpl.pl set $pl "sup" "[mark_sym $m0] \u21d2 [mark_sym $m1]"
    }
    .tlpl.do state disabled
    dict for {p mrks} $::platforms {
      if {[dict get $mrks "fut"] ne [dict get $mrks "cur"]} {
        .tlpl.do state !disabled
        break
      }
    }
  } ; # toggle_pl_marked

  proc platforms_commit {} {
    set pl_add {}
    set pl_remove {}
    dict for {p pd} $::platforms {
      if {[dict get $pd "cur"] ne [dict get $pd "fut"]} {
        if {[dict get $pd "fut"]} {
          lappend pl_add $p
        } else {
          lappend pl_remove $p
        }
      }
    }
    if {[llength $pl_add] == 0 && [llength $pl_remove] == 0} return
    set cmds {}
    if {[llength $pl_add] > 0} {
      set cmd "platform add "
      append cmd [join $pl_add " "]
      lappend cmds $cmd
    }
    if {[llength $pl_remove] > 0} {
      set cmd "platform remove "
      append cmd [join $pl_remove " "]
      lappend cmds $cmd
    }
    run_cmds $cmds 1
    vwait ::done_waiting
    update_local_revnumbers
    collect_and_display_filtered

  } ; # platforms_do

  # the platforms dialog
  proc platforms_select {} {
    create_dlg .tlpl
    wm title .tlpl [__ "Platforms"]
    if $::plain_unix {wm attributes .tlpl -type dialog}

    # wallpaper frame
    pack [ttk::frame .tlpl.bg] -expand 1 -fill both

    # buttons
    pack [ttk::frame .tlpl.but] -in .tlpl.bg -side bottom -fill x
    ttk::button .tlpl.do -text [__ "Apply and close"] -command {
      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 state disabled
    ppack .tlpl.dont -in .tlpl.but -side right
    bind .tlpl <Escape> {.tlpl.dont invoke}

    # platforms treeview; do we need a scrollbar?
    pack [ttk::frame .tlpl.fpl] -in .tlpl.bg -fill both -expand 1
    ttk::treeview .tlpl.pl -columns {sup plat} -show headings \
        -height [dict size $::platforms] -yscrollcommand {.tlpl.plsb set}
    ppack .tlpl.pl -in .tlpl.fpl -side left -fill both -expand 1
    ttk::scrollbar .tlpl.plsb -orient vertical \
        -command {.tlpl.pl yview}
    ppack .tlpl.plsb -in .tlpl.fpl -side right -fill y -expand 1
    #.tlpl.pl heading sup -text ""
    .tlpl.pl column sup -width [expr {$::cw * 8}]
    .tlpl.pl heading plat -text [__ "platform"] -anchor w
    .tlpl.pl column plat -width [expr {$::cw * 20}]
    dict for {p mks} $::platforms {
      .tlpl.pl insert {} end -id $p -values \
          [list [mark_sym [dict get $mks "cur"]] $p]
    }

    # "#2" refers to the second column, with editable mark symbols
    bind .tlpl.pl <space> {toggle_pl_marked [.tlpl.pl focus] "#1"}
    bind .tlpl.pl <Return> {toggle_pl_marked [.tlpl.pl focus] "#1"}
    # only toggle when column is "sup" i.e. #1
    bind .tlpl.pl <ButtonRelease-1> \
        {toggle_pl_marked \
             [.tlpl.pl identify item %x %y] \
             [.tlpl.pl identify column %x %y]}

    wm resizable .tlpl 0 1
    place_dlg .tlpl .
  } ; # platforms_select

} ; # $::tcl_platform(platform) ne "windows"

##### restore from backup #####

# This is currently rather dangerous.
# ::do_restore is set to 0 or 1 near the top of this source.
# This code, currently disbled, has not been tested in a while.

if $::do_restore {
# dictionary of backups, with mapping to list of available revisions
set bks {}

proc enable_restore {y_n} {
  set st [expr {$y_n ? !disabled : disabled}]
  .tlbk.bklist state $st
  .tlbk.all state $st
  .tlbk.done state $st
} ; # enable_restore

proc finish_restore {} {
  vwait ::done_waiting
  # now log_widget_finish should have run and re-enabled its close button.
  # We won't wait for the log dialog to close, but we will
  # update the packages display in the main window.
  update_local_revnumbers
  collect_and_display_filtered
} ; # finish_restore

proc restore_all {} {
  run_cmd "restore --force --all" 1
  finish_restore
} ; # restore_all

proc restore_this {} {
  set id [.tlbk.bklist focus]
  if {$id eq {}} return
  set r [.tlbk.bklist set $id rev]
  if {$r eq {}} return
  set p [.tlbk.bklist set $id pkg]
  if {$p eq {}} {
    set id [.tlbk.bklist parent $id]
    if {$id ne {}} {set p [.tlbk.bklist set $id pkg]}
  }
  if {$p eq {}} return
  set ans [tk_messageBox -message [__ "Restore %s to revision %s?" $p $r] \
               -type okcancel -parent .tlbk]
  if {$ans ne {ok}} return
  run_cmd "restore --force $p $r" 1
  finish_restore
} ; # restore_this

proc bklist_callback_click {x y} {
  set cl [.tlbk.bklist identify column $x $y]
  if {$cl eq "#0"} return
  set id [.tlbk.bklist identify item $x $y]
  .tlbk.bklist focus $id
  restore_this
} ; # bklist_callback_click

proc restore_backups_dialog {} {
  run_cmd_waiting "option autobackup"
  set re {autobackup\t(.*)$}
  set abk 0
  foreach l $::out_log {
    if [regexp $re $l m abk] break
  }
  if {$abk == 0} {
    tk_messageBox -message [__ "No backups configured"]
    return
  }
  run_cmd_waiting "option backupdir"
  set re {backupdir\t(.*)$}
  set bdir ""
  foreach l $::out_log {
    if [regexp $re $l m bdir] break
  }
  if {$bdir eq ""} {
    tk_messageBox -message [__ "No backup directory defined"]
    return
  }
  set bdir [file join [exec kpsewhich -var-value SELFAUTOPARENT] $bdir]
  if {! [file isdirectory $bdir]} {
    tk_messageBox -message [__ "Backup directory %s does not exist" $bdir]
    return
  }
  set pwd0 [pwd]
  cd $bdir
  set backups [lsort [glob -nocomplain *.tar.xz]]
  if {[llength $backups] == 0} {
    tk_messageBox -message [__ "No backups found in $bdir"]
    return
  }
  # dictionary of backups; package => list of available revisions
  set ::bks [dict create]
  set re {^(.*)\.r(\d+)\.tar\.xz$}
  foreach b $backups {
    if [regexp $re $b m pk r] {
      if {$pk in [dict keys $::bks]} {
        dict lappend ::bks $pk $r
      } else {
        dict set ::bks $pk [list $r]
      }
    }
  }
  if {[llength [dict keys $::bks]] == 0} {
    tk_messageBox -message [__ "No packages in backup directory %s" $bdir]
    return
  }
  # invert sort order of revisions for each package
  foreach pk [dict keys $::bks] {
    dict set ::bks $pk [lsort -decreasing [dict get $::bks $pk]]
  }
  toplevel .tlbk -class Dialog
  wm withdraw .tlbk
  wm transient .tlbk .
  wm title .tlbk [__ "Restore from backup"]
  if $::plain_unix {wm attributes .tlbk -type dialog}

  # wallpaper frame; see populate_main
  pack [ttk::frame .tlbk.bg] -expand 1 -fill x

  # the displayed list of backed-up packages
  pack [ttk::frame .tlbk.fbk] -in .tlbk.bg -side top
  # package names not in #0, because we want to trigger actions
  # without automatically opening a parent.
  pack [ttk::treeview .tlbk.bklist -columns {"pkg" "rev"} \
            -show {tree headings} -height 8 -selectmode browse \
            -yscrollcommand {.tlbk.bkvsb set}] -in .tlbk.fbk -side left
  pack [ttk::scrollbar .tlbk.bkvsb -orient vertical -command \
            {.tlbk.bklist yview}] -in .tlbk.fbk -side right -fill y

  .tlbk.bklist heading "pkg" -text [__ "Package"] -anchor w
  .tlbk.bklist heading "rev" -text [__ "Revision"] -anchor w

  .tlbk.bklist column "#0" -width [expr {$::cw * 2}]
  .tlbk.bklist column "pkg" -width [expr {$::cw * 25}]
  .tlbk.bklist column "rev" -width [expr {$::cw * 12}]

  # fill .tlbk.bklist. Use the last available revision.
  # Remember that $::bks is sorted and revisions inversely sorted
  # id must be unique in the entire list: rev does not qualify
  # must as well use $id for package items too
  set id 0
  dict for {pk rlist} $::bks {
    # package
    .tlbk.bklist insert {} end -id [incr id] \
        -values [list $pk [lindex $rlist 0]] -open 0
    set l [llength $rlist]
    # additional revisions
    if {$l > 1} {
      set idparent $id
      for {set i 1} {$i<$l} {incr i} {
        .tlbk.bklist insert $idparent end -id [incr id] \
            -values [list "" [lindex $rlist $i]]
      }
    }
  }

  # since we can only restore one non-last revision at a time, it is better
  # to only show one non-last revision at a time too.
  bind .tlbk.bklist <<TreeviewOpen>> {
    foreach p [.tlbk.bklist children {}] {
      if {$p ne [.tlbk.bklist focus]} {
        .tlbk.bklist item $p -open 0
      }
    }
  }
  # restoring a single package
  bind .tlbk.bklist <<RightClick>> {bklist_callback_click %x %y}
  bind .tlbk.bklist <space> restore_this

  # frame with buttons
  pack [ttk::frame .tlbk.fbut] -in .tlbk.bg -side bottom -fill x
  ppack [ttk::button .tlbk.all -text [__ "Restore all"] -command restore_all] \
        -in .tlbk.fbut -side right
  ppack [ttk::button .tlbk.done -text [__ "Close"] -command {
    end_dlg "" .tlbk}] -in .tlbk.fbut -side right

  place_dlg .tlbk .
  wm resizable .tlbk 0 0
  tkwait .tlbk
} ; # restore_backups_dialog

} ; # if $::do_restore

##### Main window and supporting procs and callbacks ##################

##### package-related #####

### updating

proc update_tlmgr_w32 {} {
  close_tlmgr
  # don't try pipes or capturing, because of
  # tlmgr's acrobatics with nested command prompts
  wm iconify .
  exec -ignorestderr cmd /k "start cmd /k tlmgr update --self"
  exec $::progname &
  destroy .
}

proc update_tlmgr {} {
  if {! $::need_update_tlmgr} {
    tk_messageBox -message [__ "Nothing to do!"]
    return
  }
  if {$::tcl_platform(platform) eq "windows"} {
    update_tlmgr_w32
    return
  }
  run_cmd "update --self" 1
  vwait ::done_waiting
  # tlmgr restarts itself automatically
  update_local_revnumbers
  .topfr.linfra configure -text \
      "tlmgr: r[dict get $::pkgs texlive.infra localrev]"
  collect_and_display_filtered
} ; # update_tlmgr

proc update_all {} {
  set updated_tlmgr 0
  if $::need_update_tlmgr {
    if {$::tcl_platform(platform) eq "windows"} {
      return ; # just to be sure; 'update all' button should be disabled
    }
    run_cmd "update --self" 1
    vwait ::done_waiting
    # tlmgr restarts itself automatically
    update_local_revnumbers
    set updated_tlmgr 1
  }
  # tlmgr restarts itself automatically
  #  tk_messageBox -message [__ "Update self first!"]
  #  return
  if {! $::n_updates && !$updated_tlmgr} {
    tk_messageBox -message [__ "Nothing to do!"]
    return
  } elseif $::n_updates {
    run_cmd "update --all" 1
    vwait ::done_waiting
    update_local_revnumbers
  }
  collect_and_display_filtered
} ; # update_all

### doing something with some packages

proc pkglist_from_option {opt {pk ""}} {
  if {$opt eq "marked"} {
    set pks {}
    dict for {p props} $::pkgs {
      if [dict get $props "marked"] {lappend pks $p}
    }
  } elseif {$opt eq "focus"} {
    set p [.pkglist focus]
    if {$p ne {}} {lappend pks $p}
  } elseif {$opt eq "name"} {
    lappend pks $pk
  }
  return $pks
} ; # pkglist_from_option

proc install_pkgs {sel_opt {pk ""}} {
  set pks [pkglist_from_option $sel_opt $pk]
  # check whether packages are installed
  set pre_installed {}
  set todo {}
  foreach p $pks {
    if {[dict get $::pkgs $p localrev] > 0} {
      lappend pre_installed $p
    } else {
      lappend todo $p
    }
  }
  if {[llength $todo] == 0} {
    tk_messageBox -message [__ "Nothing to do!"] -type ok -icon info
    return
  }
  run_cmd_waiting "install --dry-run $todo"
  # check whether dependencies are going to be installed
  set r {^(\S+)\s+i\s}
  set deps {}
  foreach l $::out_log {
    if {[regexp $r $l d p] && $p ni $pks} {
      lappend deps $p
    }
  }
  if {[llength $deps] > 0} {
    set ans \
        [any_message \
             [__ "Also installing dependencies\n\n%s" $deps] \
             "okcancel"]
    if {$ans eq "cancel"} return
  }
  run_cmd "install $todo" 1
  vwait ::done_waiting
  if {[llength $pre_installed] > 0} {
    lappend ::err_log [__ "Already installed: %s" $pre_installed]
    show_err_log
  }
  update_local_revnumbers
  if {$sel_opt eq "marked"} {mark_all 0}
  collect_and_display_filtered
} ; # install_pkgs

proc update_pkgs {sel_opt {pk ""}} {
  set pks [pkglist_from_option $sel_opt $pk]
  # check whether packages are installed
  set not_inst {}
  set uptodate {}
  set todo {}
  foreach p $pks {
    set lv [dict get $::pkgs $p localrev]
    if {[dict get $::pkgs $p localrev] == 0} {
      lappend not_inst $p
    } else {
      set rv [dict get $::pkgs $p remoterev]
      if {$lv >= $rv} {
        lappend uptodate $p
      } else {
        lappend todo $p
      }
    }
  }
  if {[llength $todo] == 0} {
    tk_messageBox -message [__ "Nothing to do!"] -type ok -icon info
    return
  }
  run_cmd_waiting "update --dry-run $todo"
  # check whether dependencies are going to be updated
  set r {^(\S+)\s+u\s}
  set deps {}
  foreach l $::out_log {
    if {[regexp $r $l d p] && $p ni $pks} {
      lappend deps $p
    }
  }
  if {[llength $deps] > 0} {
    set ans [any_message [__ "Also updating dependencies\n\n%s?" $deps] \
       "yesnocancel"]
    switch $ans {
      "cancel" return
      "yes" {run_cmd "update $todo" 1}
      "no" {
        set deps {}
        run_cmd_waiting "update --dry-run --no-depends $todo"
        foreach l $::out_log {
          if {[regexp $r $l u p] && $p ni $pks} {
            lappend deps $p
          }
        }
        if {[llength $deps] > 0} {
          set ans [any_message \
              [__ "Updating some dependencies %s anyway. Continue?" $deps] \
                       "okcancel"]
          if {$ans eq "cancel"} return
        }
        run_cmd "update --no-depends $todo" 1
      }
    }
  } else {
    run_cmd "update $todo" 1
  }
  vwait ::done_waiting
  if {[llength $not_inst] > 0} {
    lappend ::err_log [__ "Skipped because not installed: %s" $not_inst]
  }
  if {[llength $uptodate] > 0} {
    lappend ::err_log [__ "Skipped because already up to date: %s" $uptodate]
  }
  if {[llength $not_inst] > 0 || [llength $uptodate] > 0} {
    show_err_log
  }
  update_local_revnumbers
  if {$sel_opt eq "marked"} {mark_all 0}
  collect_and_display_filtered
} ; # update_pkgs

proc remove_pkgs {sel_opt {pk ""}} {
  set pks [pkglist_from_option $sel_opt $pk]
  # check whether packages are installed
  set not_inst {}
  set todo {}
  foreach p $pks {
    if {[dict get $::pkgs $p localrev] > 0} {
      lappend todo $p
    } else {
      lappend not_inst $p
    }
  }
  run_cmd_waiting "remove --dry-run $todo"
  # check whether dependencies are going to be removed
  set r {^(\S+)\s+d\s}
  set deps {}
  foreach l $::out_log {
    if {[regexp $r $l d p] && $p ni $pks} {
      lappend deps $p
    }
  }
  if {[llength $todo] == 0} {
    tk_messageBox -message [__ "Nothing to do!"] -type ok -icon info
    return
  }
  if {[llength $deps] > 0} {
    set ans [any_message [__ "Also remove dependencies\n\n%s?" $deps] \
                "yesnocancel"]
    switch $ans {
      "cancel" return
      "yes" {run_cmd "remove $todo" 1}
      "no" {
        set deps {}
        run_cmd_waiting "remove --dry-run --no-depends $todo"
        foreach l $::out_log {
          if {[regexp $r $l d p] && $p ni $pks} {
            lappend deps $p
          }
        }
        if {[llength $deps] > 0} {
          set ans [any_message \
              [__ "Removing some dependencies %s anyway. Continue?" $deps] \
                       "okcancel"]
          if {$ans eq "cancel"} return
        }
        run_cmd "remove --no-depends $todo" 1
      }
    }
  } else {
    run_cmd "remove $todo" 1
  }
  vwait ::done_waiting
 if {[llength $not_inst] > 0} {
    lappend ::err_log "Skipped because not installed: $not_inst"
    show_err_log
  }
  update_local_revnumbers
  if {$sel_opt eq "marked"} {mark_all 0}
  collect_and_display_filtered
} ; # remove_pkgs

# restoring packages is a rather different story, controlled by the
# contents of the backup directory. see further up.

##### varous callbacks #####

proc restart_self {} {
  do_debug "trying to restart"
  if {$::progname eq ""} {
    tk_messageBox -message "progname not found; not restarting"
    return
  }
  close_tlmgr
  exec $::progname &
  # on windows, it may take several seconds before
  # the old tlshell disappears.
  # oh well, windows is still windows....
  destroy .
} ; # restart_self

proc toggle_marked_pkg {itm cl} {
  # toggle_marked_pkg is triggered by a mouse click only in column #1.
  # 'marked' should get updated in ::pkgs, ::filtered and in .pkglist.

  if {$cl ne "#1"} return
  # $mrk: negation of current value of marked for $itm
  set mrk [expr {[dict get $::pkgs $itm "marked"] ? 0 : 1}]
  dict set ::pkgs $itm "marked" $mrk
  set m [mark_sym $mrk]
  dict set ::filtered $itm [lreplace [dict get $::filtered $itm] 0 0 $m]
  .pkglist set $itm mk $m
} ; # toggle_marked_pkg

proc mark_all {mrk} {
  foreach nm [dict keys $::pkgs] {
    dict set ::pkgs $nm "marked" $mrk
  }
  set m [mark_sym $mrk]
  foreach nm [dict keys $::filtered] {
    dict set ::filtered $nm [lreplace [dict get $::filtered $nm] 0 0 $m]
  }
  foreach nm [.pkglist children {}] {
    .pkglist set $nm mk $m
  }
  # alternatively: regenerate ::filtered and .pkglist from ::pkgs
} ; # mark_all

##### package popup #####

proc do_package_popup_menu {x y X Y} {
  # as focused item, the identity of the clicked item will be
  # globally available:
  .pkglist focus [.pkglist identify item $x $y]
  # recreate menu with only applicable items
  set lr [dict get $::pkgs [.pkglist focus] "localrev"]
  set rr [dict get $::pkgs [.pkglist focus] "remoterev"]
  .pkg_popup delete 0 end

  .pkg_popup add command -label [__ "Info"] -command {
    run_cmd "info [.pkglist focus]" 1; vwait ::done_waiting
  }
  if {$::have_remote && ! $::need_update_tlmgr && $rr > 0 && $lr == 0} {
    .pkg_popup add command -label [__ "Install"] -command {
      install_pkgs "focus"
    }
  }
  if {$::have_remote && ! $::need_update_tlmgr && $lr > 0 && $rr > $lr} {
    .pkg_popup add command -label [__ "Update"] -command {
      update_pkgs "focus"
    }
  }
  if {$lr > 0} {
    .pkg_popup add command -label [__ "Remove"] -command {
      remove_pkgs "focus"
    }
  }
  .pkg_popup post [expr {$X - 2}] [expr {$Y - 2}]
  focus .pkg_popup
} ; # do_package_popup_menu

proc set_paper {p} {
  run_cmd "paper paper $p" 1
}

#### gui options ####

proc set_language {l} {
  set ::lang $l
  load_translations
  rebuild_interface
  if {! [save_config_var "gui-lang" $::lang]} {
    tk_messageBox -message [__"Cannot save language setting"]
  }
}

proc set_fontscale {s} {
  set ::tkfontscale $s
  redo_fonts
  rebuild_interface
  if {[dict get $::pkgs texlive.infra localrev] >= 54766} {
    if {! [save_config_var "tkfontscale" $::tkfontscale]} {
      tk_messageBox -message [__"Cannot save font scale setting"]
    }
  }
}

proc zoom {n} {
  if {$n <= 0} {set n 1}
  set_fontscale [expr {$n*$::tkfontscale}]
}

##### running external commands #####

# For capturing an external command, we need a separate output channel,
# but we reuse ::out_log.
# stderr is bundled with stdout so ::err_log should stay empty.
proc read_capture {} {
  set l "" ; # will contain the line to be read
  if {([catch {chan gets $::capt l} len] || [chan eof $::capt])} {
    catch {chan close $::capt}
    log_widget_finish
    set ::done_waiting 1
  } elseif {$len >= 0} {
    lappend ::out_log $l
    log_widget_add $l
  }
}; # read_capture

proc run_external {cmd mess} {
  set ::out_log {}
  set ::err_log {}
  lappend ::out_log $mess
  unset -nocomplain ::done_waiting
  # 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
  chan event $::capt readable read_capture
  log_widget_init
}

proc about_cmd {} {
  set msg "\u00a9 2017-2020 Siep Kroonenberg\n\n"
  append msg [__ "GUI interface for TeX Live Manager\nImplemented in Tcl/Tk"]
  tk_messageBox -message $msg
}

proc show_help {} {
  set ::env(NOPERLDOC) 1
  long_message [exec tlmgr --help] ok
}

## arbitrary commands: no way to know what data have to be updated
#proc custom_command {} {
#  create_dlg .tlcust .
#  wm title .tlcust [__ "Custom command"]
#  pack [ttk::frame .tlcust.bg] -expand 1 -fill x
#
#  ppack [ttk::entry .tlcust.e] \
#      -in .tlcust.bg -side left -fill x -expand 1
#  ppack [ttk::button .tlcust.b -text [__ "Go"] -command run_entry] \
#      -in .tlcust.bg -side left
#  bind .tlcust.e <Return> run_entry
#  bind .tlcust <Escape> {end_dlg "" .tlcust}
#  wm .tlcust resizable 1 0
#  place_dlg .tlcust .
#}

##### main window #####

proc try_loading_remote {} {
  if {[possible_repository $::repos(main)]} {
    get_packages_info_remote
    collect_and_display_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 .

  wm title . "TeX Live Shell"

  ## menu ##

  # dummy empty menu to replace the real menu .mn in disabled states.
  # the "File" cascade should ensure that the dummy menu
  # occupies the same vertical space as the real menu.
  menu .mn_empty
  .mn_empty add cascade -label [__ "File"] -menu .mn_empty.file -underline 0
  if $::plain_unix {
    .mn_empty configure -borderwidth 1
    .mn_empty configure -background $::default_bg
  menu .mn_empty.file
  }
  # real menu
  menu .mn
  . configure -menu .mn
  if $::plain_unix {
    .mn configure -borderwidth 1
    .mn configure -background $::default_bg

    # plain_unix: avoid a possible RenderBadPicture error on quitting
    # when there is a menu.
    # 'send' bypasses the bug by changing the shutdown sequence.
    # 'tk appname <something>' restores 'send'.
    bind . <Destroy> {
      catch {tk appname appname}
    }
  }

  # 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..."]}
  .mn.act add command -label [__ "Regenerate formats"] -command \
      {run_external "fmtutil-sys --all" [__ "Rebuilding formats..."]}
  .mn.act add command -label [__ "Regenerate fontmaps"] -command \
      {run_external "updmap-sys" [__ "Rebuilding fontmap files..."]}
  #.mn.act add command -label [__ "Custom command"] -command custom_command

  .mn add cascade -label [__ "Options"] -menu .mn.opt -underline 0

  menu .mn.opt
  set inx -1
  incr inx
  .mn.opt add command -label "[__ "Repositories"] ..." \
      -command repository_dialog

  incr inx
  .mn.opt add cascade -label [__ "Paper ..."] -menu .mn.opt.paper
  incr inx
  menu .mn.opt.paper
  foreach p [list A4 letter] {
    .mn.opt.paper add command -label $p -command \
        "set_paper [string tolower $p]"
  }

  if {[llength $::langs] > 1} {
    incr inx
    .mn.opt add cascade -label [__ "GUI language"] \
        -menu .mn.opt.lang
    menu .mn.opt.lang
    foreach l [lsort $::langs] {
      if {$l eq $::lang} {
        set mlabel "$l *"
      } else {
        set mlabel $l
      }
      .mn.opt.lang add command -label $mlabel \
          -command "set_language $l"
    }
  }

  incr inx
  .mn.opt add cascade -label [__ "GUI font scaling"] \
      -menu .mn.opt.fscale
  menu .mn.opt.fscale
  .mn.opt.fscale add command -label \
      "[__ "Current"]:  [format {%.2f} $::tkfontscale]"
  foreach s {0.6 0.8 1 1.2 1.6 2 2.5 3 3.8 5 6 7.5 9} {
    .mn.opt.fscale add command -label $s -command "set_fontscale $s"
  }

  # browser-style keyboard shortcuts for scaling
  bind . <Control-KeyRelease-minus> {zoom 0.8}
  bind . <Control-KeyRelease-equal> {zoom 1.25}
  bind . <Control-Shift-KeyRelease-equal> {zoom 1.25}
  bind . <Control-KeyRelease-plus> {zoom 1.25}
  bind . <Control-KeyRelease-0> {set_fontscale 1}
  if {$::tcl_platform(os) eq "Darwin"} {
    bind . <Command-KeyRelease-minus> {zoom 0.8}
    bind . <Command-KeyRelease-equal> {zoom 1.25}
    bind . <Command-Shift-KeyRelease-equal> {zoom 1.25}
    bind . <Command-KeyRelease-plus> {zoom 1.25}
    bind . <Command-KeyRelease-0> {set_fontscale 1}
  }


  if {$::tcl_platform(platform) ne "windows"} {
    incr inx
    set ::inx_platforms $inx
    .mn.opt add command -label "[__ "Platforms"] ..." -command platforms_select
  }

  .mn add cascade -label [__ "Help"] -menu .mn.help -underline 0
  menu .mn.help
  .mn.help add command -label [__ "About"] -command about_cmd
  .mn.help add command -label [__ "tlmgr help"] -command show_help

  ## menu end

  # wallpaper frame
  # it is possible to set a background color for a toplevel, but on
  # MacOS I did not find a way to determine the right $::default_bg
  # color. Instead, all toplevels are given a wallpaper ttk::frame
  # with the default ttk::frame color, which seems to work
  # everywhere.
  pack [ttk::frame .bg] -expand 1 -fill both
  .bg configure -padding 5

  # bottom of main window
  pack [ttk::frame .endbuttons] -in .bg -side bottom -fill x
  ttk::label .busy -textvariable ::busy -font TkHeadingFont -anchor w
  ppack .busy -in .endbuttons -side left
  ppack [ttk::button .q -text [__ Quit] -command {destroy .}] \
      -in .endbuttons -side right
  ppack [ttk::button .r -text [__ "Restart self"] -command restart_self] \
      -in .endbuttons -side right
  ppack [ttk::button .t -text [__ "Restart tlmgr"] \
             -command {close_tlmgr; start_tlmgr}] \
      -in .endbuttons -side right
  ttk::button .showlogs -text [__ "Show logs"] -command show_logs
  ppack .showlogs -in .endbuttons -side right

  # top of main window
  ppack [ttk::frame .topf] -in .bg -side top -anchor w -fill x

  if $::ddebug {
    ppack [ttk::label .topf.test -text [info nameofexecutable]]
    ppack [ttk::label .topf.test2 -text $::progname]
    ppack [ttk::label .topf.test3 -text \
           [string range $::env(PATH) 0 59]]
  }

  # left frame
  pack [ttk::frame .topfl] -in .topf -side left -anchor nw

  # subframe for repositories, to be filled by show_repos
  pack [ttk::frame .toprepo] -in .topfl -side top -anchor w

  # 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
  ttk::label .topfll.luptodate -text [__ "Unknown"] -anchor w
  pgrid .topfll.luptodate -row 2 -column 1 -sticky w

  ttk::label .topfll.llcmd -text [__ "Last tlmgr command:"] -anchor w \

  pgrid .topfll.llcmd -row 3 -column 0 -sticky w
  ttk::label .topfll.lcmd -textvariable ::last_cmd \
      -wraplength [expr {60*$::cw}] -justify left -anchor w
  pgrid .topfll.lcmd -row 3 -column 1 -sticky w

  # 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
  }
  pack [ttk::label .topfr.lroot] -side top -anchor e
  .topfr.lroot configure -text [__ "Root at %s" $::instroot]
  pack [ttk::label .topfr.linfra] -side top -anchor e
  pack [ttk::label .topfr.lshell] -side top -anchor e

  pack [ttk::separator .sp -orient horizontal] \
      -in .bg -side top -fill x -pady 6

  # package list
  ttk::label .lpack -text [__ "Package list"] -font TkHeadingFont -anchor w
  pack .lpack -in .bg -side top -padx 3 -pady [list 15 3] -fill x

  # controlling package list
  ttk::frame .pkfilter
  pack .pkfilter -in .bg -side top -fill x
  grid columnconfigure .pkfilter 3 -weight 1
  # column #3 is empty, but that is allright
  # filter on status: inst, all, upd
  ttk::label .pkfilter.lstat -font TkHeadingFont -text [__ "Status"]
  ttk::radiobutton .pkfilter.inst -text [__ "Installed"] -value inst \
      -variable ::stat_opt -command collect_and_display_filtered
  ttk::radiobutton .pkfilter.alls -text [__ "All"] -value all \
      -variable ::stat_opt -command {
        if {! $::have_remote} get_packages_info_remote
        collect_and_display_filtered
      }
  ttk::radiobutton .pkfilter.upd -text [__ "Updatable"] -value upd \
      -variable ::stat_opt -command {
        if {! $::have_remote} get_packages_info_remote
        collect_and_display_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
  pgrid .pkfilter.upd -column 0 -row 3 -sticky w

  # filter on detail level: all, coll, schm
  ttk::label .pkfilter.ldtl -font TkHeadingFont -text [__ "Detail >> Global"]
  ttk::radiobutton .pkfilter.alld -text [__ All] -value all \
      -variable ::dtl_opt -command collect_and_display_filtered
  ttk::radiobutton .pkfilter.coll -text [__ "Collections and schemes"] \
      -value coll -variable ::dtl_opt -command collect_and_display_filtered
  ttk::radiobutton .pkfilter.schm -text [__ "Only schemes"] -value schm \
      -variable ::dtl_opt -command collect_and_display_filtered
  pgrid .pkfilter.ldtl -column 1 -row 0 -sticky w
  pgrid .pkfilter.alld -column 1 -row 1 -sticky w
  pgrid .pkfilter.coll -column 1 -row 2 -sticky w
  pgrid .pkfilter.schm -column 1 -row 3 -sticky w

  # marks
  grid [ttk::button .mrk_all -text [__ "Mark all"] -command {mark_all 1}] \
      -in .pkfilter -column 2 -row 1 -sticky w -padx {50 3} -pady 3
  grid [ttk::button .mrk_none -text [__ "Mark none"] -command {mark_all 0}] \
      -in .pkfilter -column 2 -row 2 -sticky w -padx {50 3} -pady 3

  # actions
  set rw -1
  incr rw
  ttk::button .mrk_inst -text [__ "Install marked"] -command {
      install_pkgs "marked"}
  pgrid .mrk_inst -in .pkfilter -column 4 -row $rw -sticky ew
  incr rw
  ttk::button .mrk_upd -text [__ "Update marked"] -command {
    update_pkgs "marked"}
  pgrid .mrk_upd -in .pkfilter -column 4 -row $rw -sticky ew
  incr rw
  ttk::button .mrk_rem -text [__ "Remove marked"] -command {
    remove_pkgs "marked"}
  pgrid .mrk_rem -in .pkfilter -column 4 -row $rw -sticky ew
  if $::do_restore {
    incr rw
    ttk::button .mrk_rest -text "[__ "Restore from backup"] ..." -command \
        restore_backups_dialog
    pgrid .mrk_rest -in .pkfilter -column 4 -row $rw -sticky ew
  }
  incr rw
  ttk::button .upd_tlmgr -text [__ "Update tlmgr"] -command update_tlmgr
  pgrid .upd_tlmgr -in .pkfilter -column 4 -row $rw -sticky ew
  incr rw
  ttk::button .upd_all -text [__ "Update all"] -command update_all
  pgrid .upd_all -in .pkfilter -column 4 -row $rw -sticky ew

  # search interface; no new row
  grid [ttk::frame .pksearch] -in .pkfilter -row $rw \
      -column 0 -columnspan 4 -sticky w
  ppack [ttk::label .pksearch.l \
             -text [__ "Search"]] -side left
  pack [ttk::entry .pksearch.e -width 30] -side left -padx {3 0} -pady 3
  ppack [ttk::radiobutton .pksearch.n -variable ::search_desc \
            -value 0 -text [__ "By name"]] -side left
  ppack [ttk::radiobutton .pksearch.d -variable ::search_desc \
             -value 1 -text [__ "By name and description"]] -side left
  bind .pksearch.e <KeyRelease> display_packages_info
  bind .pksearch.n <ButtonRelease> {set ::search_desc 0; display_packages_info}
  bind .pksearch.d <ButtonRelease> {set ::search_desc 1; display_packages_info}

  # packages list itself
  pack [ttk::frame .fpkg] -in .bg -side top -fill both -expand 1
  ttk::treeview .pkglist -columns \
      {mk name localrev remoterev shortdesc} \
      -show headings -height 8 -selectmode extended \
      -yscrollcommand {.pkvsb set}
  .pkglist heading mk -text "" -anchor w
  .pkglist heading name -text [__ "Name"] -anchor w
  .pkglist heading localrev -text [__ "Local rev. (ver.)"] -anchor w
  .pkglist heading remoterev -text [__ "Remote rev. (ver.)"] -anchor w
  .pkglist heading shortdesc -text [__ "Description"] -anchor w
  .pkglist column mk -width [expr {$::cw * 3}] -stretch 0
  .pkglist column name -width [expr {$::cw * 25}] -stretch 1
  .pkglist column localrev -width [expr {$::cw * 18}] -stretch 0
  .pkglist column remoterev -width [expr {$::cw * 18}] -stretch 0
  .pkglist column shortdesc -width [expr {$::cw * 50}] -stretch 1

  ttk::scrollbar .pkvsb -orient vertical -command {.pkglist yview}
  ppack .pkglist -in .fpkg -side left -expand 1 -fill both
  ppack .pkvsb -in .fpkg -side left -fill y

  # "#1" refers to the first column (with mark symbols)
  bind .pkglist <space> {toggle_marked_pkg [.pkglist focus] "#1"}
  bind .pkglist <Return> {toggle_marked_pkg [.pkglist focus] "#1"}
  # only toggle when column is "mk" i.e. #1
  bind .pkglist <ButtonRelease-1> {toggle_marked_pkg [
      .pkglist identify item %x %y] [.pkglist identify column %x %y]}

  menu .pkg_popup ; # entries added on-the-fly
  bind .pkglist <<RightClick>> {do_package_popup_menu %x %y %X %Y}
  if $::plain_unix {
    bind .pkg_popup <Leave> {.pkg_popup unpost}
  }

  wm protocol . WM_DELETE_WINDOW {cancel_or_destroy .q .}
  wm resizable . 1 1
  wm state . normal
  raise .
}

# to be invoked at initialization and after a font scaling change
proc rebuild_interface {} {
  foreach c [winfo children .] {catch {destroy $c}}

  # for busy/idle indicators
  set ::busy [__ "Idle"]
  populate_main
  # and now redisplay all data
  if {$::tcl_platform(platform) eq "windows"} {
    .topfr.ladmin configure -text \
        [expr {$::multiuser ? [__ "Multi-user"] : [__ "Single-user"]}]
  }
  # svns for  tlmgr and tlshell
  .topfr.linfra configure -text \
      "tlmgr: r[dict get $::pkgs texlive.infra localrev]"
  .topfr.lshell configure -text \
      "tlshell: r[dict get $::pkgs tlshell localrev]"
  show_repos
  display_packages_info
  display_updated_globals
  if {$::tcl_platform(platform) eq "windows"} {wm deiconify .}
}

##### initialize ######################################################

proc initialize {} {
  # seed random numbers
  expr {srand([clock seconds])}

  # directory for temp files
  set attemptdirs {}
  foreach tmp {TMPDIR TEMP TMP} {
    if {$tmp in [array names ::env]} {
      lappend attemptdirs $::env($tmp)
    }
  }
  if {$::tcl_platform(platform) eq "unix"} {
    lappend attemptdirs "/tmp"
  }
  lappend attemptdirs [pwd]
  set ::tempsub ""
  foreach tmp $attemptdirs {
    if {$::tcl_platform(platform) eq "windows"} {
      regsub -all {\\} $tmp {/} tmp
    }
    if {[file isdirectory $tmp]} {
      # no real point in randomizing directory name itself
      if {$::tcl_platform(platform) eq "unix"} {
        set ::tempsub [file join $tmp $::env(USER)]
      } else {
        set ::tempsub [file join $tmp $::env(USERNAME)]
      }
      append ::tempsub "-tlshell"
      if {! [catch {file mkdir $::tempsub}]} {break} ;# success
    }
  }

  if {$::tempsub eq "" || [file isdirectory $::tempsub] == 0} {
    error "Cannot create directory for temporary files"
  }
  # temp file for stderr
  set ::err_file [maketemp ".err_tlshl"]

  # logfile
  if $::ddebug {
    set fname [file join $::tempsub \
      [clock format [clock seconds] -format {%H:%M}]]
    set ::flid [open $fname w]
  }

  # store language in tlmgr configuration
  save_config_var "gui-lang" $::lang

  # in case we are going to do something with json:
  # add json subdirectory to auto_path, but at low priority
  # since the tcl/tk installation may already have a better implementation.
  # Trust kpsewhich to find out own directory and bypass symlinks.
  #set tlsdir [file dirname [exec kpsewhich -format texmfscripts tlshell.tcl]]
  #lappend ::auto_path [file join $tlsdir "json"]

  populate_main

  # testing writablilty earlier led to sizing problems
  if {! [dir_writable $::instroot]} {
    set ans [tk_messageBox -type yesno -icon warning -message \
         [__ "%s is not writable. You can probably not do much.
  Are you sure you want to continue?" $::instroot]]
    if {$ans ne "yes"} {exit}
  }

  start_tlmgr {*}$::argv
  if {$::tcl_platform(platform) eq "windows"} {
    run_cmd_waiting "option multiuser"
    set ::multiuser 0
    foreach l $::out_log {
      if [regexp {^\s*multiuser\s+([01])\s*$} $l d ::multiuser] break
    }
  }
  get_packages_info_local
  collect_filtered
  get_repos_from_tlmgr
}; # initialize

initialize