diff options
author | Karl Berry <karl@freefriends.org> | 2018-03-03 18:29:03 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2018-03-03 18:29:03 +0000 |
commit | be3df25db62116ef060b36ae89fd2c3d41da4d7d (patch) | |
tree | 0927b57c937e19e51b7e0c1e239066762ff27403 /Build | |
parent | be898c6b1244e8e97f7bb28f2fee6313882de105 (diff) |
tl18 pretest initial setup
git-svn-id: svn://tug.org/texlive/trunk@46798 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build')
4 files changed, 2154 insertions, 4 deletions
diff --git a/Build/source/texk/texlive/linked_scripts/Makefile.am b/Build/source/texk/texlive/linked_scripts/Makefile.am index 2ababe9d2ca..b9611f0a98e 100644 --- a/Build/source/texk/texlive/linked_scripts/Makefile.am +++ b/Build/source/texk/texlive/linked_scripts/Makefile.am @@ -206,6 +206,8 @@ texmf_other_scripts = \ texliveonfly/texliveonfly.py \ texloganalyser/texloganalyser \ thumbpdf/thumbpdf.pl \ + tlcockpit/tlcockpit.sh \ + tlshell/tlshell.tcl \ ulqda/ulqda.pl \ urlbst/urlbst \ vpe/vpe.pl \ @@ -230,9 +232,9 @@ nobase_dist_texmf_scripts_SCRIPTS = \ ## Symlinks within $(bindir): FILE:LINK here means "ln -s FILE LINK" is done. bin_links = \ - texdef:latexdef \ epstopdf:repstopdf \ - pdfcrop:rpdfcrop + pdfcrop:rpdfcrop \ + texdef:latexdef # The idea is to install the scripts themselves in texmf*/scripts, and # have bin/arch/foo be a symlink to, say, diff --git a/Build/source/texk/texlive/linked_scripts/Makefile.in b/Build/source/texk/texlive/linked_scripts/Makefile.in index 50c23d2bf7f..fb41af59f35 100644 --- a/Build/source/texk/texlive/linked_scripts/Makefile.in +++ b/Build/source/texk/texlive/linked_scripts/Makefile.in @@ -420,6 +420,8 @@ texmf_other_scripts = \ texliveonfly/texliveonfly.py \ texloganalyser/texloganalyser \ thumbpdf/thumbpdf.pl \ + tlcockpit/tlcockpit.sh \ + tlshell/tlshell.tcl \ ulqda/ulqda.pl \ urlbst/urlbst \ vpe/vpe.pl \ @@ -440,9 +442,9 @@ nobase_dist_texmf_scripts_SCRIPTS = \ $(texmf_context_scripts) bin_links = \ - texdef:latexdef \ epstopdf:repstopdf \ - pdfcrop:rpdfcrop + pdfcrop:rpdfcrop \ + texdef:latexdef relpath = $(SHELL) $(top_srcdir)/../../build-aux/relpath runscript = $(top_srcdir)/$(WIN_WRAPPER)/runscript.exe diff --git a/Build/source/texk/texlive/linked_scripts/tlcockpit/tlcockpit.sh b/Build/source/texk/texlive/linked_scripts/tlcockpit/tlcockpit.sh new file mode 100755 index 00000000000..734ffe54c3c --- /dev/null +++ b/Build/source/texk/texlive/linked_scripts/tlcockpit/tlcockpit.sh @@ -0,0 +1,10 @@ +#!/bin/sh + +kernel=`uname -s` +if test "${kernel#*CYGWIN}" != "$kernel" +then + jarpath=`cygpath -w $(kpsewhich --progname=tlcockpit --format=texmfscripts tlcockpit.jar)` +else + jarpath=`kpsewhich --progname=tlcockpit --format=texmfscripts tlcockpit.jar` +fi +exec java -jar "$jarpath" "$@" diff --git a/Build/source/texk/texlive/linked_scripts/tlshell/tlshell.tcl b/Build/source/texk/texlive/linked_scripts/tlshell/tlshell.tcl new file mode 100755 index 00000000000..2dc4f28341d --- /dev/null +++ b/Build/source/texk/texlive/linked_scripts/tlshell/tlshell.tcl @@ -0,0 +1,2136 @@ +#!/usr/bin/env wish + +# Copyright 2017, 2018 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. + +# dis/enable restore dialog +set do_restore 0 +# dis/enable debug output (only for private development purposes) +set ddebug 0 + +##### 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 + +## italicized items; not used +#font create it_font {*}[font configure TkDefaultFont] +#font configure it_font -slant italic + +set plain_unix 0 +if {$::tcl_platform(platform) eq "unix" && \ + $::tcl_platform(os) ne "Darwin"} { + set plain_unix 1 +} + +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 { + puts stderr $s + # On windows, stderr output goes nowhere. + # Therefore also debug output for the log toplevel. + lappend ::dbg_log $s + # Track debug output in the log toplevel 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 + +proc get_stacktrace {} { + set level [info level] + set s "" + for {set i 1} {$i < $level} {incr i} { + append s [format "Level %u: %s\n" $i [info level $i]] + } + return $s +} ; # get_stacktrace + +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 + +### GUI utilities ##################################################### + +# 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>> <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 +} + +# unicode symbols as fake checkboxes in ttk::treeview widgets +proc mark_sym {mrk} { + if $mrk { + return "\u25A3" ; # 'white square containing black small square' + } else { + return "\u25A1" ; # 'white square' + } +} ; # mark_sym + +# place a toplevel, or at least its upperleft corner, centered wrt its parent +proc place_dlg {wnd {p ""}} { + if {$p eq ""} { + set p [winfo toplevel [winfo parent $wnd]] + if {$p eq ""} return + } + set g [wm geometry $p] + scan $g "%dx%d+%d+%d" pw ph px py + set hcenter [expr {$px + $pw / 2}] + set vcenter [expr {$py + $ph / 2}] + set g [wm geometry $wnd] + set wh [winfo reqheight $wnd] + set ww [winfo reqwidth $wnd] + set wx [expr {$hcenter - $ww / 2}] + if {$wx < 0} { set wx 0} + set wy [expr {$vcenter - $wh / 2}] + if {$wy < 0} { set wy 0} + wm geometry $wnd [format "+%d+%d" $wx $wy] + wm attributes $wnd -topmost 1 + wm attributes $p -topmost 0 + wm state $wnd normal + raise $wnd $p + tkwait visibility $wnd + if {$::tcl_platform(platform) ne "windows"} { + # dont understand why these give trouble in windows + focus $wnd + grab set $wnd + } +} ; # place_dlg + +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 "Illegal type $type for long_message" + } + set ::lms_parent $p + unset -nocomplain ::lms_var + do_debug "type $type" + catch {destroy .tlmg} + toplevel .tlmg -class Dialog + wm withdraw .tlmg + wm transient .tlmg . + if $::plain_unix {wm attributes .tlmg -type dialog} + + # wallpaper frame; see make_widgets + pack [ttk::frame .tlmg.bg] -fill both -expand 1 + 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 + + # 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 \ + {raise $::lms_parent; destroy .tlmg; set ::lms_var "ok"} + ppack .tlmg.ok -in .tlmg.bts -side right + } + if {$type eq "yesnocancel"} { + ttk::button .tlmg.yes -text "yes" -command \ + {raise $::lms_parent; destroy .tlmg; set::lms_var "yes"} + ppack .tlmg.yes -in .tlmg.bts -side right + ttk::button .tlmg.no -text "no" -command \ + {raise $::lms_parent; destroy .tlmg; set ::lms_var "no"} + ppack .tlmg.no -in .tlmg.bts -side right + } + if {$type eq "yesnocancel" || $type eq "okcancel"} { + ttk::button .tlmg.cancel -text "cancel" -command \ + {raise $::lms_parent; destroy .tlmg; set ::lms_var "cancel"} + ppack .tlmg.cancel -in .tlmg.bts -side right + } + + place_dlg .tlmg $::lms_parent + 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 { + # 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 + +### enabling and disabling user interaction + +proc enable_menu_controls {yesno} { + if {! $yesno} { + . configure -menu .mn_empty + return + } + . configure -menu .mn + if {! $::n_updates} { + .mn.pkg entryconfigure $::inx_upd_all -state disabled + .mn.pkg entryconfigure $::inx_upd_tlmgr -state disabled + } elseif $::need_update_tlmgr { + .mn.pkg entryconfigure $::inx_upd_all -state disabled + .mn.pkg entryconfigure $::inx_upd_tlmgr -state normal + } else { + .mn.pkg entryconfigure $::inx_upd_all -state normal + .mn.pkg entryconfigure $::inx_upd_tlmgr -state disabled + } + if {$::tcl_platform(platform) ne "windows"} { + if $::have_remote { + .mn.opt entryconfigure $::inx_platforms -state normal + } else { + .mn.opt entryconfigure $::inx_platforms -state disabled + } + } +}; # enable_menu_controls + +proc enable_widgets {yesno} { + # This proc should cover all active interface elements of the main window. + # But if actions are initiated via a dialog, the main window can be + # deactivated simply by a grab and focus on the dialog. + enable_menu_controls $yesno + + if $yesno { + set st !disabled + set ::busy "IDLE" + } else { + set st disabled + set ::busy "BUSY" + } + + # command entry + .ent.b configure -state $st + .ent.e configure -state $st + + # filter options + # status + .pkfilter.inst configure -state $st + .pkfilter.alls configure -state $st + .pkfilter.upd configure -state $st + # detail + .pkfilter.alld configure -state $st + .pkfilter.coll configure -state $st + .pkfilter.schm configure -state $st + + # mark commands + .mrk_all configure -state $st + .mrk_none configure -state $st + + # search + .pksearch.e configure -state $st + .pksearch.d configure -state $st + + # packages + #.pkglist configure -state $st + .pkglist state $st + + # final buttons + .q configure -state $st + .r configure -state $st + .t configure -state $st + .showlogs configure -state $st +} ; # enable_widgets + +##### tl global data ################################################## + +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 {} + +# 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; 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 + +##### handling tlmgr via pipe and stderr tempfile ##################### + +set prmpt "tlmgr>" +set busy "BUSY" + +# 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 {} { + 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 {} { + do_debug "error exit" + read_err_tempfile + 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" + if [catch \ + {open "|tlmgr $args --machine-readable shell 2>>$::err_file" w+} \ + ::tlshl] { + tk_messageBox -message [get_stacktrace] + exit + } + 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} +}; # close_tlmgr + +# 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])} { + #do_debug "read_line: failing to read " + puts stderr "Read failure; tlmgr command was $::last_cmd" + catch {chan close $::tlshl} + # note. the right 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 + enable_widgets 1 ; # this may have to be redone later + # catch up with stderr + read_err_tempfile + if {$::pipe_cb ne ""} { + do_debug "prompt found, $l" + $::pipe_cb "finish" + } + # for vwait: + set ::done_waiting 1 + } else { + # regular output + lappend ::out_log $l + if {$::pipe_cb ne ""} {$::pipe_cb "line" "$l"} + } + } +} ; # read_line + +# copy error strings to error page in logs toplevel .tllg and send it to top. +# This by itself does not map the logs toplevel .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 + +##### running tlmgr commands ##### + +# optional callback for run_cmds/read_line: +set pipe_cb "" + +# run a list of commands +proc run_cmds {cmds {cb ""}} { + set ::pipe_cb $cb + do_debug "run_cmds \"$cmds\"" + if $::ddebug {puts $::flid "\n$cmds"} + enable_widgets 0 + set ::out_log {} + set ::err_log {} + if {$::pipe_cb ne ""} {$::pipe_cb "init"} + set l [llength $cmds] + for {set i 0} {$i<$l} {incr i} { + set cmd [lindex $cmds $i] + set ::last_cmd $cmd + unset -nocomplain ::done_waiting + 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 {cb ""}} { + run_cmds [list $cmd] $cb +} ; # run_cmd + +proc run_cmd_waiting {cmd} { + run_cmd $cmd + vwait ::done_waiting +} ; # run_cmd_waiting + +##### callbacks for file events of tlmgr pipe ::tlshl (names *_cb) #### + +# callback for reading tlmgr pipe. +# 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 + +# In init mode, it is invoked by run_cmds, otherwise by read_line + +## 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"} { + .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 + } + } elseif {$mode eq "init"} { + show_logs + .tllg.status configure -text "Running" + .tllg.close configure -state disabled + } elseif {$mode eq "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 + } + .tllg.status configure -text "Idle" + .tllg.close configure -state !disabled + # the caller, read_line, will set ::done_waiting after + # this callback returns from finish mode + } else { + lappend ::err_log "Illegal call of log_widget_cb" + err_exit + } +} ; # log_widget_cb + +##### Handling package info ##### + +# what invokes what? +# The main '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/menu states are set at initialization and updated +# by update_globals, both via the enable_menu_controls 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_menu_controls 1 +} + +# 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" + 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] + 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] + } + display_packages_info +} ; # collect_filtered + +# 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_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,cat-version,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 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 + } + } + set ::have_remote 1 + .topf.loaded configure -text "Loaded" + update_globals + 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 + } + } + update_globals +} ; # update_local_revnumbers + +##### Dialogs and their supporting procs ############################## + +# look at dialog.tcl, part of Tk itself, how to implement dialog-type behavior + +# So far: +# - logs notebook, +# - maybe a toplevel for restoring packages from backup, and +# - a toplevel for picking a different local or remote repository. + +##### logs notebook ##### + +# if invoked via log_widget_cb init, it tracks progress of a tlmgr command. +# log_widget_cb will temporarily disable the close button +# and set .tllg.status to busy. +# 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 {} { + toplevel .tllg -class Dialog + wm withdraw .tllg + set p [winfo toplevel [winfo parent .tllg]] + wm transient .tllg $p + wm title .tllg Logs + if $::plain_unix {wm attributes .tllg -type dialog} + + # wallpaper + pack [ttk::frame .tllg.bg] -fill both -expand 1 + + 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 + } + + 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 "Errors" + if $::ddebug { + .tllg.logs add .tllg.dbg -text "Debug" + raise .tllg.dbg .tllg.logs + } + raise .tllg.err .tllg.logs + raise .tllg.log .tllg.logs + + pack [ttk::frame .tllg.bottom] -in .tllg.bg -side bottom -fill x + ttk::button .tllg.close -text close -command { + set p [winfo toplevel [winfo parent .tllg]] + if {$p eq ""} {set p "."} + raise $p; destroy .tllg} + ppack .tllg.close -in .tllg.bottom -side right -anchor e + ppack [ttk::label .tllg.status -anchor w] -in .tllg.bottom -side left + + place_dlg .tllg $p + wm resizable .tllg 1 1 +} ; # show_logs + +##### repositories ##### + +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] +} + +### mirrors + +proc edit_name {n} { + set n [string tolower $n] + set n [string map {" " "_"} $n] + return $n +} ; # edit_name + +set mirrors [dict create] +proc read_mirrors {} { + if [catch {open [file join [exec kpsewhich -var-value SELFAUTOPARENT] \ + "tlpkg/installer/ctan-mirrors.pl"] r} fm] {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 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" -parent .tlr + set inidir $::new_repo + set ::new_repo "" + continue + } else { + break + } + } +} ; # find_local_repo + +proc close_repos {} { + raise . + destroy .tlr + 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 repositories {} { + + set ::new_repo $::repo + + # dialog toplevel with + # - popup menu of mirrors (parse tlpkg/installer/ctan-mirrors.pl) + # - text entry box + # - directory browser button + # - ok and cancel buttons + + 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 -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 + # 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 + # freshly create a cascading mirror dropdown 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 + 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 + + spacing .tlr.bg + + # two ways to close the dialog + pack [ttk::frame .tlr.closebuttons] -in .tlr.bg -fill x + ttk::button .tlr.save -text "Save and Load" -command close_repos + ppack .tlr.save -in .tlr.closebuttons -side right + ttk::button .tlr.abort -text "Abort"\ + -command {raise .; destroy .tlr} + ppack .tlr.abort -in .tlr.closebuttons -side right + + place_dlg .tlr . + wm resizable .tlr 0 0 +} ; # repositories + +### platforms + +if {$::tcl_platform(platform) ne "windows"} { + + set ::platforms {} + + proc toggle_pl_marked {pl cl} { + # toggle_pl_marked is triggered by a mouse click only in column #1. + # 'fut' 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 $::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 configure -state disabled + dict for {p mrks} $::platforms { + if {[dict get $mrks "fut"] ne [dict get $mrks "cur"]} { + .tlpl.do configure -state !disabled + break + } + } + } ; # toggle_pl_marked + + proc platform_do {} { + raise . + destroy .tlpl + 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 log_widget_cb + vwait ::done_waiting + update_local_revnumbers + collect_filtered + + } ; # platform_do + + proc platform_select {} { + run_cmd_waiting "platform list" + set ::platforms {} + foreach l $::out_log { + if [regexp {^\s+(\S+)$} $l m p] { + dict set ::platforms $p {} + dict set ::platforms $p "cur" 0 + dict set ::platforms $p "fut" 0 + } elseif [regexp {^\(i\)\s+(\S+)$} $l m p] { + dict set ::platforms $p {} + dict set ::platforms $p "cur" 1 + dict set ::platforms $p "fut" 1 + } + } + destroy .tlpl + toplevel .tlpl -class Dialog + wm withdraw .tlpl + wm transient .tlpl . + wm title .tlpl "Platforms" + if $::plain_unix {wm attributes .tlpl -type dialog} + + # wallpaper frame + pack [ttk::frame .tlpl.bg] -expand 1 -fill both + + # platforms treeview + 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 + foreach col {sup plat} nm {"" "Platform"} { + .tlpl.pl heading $col -text $nm -anchor w + } + .tlpl.pl column sup -width [expr {$::cw * 6}] + .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]} + + # buttons + pack [ttk::frame .tlpl.but] -in .tlpl.bg -fill x + ttk::button .tlpl.do -text "Apply and close" -command platform_do + ttk::button .tlpl.dont -text "Close" -command \ + {raise .; destroy .tlpl} + ppack .tlpl.do -in .tlpl.but -side right + .tlpl.do configure -state disabled + ppack .tlpl.dont -in .tlpl.but -side right + + place_dlg .tlpl . + wm resizable .tlpl 0 0 + } ; # platform_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. + +if $::do_restore { +# dictionary of backups, with mapping to list of available revisions +set bks {} + +proc enable_restore {yesno} { + set st [expr {$yesno ? !disabled : disabled}] + .tlbk.bklist state $st + .tlbk.all configure -state $st + .tlbk.done configure -state $st +} ; # enable_restore + +proc finish_restore {} { + vwait ::done_waiting + # now log_widget_cb should have done finish mode + # and re-enabled its close button. + # We won't wait for the log toplevel to close, but we will + # update the packages display in the main window. + update_local_revnumbers + collect_filtered +} ; # finish_restore + +proc restore_all {} { + run_cmd "restore --force --all" log_widget_cb + finish_restore + raise . + destroy .tlbk +} ; # 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 $p to revision $r?" \ + -type okcancel -parent .tlbk] + if {$ans ne {ok}} return + run_cmd "restore --force $p $r" log_widget_cb + finish_restore + # tkwait window .tllg +} ; # 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 $bdir does not exist" + return + } + set pwd0 [pwd] + cd $bdir + set backups [lsort [glob *.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 $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 make_widgets + 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 + + foreach col {"pkg" "rev"} nm {"Package" "Revision"} { + .tlbk.bklist heading $col -text $nm -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 {raise .; destroy .tlbk}] -in .tlbk.fbut -side right + + place_dlg .tlbk . + wm resizable .tlbk 0 0 +} ; # restore_backups_dialog + +} ; # if $::do_restore + +##### Main window and supporting procs and callbacks ################## + +##### package-related ##### + +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 + +# restoring packages is a rather different story, controlled by the +# contents of the backup directory. see further up. + +##### varous callbacks ##### + +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 + run_cmd $cmd log_widget_cb +} + +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 {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 + set m [mark_sym $mrk] + dict set ::filtered $itm [lreplace [dict get $::filtered $itm] 0 0 $m] + .pkglist set $itm mk $m +} ; # toggle_marked + +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 + +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}] +} + +##### 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]" 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 [expr {$X - 2}] [expr {$Y - 2}] + focus .pkg_popup +} ; # do_package_popup_menu + +proc set_paper {p} { + run_cmd "paper paper $p" log_widget_cb +} + +##### 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_capt {} { + 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_cb "finish" + set ::done_waiting 1 + } elseif {$len >= 0} { + lappend ::out_log $l + log_widget_cb "line" $l + } +}; # read_capt + +proc run_external {cmd mess} { + set ::out_log {} + set ::err_log {} + lappend ::out_log $mess + unset -nocomplain ::done_waiting + # dont understand why, on windows, start_tlmgr does not trigger + # a console window but this proc does + if [catch {open "|$cmd 2>&1" "r"} ::capt] { + tk_messageBox -message "Failure to launch $cmd" + } + chan configure $::capt -buffering line -blocking 0 + chan event $::capt readable read_capt + log_widget_cb "init" +} + +##### main window ##### + +proc make_widgets {} { + + wm title . "$::progname $::procid" + + # width of '0', as a rough estimate of average character width + set ::cw [font measure TkTextFont "0"] + + # 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 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 -command {destroy .} -label "Exit" -underline 1 + + # inx: keeping count where needed, i.e. when an entry needs to be referenced + .mn add cascade -label "Packages" -menu .mn.pkg + menu .mn.pkg + set inx 0 + set ::inx_upd_tlmgr $inx + .mn.pkg add command -label "Update tlmgr" -command update_tlmgr + incr inx + set ::inx_upd_all $inx + .mn.pkg add command -label "Update all" -command update_all + incr inx + .mn.pkg add command -label "Install marked" \ + -command {install_pkgs "marked"} + incr inx + .mn.pkg add command -label "Update marked" \ + -command {update_pkgs "marked"} + incr inx + .mn.pkg add command -label "Remove marked" \ + -command {remove_pkgs "marked"} + if $::do_restore { + incr inx + .mn.pkg add command -label "Restore from backup..." \ + -command restore_backups_dialog + } + + .mn add cascade -label "Actions" -menu .mn.act -underline 0 + menu .mn.act + .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 add cascade -label "Options" -menu .mn.opt -underline 0 + menu .mn.opt + set inx 0 + .mn.opt add command -label "Change repository..." \ + -command repositories + incr inx + .mn.opt add cascade -label "Paper" -menu .mn.opt.paper + menu .mn.opt.paper + foreach p [list a4 letter] { + .mn.opt.paper add command -label $p -command "set_paper $p" + } + if {$::tcl_platform(platform) ne "windows"} { + incr inx + set ::inx_platforms $inx + .mn.opt add command -label "Platforms..." -command platform_select + } + + .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 + pack .topf -in .bg -side top -anchor w + + pgrid [ttk::label .topf.llrepo -text "Default repository" -anchor w] \ + -row 0 -column 0 -sticky w + pgrid [ttk::label .topf.lrepo -textvariable ::repo] \ + -row 0 -column 1 -sticky w + pgrid [ttk::label .topf.loaded -text "Not loaded"] \ + -row 1 -column 1 -sticky w + + ttk::label .topf.lluptodate -text "TL Manager up to date?" -anchor w + pgrid .topf.lluptodate -row 2 -column 0 -sticky w + ttk::label .topf.luptodate -text "Unknown" -anchor w + pgrid .topf.luptodate -row 2 -column 1 -sticky w + + pgrid [ttk::label .topf.llcmd -anchor w -text "Last tlmgr command: "] \ + -row 3 -column 0 -sticky w + pgrid [ttk::label .topf.lcmd -anchor w -textvariable ::last_cmd] \ + -row 3 -column 1 -sticky w + + # command entry widget + 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 + + 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} -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 + + pack .pkfilter -in .bg -side top -fill x + + # search interface + pack [ttk::frame .pksearch] -in .bg -side top -fill x + 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 + ppack [ttk::checkbutton .pksearch.d -variable ::search_desc \ + -text "Also search short descriptions"] -side left + bind .pksearch.e <KeyRelease> display_packages_info + bind .pksearch.d <ButtonRelease> toggle_search_desc + + # packages list + 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 \ + -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set} + foreach \ + col {mk name localrev remoterev shortdesc} \ + nm {"" Name "Local Rev. (ver.)" "Remote Rev. (ver.)" 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 * 18}] + .pkglist column remoterev -width [expr {$::cw * 18}] + .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 + + # "#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 "mk" i.e. #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_menu %x %y %X %Y} + if $::plain_unix { + bind .pkg_popup <Leave> {.pkg_popup unpost} + } + + # 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 +} ; # make_widgets + +##### initialize ###################################################### + +proc initialize {} { + # seed random numbers + expr {srand([clock seconds])} + # 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)" + } + # now is a good time to ask tlmgr for the tl name of our platform + set ::our_platform [exec tlmgr print-platform] + } + # 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_menu_controls 1 +}; # initialize + +initialize |