texlive[45040] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Reading
commits+siepo at tug.org
commits+siepo at tug.org
Mon Aug 14 13:30:29 CEST 2017
Revision: 45040
http://tug.org/svn/texlive?view=revision&revision=45040
Author: siepo
Date: 2017-08-14 13:30:29 +0200 (Mon, 14 Aug 2017)
Log Message:
-----------
Reading database; restart button
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-08-14 00:18:01 UTC (rev 45039)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-08-14 11:30:29 UTC (rev 45040)
@@ -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,6 +13,7 @@
# 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
@@ -14,6 +20,9 @@
set err_log {}
set out_log {}
+# pkgs: dict of package dicts
+set pkgs {}
+
set prmpt "tlmgr>"
set busy 0
@@ -53,7 +62,6 @@
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 @@
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 @@
.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 @@
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,7 +151,6 @@
.log.tx configure -state disabled
}
.ent.e configure -state normal
- update
} else {
lappend ::err_log "Illegal call of log_widget_cb"
err_exit
@@ -153,50 +157,130 @@
}
} ; # 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"
+ # width of '0', as a rough estimate of character width
+ set cw [font measure TkTextFont "0"]
+
+ 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
- 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
+ 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
- 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
+ # 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 @@
.logs add .err -text "Errors"
raise .err .logs
raise .log .logs
- pack .logs -side top -fill both -expand 1 -padx 3 -pady 6
+ pack .logs -side top -fill x -expand 1 -padx 3 -pady 6
- pack [button .b -text Quit -command exit]
+ # 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 @@
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
More information about the tex-live-commits
mailing list