summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xMaster/texmf-dist/scripts/tlshell/tlshell.tcl79
1 files changed, 65 insertions, 14 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 1cdd4590a2e..3dc2064ac47 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -23,14 +23,26 @@ set err_log {}
set out_log {}
# dicts of package dicts
+set pkgs {}
+if 0 {
set pkgs_local {}
set pkgs_remote {}
set pkgs pkgs_local
+}
set prmpt "tlmgr>"
set busy 0
set ddebug 1
+if $::ddebug {
+ frame .dbg
+ pack [ttk::scrollbar .dbg.scroll -command ".dbg.tx yview"] \
+ -side right -fill y
+ pack [text .dbg.tx -height 10 -bd 2 -relief groove -wrap word \
+ -yscrollcommand ".dbg.scroll set"] \
+ -expand 1 -fill both
+ .dbg.tx yview moveto 1
+}
proc do_debug {s} {
if {$::ddebug} {
puts stderr $s
@@ -128,6 +140,7 @@ proc selection_popup {sl} {
# combined display of local and remote package database information
# in treeview widget
+if 0 {
proc display_packages {} {
set pknames {}
.pkglist delete [.pkglist children {}]
@@ -172,6 +185,7 @@ proc display_packages {} {
}
update ; # uncomment if necessary
} ; # display_packages
+}
# callbacks for file events of tlmgr pipe ::tlshl (names *_cb) ###
@@ -215,6 +229,41 @@ proc log_widget_cb {mode {l ""}} {
}
} ; # log_widget_cb
+proc packages_cb {mode {l ""}} {
+ if {$mode eq "line"} {
+ # .pkglist configure -state normal
+ # set re {^([ i]) ([^: ]+): (.*)$}
+ #set re {^[^,]+,([0-9]+),([0-9]+),([^,]*),(\\\".*\\\")?$}
+ set re {^([^,]+),([0-9]+),([0-9]+),([^,]*),(.*)$}
+ if {[regexp $re $l m pname lrev rrev catg pdescr]} {
+ # do_debug "Match: $pname -- $lrev -- $rrev -- $catg -- $pdescr"
+ if {[string index $pdescr 0] eq "\""} {
+ set pdescr [string range $pdescr 1 end-1]
+ }
+ set pdescr [regsub -all "\\\"" $pdescr "\""]
+ dict set ::pkgs $pname \
+ [list "lrev" $lrev "rrev" $rrev "category" $catg shortdesc $pdescr]
+ if {$lrev == 0} { set lrev {}}
+ .pkglist insert {} end -id $pname -values \
+ [list $pname $lrev $rrev $pdescr]
+ } else {
+ do_debug "No match: $l"
+ }
+ return
+ } elseif {$mode eq "init"} {
+ # is this useful? or will the garbage collector take care of it?
+ foreach nm [dict keys $::pkgs] {dict set ::pkgs $nm {}}
+ set ::pkgs {}
+ return
+ } elseif {$mode eq "finish"} {
+ return
+ } else {
+ lappend ::err_log "Illegal call of packages_cb"
+ err_exit
+ }
+} ; # packages_cb
+
+if 0 {
proc dump_db_cb {mode {l ""}} {
upvar #0 $::pkgs pk
if {$mode eq "line"} {
@@ -262,7 +311,7 @@ proc dump_db_cb {mode {l ""}} {
err_exit
}
} ; # dump_db_cb
-
+}
proc package_popup_cb {mode {l ""}} {
if {$mode eq "finish"} {
tk_messageBox -message [join $::out_log "\n"]
@@ -302,12 +351,20 @@ proc package_popup {it} {
}
# $db should be either local or remote
+if 0 {
proc dump_db {db} {
do_debug "reading $db"
set ::pkgs pkgs_$db
set ::pipe_cb dump_db_cb
run_cmd "dump-tlpdb --$db"
}
+}
+
+# complete package list
+proc list_packages {} {
+ set ::pipe_cb packages_cb
+ run_cmd "info --data name,localrev,remoterev,category,shortdesc"
+}
# (re)initialization procs ############################
@@ -346,12 +403,17 @@ proc make_widgets {} {
frame .buttons
grid [label .more -justify left -text "Buttons (more to come)"] \
-in .buttons -column 0 -columnspan 3 -row 0 -sticky w
+ grid [ttk::button .pkgl -text "Show all packages" \
+ -command list_packages] \
+ -in .buttons -column 0 -row 1 -sticky w
+ if 0 {
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
@@ -415,23 +477,13 @@ proc make_widgets {} {
-expand 1 -fill both
.err.tx yview moveto 1
- if $::ddebug {
- frame .dbg
- pack [ttk::scrollbar .dbg.scroll -command ".dbg.tx yview"] \
- -side right -fill y
- pack [text .dbg.tx -height 10 -bd 2 -relief groove -wrap word \
- -yscrollcommand ".dbg.scroll set"] \
- -expand 1 -fill both
- .dbg.tx yview moveto 1
- }
+ # .dbg notbook tab created early on
ttk::notebook .logs
.logs add .log -text "Output"
.logs add .err -text "Errors"
if $::ddebug {
.logs add .dbg -text "Debug"
- }
- if $::ddebug {
raise .dbg .logs
}
raise .err .logs
@@ -458,8 +510,7 @@ proc enable_widgets {yesno} {
set ::busy "BUSY"
}
# buttons
- .locals configure -state $ttk_st
- .remotes configure -state $ttk_st
+ .pkgl configure -state $ttk_st
# command entry
.ent.b configure -state $st
.ent.e configure -state $st