texlive[45996] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Added

commits+siepo at tug.org commits+siepo at tug.org
Wed Dec 6 11:57:24 CET 2017


Revision: 45996
          http://tug.org/svn/texlive?view=revision&revision=45996
Author:   siepo
Date:     2017-12-06 11:57:24 +0100 (Wed, 06 Dec 2017)
Log Message:
-----------
Added repository selection menu item

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	2017-12-06 01:17:49 UTC (rev 45995)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl	2017-12-06 10:57:24 UTC (rev 45996)
@@ -23,12 +23,13 @@
 # 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,13 +79,35 @@
 
 ##### 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 {}
 set out_log {}
@@ -147,7 +170,8 @@
 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 @@
   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 @@
   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 @@
 # 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 @@
   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 @@
   }
   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 @@
   }
   run_cmd "update --all" log_widget_cb
   vwait ::done_waiting
-  #wm withdraw .lw
   update_local_revnumbers
   collect_filtered
 } ; # update_all
@@ -602,7 +625,7 @@
 }
 
 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
@@ -609,7 +632,7 @@
   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 @@
   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 @@
   .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 @@
   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 @@
       -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 @@
       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 @@
   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 @@
   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 @@
   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 @@
     .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,13 +1253,21 @@
 
 ##### (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
@@ -971,25 +1274,28 @@
   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 @@
   # 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
 



More information about the tex-live-commits mailing list