texlive[53707] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Tlmgr
commits+siepo at tug.org
commits+siepo at tug.org
Fri Feb 7 21:27:06 CET 2020
Revision: 53707
http://tug.org/svn/texlive?view=revision&revision=53707
Author: siepo
Date: 2020-02-07 21:27:04 +0100 (Fri, 07 Feb 2020)
Log Message:
-----------
Tlmgr update now supported for w32; bug fix error handling; revised platform detection
Modified Paths:
--------------
trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
Modified: trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2020-02-07 01:48:10 UTC (rev 53706)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2020-02-07 20:27:04 UTC (rev 53707)
@@ -78,10 +78,14 @@
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,13 +332,15 @@
# 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
@@ -341,7 +347,7 @@
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 @@
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 @@
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 @@
# 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
+ -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
- }
+ 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 @@
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 @@
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 @@
}
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 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 @@
##### 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:"]
+### 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
}
- set mess [string cat $mess "\n\ntlmgr update --self"]
- tk_messageBox -message $mess
- return
+ 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 @@
return
}
if {$::tcl_platform(platform) eq "windows"} {
- update_self_w32
+ update_tlmgr_w32
return
}
run_cmd "update --self" 1
More information about the tex-live-commits
mailing list.