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