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

#!/usr/bin/env wish

# Copyright 2017 Siep Kroonenberg

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

package require Tk

# searchpath:
# windows: most scripts run via [w]runscript, which adjusts the searchpath
# for the current process.
# unix/linux: 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 will disentangle symlinks.

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

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

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

# no bold text for messages
option add *Dialog.msg.font TkDefaultFont userDefault
set plain_unix 0
if {$::tcl_platform(platform) eq "unix" && \
        $::tcl_platform(os) ne "Darwin"} {
  set plain_unix 1
}

set test {}
set ddebug 0
proc do_debug {s} {
  if {$::ddebug} {
    puts stderr $s
    # catch in case the widget concerned has not yet been created
    catch {.lw.dbg.tx configure -state normal; .lw.dbg.tx insert end "$s\n"}
  }
}

proc get_stacktrace {} {
  set level [info level]
  set s ""
  for {set i 1} {$i < $level} {incr i} {
    append s [format "Level %u: %s\n" $i [info level $i]]
  }
  return $s
}

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]
    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

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

##### tl global status variables #####

set last_cmd ""

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

# package repository (no suport for a one-off repository switch)
set repo ""
# while selecting another repo:
set new_repo ""

# mirrors: dict of dicts of lists of urls per country per continent
set mirrors {}

proc get_repo {} {
  run_cmd_waiting "option repository"
  # this returns the configured repository.
  # for now, do not support a temporary change.
  set re {repository\t(.*)$}
  foreach l $::out_log {
    if [regexp $re $l m ::repo] break
  }
} ; # get_repo

proc is_repo_local {r} {
  set db [file join $r "tlpkg/texlive.tlpdb"]
  return [file exists $db]
}

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

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

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

## data to be displayed ##

# sorted display data for packages
set filtered [dict create]

# selecting packages for display
set stat_opt "inst"
set dtl_opt "all"
# searching packages for display
set search_desc 0

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

set prmpt "tlmgr>"
set busy 0

proc err_exit {} {
  do_debug "error exit"
  read_err_output
  any_message [join $::err_log "\n"] "ok"
  exit
}

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

# 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.

# a caller of run_cmd needs to explicitly invoke 'vwait ::done_waiting'
# if it wants to wait for the command to finish
proc read_line {} {
  set l "" ; # will contain the line to be read
  if {([catch {chan gets $::tlshl l} len] || [chan eof $::tlshl])} {
    #do_debug "read_line: failing to read "
    puts stderr "Read failure; tlmgr command was $::last_cmd"
    catch {chan close $::tlshl}
    err_exit
    # note. the right way to terminate is terminating the GUI shell.
    # This closes stdin of tlmgr shell.
  } elseif {$len >= 0} {
    # do_debug "read: $l"
    if $::ddebug {puts $::flid $l}
    if {[string first $::prmpt $l] == 0} {
      # prompt line: done with command
      enable_widgets 1 ; # this may have to be redone later
      read_err_output
      if {$::pipe_cb ne ""} {
        do_debug "prompt found, $l"
        $::pipe_cb "finish"
      }
      # for vwait:
      set ::done_waiting 1
    } else {
      lappend ::out_log $l
      if {$::pipe_cb ne ""} {$::pipe_cb "line" "$l"}
    }
  }
} ; # read_line

##### displaying stuff in GUI #####

## stderr ##

# copy error strings to error log page, which is sent to top.
# This by itself does not map the logs toplevel .lw
proc show_err_log {} {
  #do_debug "show_err_log"
  .lw.err.tx configure -state normal
  .lw.err.tx delete 1.0 end
  if {[llength $::err_log] > 0} {
    foreach l $::err_log {.lw.err.tx insert end "$l\n"}
    .lw.err.tx yview moveto 1
    .lw.logs select .lw.err
  }
  if {$::tcl_platform(os) ne "Darwin"} {
    # os x: text widget disabled => no selection possible
    .lw.err.tx configure -state disabled
  }
} ; # show_err_log

##### callbacks for file events of tlmgr pipe ::tlshl (names *_cb) #####

# callback for reading tlmgr pipe
set pipe_cb ""

# but maybe we just want a boolean whether or not to write
# to the logs notebook.
# consider writing log to file, always or on demand

## template for pipe callback:
#proc template_cb {mode {l ""}} {
#  if {$mode eq "line"} {
#    # do something
#  } elseif {$mode eq "init"} {
#    # do something
#  } elseif {$mode eq "finish"} {
#    # do something BUT DO NOT TRIGGER ANOTHER EVENT LOOP
#  } else {
#    lappend ::err_log "Illegal call of whatever_cb"
#    err_exit
#  }
#}

proc log_widget_cb {mode {l ""}} {
  if {$mode eq "line"} {
    .lw.log.tx configure -state normal
    .lw.log.tx insert end "$l\n"
  } elseif {$mode eq "init"} {
    .lw.log.tx configure -state normal
    .lw.log.tx delete 1.0 end
    .lw.err.tx delete 1.0 end
    .lw.status configure -text "Running"
    .lw.close configure -state disabled
    wm state .lw normal
    raise .lw .
  } elseif {$mode eq "finish"} {
    .lw.log.tx yview moveto 1
    .lw.logs select .lw.log
    # error log on top if it contains anything
    show_err_log
    if {$::tcl_platform(os) ne "Darwin"} {
      .lw.log.tx configure -state disabled
    }
    .lw.status configure -text ""
    .lw.close configure -state !disabled
  } else {
    lappend ::err_log "Illegal call of log_widget_cb"
    err_exit
  }
} ; # log_widget_cb

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

## general and various:

proc run_cmd {cmd {cb ""}} {
  set ::pipe_cb $cb
  do_debug "run_cmd \"$cmd\""
  if $::ddebug {puts $::flid "\n$cmd"}
  #.topf.lcmd configure -text $cmd
  set ::last_cmd $cmd
  enable_widgets 0
  set ::out_log {}
  set ::err_log {}
  unset -nocomplain ::done_waiting
  if {$::pipe_cb ne ""} {$::pipe_cb "init"}
  chan puts $::tlshl $cmd
  chan flush $::tlshl
}

proc run_cmd_waiting {cmd} {
  run_cmd $cmd
  vwait ::done_waiting
}

proc run_entry {} {
  # TODO: some validation of $cmd
  do_debug "run_entry"
  set cmd [.ent.e get]
  if {$cmd eq ""} return
  do_debug $cmd
  .ent.e delete 0 end
  #.ent.prv configure -text $cmd
  run_cmd $cmd log_widget_cb
}

## package-related: what invokes what?

# The 'globals' are:

# ::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 states are set at initialization and updated
# by update_globals, both via the enable_update_buttons proc

# get_packages_info_local is invoked only once, at initialization.  After
# installations and removals, the collected information is updated by
# update_local_revnumbers.

# 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_remote invokes update_globals.

# 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_packes_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 check_tlmgr_updatable {} {
  run_cmd_waiting "update --self --list"
  foreach l $::out_log {
    if [regexp {^total-bytes[ \t]+([0-9]+)$} $l m b] {
      do_debug "matches, $b"
      set ::need_update_tlmgr [expr {$b > 0} ? 1 : 0]
      return
    }
  }
  do_debug "check_tlmgr_uptodate: should not get here"
} ; # check_tlmgr_uptodate

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 update_globals {} {
  if {! $::have_remote} return
  set ::n_updates 0
  foreach nm [dict keys $::pkgs] {
    if [is_updatable $nm] {incr ::n_updates}
  }
  check_tlmgr_updatable
  set ::tlshell_updatable [is_updatable tlshell]

  # also update displayed status info
  if {$::have_remote && $::need_update_tlmgr} {
    .topf.luptodate configure -text "Needs updating"
  } elseif $::have_remote {
    .topf.luptodate configure -text "Up to date"
  } else {
    .topf.luptodate configure -text "Unknown"
  }
  # ... and status of update buttons
  enable_update_buttons 1
}

# display packages: have columns for both local and remote revision numbers.
# ::pkgs should already be up to date

# I added a field 'marked' to ::pkgs. It is displayed in the first treeview
# column. Treeview tags are not involved.

proc mark_sym {mrk} {
  if $mrk {
    return "\u25A3" ; # 'white square containing black small square'
  } else {
    return "\u25A1" ; # 'white square'
  }
} ; # mark_sym

proc toggle_marked {itm cl} {
  # toggle_marked 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
  dict set ::filtered $itm [lreplace [dict get $::filtered $itm] 0 0 $mrk]
  .pkglist set $itm mk [mark_sym $mrk]
} ; # toggle_marked

proc mark_all {m} {
  foreach nm [dict keys $::pkgs] {
    dict set ::pkgs $nm "marked" $m
  }
  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 [mark_sym $m]
  }
  # alternatively: regenerate ::filtered and .pkglist from ::pkgs
}

# (re)create ::filtered dictionary; disregard search string
proc collect_filtered {} {
  do_debug \
      "collect_filtered for $::stat_opt and $::dtl_opt"
  if {$::stat_opt ne "inst" && ! $::have_remote} {
    get_packages_info_remote
  }
  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]
    if {$v eq "0" || $v == 0} {set v ""}
    dict lappend ::filtered $nm $v
    set v [dict get $pk remoterev]
    if {$v eq "0" || $v == 0} {set v ""}
    dict lappend ::filtered $nm $v
    dict lappend ::filtered $nm [dict get $pk shortdesc]
  }
  display_packages_info
} ; # collect_filtered

# display packages obeying both filter and search string.
# even on a relatively slow system, regenerating the entire list
# 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

proc toggle_search_desc {} {
  # when this proc is called, ::search_desc is not yet toggled
  # so we temporarily pre-toggle and post-untoggle it
  set ::search_desc [expr $::search_desc ? 0 : 1]
  display_packages_info
  set ::search_desc [expr $::search_desc ? 0 : 1]
}

# 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,category,shortdesc"
  set re {^([^,]+),([0-9]+),([^,]*),(.*)$}
  foreach l $::out_log {
    if [regexp $re $l m nm lrev 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 "remoterev" 0 \
               "category" $catg shortdesc $pdescr]
    }
  }
} ; # get_packages_info_local

# 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

  if [catch {run_cmd_waiting \
                 "info --data name,localrev,remoterev,category,shortdesc"}] {
    do_debug [get_stacktrace]
    tk_messageBox -message \
        "Repository $::repo unavailable. Please choose another one."
    return 0
  }
  set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$}
  foreach l $::out_log {
    if [regexp $re $l m nm lrev rrev 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 exist
        dict set ::pkgs $nm [dict create "marked" 0 "localrev" 0]
      }
      dict set ::pkgs $nm "remoterev" $rrev
      dict set ::pkgs $nm "category" $catg
      dict set ::pkgs $nm "shortdesc" $pdescr
    }
  }
  set ::have_remote 1
  update_globals
  return 1
} ; # get_packages_info_remote

## update ::pkgs after installing packages without going online again.
proc update_local_revnumbers {} {
  run_cmd_waiting "info --only-installed --data name,localrev"
  set re {^([^,]+),([0-9]+)$}
  foreach nm [dict keys $::pkgs] {
    dict set ::pkgs $nm "localrev" 0
  }
  foreach l $::out_log {
    if [regexp $re $l m nm lr] {
      dict set ::pkgs $nm "localrev" $lr
    }
  }
  update_globals
} ; # update_local_revnumbers

proc update_tlmgr {} {
  if {! $::need_update_tlmgr} {
    tk_messageBox -message "Nothing to do!"
    return
  }
  run_cmd "update --self" log_widget_cb
  vwait ::done_waiting
  # tlmgr restarts itself automatically
  update_local_revnumbers
  collect_filtered
} ; # update_tlmgr

proc update_all {} {
  if $::need_update_tlmgr {
    tk_messageBox -message "Update self first!"
    return
  } elseif {! $::n_updates} {
    tk_messageBox -message "Nothing to do!"
    return
  }
  run_cmd "update --all" log_widget_cb
  vwait ::done_waiting
  update_local_revnumbers
  collect_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$deps.\n\nContinue?" "okcancel"]
    if {$ans eq "cancel"} return
  }
  run_cmd "install $todo" log_widget_cb
  vwait ::done_waiting
  if {[llength $pre_installed] > 0} {
    lappend ::err_log "Already installed: $pre_installed"
    show_err_log
  }
  update_local_revnumbers
  collect_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$deps?" \
       "yesnocancel"]
    switch $ans {
      "cancel" return
      "yes" {run_cmd "update $todo" log_widget_cb}
      "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 hard dependencies $deps anyway. Continue?" \
                       "okcancel"]
          if {$ans eq "cancel"} return
        }
        run_cmd "update --no-depends $todo" log_widget_cb
      }
    }
  } else {
    run_cmd "update $todo" log_widget_cb
  }
  vwait ::done_waiting
  if {[llength $not_inst] > 0} {
    lappend ::err_log "Skipped because not installed: $not_inst"
  }
  if {[llength $uptodate] > 0} {
    lappend ::err_log "Skipped because already up to date: $uptodate"
  }
  if {[llength $not_inst] > 0 || [llength $uptodate] > 0} {
    show_err_log
  }
  update_local_revnumbers
  collect_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$deps?" \
                "yesnocancel"]
    switch $ans {
      "cancel" return
      "yes" {run_cmd "remove $todo" log_widget_cb}
      "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 hard dependencies $deps anyway. Continue?" \
                       "okcancel"]
          if {$ans eq "cancel"} return
        }
        run_cmd "remove --no-depends $todo" log_widget_cb
      }
    }
  } else {
    run_cmd "remove $todo" log_widget_cb
  }
  vwait ::done_waiting
 if {[llength $not_inst] > 0} {
    lappend ::err_log "Skipped because not installed: $not_inst"
    show_err_log
  }
  update_local_revnumbers
  collect_filtered
} ; # remove_pkgs

#proc restore_pkgs {sel_opt {pk ""}} {
#} ; # restore_pkgs # not yet

## package popup ##

proc do_package_popup {x y X Y} {
  # as focused item, the identity of the 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]" log_widget_cb; \
           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 $X $Y
  focus .pkg_popup
} ; # do_package_popup

##### building GUI #####

# dummy widgets for vertical spacing within $w
set idummy -1
proc spacing {w} {
  incr ::idummy
  pack [ttk::label $w.$::idummy -text " "]
}

proc pgrid {wdg args} { ; # grid command with padding
  grid $wdg {*}$args -padx 3 -pady 3
}

proc ppack {wdg args} { ; # pack command with padding
  pack $wdg {*}$args -padx 3 -pady 3
}

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

proc notyet {} {
  tk_messageBox -message "Not yet implemented"
}

## default_bg , only used for menus under ::plain_unix
if [catch {ttk::style lookup TFrame -background} ::default_bg] {
  set ::default_bg white
}

# place a toplevel centered wrt its parent.
# if the geometry of the new toplevel cannot be determined,
# its upperleft corner will be centered wrt its parent, which is not too bad.
proc place_wrt {wnd {p ""}} {
  if {$p eq ""} {
    set p [winfo [winfo toplevel parent $wnd]]
    if {$p eq ""} return
  }
  update ; # try to make geometry info current; does not always work
  set g [wm geometry $p]
  scan $g "%dx%d+%d+%d" pw ph px py
  set hcenter [expr $px + $pw / 2]
  set vcenter [expr $py + $ph / 2]
  set g [wm geometry $wnd]
  scan $g "%dx%d+%d+%d" ww wh wx wy
  set wx [expr $hcenter - $ww / 2]
  if {$wx < 0} { set wx 0}
  set wy [expr $vcenter - $wh / 2]
  if {$wy < 0} { set wy 0}
  wm geometry $wnd [format "+%d+%d" $wx $wy]
  wm attributes $wnd -topmost 1
  wm attributes $p -topmost 0
  wm state $wnd normal
  raise $wnd $p
} ; # place_wrt


proc long_message {str type {p "."}} {
  # custom dialog
  # not all types are supported
  if {$type ne "ok" && $type ne "okcancel" && $type ne "yesnocancel"} {
    err_exit "Illegal type $type for long_message"
  }
  set ::lms_parent $p
  unset -nocomplain ::lms_var
  do_debug "type $type"
  catch {destroy .lms}
  toplevel .lms -class Dialog
  wm withdraw .lms
  wm transient .lms .
  if $::plain_unix {wm attributes .lms -type dialog}

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

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

  # buttons
  pack [ttk::frame .lms.bts] -in .lms.bg -side bottom -fill x
  if {$type eq "ok" || $type eq "okcancel"} {
    ttk::button .lms.ok -text "ok" -command \
        {raise $::lms_parent; destroy .lms; set ::lms_var "ok"}
    ppack .lms.ok -in .lms.bts -side right
  }
  if {$type eq "yesnocancel"} {
    ttk::button .lms.yes -text "yes" -command \
      {raise $::lms_parent; destroy .lms; set::lms_var "yes"}
    ppack .lms.yes -in .lms.bts -side right
    ttk::button .lms.no -text "no" -command \
      {raise $::lms_parent; destroy .lms; set ::lms_var "no"}
    ppack .lms.no -in .lms.bts -side right
  }
  if {$type eq "yesnocancel" || $type eq "okcancel"} {
    ttk::button .lms.cancel -text "cancel" -command \
        {raise $::lms_parent; destroy .lms; set ::lms_var "cancel"}
    ppack .lms.cancel -in .lms.bts -side right
  }

  place_wrt .lms $::lms_parent
  grab set .lms
  focus .lms
  tkwait variable ::lms_var
  return $::lms_var
} ; # 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 {
    return [long_message $str $type $p]
  }
} ; # any_message

proc make_widgets {} {

  wm title . "$::progname $::procid"

  # width of '0', as a rough estimate of average character width
  set ::cw [font measure TkTextFont "0"]

  # menu
  menu .mn
  . configure -menu .mn
  if $::plain_unix {
    .mn configure -borderwidth 1
    .mn configure -background $::default_bg

    # 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}
    }
  }

  .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 -label "Load another repository" \
      -command repositories
  .mn.file add command -command {destroy .} -label "Exit" -underline 1

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

  .mn add cascade -label "Actions" -menu .mn.act -underline 0
  menu .mn.act
  .mn.act add command -label "Install marked" \
      -command {install_pkgs "marked"}
  .mn.act add command -label "Update marked" \
      -command {update_pkgs "marked"}
  .mn.act add command -label "Remove marked" \
      -command {remove_pkgs "marked"}

  .mn add cascade -label "Help" -menu .mn.help -underline 0
  menu .mn.help
  .mn.help add command -command {tk_messageBox -message "Helpless"} \
      -label "About"

  # 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

  # various info
  ttk::frame .topf

  pgrid [ttk::label .topf.llrepo -text Repository -anchor w] \
      -row 0 -column 0 -sticky w
  pgrid [ttk::label .topf.lrepo -textvariable ::repo] \
      -row 0 -column 1 -sticky w

  ttk::label .topf.lluptodate -text "TL Manager up to date?" -anchor w
  pgrid .topf.lluptodate -row 1 -column 0 -sticky w
  ttk::label .topf.luptodate -text "Unknown" -anchor w
  pgrid .topf.luptodate -row 1 -column 1 -sticky w

  pgrid [ttk::label .topf.llcmd -anchor w -text "Last tlmgr command: "] \
      -row 2 -column 0 -sticky w
  pgrid [ttk::label .topf.lcmd -anchor w -textvariable ::last_cmd] \
      -row 2 -column 1 -sticky w
  pack .topf -in .bg -side top -anchor w

  # some buttons
  spacing .bg
  ttk::frame .butf
  ttk::button .butf.all -text "Update all" -command update_all
  ppack .butf.all -side left
  .butf.all configure -state disabled
  ttk::button .butf.self -text "Update tlmgr" -command update_tlmgr
  .butf.self configure -state disabled
  ppack .butf.self -side left
  pack .butf -in .bg -side top -anchor w

  # command entry
  spacing .bg
  ttk::frame .ent
  ppack [ttk::label .ent.l -text "Type command:"] -side left
  ppack [ttk::entry .ent.e -width 40] -side left -padx 3
  ppack [ttk::button .ent.b -text Go -command run_entry] -side left
  bind .ent.e <Return> run_entry
  pack .ent -in .bg -fill x -side top -expand 1

  spacing .bg

  # package list
  ttk::label .lpack -text "Package list" -font TkHeadingFont -anchor w
  ppack .lpack -in .bg -side top -fill x

  # controlling package list
  ttk::frame .pkfilter
  # 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_filtered
  ttk::radiobutton .pkfilter.alls -text All -value all \
      -variable ::stat_opt -command collect_filtered
  ttk::radiobutton .pkfilter.upd -text Updatable -value upd \
      -variable ::stat_opt -command 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
  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_filtered
  ttk::radiobutton .pkfilter.coll -text "Collections and schemes" -value coll \
      -variable ::dtl_opt -command collect_filtered
  ttk::radiobutton .pkfilter.schm -text "Only schemes" -value schm \
      -variable ::dtl_opt -command collect_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}
  grid [ttk::button .mrk_none -text "Mark none" -command {mark_all 0}] \
      -in .pkfilter -column 2 -row 2 -sticky w -padx {50 3}

  pack .pkfilter -in .bg -side top -fill x

  # search interface
  ttk::frame .pksearch
  ppack [ttk::label .pksearch.l \
      -text "Search package names"] \
      -side left
  pack [ttk::entry .pksearch.e -width 30] -side left -padx {3 0} -pady 3
  # cancel search: \u2A2F is 'vector or cross product'
  #pack [ttk::button .pksearch.can -text "X" -width 1 \
  #          -command {.pksearch.e delete 0 end}] -side left -padx {0 6}
  #pack [button .pksearch.can -text "\u2A2F" -padx 3 -pady 1 -borderwidth 1 \
  #          -command {.pksearch.e delete 0 end}] -side left -padx {0 6}
  #.pksearch.can configure -command \
  #    {.pksearch.e delete 0 end; display_packages_info}
  ppack [ttk::checkbutton .pksearch.d -variable ::search_desc \
             -text "Also search short descriptions"] -side left
  pack .pksearch -in .bg -side top -fill x -expand 1
  bind .pksearch.e <KeyRelease> display_packages_info
  bind .pksearch.d <ButtonRelease> toggle_search_desc

  # packages list
  ttk::frame .fpkg
  ttk::treeview .pkglist -columns \
      {mk name localrev remoterev shortdesc} \
      -show headings -height 8 -selectmode extended \
      -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set}
  foreach \
      col {mk name localrev remoterev shortdesc} \
      nm {"" Name "Local Rev." "Remote Rev." Description} {
    .pkglist heading $col -text $nm -anchor w
  }
  .pkglist column mk -width [expr $::cw * 3]
  .pkglist column name -width [expr $::cw * 25]
  .pkglist column localrev -width [expr $::cw * 12]
  .pkglist column remoterev -width [expr $::cw * 12]
  .pkglist column shortdesc -width [expr $::cw * 50]

  ttk::scrollbar .pkhsb -orient horizontal -command {.pkglist xview}
  ttk::scrollbar .pkvsb -orient vertical -command {.pkglist yview}
  pgrid .pkglist -in .fpkg -row 0 -column 0 -sticky news
  grid .pkvsb -in .fpkg -row 0 -column 1 -sticky ns
  grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew
  grid columnconfigure .fpkg 0 -weight 1
  grid rowconfigure .fpkg 0 -weight 1
  pack .fpkg -in .bg -side top -fill both -expand 1

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

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

  # bottom of main window
  ttk::frame .endbuttons
  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 {wm state .lw normal; place_wrt .lw .}
  ppack .showlogs -in .endbuttons -side right
  pack .endbuttons -in .bg -side bottom -fill x -expand 1

  # log displays: new toplevel, again with themed background frame
  toplevel .lw
  wm title .lw Logs
  pack [ttk::frame .lw.bg] -fill both -expand 1

  ttk::frame .lw.log
  pack [ttk::scrollbar .lw.log.scroll -command ".lw.log.tx yview"] \
      -side right -fill y
  ppack [text .lw.log.tx -height 10 -wrap word \
      -yscrollcommand ".lw.log.scroll set"] \
      -expand 1 -fill both
  .lw.log.tx yview moveto 1

  ttk::frame .lw.err
  pack [ttk::scrollbar .lw.err.scroll -command ".lw.err.tx yview"] \
      -side right -fill y
  ppack [text .lw.err.tx -height 10 -wrap word \
      -yscrollcommand ".lw.err.scroll set"] \
      -expand 1 -fill both
  .lw.err.tx yview moveto 1

  if $::ddebug {
    ttk::frame .lw.dbg
    pack [ttk::scrollbar .lw.dbg.scroll -command ".lw.dbg.tx yview"] \
        -side right -fill y
    ppack [text .lw.dbg.tx -height 10 -bd 2 -relief groove -wrap word \
        -yscrollcommand ".lw.dbg.scroll set"] \
        -expand 1 -fill both
    .lw.dbg.tx yview moveto 1
  }

  ttk::notebook .lw.logs
  .lw.logs add .lw.log -text "Output"
  .lw.logs add .lw.err -text "Errors"
  if $::ddebug {
    .lw.logs add .lw.dbg -text "Debug"
    raise .lw.dbg .lw.logs
  }
  raise .lw.err .lw.logs
  raise .lw.log .lw.logs
  pack .lw.logs -in .lw.bg -side top -fill both -expand 1

  pack [ttk::frame .lw.bottom] -in .lw.bg -side top -expand 1 -fill x
  ttk::button .lw.close -text close -command {wm withdraw .lw}
  ppack .lw.close -in .lw.bottom -side right -anchor e
  ppack [ttk::label .lw.status -anchor w] -in .lw.bottom -side left

  wm withdraw .lw
} ; # make_widgets

### repositories

proc repositories {} {

  set ::new_repo $::repo

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

  # look at dialog.tcl how to implement dialog-type behavior
  toplevel .tlr -class Dialog
  wm withdraw .tlr
  wm transient .tlr .
  wm title .tlr "Repositories"
  if $::plain_unix {wm attributes .tlr -type dialog}

  # wallpaper frame; see make_widgets:
  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 -textvariable ::repo] \
      -in .tlr.info -row 0 -column 1 -sticky w
  # 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 -textvariable ::new_repo -width 40] \
      -in .tlr.info -row $row -column 1 -columnspan 2 -sticky w

  ### three ways to specify a repository ###
  pack [ttk::frame .tlr.mirbuttons] -in .tlr.bg -fill x -expand 1
  # default remote repository
  ttk::button .tlr.ctan -text "Any CTAN mirror" \
      -command {set ::new_repo "http://mirror.ctan.org/systems/texlive/tlnet"}
  ppack .tlr.ctan -in .tlr.mirbuttons -side left -fill x -expand 1
  # freshly create a cascading mirror popup menu
  destroy .tlr.mir.m
  if {[dict size $::mirrors] == 0} read_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 -expand 1
    menu .tlr.mir.m
    dict for {cont d_cont} $::mirrors {
      set c_ed [edit_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 [edit_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 "set ::new_repo $u"
        }
      }
    }
  }
  # local repository
  ttk::button .tlr.browse -text "Local directory..." \
      -command find_local_repo
  ppack .tlr.browse -in .tlr.mirbuttons -side left -fill x -expand 1

  spacing .tlr.bg

  # two ways to close the dialog
  pack [ttk::frame .tlr.closebuttons] -in .tlr.bg -fill x -expand 1
  ttk::button .tlr.save -text "Save and Load" -command {close_repos "save"}
  ppack .tlr.save -in .tlr.closebuttons -side right
  ttk::button .tlr.abort -text "Abort" -command {close_repos "abort"}
  ppack .tlr.abort -in .tlr.closebuttons -side right

  place_wrt .tlr .
  grab set .tlr
  focus .tlr
  wm resizable .tlr 0 0 ; # .tlr not resizable
} ; # repositories

proc close_repos {{how ""}} {
  raise .
  destroy .tlr
  if {$how eq "save"} {
    set ::repo $::new_repo
    if {$::tcl_platform(platform) eq "windows"} {
      set ::repo [string map {\\ /} $::repo]
    }
    set ::new_repo ""
    run_cmd_waiting "option repository $::repo"
    close_tlmgr
    start_tlmgr
    # reload remote package information
    set ::have_remote 0
    get_packages_info_remote
    collect_filtered
  }
} ; # close_repos

proc find_local_repo {} {
  if [is_repo_local $::new_repo] {
    set inidir $::new_repo
  } elseif [is_repo_local $::repo] {
    set inidir $::repo
  } else {
    set inidir $::env(HOME) ; # HOME also ok for windows
  }
  set ::new_repo ""
  while 1 {
    set ::new_repo [tk_chooseDirectory -initialdir $inidir -mustexist 1 \
                        -parent .tlr -title "Local repository..."]
    if {$::new_repo ne "" && ! [is_repo_local $::new_repo]} {
      tk_messageBox -message "$::new_repo not a repository"
      set inidir $::new_repo
      set ::new_repo ""
      continue
    } else {
      break
    }
  }
} ; # find_local_repo

### mirrors

set mirrors [dict create]
proc read_mirrors {} {
  if [catch {open [file join [exec kpsewhich -var-value SELFAUTOPARENT] \
                       "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
  if {! $ok} {do_debug $msg}
} ; # read_mirrors

proc edit_name {n} { ; # probably unnecessary
  set n [string tolower $n]
  set n [string map {" "  "_"} $n]
  return $n
} ; # edit_name

proc enable_update_buttons {yesno} {
  if {! $yesno || ! $::n_updates} {
    .butf.all configure -state disabled
    .butf.self configure -state disabled
  } elseif $::need_update_tlmgr {
    .butf.all configure -state disabled
    .butf.self configure -state !disabled
  } else {
    .butf.all configure -state !disabled
    .butf.self configure -state disabled
  }
}

proc enable_widgets {yesno} {
  enable_update_buttons $yesno

  if $yesno {
    set st normal
    set ttk_st !disabled
    set ::busy "IDLE"
  } else {
    set st disabled
    set ttk_st disabled
    set ::busy "BUSY"
  }

  # command entry
  .ent.b configure -state $st
  .ent.e configure -state $st

  # final buttons
  .q configure -state $ttk_st
  .r configure -state $ttk_st
  .t configure -state $ttk_st
  .showlogs configure -state $ttk_st

  .lw.close configure -state $ttk_st
  if $yesno {
    .lw.status configure -text "Done"
  } else {
    .lw.status configure -text "Please wait..."
  }
} ; # enable_widgets

##### (re)initialization procs #####

proc start_tlmgr {{args ""}} {
  # start the TeX Live Manager shell interface
  # capture stdout into the pipe, stderr into a temp file
  # below, vwait ::done_waiting forces tlshell
  # 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] {
    tk_messageBox -message [get_stacktrace]
    exit
  }
 #set ::tlshl [open "|tlmgr $args --machine-readable shell 2>>$::err_file" w+]
  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 {} {
  catch {chan close $::tlshl}
  catch {chan close $::err}
}

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 initialize {} {
  # prepend TL to process searchpath (not needed on windows)
  if {$::tcl_platform(platform) ne "windows"} {
    set texbin [file dirname [info script]]
    set savedir [pwd]
    cd $texbin
    set texbin [pwd]
    cd $savedir
    # prepend texbin to PATH, unless it is already the _first_
    # path component
    if {$::tcl_platform(platform) eq "unix"} {
      set pathsep ":"
    } else {
      set pathsep ";"
    }
    set dirs [split $::env(PATH) $pathsep]
    if {[lindex $dirs 0] ne $texbin} {
      set ::env(PATH) "$texbin$pathsep$::env(PATH)"
    }
  }
  # 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]
  }

  # add json subdirectory to auto_path, but at low priority
  # since the tcl/tk installation may already have a better implementation.
  # Use 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"]

  make_widgets

  start_tlmgr
  get_repo
  get_packages_info_local
  collect_filtered ; # invokes display_packages_info
  enable_update_buttons 1
}; # initialize

initialize