diff options
Diffstat (limited to 'Master/texmf-dist/scripts')
-rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 149 |
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 |