diff options
Diffstat (limited to 'Master/texmf-dist')
| -rwxr-xr-x | Master/texmf-dist/scripts/tlshell/tlshell.tcl | 295 |
1 files changed, 295 insertions, 0 deletions
diff --git a/Master/texmf-dist/scripts/tlshell/tlshell.tcl b/Master/texmf-dist/scripts/tlshell/tlshell.tcl new file mode 100755 index 00000000000..f724dcf720c --- /dev/null +++ b/Master/texmf-dist/scripts/tlshell/tlshell.tcl @@ -0,0 +1,295 @@ +#!/usr/bin/env wish +package require Tk + +# 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. + +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 {} + +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 ::err_log {} + 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" + } + } + update +} + +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 + } + update + 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" + update + } elseif {$mode eq "init"} { + .log.tx configure -state normal + .log.tx delete 1.0 end + update + } 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 + update + } else { + lappend ::err_log "Illegal call of log_widget_cb" + err_exit + } +} ; # log_widget_cb + +# running tlmgr ############################################ + +proc run_cmd {cmd} { + do_debug "run_cmd \"$cmd\"" + $::pipe_cb "init" + chan puts $::tlshl $cmd + chan flush $::tlshl + do_debug "posting busy" + set ::busy "BUSY" + update + do_debug "puts and flush" +} + +proc run_entry {} { + # TODO: some validation of $cmd + do_debug "run_entry" + set cmd [.ent.e get] + do_debug $cmd + .ent.e delete 0 end + .prev.prv configure -text $cmd + update + .ent.e configure -state disabled + set ::pipe_cb log_widget_cb + run_cmd $cmd +} + +proc make_widgets {} { + set textgray "#606060" + + frame .ent + pack [label .ent.l -text "Type command:"] -side left + pack [button .ent.b -text Run -command run_entry] -side right + pack [entry .ent.e -width 60] -side left -fill x + pack .ent -fill x -side top + bind .ent.e <Return> run_entry + + frame .prev + pack [label .prev.lprv -justify left -text "Last command entry: "] \ + -side left + pack [label .prev.prv -justify left] \ + -side left -fill x + pack [label .prev.busy -justify right -textvariable ::busy] -side right + pack .prev -side top -fill x + + frame .log + pack [scrollbar .log.scroll -command ".log.tx yview" -bd 1] \ + -side right -fill y + pack [text .log.tx -height 10 -width 80 -bd 2 -relief groove -wrap word \ + -yscrollcommand ".log.scroll set" -fg $textgray] \ + -expand 1 -fill both + .log.tx yview moveto 1 + + frame .err + pack [scrollbar .err.scroll -command ".err.tx yview" -bd 1] \ + -side right -fill y + pack [text .err.tx -height 10 -width 80 -bd 2 -relief groove -wrap word \ + -yscrollcommand ".err.scroll set" -fg $textgray] \ + -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 both -expand 1 -padx 3 -pady 6 + + pack [button .b -text Quit -command exit] +} ; # 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]} { + 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 ""} + } + if {$::tempsub ne ""} {break} + } + } + + 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 the TeX Live Manager shell interface + # capture stdout into the pipe, stderr into a temp file + set ::tlshl [open "|tlmgr --autoflush 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 + run_cmd "set machine-readable 1" +}; # initialize + +initialize |