diff options
Diffstat (limited to 'Master')
| -rwxr-xr-x | Master/tlpkg/installer/install-tl-gui.tcl | 107 |
1 files changed, 39 insertions, 68 deletions
diff --git a/Master/tlpkg/installer/install-tl-gui.tcl b/Master/tlpkg/installer/install-tl-gui.tcl index 55b37756613..cfaa1c5b86c 100755 --- a/Master/tlpkg/installer/install-tl-gui.tcl +++ b/Master/tlpkg/installer/install-tl-gui.tcl @@ -41,6 +41,10 @@ option add *Menu.tearOff 0 # no bold text for messages; `userDefault' indicates priority option add *Dialog.msg.font TkDefaultFont userDefault +# larger font +font create lfont {*}[font configure TkDefaultFont] +font configure lfont -size [expr {round(1.2 * [font actual lfont -size])}] + ## italicized items; not used #font create it_font {*}[font configure TkDefaultFont] #font configure it_font -slant italic @@ -74,22 +78,6 @@ set ::instroot [file dirname [file dirname [file dirname $::instroot]]] set ::perlbin "perl" if {$::tcl_platform(platform) eq "windows"} { set ::perlbin "${::instroot}/tlpkg/tlperl/bin/perl.exe" - - # shall need to run the actual installation from a batchfile, - # to prevent hundreds of dosboxes popping up. - # need to tell perl where to write profile for noninteractive install - set ::env(tmpprofile) "" - for {set i 0} {$i<10} {incr i} { - if [file exists [file join $::env(tmp) "temp${i}.profile"]] { - continue - } else { - set ::env(tmpprofile) "temp${i}.profile" - break - } - } - if {$::env(tmpprofile) eq ""} { - err_exit "Cannot create required tempfile" - } } ### procedures, mostly organized bottom-up ### @@ -106,8 +94,16 @@ proc get_stacktrace {} { # for debugging frontend-backend communication: # write to a logfile which is shared with the backend. # both parties open, append and close every time. + +if {$::tcl_platform(platform) eq "unix" && $::tcl_platform(os) eq "Darwin"} { + set ::dblfile "$::env(TMPDIR)/dblog" +} elseif {$::tcl_platform(platform) eq "unix"} { + set ::dblfile "/tmp/dblog" +} else { + set ::dblfile "$::env(TEMP)/dblog.txt" +} proc dblog {s} { - set db [open "/tmp/dblog" a] + set db [open $::dblfile a] set t [get_stacktrace] puts $db "TCL: $s\n$t" close $db @@ -312,7 +308,7 @@ proc make_splash {} { update }; # make_splash -# short descriptions for collections and schemes from texlive.tlpdb +# short descriptions for collections and schemes from texlive.tlpdb, # not from the backend proc get_short_descs {} { set dbfile [file join $::instroot "tlpkg/texlive.tlpdb"] @@ -358,6 +354,8 @@ proc get_short_descs {} { set ::scheme_descs(scheme-custom) "Custom scheme" }; # get_short_descs +############################################################# + # toggle platform in treeview widget, but not in underlying data proc toggle_bin {b} { if {$b eq $::vars(this_platform)} { @@ -446,6 +444,8 @@ proc select_binaries {} { return $::dialog_ans }; # select_binaries +############################################################# + ### scheme ### proc select_scheme {} { create_dlg .tlschm . @@ -494,6 +494,8 @@ proc select_scheme {} { return $::dialog_ans }; # select_scheme +############################################################# + ### collections ### # toggle collection in treeview widget, but not in underlying data @@ -610,6 +612,8 @@ proc select_collections {} { return $::dialog_ans }; # select_collections +############################################################# + # the main menu interface will at certain events send the current values of # the ::vars array to install-tl[-tcl], which will send back an updated version # of this array. @@ -690,6 +694,8 @@ proc run_menu {} { return $::menu_ans }; # run_menu +############################################################# + # we need data from the backend. # choices of schemes, platforms and options impact choices of # collections and required disk space. @@ -806,52 +812,7 @@ proc run_installer {} { chan puts $::inst "startinst" write_vars } - # windows: do profile installation via a batchfile, - # to prevent hundreds of dosboxes popping up. - # for simplicity, use install-tl-windows.bat - # with the original command-line arguments minus - # gui- and old profile command-line arguments - if {$::tcl_platform(platform) eq "windows"} { - # do not want to be asked again about aborted installation: - file delete "installation.profile" - catch {chan close $::inst}; # should already have been closed by backend - set newargs {} - set i 0 - while {$i<$::argc} { - set a [lindex $::argv $i] - # gui-related? - if [string equal -length 2 $a "--"] { - set a [string range $a 1 end] - } - if [string equal -length 4 $a "-gui"] { - incr $i - if {$i < $::argc} { - set b [lindex $::argv $i] - if {[string index $b 0] ne "-"} { - # gui parameter; skip too - incr $i - } - } - } elseif [string equal -length 8 $a "-profile"] { - incr $i - if {$i < $::argc} { - set b [lindex $::argv $i] - if {[string index $b 0] ne "-"} { - # profile parameter; skip too - incr $i - } - } - } else { - lappend newargs $a - incr $i - } - } - set cmd [list "${::instroot}/install-tl-windows.bat" {*}$newargs \ - "-profile" $::env(tmpprofile)] - if [catch {open "|[join $cmd " "] 2>@1" r+} ::inst] { - err_exit "Error starting actual installation" - } - } + # - non-blocking i/o chan configure $::inst -buffering line -blocking 0 chan event $::inst readable read_line_cb @@ -859,9 +820,6 @@ proc run_installer {} { proc main_prog {} { - wm title . "TeX Live 2018 Installer" - make_splash - # start install-tl-[tcl] via a pipe set cmd [list ${::perlbin} "${::instroot}/install-tl" \ "-from_ext_gui" {*}$::argv] @@ -871,6 +829,18 @@ proc main_prog {} { } set ::perlpid [pid $::inst] + # scan tlpkg/TeXLive/TLConfig.pm for $ReleaseYear + set ::release_year 0 + set cfg [open [file join $::instroot "tlpkg/TeXLive/TLConfig.pm"] r] + set re {\$ReleaseYear\s*=\s*([0-9]+)\s*;} + while {[gets $cfg l] >= 0} { + if [regexp $re $l m ::release_year] break + } + close $cfg + + wm title . "TeX Live $::release_year Installer" + make_splash + # do not start event-driven, non-blocking io # until the actual installation starts chan configure $::inst -buffering line -blocking 1 @@ -913,5 +883,6 @@ proc main_prog {} { } } -#file delete "/tmp/dblog" +file delete $::dblfile + main_prog |