summaryrefslogtreecommitdiff
path: root/Master
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2017-12-06 10:57:24 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2017-12-06 10:57:24 +0000
commite621a3a4f58f8414fb7b021e88e97b08ae48522f (patch)
tree14602a1fd863fd858c15ea699c06b04f0fa31968 /Master
parent78142b585cadab705de9cfabfc7db8037d924e33 (diff)
Added repository selection menu item
git-svn-id: svn://tug.org/texlive/trunk@45996 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master')
-rwxr-xr-xMaster/texmf-dist/scripts/tlshell/tlshell.tcl456
1 files changed, 381 insertions, 75 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 5866e4f5a69..ce7d9377f90 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -23,12 +23,13 @@ catch {rename send {}}
# menus: disable tearoff feature
option add *Menu.tearOff 0
+set plain_unix 0
if {$::tcl_platform(platform) eq "unix" && \
$::tcl_platform(os) ne "Darwin"} {
set plain_unix 1
-} else {
- set plain_unix 0
}
+set any_unix 0
+if {$::tcl_platform(platform) eq "unix"} {set any_unix 1}
set test {}
set ddebug 0
@@ -78,12 +79,34 @@ proc search_nocase {needle haystack} {
##### tl global status variables #####
+set last_cmd ""
+
set progname [info script]
regexp {^.*[\\/]([^\\/\.]*)(?:\....)?$} $progname dummy progname
set procid [pid]
-# package repository
+# 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 {}
+
+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]
+}
# the stderr and stdout of tlmgr are each read into a list of strings
set err_log {}
@@ -147,7 +170,8 @@ proc read_err {} {
proc read_line {} {
set l "" ; # will contain the line to be read
if {([catch {chan gets $::tlshl l} len] || [chan eof $::tlshl])} {
- do_debug "read_line: failing to read"
+ #do_debug "read_line: failing to read "
+ puts stderr "Read failure; tlmgr command was $::last_cmd"
catch {chan close $::tlshl}
err_exit
# note. the right way to terminate is terminating the GUI shell.
@@ -252,7 +276,8 @@ 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
+ #.topf.lcmd configure -text $cmd
+ set ::last_cmd $cmd
enable_widgets 0
set ::out_log {}
set ::err_log {}
@@ -278,14 +303,6 @@ proc run_entry {} {
run_cmd $cmd log_widget_cb
}
-proc get_repo {} {
- run_cmd_waiting "option repository"
- set re {repository\t(.*)$}
- foreach l $::out_log {
- if [regexp $re $l m ::repo] break
- }
-} ; # get_repo
-
## package-related: what invokes what?
# The 'globals' are:
@@ -490,7 +507,7 @@ proc toggle_search_desc {} {
# from more recent linux-only installation
proc get_packages_info_local {} {
- # start from scratch
+ # start from scratch; see also update_local_revnumbers
foreach nm [dict keys $::pkgs] {
dict unset ::pkgs $nm
}
@@ -528,7 +545,13 @@ proc get_packages_info_remote {} {
set ::updatable 0
set ::tlshell_updatable 0
- run_cmd_waiting "info --data name,localrev,remoterev,category,shortdesc"
+ if [catch {run_cmd_waiting \
+ "info --data name,localrev,remoterev,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 catg pdescr] {
@@ -548,6 +571,7 @@ proc get_packages_info_remote {} {
}
set ::have_remote 1
update_globals
+ return 1
} ; # get_packages_info_remote
## update ::pkgs after installing packages without going online again.
@@ -587,7 +611,6 @@ proc update_all {} {
}
run_cmd "update --all" log_widget_cb
vwait ::done_waiting
- #wm withdraw .lw
update_local_revnumbers
collect_filtered
} ; # update_all
@@ -602,14 +625,14 @@ proc spacing {w} {
}
proc pgrid {wdg args} { ; # grid command with padding
- grid $wdg {*}$args -padx 3 -pady 3 -sticky w
+ grid $wdg {*}$args -padx 3 -pady 3
}
proc ppack {wdg args} { ; # pack command with padding
pack $wdg {*}$args -padx 3 -pady 3
}
-# deal with MacOS platform differences
+# mouse clicks: deal with MacOS platform differences
if {[tk windowingsystem] eq "aqua"} {
event add <<RightClick>> <Button-2> <Control-Button-1>
} else {
@@ -620,35 +643,72 @@ proc notyet {} {
tk_messageBox -message "Not yet implemented"
}
+## default_bg , only used for menus under ::plain_unix
+if [catch {ttk::style lookup TFrame -background} ::default_bg] {
+ set ::default_bg white
+}
+# The background color of a toplevel is 'set' by covering it
+# with a background ttk::frame.
+# Under MacOS we get the wrong answer with ttk::style lookup,
+# and the default is not right either.
+
+# place a toplevel centered wrt its parent.
+# if the geometry of the new toplevel cannot be determined,
+# its top left corner will be centered wrt its parent, which is not too bad.
+proc place_wrt {wnd {p ""}} {
+ if {$p eq ""} {
+ set p [winfo [winfo toplevel parent $wnd]]
+ if {$p eq ""} return
+ }
+ update ; # try to ensure that geometry info is current
+ 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]
+ scan $g "%dx%d+%d+%d" ww wh wx wy
+ 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 deiconify $wnd
+ raise $wnd $p
+} ; # place_wrt
+
proc make_widgets {} {
wm title . "$::progname $::procid"
+ if $::any_unix {. configure -background $::default_bg}
# width of '0', as a rough estimate of average character width
- set cw [font measure TkTextFont "0"]
+ set ::cw [font measure TkTextFont "0"]
# menu
menu .mn
. configure -menu .mn
-
- # set ::default_bg white ;# only used for ::plain_unix
- if [catch {ttk::style lookup TFrame -background} ::default_bg] {
- set ::default_bg white
- }
if $::plain_unix {
.mn configure -borderwidth 1
.mn configure -background $::default_bg
+
+ # 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 notyet
- .mn.file add command -label "Load default net repository" \
- -command notyet
- .mn.file add command -label "Load another repository" \
- -command notyet
- .mn.file add command -command exit -label "Exit" -underline 1
+ -command {get_packages_info_remote; collect_filtered}
+ .mn.file add command -label "Load another repository" \
+ -command repositories
+ .mn.file add command -command {destroy .} -label "Exit" -underline 1
.mn add cascade -label Options -menu .mn.opt -underline 0
menu .mn.opt
@@ -656,37 +716,31 @@ proc make_widgets {} {
.mn add cascade -label Actions -menu .mn.act -underline 0
menu .mn.act
- if 1 {
- .mn add cascade -label Styles -menu .mn.sty -underline 0
- menu .mn.sty
- foreach st [ttk::style theme names] {
- .mn.sty add command -command "ttk::style theme use $st" \
- -label "Style $st"
- }
- }
-
.mn add cascade -label Help -menu .mn.help -underline 0
menu .mn.help
.mn.help add command -command {tk_messageBox -message "Helpless"} \
-label "About"
- # encompassing themed frame to guarantee a uniform background
+ # wallpaper frame
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
+ pgrid [ttk::label .topf.llrepo -text Repository -anchor w] \
+ -row 0 -column 0 -sticky w
+ pgrid [ttk::label .topf.lrepo -textvariable ::repo] \
+ -row 0 -column 1 -sticky w
ttk::label .topf.lluptodate -text "TL Manager up to date?" -anchor w
- pgrid .topf.lluptodate -row 1 -column 0
+ pgrid .topf.lluptodate -row 1 -column 0 -sticky w
ttk::label .topf.luptodate -text "Unknown" -anchor w
- pgrid .topf.luptodate -row 1 -column 1
+ pgrid .topf.luptodate -row 1 -column 1 -sticky w
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
+ -row 2 -column 0 -sticky w
+ pgrid [ttk::label .topf.lcmd -anchor w -textvariable ::last_cmd] \
+ -row 2 -column 1 -sticky w
pack .topf -in .bg -side top -anchor w
# some buttons
@@ -731,7 +785,7 @@ proc make_widgets {} {
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::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 \
@@ -758,10 +812,12 @@ proc make_widgets {} {
-side left
pack [ttk::entry .pksearch.e -width 30] -side left -padx {3 0} -pady 3
# cancel search: \u2A2F is 'vector or cross product'
- pack [button .pksearch.can -text "\u2A2F" -padx 3 -pady 0 -borderwidth 0 \
- -command {.pksearch.e delete 0 end}] -side left -padx {0 6}
- .pksearch.can configure -command \
- {.pksearch.e delete 0 end; display_packages_info}
+ #pack [ttk::button .pksearch.can -text "X" -width 1 \
+ # -command {.pksearch.e delete 0 end}] -side left -padx {0 6}
+ #pack [button .pksearch.can -text "\u2A2F" -padx 3 -pady 1 -borderwidth 1 \
+ # -command {.pksearch.e delete 0 end}] -side left -padx {0 6}
+ #.pksearch.can configure -command \
+ # {.pksearch.e delete 0 end; display_packages_info}
ppack [ttk::checkbutton .pksearch.d -variable ::search_desc \
-text "Also search short descriptions"] -side left
pack .pksearch -in .bg -side top -fill x -expand 1
@@ -779,11 +835,11 @@ proc make_widgets {} {
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]
+ .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}
@@ -805,18 +861,23 @@ proc make_widgets {} {
menu .pkg_popup ; # entries added on-the-fly
bind .pkglist <<RightClick>> \
{do_package_popup %x %y %X %Y}
+ if $::plain_unix {
+ bind .pkg_popup <Leave> {.pkg_popup unpost}
+ }
# 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] \
+ 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 restart_tlmgr] \
+ ppack [ttk::button .t -text "Restart tlmgr" \
+ -command {close_tlmgr; start_tlmgr}] \
-in .endbuttons -side right
- ttk::button .showlogs -text "Show logs" -command {wm state .lw normal}
+ ttk::button .showlogs -text "Show logs" \
+ -command {wm state .lw normal; place_wrt .lw .}
ppack .showlogs -in .endbuttons -side right
pack .endbuttons -in .bg -side bottom -fill x -expand 1
@@ -828,7 +889,7 @@ proc make_widgets {} {
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 \
+ ppack [text .lw.log.tx -height 10 -wrap word \
-yscrollcommand ".lw.log.scroll set"] \
-expand 1 -fill both
.lw.log.tx yview moveto 1
@@ -836,7 +897,7 @@ proc make_widgets {} {
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 \
+ ppack [text .lw.err.tx -height 10 -wrap word \
-yscrollcommand ".lw.err.scroll set"] \
-expand 1 -fill both
.lw.err.tx yview moveto 1
@@ -905,13 +966,247 @@ proc do_package_popup {x y X Y} {
.pkg_popup add command -label "Remove" -command \
{run_package_cmd "remove" 1}
}
- #tk_popup .pkg_popup $X $Y
- # tk_popup will generate a RenderBadPicture error
- # when tlshell terminates so we do something else:
.pkg_popup post $X $Y
focus .pkg_popup
} ; # do_package_popup
+### repositories
+
+proc repositories {} {
+
+ set ::new_repo $::repo
+
+ # look at dialog.tcl how to implement dialog-type behavior
+
+ # toplevel with
+ # - list of mirrors (parse tlpkg/installer/ctan-mirrors.pl)
+ # - text entry box, or 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}
+ #if $::any_unix .tlr configure -background $::default_bg
+ pack [ttk::frame .tlr.bg]
+ pack [ttk::frame .tlr.info] -in .tlr.bg
+ 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 -expand 1
+ # 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 -expand 1
+ # create a cascading mirror popup 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 -expand 1
+ 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 -expand 1
+
+ spacing .tlr.bg
+
+ # two ways to close the dialog
+ pack [ttk::frame .tlr.closebuttons] -in .tlr.bg -fill x -expand 1
+ ttk::button .tlr.save -text "Save and Load" -command {close_repos "save"}
+ ppack .tlr.save -in .tlr.closebuttons -side right
+ ttk::button .tlr.abort -text "Abort" -command {close_repos "abort"}
+ ppack .tlr.abort -in .tlr.closebuttons -side right
+
+ place_wrt .tlr .
+ grab set .tlr
+ focus .tlr
+} ; # repositories
+
+proc close_repos {{how ""}} {
+ raise .
+ destroy .tlr
+ if {$how eq "save"} {
+ # the alternative
+ 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
+ }
+}
+
+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"
+ set inidir $::new_repo
+ set ::new_repo ""
+ continue
+ } else {
+ break
+ }
+ }
+} ; # find_local_repo
+
+### mirrors
+
+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}
+ # relocate Australia and New Zealand if they are
+ # classified under North America
+ dict set ::mirrors "Other" [dict create]
+ set dict_nam [dict get $::mirrors "North America"]
+ foreach c {"Australia" "New Zealand"} {
+ if [dict exists $dict_nam $c] {
+ dict set ::mirrors "Other" $c [dict get $dict_nam $c]
+ dict unset ::mirrors "North America" $c
+ }
+ }
+ if {[dict size [dict get $::mirrors "Other"]] == 0} {
+ dict unset ::mirrors "Other"
+ }
+} ; # read_mirrors
+
+proc edit_name {n} {
+ set n [string tolower $n]
+ set n [string map {" " "_"} $n]
+ return $n
+} ; # edit_name
+
proc enable_update_buttons {yesno} {
if {! $yesno || ! $::n_updates} {
.butf.all configure -state disabled
@@ -958,38 +1253,49 @@ proc enable_widgets {yesno} {
##### (re)initialization procs #####
-proc start_tlmgr {} {
+proc start_tlmgr {{args ""}} {
# 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+]
+ do_debug "opening tlmgr"
+ if [catch \
+ {open "|tlmgr $args --machine-readable shell 2>>$::err_file" w+} \
+ ::tlshl] {
+ tk_messageBox -message [get_stacktrace]
+ exit
+ }
+ #set ::tlshl [open "|tlmgr $args --machine-readable shell 2>>$::err_file" w+]
+ 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
}
-proc restart_tlmgr {} {
+proc close_tlmgr {} {
catch {chan close $::tlshl}
catch {chan close $::err}
- start_tlmgr
}
-proc restart_self {{param ""}} {
+proc change_repo {} {
+ run_cmd_waiting "option repository $::repo"
+ get_packages_info_remote
+}
+
+proc restart_self {} {
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}
+ close_tlmgr
exec $::progname &
# on windows, it may take several seconds before
# the old tlshell disappears.
# oh well, windows is still windows....
- exit
+ destroy .
} ; # restart_self
proc initialize {} {
@@ -1056,8 +1362,8 @@ proc initialize {} {
# 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"]
+ #set tlsdir [file dirname [exec kpsewhich -format texmfscripts tlshell.tcl]]
+ #lappend ::auto_path [file join $tlsdir "json"]
make_widgets