diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2017-08-22 14:36:53 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2017-08-22 14:36:53 +0000 |
commit | 1870a172c11fb0467f2cdd4892c519befe3674db (patch) | |
tree | f2b174a85c58e16e4bb3bec9a136315ba8c04377 | |
parent | 81fbb26155957f6b9a11f9621783ed2fe1b5e0b4 (diff) |
Complete local and remote package listings
git-svn-id: svn://tug.org/texlive/trunk@45094 c570f23f-e606-0410-a88d-b1316a301751
-rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 275 |
1 files changed, 200 insertions, 75 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl index 86906dcf2b5..b20cf46a0c2 100755 --- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -5,17 +5,15 @@ package require Tk # - example of doing something with selected database item # - restart self -# windows: most scripts run via [w]runscript. - -# linux: tlshell.tcl MUST be run via a symlink in a directory +# searchpath: +# windows: most scripts run via [w]runscript, which adjusts the searchpath +# for the current process. +# unix/linux: tlshell.tcl should be run via a symlink in a directory # which also contains (a symlink to) kpsewhich. # This directory will be prepended to the searchpath. -# let kpsewhich disentangle symlinks. - -# short wait in case of restart. Would this be useful? -# after 100 +# kpsewhich will disentangle symlinks. -# for security: +# security: disable send catch {rename send {}} set progname [info script] @@ -28,13 +26,18 @@ set tempsub "" ; # subdirectory for temporary files set err_log {} set out_log {} -# pkgs: dict of package dicts -set pkgs {} +# dicts of package dicts +if 0 { + set pkgs {} +} +set pkgs_local {} +set pkgs_remote {} +set pkgs pkgs_local set prmpt "tlmgr>" set busy 0 -set ddebug 0 +set ddebug 1 proc do_debug {s} { if {$::ddebug} { puts stderr $s @@ -60,7 +63,9 @@ proc maketemp {ext} { return $fname } -# TODO: replace messagebox with a custom toplevel with a text widget +# TODO: +# replace messagebox with a custom toplevel with a text widget +# in case there is a lot of text proc err_exit {} { do_debug "error exit" read_err @@ -99,7 +104,7 @@ proc read_line {} { if {[string first $::prmpt $l] == 0} { # prompt line: done with command read_err - set ::busy "IDLE" + enable_widgets 1 $::pipe_cb "finish" } else { lappend ::out_log $l @@ -123,17 +128,71 @@ proc show_err {} { } } -# cb: short for callback (for file events of tlmgr pipe ::tlshl) +proc selection_popup {sl} { + tk_messageBox -message [join $sl "\n"] +} + +# combined display of local and remote package database information +# in treeview widget +proc display_packages {} { + set pknames {} + .pkglist delete [.pkglist children {}] + if {[llength $::pkgs_remote] > 0} { + set pknames [dict keys $::pkgs_remote] + set n [llength $pknames] + append mess "\n $n remote packages" + } + if {[llength [dict keys $::pkgs_local]] > 0} { + set n [llength [dict keys $::pkgs_local]] + append mess "\n $n local packages" + foreach nm [dict keys $::pkgs_local] { + lappend pknames $nm + do_debug "found $nm" + } + } + if {[llength $pknames] <= 0} {return} + + set pknames [lsort -unique $pknames] + foreach nm $pknames { + set in_l 0 + if {[lsearch $::pkgs_local $nm] >= 0} {set in_l 1} + set in_r 0 + if {[lsearch $::pkgs_remote $nm] >= 0} {set in_r 1} + set vl [list $nm] + if $in_l { + lappend vl [dict get $::pkgs_local $nm revision] + } else { + lappend vl {} + } + if $in_r { + lappend vl [dict get $::pkgs_remote $nm revision] + } else { + lappend vl {} + } + if $in_l { + lappend vl [dict get $::pkgs_local $nm shortdesc] + } else { + lappend vl [dict get $::pkgs_remote $nm shortdesc] + } + .pkglist insert {} end -id $nm -values $vl + } + update ; # uncomment if necessary +} ; # display_packages + +# callbacks for file events of tlmgr pipe ::tlshl (names *_cb) ### proc empty_cb {mode {l ""}} {} set pipe_cb empty_cb ## template for non-empty pipe callback: -#proc packages_cb {mode {l ""}} { +#proc template_cb {mode {l ""}} { # if {$mode eq "line"} { +# # do something # } elseif {$mode eq "init"} { +# # do something # } elseif {$mode eq "finish"} { +# # do something # } else { # lappend ::err_log "Illegal call of whatever_cb" # err_exit @@ -164,29 +223,53 @@ proc log_widget_cb {mode {l ""}} { } } ; # log_widget_cb -proc packages_cb {mode {l ""}} { +proc dump_db_cb {mode {l ""}} { + upvar #0 $::pkgs pk 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] + if {$l eq ""} { + # package records are separated by blank lines + set ::cur_pkg "" + return + } elseif {[string first "name " $l] == 0} { + set nm [string range $l 5 end] + if {$nm eq ""} { + lappend ::err_log "Empty name in database" + err_exit + } + do_debug "package $nm" + set ::cur_pkg $nm + # initialize package sub-dictionary to empty + dict set pk $nm {} + # initialize relevant subkeys to empty + foreach f {shortdesc category revision} { + dict set pk $::cur_pkg $f {} + } + return } else { - do_debug "No match: $l" + if {$::cur_pkg eq ""} {return} + foreach s {category revision shortdesc} { + set i [string length $s] + incr i + if {[string first "$s " $l] == 0} { + dict set pk $::cur_pkg $s [string range $l $i end] + return + } + } } + # do not process other information + return } elseif {$mode eq "init"} { - foreach k [dict keys $::pkgs] {dict unset ::pkgs $k} + set pk {} + set ::cur_pkg "" + return } elseif {$mode eq "finish"} { - # fill_package_listbox + display_packages + return } else { - lappend ::err_log "Illegal call of packages_cb" + lappend ::err_log "Illegal call of dump_db_cb" err_exit } -} ; # log_widget_cb +} ; # dump_db_cb proc package_popup_cb {mode {l ""}} { if {$mode eq "finish"} { @@ -194,20 +277,48 @@ proc package_popup_cb {mode {l ""}} { } } -# running tlmgr ############################################ +# procs involving running tlmgr commands ######################### proc run_cmd {cmd} { do_debug "run_cmd \"$cmd\"" + enable_widgets 0 set ::out_log {} set ::err_log {} $::pipe_cb "init" chan puts $::tlshl $cmd chan flush $::tlshl - do_debug "posting busy" - set ::busy "BUSY" do_debug "puts and flush" } +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 + .ent.prv configure -text $cmd + .ent.e configure -state disabled + set ::pipe_cb log_widget_cb + run_cmd $cmd +} + +proc package_popup {it} { + # tk_messageBox -message $it + set ::pipe_cb package_popup_cb + run_cmd "info $it" +} + +# $db should be either local or remote +proc dump_db {db} { + do_debug "reading $db" + set ::pkgs pkgs_$db + set ::pipe_cb dump_db_cb + run_cmd "dump-tlpdb --$db" +} + +# (re)initialization procs ############################ + proc start_tlmgr {} { # start the TeX Live Manager shell interface # capture stdout into the pipe, stderr into a temp file @@ -218,8 +329,6 @@ proc start_tlmgr {} { set ::pipe_cb empty_cb } -# no more restart of tlmgr only - proc restart_self {} { do_debug "trying to restart" if {$::progname eq ""} { @@ -229,34 +338,12 @@ proc restart_self {} { catch {chan close $::tlshl} catch {chan close $::err} exec $::progname & + # on windows, it may take several seconds before + # the old tlshell disappears. + # oh well, windows is still windows.... exit } -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 - .ent.prv configure -text $cmd - .ent.e configure -state disabled - set ::pipe_cb log_widget_cb - run_cmd $cmd -} - -proc package_popup {it} { - # tk_messageBox -message $it - set ::pipe_cb package_popup_cb - run_cmd "info $it" -} - -proc view_collections {} { - set cmd "info collections" - set ::pipe_cb packages_cb - run_cmd $cmd -} - proc make_widgets {} { wm title . "$::progname $::procid" @@ -266,10 +353,13 @@ proc make_widgets {} { frame .buttons grid [label .more -justify left -text "Buttons (more to come)"] \ - -in .buttons -column 0 -columnspan 2 -row 0 -sticky w - grid [ttk::button .collections -text "Show collections" \ - -command view_collections] \ + -in .buttons -column 0 -columnspan 3 -row 0 -sticky w + grid [ttk::button .locals -text "Show installed packages" \ + -command {dump_db local}] \ -in .buttons -column 0 -row 1 -sticky w + grid [ttk::button .remotes -text "Show all packages" \ + -command {dump_db remote}] \ + -in .buttons -column 1 -row 1 -sticky w pack .buttons -side top -fill x -expand 1 # command entry @@ -288,27 +378,33 @@ proc make_widgets {} { grid columnconfigure .ent 1 -weight 1 pack .ent -fill x -side top -expand 1 - # packages list (tlmgrgui uses a ptk-specific HList widget) + # packages list (tlmgrgui uses an old HList widget) frame .fpkg - ttk::treeview .pkglist -columns {ins name description} \ - -show headings -height 8 -selectmode browse \ + ttk::treeview .pkglist -columns \ + {name localrev remoterev shortdesc} \ + -show headings -height 8 -selectmode extended \ -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set} - foreach col {ins name description} nm {{Inst.} Name Description} { + foreach \ + col {name localrev remoterev shortdesc} \ + nm {Name "Local Rev." "Remote Rev." Description} { .pkglist heading $col -text $nm -anchor w } - .pkglist column ins -width [expr $cw * 5] .pkglist column name -width [expr $cw * 25] - .pkglist column description -width [expr $cw * 50] + .pkglist column localrev -width [expr $cw * 10] + .pkglist column remoterev -width [expr $cw * 10] + .pkglist column shortdesc -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 - grid columnconfigure .fpkg 2 -weight 1 + grid columnconfigure .fpkg 0 -weight 1 pack .fpkg -side top -expand 1 bind .pkglist <ButtonRelease> {package_popup [.pkglist identify item %x %y]} - bind .pkglist <space> {package_popup [.pkglist selection]} - bind .pkglist <Return> {package_popup [.pkglist selection]} + # focus or selection? + bind .pkglist <space> {package_popup [.pkglist focus]} + bind .pkglist <Return> {selection_popup [.pkglist selection]} # log displays frame .log @@ -338,13 +434,42 @@ proc make_widgets {} { frame .endbuttons pack [ttk::button .q -text Quit -command exit] \ -in .endbuttons -side right - # pack [ttk::button .r -text "Restart tlmgr" -command restart_tlmgr] \ - # -in .endbuttons -side right - pack [ttk::button .s -text "Restart self" -command restart_self] \ + pack [ttk::button .r -text "Restart self" -command restart_self] \ -in .endbuttons -side right pack .endbuttons -side bottom -fill x -expand 1 } ; # make_widgets +proc enable_widgets {yesno} { + if $yesno { + set st normal + set ttk_st !disabled + set ::busy "IDLE" + } else { + set st disabled + set ttk_st disabled + set ::busy "BUSY" + } + # buttons + .locals configure -state $ttk_st + .remotes configure -state $ttk_st + # command entry + .ent.b configure -state $st + .ent.e configure -state $st + # package list + if $yesno { + .pkglist configure -takefocus 1 + bind .pkglist <ButtonRelease> \ + {package_popup [.pkglist identify item %x %y]} + } else { + .pkglist configure -takefocus 0 + bind .pkglist <ButtonRelease> {} + } + # do not touch the log windows + # final buttons + .q configure -state $ttk_st + .r configure -state $ttk_st +} ; # enable_widgets + proc initialize {} { # prepend TL to process searchpath (not needed on windows) if {$::tcl_platform(platform) ne "windows"} { |