package list now uses info --data <columns>

git-svn-id: svn://tug.org/texlive/trunk@45106 c570f23f-e606-0410-a88d-b1316a301751

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