diff options
-rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 106 |
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 } } |