texlive[45066] Master/texmf-dist/scripts/tlshell/tlshell.tcl: Popup
commits+siepo at tug.org
commits+siepo at tug.org
Fri Aug 18 21:50:11 CEST 2017
Revision: 45066
http://tug.org/svn/texlive?view=revision&revision=45066
Author: siepo
Date: 2017-08-18 21:50:11 +0200 (Fri, 18 Aug 2017)
Log Message:
-----------
Popup package descriptions for package list
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-18 15:52:53 UTC (rev 45065)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2017-08-18 19:50:11 UTC (rev 45066)
@@ -34,7 +34,7 @@
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 @@
read_err
set ::busy "IDLE"
$::pipe_cb "finish"
- # update
} else {
lappend ::out_log $l
$::pipe_cb "line" "$l"
@@ -189,6 +188,12 @@
}
} ; # 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 @@
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 @@
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}
-}
+# no more restart of tlmgr only
-proc restart_tlmgr {} {
- close_tlmgr
- .pkglist delete [dict keys $::pkgs]
- start_tlmgr
-}
-
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 @@
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,17 +258,16 @@
}
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
@@ -278,50 +274,56 @@
# 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,12 +336,12 @@
# finally...
frame .endbuttons
- pack [button .q -text Quit -command exit] \
+ pack [ttk::button .q -text Quit -command exit] \
-in .endbuttons -side right
- pack [button .r -text "Restart tlmgr" -command restart_tlmgr] \
+ # 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 [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 @@
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
}
}
More information about the tex-live-commits
mailing list