Reading database; restart button

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

1 files changed, 116 insertions, 33 deletions

diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 0af0c38b231..1271e15d074 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -1,6 +1,11 @@
 #!/usr/bin/env wish
 package require Tk
 
+# This version:
+# - example of reading database
+# - restart
+# - update commands removed or disabled; can get in the way
+
 # windows: most scripts run via [w]runscript.
 
 # linux: tlshell.tcl MUST  be run via a symlink in a directory
@@ -8,12 +13,16 @@ package require Tk
 # This directory will be prepended to the searchpath.
 # let kpsewhich disentangle symlinks.
 
+
 set tempsub "" ; # subdirectory for temporary files
 
 # the stderr and stdout of tlmgr are each read into a list of strings
 set err_log {}
 set out_log {}
 
+# pkgs: dict of package dicts
+set pkgs {}
+
 set prmpt "tlmgr>"
 set busy 0
 
@@ -53,7 +62,6 @@ proc err_exit {} {
 
 proc read_err {} {
   do_debug "read_err"
-  set ::err_log {}
   set len 0
   while 1 {
     do_debug "read_err: one iteration"
@@ -85,12 +93,12 @@ proc read_line {} {
       read_err
       set ::busy "IDLE"
       $::pipe_cb "finish"
+      # update
     } else {
       lappend ::out_log $l
       $::pipe_cb "line" "$l"
     }
   }
-  update
 }
 
 proc show_err {} {
@@ -102,7 +110,6 @@ proc show_err {} {
     .err.tx yview moveto 1
     .logs select .err
   }
-  update
   if {$::tcl_platform(os) ne "Darwin"} {
     # os x: text widget disabled => no selection possible
     .err.tx configure -state disabled
@@ -132,11 +139,9 @@ proc log_widget_cb {mode {l ""}} {
     do_debug "to log widget:"
     do_debug $l
     .log.tx insert end "$l\n"
-    update
   } elseif {$mode eq "init"} {
     .log.tx configure -state normal
     .log.tx delete 1.0 end
-    update
   } elseif {$mode eq "finish"} {
     .log.tx yview moveto 1
     .logs select .log
@@ -146,57 +151,136 @@ proc log_widget_cb {mode {l ""}} {
       .log.tx configure -state disabled
     }
     .ent.e configure -state normal
-    update
   } else {
     lappend ::err_log "Illegal call of log_widget_cb"
     err_exit
   }
 } ; # log_widget_cb
 
+proc packages_cb {mode {l ""}} {
+  if {$mode eq "line"} {
+    # .pkglist configure -state normal
+    set re {^([ i]) ([^: ]+): (.*)$}
+    if {[regexp $re $l m is_inst pname pdescr]} {
+      do_debug "Match: $l"
+      # for now, we assume that there are no duplicates
+      if {$is_inst eq " "} {set is_inst false} else {set is_inst true}
+      dict set ::pkgs $pname {$pdescr $is_inst}
+      .pkglist insert {} end -id $pname -values \
+          [list [expr {$is_inst ? {X} : {}}] $pname $pdescr]
+    } else {
+      do_debug "No match: $l"
+    }
+  } elseif {$mode eq "init"} {
+    foreach k [dict keys $::pkgs] {dict unset ::pkgs $k}
+  } elseif {$mode eq "finish"} {
+    # fill_package_listbox
+  } else {
+    lappend ::err_log "Illegal call of packages_cb"
+    err_exit
+  }
+} ; # log_widget_cb
+
 # running tlmgr ############################################
 
 proc run_cmd {cmd} {
   do_debug "run_cmd \"$cmd\""
+  set ::out_log {}
+  set ::err_log {}
   $::pipe_cb "init"
+  # update
   chan puts $::tlshl $cmd
   chan flush $::tlshl
   do_debug "posting busy"
   set ::busy "BUSY"
-  update
   do_debug "puts and flush"
 }
 
+proc start_tlmgr {} {
+  # start the TeX Live Manager shell interface
+  # capture stdout into the pipe, stderr into a temp file
+  set ::tlshl [open "|tlmgr shell 2>>$::err_file" w+]
+  set ::err [open $::err_file r]
+  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 {} {
+  set ::pipe_cb empty_cb
+  run_cmd "quit"
+  chan close $::tlshl
+  start_tlmgr
+}
+
 proc run_entry {} {
   # TODO: some validation of $cmd
   do_debug "run_entry"
   set cmd [.ent.e get]
+  if {$cmd eq ""} return
   do_debug $cmd
   .ent.e delete 0 end
-  .prev.prv configure -text $cmd
-  update
+  .ent.prv configure -text $cmd
   .ent.e configure -state disabled
   set ::pipe_cb log_widget_cb
   run_cmd $cmd
 }
 
+proc view_collections {} {
+  set cmd "info collections"
+  set ::pipe_cb packages_cb
+  run_cmd $cmd
+}
+
 proc make_widgets {} {
   set textgray "#606060"
 
-  frame .ent
-  pack [label .ent.l -text "Type command:"] -side left
-  pack [button .ent.b -text Run -command run_entry] -side right
-  pack [entry .ent.e -width 60] -side left -fill x
-  pack .ent -fill x -side top
-  bind .ent.e <Return> run_entry
+  # width of '0', as a rough estimate of character width
+  set cw [font measure TkTextFont "0"]
 
-  frame .prev
-  pack [label .prev.lprv -justify left -text "Last command entry: "] \
-      -side left
-  pack [label .prev.prv -justify left] \
-      -side left -fill x
-  pack [label .prev.busy -justify right -textvariable ::busy] -side right
-  pack .prev -side top -fill x
+  frame .buttons -background "#d0d0d0"
+  grid [label .more -justify left -text "Buttons (more to come)" \
+            -background "#d0d0d0"] \
+      -in .buttons -column 0 -columnspan 2 -row 0 -sticky w
+  grid [button .collections -text "Show collections" \
+            -command view_collections] \
+      -in .buttons -column 0 -row 1 -sticky w
+  pack .buttons -side top -fill x -expand 1
 
+  # command entry
+  frame .ent
+  grid [label .ent.l -text "Type command:"] -row 0 -column 0
+  grid [button .ent.b -text Run -command run_entry] \
+      -row 0 -column 2 -sticky w
+  grid [entry .ent.e -width 70] -row 0 -column 1 -sticky ew
+  bind .ent.e <Return> run_entry
+  grid [label .ent.lprv -justify left -text "Last command entry: "] \
+      -row 1 -column 0
+  grid [label .ent.prv -justify left] -row 1 -column 1
+  grid [label .ent.busy -justify right -textvariable ::busy] \
+      -row 1 -column 2
+  pack .ent -fill x -side top -expand 1
+
+  # packages list
+  frame .fpkg
+  ttk::treeview .pkglist -columns {ins Name Description} \
+      -show headings -height 8 \
+      -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set}
+  foreach col  {ins Name Description} {
+    .pkglist heading $col -text $col -anchor w
+  }
+  .pkglist column ins -width [expr $cw * 5]
+  .pkglist column Name -width [expr $cw * 25]
+  .pkglist column Description -width [expr $cw * 50]
+  ttk::scrollbar .pkhsb -orient horizontal -command {.pkglist xview}
+  ttk::scrollbar .pkvsb -orient vertical -command {.pkglist yview}
+  grid .pkglist -in .fpkg -row 0 -column 0 -sticky news
+  grid .pkvsb -in .fpkg -row 0 -column 1 -sticky ns
+  grid .pkhsb -in .fpkg -row 1 -column 0 -sticky ew
+  pack .fpkg -side top -fill x -expand 1
+
+  # log displays
   frame .log
   pack [scrollbar .log.scroll -command ".log.tx yview" -bd 1] \
       -side right -fill y
@@ -218,9 +302,15 @@ proc make_widgets {} {
   .logs add .err -text "Errors"
   raise .err .logs
   raise .log .logs
-  pack .logs -side top -fill both -expand 1 -padx 3 -pady 6
-
-  pack [button .b -text Quit -command exit]
+  pack .logs -side top -fill x -expand 1 -padx 3 -pady 6
+
+  # finally...
+  frame .endbuttons
+  pack [button .q -text Quit -command exit] \
+      -in .endbuttons -side right
+  pack [button .r -text Restart -command restart_tlmgr] \
+      -in .endbuttons -side right
+  pack .endbuttons -side bottom -fill x -expand 1
 } ; # make_widgets
 
 proc initialize {} {
@@ -282,14 +372,7 @@ proc initialize {} {
 
   make_widgets
 
-  # start the TeX Live Manager shell interface
-  # capture stdout into the pipe, stderr into a temp file
-  set ::tlshl [open "|tlmgr shell 2>>$::err_file" w+]
-  set ::err [open $::err_file r]
-  chan configure $::tlshl -buffering line -blocking 0
-  chan event $::tlshl readable read_line
-  set pipe_cb empty_cb
-  run_cmd "set machine-readable 1"
+  start_tlmgr
 }; # initialize
 
 initialize