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

if {$::tcl_platform(platform) eq "unix" && \
        $::tcl_platform(os) ne "Darwin"} {
  set plain_unix 1
} else {
  set plain_unix 0
}

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 progname [info script]
regexp {^.*[\\/]([^\\/\.]*)(?:\....)?$} $progname dummy progname
set procid [pid]

# package repository
set repo ""

# 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

# TODO:
# replace messagebox with a custom toplevel with a text widget
# in case there is a lot of text
proc err_exit {} {
  do_debug "error exit"
  read_err
  tk_messageBox -message [join $::err_log "\n"] -type ok -icon error
  exit
}

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

# 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"
    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
      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
    wm deiconify .lw ;# also raises the window
  } 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
  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
}

proc get_repo {} {
  run_cmd_waiting "option repository"
  set re {repository\t(.*)$}
  foreach l $::out_log {
    if [regexp $re $l m ::repo] break
  }
} ; # get_repo

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

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

  run_cmd_waiting "info --data name,localrev,remoterev,category,shortdesc"
  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
} ; # 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
  #wm withdraw .lw
  update_local_revnumbers
  collect_filtered
} ; # update_all

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

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

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

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

  # set ::default_bg white ;# only used for ::plain_unix
  if [catch {ttk::style lookup TFrame -background} ::default_bg] {
    set ::default_bg white
  }
  if $::plain_unix {
    .mn configure -borderwidth 1
    .mn configure -background $::default_bg
  }

  .mn add cascade -label File -menu .mn.file -underline 0
  menu .mn.file
  .mn.file add command -label "Load default repository" \
      -command notyet
  .mn.file add command -label "Load default net repository" \
      -command notyet
   .mn.file add command -label "Load another repository" \
      -command notyet
  .mn.file add command -command exit -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

  if 1 {
    .mn add cascade -label Styles -menu .mn.sty -underline 0
    menu .mn.sty
    foreach st [ttk::style  theme names] {
      .mn.sty add command -command "ttk::style theme use $st" \
          -label "Style $st"
    }
  }

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

  # encompassing themed frame to guarantee a uniform background
  pack [ttk::frame .bg]

  # various info
  ttk::frame .topf

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

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

  pgrid [ttk::label .topf.llcmd -anchor w -text "Last tlmgr command: "] \
      -row 2 -column 0
  pgrid [ttk::label .topf.lcmd -anchor w] -row 2 -column 1
  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 [button .pksearch.can -text "\u2A2F" -padx 3 -pady 0 -borderwidth 0 \
            -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
  pack .fpkg -in .bg -side top -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}

  # 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 exit] \
      -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 restart_tlmgr] \
      -in .endbuttons -side right
  ttk::button .showlogs -text "Show logs" -command {wm state .lw normal}
  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]

  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 -bd 2 -relief groove -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 -bd 2 -relief groove -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

  ttk::frame .lw.bottom
  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
  pack .lw.bottom -in .lw.bg -side top -expand 1 -fill x

  wm withdraw .lw
} ; # make_widgets

## package popup ##

proc run_package_cmd {cmd {chg 0}} {
  set mn [.pkglist focus]
  run_cmd "$cmd $mn" log_widget_cb
  vwait ::done_waiting
  if $chg {
    do_debug "Package_cmd $cmd; should call update_local_revnumbers"
    update_local_revnumbers
    collect_filtered
  }
} ; # run_package_cmd

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_package_cmd "info"}
  if {$::have_remote && ! $::need_update_tlmgr && $rr > 0 && $lr == 0} {
    .pkg_popup add command -label "Install" -command \
        {run_package_cmd "install" 1}
  }
  if {$::have_remote && ! $::need_update_tlmgr && $rr > $lr} {
    .pkg_popup add command -label "Update" -command \
        {run_package_cmd "update" 1}
  }
  if {$lr > 0} {
    .pkg_popup add command -label "Remove" -command \
        {run_package_cmd "remove" 1}
  }
  #tk_popup .pkg_popup $X $Y
  # tk_popup will generate a RenderBadPicture error
  # when tlshell terminates so we do something else:
  .pkg_popup post $X $Y
  focus .pkg_popup
} ; # do_package_popup

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 {} {
  # 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
  set ::tlshl [open "|tlmgr --machine-readable shell 2>>$::err_file" w+]
  set ::err [open $::err_file r]
  chan configure $::tlshl -buffering line -blocking 0
  chan event $::tlshl readable read_line
  vwait ::done_waiting
}

proc restart_tlmgr {} {
  catch {chan close $::tlshl}
  catch {chan close $::err}
  start_tlmgr
}

proc restart_self {{param ""}} {
  do_debug "trying to restart"
  if {$::progname eq ""} {
    tk_messageBox -message "progname not found; not restarting"
    return
  }
  catch {chan close $::tlshl}
  catch {chan close $::err}
  exec $::progname &
  # on windows, it may take several seconds before
  # the old tlshell disappears.
  # oh well, windows is still windows....
  exit
} ; # 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