diff options
| -rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 164 |
1 files changed, 81 insertions, 83 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index 275ebbe903b..66476199bb1 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -78,10 +78,14 @@ if $ddebug {set dbg_log {}} proc do_debug {s} { if $::ddebug { - puts stderr $s + if {$::tcl_platform(platform) ne "windows"} {puts stderr $s} # On windows, stderr output goes nowhere. # Therefore also debug output for the log dialog. lappend ::dbg_log $s + file mkdir ${::instroot}/temp + set dbg [open "${::instroot}/temp/mydbglog" a] + puts $dbg "TCL: $s" + close $dbg # Track debug output in the log dialog if it is running: if [winfo exists .tllg.dbg.tx] { .tllg.dbg.tx configure -state normal @@ -328,20 +332,22 @@ set ::show_output 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 + if [info exists ::err] { + set len 0 + while 1 { + set len [chan gets $::err l] + if {$len >= 0} { + lappend ::err_log $l + } else { + break + } } } } ; # read_err_tempfile proc err_exit {{m ""}} { do_debug "error exit" - if [info exists ::err] read_err_tempfile + read_err_tempfile if {$m ne ""} { set ::err_log [linsert $::err_log 0 $m] } @@ -678,22 +684,19 @@ proc collect_filtered {} { display_packages_info } ; # collect_filtered -# derive the set of platforms from the dictionary of packages: -# collect the values $plname from packages 'tex\.$plname' proc get_platforms {} { # guarantee fresh start foreach k $::platforms {dict unset ::platforms $k} set ::platforms [dict create] - # glob-style matching: $k should start with "tex." - foreach k [dict keys $::pkgs "tex.*"] { - set plname [string range $k 4 end] - if {$plname eq ""} continue - set pl [dict create "cur" 0 "fut" 0] - if {[dict get $::pkgs $k "localrev"] > 0} { - dict set pl "cur" 1 - dict set pl "fut" 1 + run_cmd_waiting "platform list" + foreach l $::out_log { + if [regexp {^\(i\)\s+(\S+)\s*$} $l dum plname] { + set pl [dict create "cur" 1 "fut" 1] + dict set ::platforms $plname $pl + } elseif [regexp {^\s+(\S+)\s*$} $l dum plname] { + set pl [dict create "cur" 0 "fut" 0] + dict set ::platforms $plname $pl } - dict set ::platforms $plname $pl } } @@ -749,13 +752,11 @@ proc abort_load {} { catch {exec -ignorestderr taskkill /pid [pid] /t /f} } else { catch {exec -ignorestderr kill -9 [pid]} - # kill -9 should also be ok for darwin } } ; # abort load -# activate abort button # toplevel with abort button in case loading of a repository takes too long. -# it should disappear if loading finishes +# it can be closed when loading finishes proc splash_loading {} { create_dlg .loading . @@ -765,37 +766,23 @@ proc splash_loading {} { # wallpaper pack [ttk::frame .loading.bg -padding 3] -fill both -expand 1 - set ::do_track_loading \ - [expr {[dict get $::pkgs texlive.infra localrev] >= 51676}] - - if $::do_track_loading { - set lbl [__ \ - "If loading takes too long, press Abort and choose another repository."] - } else { - set lbl [__ "Trying to load %s. - -If this takes too long, press Abort and choose another repository." \ - $::repos(main)] - } + set lbl [__ \ + "If loading takes too long, press Abort and choose another repository."] append lbl "\n([__ "Options"] \/ [__ "Repositories"] ...)" ppack [ttk::label .loading.l0 -text $lbl \ - -wraplength [expr {60*$::cw}] -justify left] \ - -in .loading.bg -anchor w - - if $::do_track_loading { - pack [ttk::frame .loading.tfr] -in .loading.bg -expand 1 -fill x - pack [ttk::scrollbar .loading.scroll -command ".loading.tx yview"] \ - -in .loading.tfr -side right -fill y - ppack [text .loading.tx -height 5 -wrap word \ - -yscrollcommand ".loading.scroll set"] \ - -in .loading.tfr -expand 1 -fill both - } + -wraplength [expr {60*$::cw}] -justify left] \ + -in .loading.bg -anchor w + + pack [ttk::frame .loading.tfr] -in .loading.bg -expand 1 -fill x + pack [ttk::scrollbar .loading.scroll -command ".loading.tx yview"] \ + -in .loading.tfr -side right -fill y + ppack [text .loading.tx -height 5 -wrap word \ + -yscrollcommand ".loading.scroll set"] \ + -in .loading.tfr -expand 1 -fill both pack [ttk::frame .loading.buttons] -in .loading.bg -expand 1 -fill x - if $::do_track_loading { - ttk::button .loading.close -text [__ "Close"] -command {end_dlg "" .loading} - ppack .loading.close -in .loading.buttons -side right - .loading.close configure -state disabled - } + ttk::button .loading.close -text [__ "Close"] -command {end_dlg "" .loading} + ppack .loading.close -in .loading.buttons -side right + .loading.close configure -state disabled ttk::button .loading.abo -text [__ "Abort"] -command abort_load ppack .loading.abo -in .loading.buttons -side right wm protocol .loading {cancel_or_destroy .loading.abo .loading} @@ -803,22 +790,24 @@ If this takes too long, press Abort and choose another repository." \ place_dlg .loading . } ; # splash_loading + proc track_err {} { - if $::do_track_loading { - set inx0 [llength $::err_log] - #puts stderr "track_err: $inx0" - read_err_tempfile + set inx0 [llength $::err_log] + read_err_tempfile + .loading.tx configure -state normal + for {set i $inx0} {$i < [llength $::err_log]} {incr i} { + .loading.tx insert end "[lindex $::err_log $i]\n" + } + .loading.tx configure -state disabled + update idletasks + if {![info exists ::loaded]} { + after 500 track_err + } else { + .loading.close state !disabled + .loading.abo state disabled .loading.tx configure -state normal - for {set i $inx0} {$i < [llength $::err_log]} {incr i} { - .loading.tx insert end "[lindex $::err_log $i]\n" - } + .loading.tx insert end [__ "Done loading"] .loading.tx configure -state disabled - if {![info exists ::loaded]} { - after 500 track_err - } else { - .loading.close state !disabled - .loading.abo state disabled - } } } @@ -837,7 +826,7 @@ proc get_packages_info_remote {} { splash_loading unset -nocomplain ::loaded - track_err ; # is a no-op unless $::do_track_loading + track_err if [catch {run_cmd \ "info --data name,localrev,remoterev,cat-version,category,shortdesc"}] { do_debug [get_stacktrace] @@ -846,9 +835,6 @@ proc get_packages_info_remote {} { } vwait ::done_waiting set ::loaded 1 - if {! $::do_track_loading} { - destroy .loading - } ; # otherwise, .loading destroyed by close button of track_err set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),([^,]*),(.*)$} foreach l $::out_log { if [regexp $re $l m nm lrev rrev rcatv catg pdescr] { @@ -1136,10 +1122,11 @@ proc show_repos {} { proc repos_commit {} { set changes 0 # set repositories then add pinning if appropriate - if {! [regexp {^\s*$} [.tlr.new get]]} { - # repository entry widget non-empty: retrieve it - if {$::repos(main) ne [.tlr.new get]} { - set ::repos(main) [.tlr.new get] + set new_repo [forward_slashify [.tlr.new get]] + if {! [regexp {^\s*$} $new_repo]} { + # repository entry widget non-empty: use it + if {$::repos(main) ne $new_repo} { + set ::repos(main) $new_repo set changes 1 } } @@ -1587,16 +1574,27 @@ proc restore_backups_dialog {} { ##### package-related ##### -proc update_self_w32 {} { - if $::multiuser { - set mess \ - [__ "Close this shell and run in an administrative command-prompt:"] - } else { - set mess [__ "Close this shell and run in a command-prompt:"] - } - set mess [string cat $mess "\n\ntlmgr update --self"] - tk_messageBox -message $mess - return +### updating + +proc update_tlmgr_w32 {} { + close_tlmgr + # cannot overwrite runscript.dll because it is in use. + # move it aside instead and put a copy in its place. + set runbk [file join $::instroot "temp" "runbk"] + if [file exists $runbk] { + file delete -force $runbk + } + file mkdir $runbk + file rename -force -- "${::instroot}/bin/win32/runscript.dll" $runbk + file copy "$runbk/runscript.dll" "${::instroot}/bin/win32" + # tell tlmgr via an environment variable that it was invoked by tlshell + set ::env(from_tcl) 1 + # don't try pipes or capturing, because of + # tlmgr's acrobatics with nested command prompts + wm iconify . + exec -ignorestderr cmd /k "start cmd /k tlmgr update --self" + exec $::progname & + destroy . } proc update_tlmgr {} { @@ -1605,7 +1603,7 @@ proc update_tlmgr {} { return } if {$::tcl_platform(platform) eq "windows"} { - update_self_w32 + update_tlmgr_w32 return } run_cmd "update --self" 1 |