#!/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 {}} 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 # 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 {} { incr ::lnum 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 "$::lnum: 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 "" set lnum -1 ## 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.status configure -text "Running" .lw.close configure -state disabled wm state .lw normal } 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 {} set ::lnum 0 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: 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] } # get fresh package list # 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 # local: start from scratch proc get_packages_info_local {} { 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: remove outer, unescape inner if {[string index $pdescr 0] eq "\""} { set pdescr [string range $pdescr 1 end-1] } set pdescr [regsub -all "\\\"" $pdescr "\""] dict set ::pkgs $nm \ [list "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 [regsub -all "\\\"" $pdescr "\""] if [catch {dict get $::pkgs $nm} pk] { # package entry does not exist dict set ::pkgs $nm [dict create "localrev" 0 \ "remoterev" $rrev "category" $catg shortdesc $pdescr] } else { 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. ## this should be considered a shortcut version of get_packages_info_xxx, ## and should similarly take care of the globals; see above 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, reload remote get_packages_info_remote set ::sel_opt "inst" display_packages_info } ; # 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 set ::sel_opt "inst" display_packages_info } ; # 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 } proc make_widgets {} { wm title . "$::progname $::procid" # width of '0', as a rough estimate of average character width set cw [font measure TkTextFont "0"] # 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 -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 self" -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 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 show_packages_info ttk::radiobutton .pkfilter.alls -text All -value all \ -variable ::stat_opt -command show_packages_info ttk::radiobutton .pkfilter.upd -text Updatable -value upd \ -variable ::stat_opt -command show_packages_info 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 show_packages_info ttk::radiobutton .pkfilter.coll -text "Collections and schemes" -value coll \ -variable ::dtl_opt -command show_packages_info ttk::radiobutton .pkfilter.schm -text "Only schemes" -value schm \ -variable ::dtl_opt -command show_packages_info 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 pack .pkfilter -in .bg -side top -fill x # search 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; show_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 {+display_packages_info} bind .pksearch.d {+toggle_search_desc} # packages list (tlmgrgui uses an old HList widget) 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 bind .pkglist {toggle_marked [.pkglist focus] "#1"} bind .pkglist {toggle_marked [.pkglist focus] "#1"} bind .pkglist {toggle_marked \ [.pkglist identify item %x %y] [.pkglist identify column %x %y]} bind .pkglist \ {popup_focused [.pkglist identify item %x %y]} bind .pkglist \ {popup_focused [.pkglist identify item %x %y]} bind .pkglist \ {popup_focused [.pkglist identify item %x %y]} bind .pkglist \ {popup_focused [.pkglist identify item %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 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} { if $yesno { set st normal set ttk_st !disabled set ::busy "IDLE" } else { set st disabled set ttk_st disabled set ::busy "BUSY" } enable_update_buttons $yesno # 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 ## single-package info ## proc popup_focused {itm} { run_cmd_waiting "info $itm" tk_messageBox -message [join $::out_log "\n"] } ## data to be displayed ## # sorted display data for packages to be displayed set filtered [dict create] # matching package names ## selection tags # manual selection tags: unicode chars as tags are resolution-independent. # ATM we only display tags but do not use them otherwise. set mrk "\u25A3" ; # 'white square containing black small square' set nomrk "\u25A1" ; # 'white square' # sel_opt: which packages to show from package list; # after updates it will always be set to "inst", after installations "all" set sel_opt inst proc toggle_marked {itm cl} { # if toggle_marked is triggered by a mouse click # then it should do nothing unless it was a click in column #1 if {$cl ne "#1"} { return } if [.pkglist tag has marked $itm] { .pkglist tag remove marked $itm .pkglist set $itm mk $::nomrk } else { .pkglist tag add marked $itm .pkglist set $itm mk $::mrk } } ; # toggle_marked # display packages: always display both local and remote revision columns. # ::pkgs should already be up to date # (re)create ::filtered dictionary; disregard search string proc initialize_display_info {} { do_debug \ "initialize_packages_info for $::stat_opt and $::dtl_opt" foreach nm [lsort [dict keys $::filtered]] { dict unset ::filtered $nm } foreach nm [lsort [dict keys $::pkgs]] { set pk [dict get $::pkgs $nm] set do_show 1 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 $::nomrk 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] } } ; # initialize_display_info # display packages obeying filter and search string # even on a relatively slow system, regenerating the entire list # at every keystroke is acceptably responsive proc display_packages_info {} { 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 } } # 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_info proc toggle_search_desc {} { # when this proc is called, ::search_desc is not yet toggled # so we temporarily toggle and untoggle it set ::search_desc [expr $::search_desc ? 0 : 1] display_packages_info set ::search_desc [expr $::search_desc ? 0 : 1] } # selection tags in package list # 1. selections themselves get lost too easily # 2. the -image option for ttk::treeview tags does not look right # Therefore a do-it-yourself implementation with column #1 reserved for # a marker, package name in column #2, and column #0 not displayed at all. # the marker could have been prefixed to the package name in column #0, # but I think a separate marker column is a cleaner solution. # display packages, invoking get_packages_info if necessary. # called at end of initialization and when a selection radio button # is clicked. Otherwise, get_packages_info_... and display_packages_info # are invoked separately. proc show_packages_info {} { # first, reset search #.pksearch.e delete 0 end # make sure requested info is available if {! [llength [dict keys $::pkgs]]} {get_packages_info_local} if {$::stat_opt ne "inst" && ! $::have_remote} get_packages_info_remote # build ::filtered dictionary of info to be displayed initialize_display_info display_packages_info } ; # show_packages_info ##### (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 #get_repo #if {$::argc && [lindex $::argv 0] eq "remote"} { # show_packages_info 0 is_local #} else { # show_packages_info 1 is_local #} } proc restart_tlmgr {} { catch {chan close $::tlshl} catch {chan close $::err} start_tlmgr get_packages_info_remote display_packages_info } 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 } 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(os) eq "Darwin"} { lappend attemptdirs "/private/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] } make_widgets start_tlmgr get_repo set ::sel_opt "inst" show_packages_info }; # initialize initialize