#!/usr/bin/env wish package require Tk # This version: # - example of doing something with selected database item # - restart self # windows: most scripts run via [w]runscript. # linux: tlshell.tcl MUST be run via a symlink in a directory # which also contains (a symlink to) kpsewhich. # This directory will be prepended to the searchpath. # let kpsewhich disentangle symlinks. # short wait in case of restart. Would this be useful? # after 100 # for security: catch {rename send {}} set progname [info script] regexp {^.*[\\/]([^\\/\.]*)(?:\....)?$} $progname dummy progname set procid [pid] set tempsub "" ; # subdirectory for temporary files # the stderr and stdout of tlmgr are each read into a list of strings set err_log {} set out_log {} # pkgs: dict of package dicts set pkgs {} set prmpt "tlmgr>" set busy 0 set ddebug 0 proc do_debug {s} { if {$::ddebug} { puts stderr $s } } proc maketemp {ext} { set fname "" foreach i {0 1 2 3 4 5 6 7 8 9} { ; # ten tries set fname [file join $::tempsub "[expr int(10000.0*rand())]$ext"] if {[file exist $fname]} {set fname ""; continue} # create empty file. although we just want a name, # we must make sure that it can be created. set fid [open $fname w] close $fid if {! [file exists $fname]} {error "Cannot create temporary file"} if {$::tcl_platform(platform) eq "unix"} { file attributes $fname -permissions 0600 } break } if {$fname eq ""} {error "Cannot create temporary file"} return $fname } # TODO: replace messagebox with a custom toplevel with a text widget proc err_exit {} { do_debug "error exit" read_err tk_messageBox -message [join $::err_log "\n"] -type ok -icon error exit } proc read_err {} { do_debug "read_err" set len 0 while 1 { do_debug "read_err: one iteration" set len [chan gets $::err l] if {$len >= 0} { lappend ::err_log $l } else { return } } } # about [chan] gets: # if a second parameter is supplied # then this variable receives the result, with EOL stripped, # and the return value is the string length, possibly 0 # EOF is indicated by a return value of -1. proc read_line {} { set l "" ; # will contain the line to be read if {([catch {chan gets $::tlshl l} len] || [chan eof $::tlshl])} { do_debug "read_line: failing to read" catch {chan close $::tlshl} err_exit } elseif {$len >= 0} { do_debug "read: $l" if {[string first $::prmpt $l] == 0} { # prompt line: done with command read_err set ::busy "IDLE" $::pipe_cb "finish" } else { lappend ::out_log $l $::pipe_cb "line" "$l" } } } proc show_err {} { do_debug "show_err" .err.tx configure -state normal .err.tx delete 1.0 end if {[llength $::err_log] > 0} { foreach l $::err_log {.err.tx insert end "$l\n"} .err.tx yview moveto 1 .logs select .err } if {$::tcl_platform(os) ne "Darwin"} { # os x: text widget disabled => no selection possible .err.tx configure -state disabled } } # cb: short for callback (for file events of tlmgr pipe ::tlshl) proc empty_cb {mode {l ""}} {} set pipe_cb empty_cb ## template for non-empty pipe callback: #proc packages_cb {mode {l ""}} { # if {$mode eq "line"} { # } elseif {$mode eq "init"} { # } elseif {$mode eq "finish"} { # } else { # lappend ::err_log "Illegal call of whatever_cb" # err_exit # } #} proc log_widget_cb {mode {l ""}} { if {$mode eq "line"} { .log.tx configure -state normal do_debug "to log widget:" do_debug $l .log.tx insert end "$l\n" } elseif {$mode eq "init"} { .log.tx configure -state normal .log.tx delete 1.0 end } elseif {$mode eq "finish"} { .log.tx yview moveto 1 .logs select .log # error log on top if it contains anything show_err if {$::tcl_platform(os) ne "Darwin"} { .log.tx configure -state disabled } .ent.e configure -state normal } else { lappend ::err_log "Illegal call of log_widget_cb" err_exit } } ; # log_widget_cb proc packages_cb {mode {l ""}} { if {$mode eq "line"} { # .pkglist configure -state normal set re {^([ i]) ([^: ]+): (.*)$} if {[regexp $re $l m is_inst pname pdescr]} { do_debug "Match: $l" # for now, we assume that there are no duplicates if {$is_inst eq " "} {set is_inst false} else {set is_inst true} dict set ::pkgs $pname {$pdescr $is_inst} .pkglist insert {} end -id $pname -values \ [list [expr {$is_inst ? {X} : {}}] $pname $pdescr] } else { do_debug "No match: $l" } } elseif {$mode eq "init"} { foreach k [dict keys $::pkgs] {dict unset ::pkgs $k} } elseif {$mode eq "finish"} { # fill_package_listbox } else { lappend ::err_log "Illegal call of packages_cb" err_exit } } ; # 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} { do_debug "run_cmd \"$cmd\"" set ::out_log {} set ::err_log {} $::pipe_cb "init" chan puts $::tlshl $cmd chan flush $::tlshl do_debug "posting busy" set ::busy "BUSY" do_debug "puts and flush" } proc start_tlmgr {} { # start the TeX Live Manager shell interface # capture stdout into the pipe, stderr into a temp file set ::tlshl [open "|tlmgr --machine-readable shell 2>>$::err_file" w+] set ::err [open $::err_file r] chan configure $::tlshl -buffering line -blocking 0 chan event $::tlshl readable read_line set ::pipe_cb empty_cb } # no more restart of tlmgr only proc restart_self {} { do_debug "trying to restart" if {$::progname eq ""} { tk_messageBox -message "progname not found; not restarting" return } catch {chan close $::tlshl} catch {chan close $::err} exec $::progname & exit } proc run_entry {} { # TODO: some validation of $cmd do_debug "run_entry" set cmd [.ent.e get] if {$cmd eq ""} return do_debug $cmd .ent.e delete 0 end .ent.prv configure -text $cmd .ent.e configure -state disabled set ::pipe_cb log_widget_cb 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 run_cmd $cmd } proc make_widgets {} { wm title . "$::progname $::procid" # width of '0', as a rough estimate of character width set cw [font measure TkTextFont "0"] frame .buttons grid [label .more -justify left -text "Buttons (more to come)"] \ -in .buttons -column 0 -columnspan 2 -row 0 -sticky w 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:" -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 20] -row 0 -column 1 -sticky ew bind .ent.e 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 -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 (tlmgrgui uses a ptk-specific HList widget) frame .fpkg ttk::treeview .pkglist -columns {ins name description} \ -show headings -height 8 -selectmode browse \ -xscrollcommand {.pkhsb set} -yscrollcommand {.pkvsb set} 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] 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 grid columnconfigure .fpkg 2 -weight 1 pack .fpkg -side top -expand 1 bind .pkglist {package_popup [.pkglist identify item %x %y]} bind .pkglist {package_popup [.pkglist selection]} bind .pkglist {package_popup [.pkglist selection]} # log displays frame .log pack [ttk::scrollbar .log.scroll -command ".log.tx yview"] \ -side right -fill y 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 [ttk::scrollbar .err.scroll -command ".err.tx yview"] \ -side right -fill y 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 ttk::notebook .logs .logs add .log -text "Output" .logs add .err -text "Errors" raise .err .logs raise .log .logs pack .logs -side top -fill x -expand 1 -padx 3 -pady 6 # finally... frame .endbuttons pack [ttk::button .q -text Quit -command exit] \ -in .endbuttons -side right # 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 proc initialize {} { # prepend TL to process searchpath (not needed on windows) if {$::tcl_platform(platform) ne "windows"} { set texbin [file dirname [info script]] set savedir [pwd] cd $texbin set texbin [pwd] cd $savedir # prepend texbin to PATH, unless it is already the _first_ # path component if {$::tcl_platform(platform) eq "unix"} { set pathsep ":" } else { set pathsep ";" } set dirs [split $::env(PATH) $pathsep] if {[lindex $dirs 0] ne $texbin} { set ::env(PATH) "$texbin$pathsep$::env(PATH)" } } # directory for temp files set attemptdirs {} foreach tmp {TMPDIR TEMP TMP} { if {[lsearch [array names ::env] $tmp] >= 0} { lappend attemptdirs $::env($tmp) } } if {$::tcl_platform(os) eq "Darwin"} { lappend attemptdirs "/private/tmp" } if {$::tcl_platform(platform) eq "unix"} { lappend attemptdirs "/tmp" } lappend attemptdirs [pwd] set ::tempsub "" foreach tmp $attemptdirs { if {$::tcl_platform(platform) eq "windows"} { regsub -all {\\} $tmp {/} tmp } if {[file isdirectory $tmp]} { # 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)] } append ::tempsub "-tlshell" if {! [catch {file mkdir $::tempsub}]} {break} ;# success } } if {$::tempsub eq "" || [file isdirectory $::tempsub] == 0} { error "Cannot create directory for temporary files" } # temp file for stderr set ::err_file [maketemp ".err_tlshl"] make_widgets start_tlmgr }; # initialize initialize