tlshell restart button added

git-svn-id: svn://tug.org/texlive/trunk@45052 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 40 insertions, 9 deletions

diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index c3727718a90..10e471f0a53 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -1,10 +1,9 @@
-#!/usr/bin/env wish
+#!/usr/bin/env wish8.5
 package require Tk
 
 # This version:
-# - example of reading database
-# - restart
-# - update commands removed or disabled; can get in the way
+# - example of doing something with selected database item
+# - restart self
 
 # windows: most scripts run via [w]runscript.
 
@@ -13,6 +12,15 @@ package require Tk
 # This directory will be prepended to the searchpath.
 # let kpsewhich disentangle symlinks.
 
+# short wait in case of restart. Would this be useful?
+# after 100
+
+# for security:
+catch {rename send {}}
+
+set progname [info script]
+regexp {^.*[\\/]([^\\/\.]*)(?:\....)?$} $progname dummy progname
+set procid [pid]
 
 set tempsub "" ; # subdirectory for temporary files
 
@@ -26,7 +34,7 @@ set pkgs {}
 set prmpt "tlmgr>"
 set busy 0
 
-set ddebug 0
+set ddebug 1
 proc do_debug {s} {
   if {$::ddebug} {
     puts stderr $s
@@ -204,15 +212,35 @@ proc start_tlmgr {} {
   chan configure $::tlshl -buffering line -blocking 0
   chan event $::tlshl readable read_line
   set ::pipe_cb empty_cb
+  run_cmd "set machine-readable 1"
 }
 
-proc restart_tlmgr {} {
+proc close_tlmgr {} {
   set ::pipe_cb empty_cb
-  run_cmd "quit"
-  chan close $::tlshl
+  catch {chan close $::tlshl}
+}
+
+proc restart_tlmgr {} {
+  close_tlmgr
+  .pkglist delete [dict keys $::pkgs]
   start_tlmgr
 }
 
+proc restart_self {} {
+  # eval exec [info nameofexecutable] [file normalize [info script]] &
+  # exec [file normalize [info script]] &
+  do_debug "trying to restart"
+  if {$::progname eq ""} {
+    tk_messageBox -message "progname not found; not restarting"
+    return
+  }
+  close_tlmgr
+  catch {chan close $::err}
+  exec $::progname &
+  # destroy .
+  exit
+}
+
 proc run_entry {} {
   # TODO: some validation of $cmd
   do_debug "run_entry"
@@ -234,6 +262,7 @@ proc view_collections {} {
 
 proc make_widgets {} {
   set textgray "#606060"
+  wm title . "$::progname $::procid"
 
   # width of '0', as a rough estimate of character width
   set cw [font measure TkTextFont "0"]
@@ -307,7 +336,9 @@ proc make_widgets {} {
   frame .endbuttons
   pack [button .q -text Quit -command exit] \
       -in .endbuttons -side right
-  pack [button .r -text Restart -command restart_tlmgr] \
+  pack [button .r -text "Restart tlmgr" -command restart_tlmgr] \
+      -in .endbuttons -side right
+  pack [button .s -text "Restart self" -command restart_self] \
       -in .endbuttons -side right
   pack .endbuttons -side bottom -fill x -expand 1
 } ; # make_widgets