Popup package descriptions for package list

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

1 files changed, 54 insertions, 52 deletions

diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
index 10e471f0a53..41a81cb5a32 100755
--- a/Master/texmf-dist/scripts/tlshell/tlshell.tcl
+++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl
@@ -34,7 +34,7 @@ set pkgs {}
 set prmpt "tlmgr>"
 set busy 0
 
-set ddebug 1
+set ddebug 0
 proc do_debug {s} {
   if {$::ddebug} {
     puts stderr $s
@@ -101,7 +101,6 @@ proc read_line {} {
       read_err
       set ::busy "IDLE"
       $::pipe_cb "finish"
-      # update
     } else {
       lappend ::out_log $l
       $::pipe_cb "line" "$l"
@@ -189,6 +188,12 @@ proc packages_cb {mode {l ""}} {
   }
 } ; # log_widget_cb
 
+proc package_popup_cb {mode {l ""}} {
+  if {$mode eq "finish"} {
+    tk_messageBox -message [join $::out_log "\n"]
+  }
+}
+
 # running tlmgr ############################################
 
 proc run_cmd {cmd} {
@@ -196,7 +201,6 @@ proc run_cmd {cmd} {
   set ::out_log {}
   set ::err_log {}
   $::pipe_cb "init"
-  # update
   chan puts $::tlshl $cmd
   chan flush $::tlshl
   do_debug "posting busy"
@@ -212,32 +216,19 @@ proc start_tlmgr {} {
   chan configure $::tlshl -buffering line -blocking 0
   chan event $::tlshl readable read_line
   set ::pipe_cb empty_cb
-  run_cmd "set machine-readable 1"
-}
-
-proc close_tlmgr {} {
-  set ::pipe_cb empty_cb
-  catch {chan close $::tlshl}
 }
 
-proc restart_tlmgr {} {
-  close_tlmgr
-  .pkglist delete [dict keys $::pkgs]
-  start_tlmgr
-}
+# no more restart of tlmgr only
 
 proc restart_self {} {
-  # eval exec [info nameofexecutable] [file normalize [info script]] &
-  # exec [file normalize [info script]] &
   do_debug "trying to restart"
   if {$::progname eq ""} {
     tk_messageBox -message "progname not found; not restarting"
     return
   }
-  close_tlmgr
+  catch {chan close $::tlshl}
   catch {chan close $::err}
   exec $::progname &
-  # destroy .
   exit
 }
 
@@ -254,6 +245,12 @@ proc run_entry {} {
   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
@@ -261,67 +258,72 @@ proc view_collections {} {
 }
 
 proc make_widgets {} {
-  set textgray "#606060"
+
   wm title . "$::progname $::procid"
 
   # width of '0', as a rough estimate of character width
   set cw [font measure TkTextFont "0"]
 
-  frame .buttons -background "#d0d0d0"
-  grid [label .more -justify left -text "Buttons (more to come)" \
-            -background "#d0d0d0"] \
+  frame .buttons
+  grid [label .more -justify left -text "Buttons (more to come)"] \
       -in .buttons -column 0 -columnspan 2 -row 0 -sticky w
-  grid [button .collections -text "Show collections" \
+  grid [ttk::button .collections -text "Show collections" \
             -command view_collections] \
       -in .buttons -column 0 -row 1 -sticky w
   pack .buttons -side top -fill x -expand 1
 
   # command entry
   frame .ent
-  grid [label .ent.l -text "Type command:"] -row 0 -column 0
-  grid [button .ent.b -text Run -command run_entry] \
+  grid [label .ent.l -text "Type command:" -justify left] -row 0 -column 0 \
+      -sticky w
+  grid [ttk::button .ent.b -text Run -command run_entry] \
       -row 0 -column 2 -sticky w
-  grid [entry .ent.e -width 70] -row 0 -column 1 -sticky ew
+  grid [entry .ent.e -width 20] -row 0 -column 1 -sticky ew
   bind .ent.e <Return> run_entry
   grid [label .ent.lprv -justify left -text "Last command entry: "] \
       -row 1 -column 0
-  grid [label .ent.prv -justify left] -row 1 -column 1
+  grid [label .ent.prv -justify left] -row 1 -column 1 -sticky w
   grid [label .ent.busy -justify right -textvariable ::busy] \
       -row 1 -column 2
+  grid columnconfigure .ent 1 -weight 1
   pack .ent -fill x -side top -expand 1
 
-  # packages list
+  # packages list (tlmgrgui uses a ptk-specific HList widget)
   frame .fpkg
-  ttk::treeview .pkglist -columns {ins Name Description} \
-      -show headings -height 8 \
+  ttk::treeview .pkglist -columns {ins name description} \
+      -show headings -height 8 -selectmode browse \
       -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set}
-  foreach col  {ins Name Description} {
-    .pkglist heading $col -text $col -anchor w
+  foreach col {ins name description} nm {{Inst.} Name 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 name -width [expr $cw * 25]
+  .pkglist column description -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
-  pack .fpkg -side top -fill x -expand 1
+  grid columnconfigure .fpkg 2 -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]}
 
   # log displays
   frame .log
-  pack [scrollbar .log.scroll -command ".log.tx yview" -bd 1] \
+  pack [ttk::scrollbar .log.scroll -command ".log.tx yview"] \
       -side right -fill y
-  pack [text .log.tx -height 10 -width 80 -bd 2 -relief groove -wrap word \
-      -yscrollcommand ".log.scroll set" -fg $textgray] \
+  pack [text .log.tx -height 10 -bd 2 -relief groove -wrap word \
+      -yscrollcommand ".log.scroll set"] \
       -expand 1 -fill both
   .log.tx yview moveto 1
 
   frame .err
-  pack [scrollbar .err.scroll -command ".err.tx yview" -bd 1] \
+  pack [ttk::scrollbar .err.scroll -command ".err.tx yview"] \
       -side right -fill y
-  pack [text .err.tx -height 10 -width 80 -bd 2 -relief groove -wrap word \
-      -yscrollcommand ".err.scroll set" -fg $textgray] \
+  pack [text .err.tx -height 10 -bd 2 -relief groove -wrap word \
+      -yscrollcommand ".err.scroll set"] \
       -expand 1 -fill both
   .err.tx yview moveto 1
 
@@ -334,11 +336,11 @@ proc make_widgets {} {
 
   # finally...
   frame .endbuttons
-  pack [button .q -text Quit -command exit] \
-      -in .endbuttons -side right
-  pack [button .r -text "Restart tlmgr" -command restart_tlmgr] \
+  pack [ttk::button .q -text Quit -command exit] \
       -in .endbuttons -side right
-  pack [button .s -text "Restart self" -command restart_self] \
+  # pack [ttk::button .r -text "Restart tlmgr" -command restart_tlmgr] \
+  #     -in .endbuttons -side right
+  pack [ttk::button .s -text "Restart self" -command restart_self] \
       -in .endbuttons -side right
   pack .endbuttons -side bottom -fill x -expand 1
 } ; # make_widgets
@@ -383,14 +385,14 @@ proc initialize {} {
       regsub -all {\\} $tmp {/} tmp
     }
     if {[file isdirectory $tmp]} {
-      foreach i {0 1 2 3 4 5 6 7 8 9} {
-        # 10 tries to get a new name for this value of tmp
-        set ::tempsub [file join $tmp "tlshl[expr int(10000.0*rand())]"]
-        if {[file isdirectory $::tempsub]} {set ::tempsub ""; continue}
-        if {! [catch {file mkdir $::tempsub}]} {break} ;# success
-        else {set ::tempsub ""}
+      # no real point in randomizing directory name itself
+      if {$::tcl_platform(platform) eq "unix"} {
+        set ::tempsub [file join $tmp $::env(USER)]
+      } else {
+        set ::tempsub [file join $tmp $::env(USERNAME)]
       }
-      if {$::tempsub ne ""} {break}
+      append ::tempsub "-tlshell"
+      if {! [catch {file mkdir $::tempsub}]} {break} ;# success
     }
   }