texlive[45106] Master/texmf-dist/scripts/tlshell/tlshell.tcl: package
commits+siepo at tug.org
commits+siepo at tug.org
Thu Aug 24 09:17:13 CEST 2017
Revision: 45106
http://tug.org/svn/texlive?view=revision&revision=45106
Author: siepo
Date: 2017-08-24 09:17:13 +0200 (Thu, 24 Aug 2017)
Log Message:
-----------
package list now uses info --data <columns>
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-24 07:10:36 UTC (rev 45105)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-08-24 07:17:13 UTC (rev 45106)
@@ -23,14 +23,26 @@
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 @@
# 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 @@
}
update ; # uncomment if necessary
} ; # display_packages
+}
# callbacks for file events of tlmgr pipe ::tlshl (names *_cb) ###
@@ -215,6 +229,41 @@
}
} ; # 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 @@
err_exit
}
} ; # dump_db_cb
-
+}
proc package_popup_cb {mode {l ""}} {
if {$mode eq "finish"} {
tk_messageBox -message [join $::out_log "\n"]
@@ -302,6 +351,7 @@
}
# $db should be either local or remote
+if 0 {
proc dump_db {db} {
do_debug "reading $db"
set ::pkgs pkgs_$db
@@ -308,7 +358,14 @@
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 ############################
proc start_tlmgr {} {
@@ -346,6 +403,10 @@
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
@@ -352,6 +413,7 @@
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,15 +477,7 @@
-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"
@@ -430,8 +484,6 @@
.logs add .err -text "Errors"
if $::ddebug {
.logs add .dbg -text "Debug"
- }
- if $::ddebug {
raise .dbg .logs
}
raise .err .logs
@@ -458,8 +510,7 @@
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
More information about the tex-live-commits
mailing list