texlive[48099] Master/tlpkg/installer/install-tl-gui.tcl: Win32
commits+siepo at tug.org
commits+siepo at tug.org
Wed Jun 27 18:13:05 CEST 2018
Revision: 48099
http://tug.org/svn/texlive?view=revision&revision=48099
Author: siepo
Date: 2018-06-27 18:13:04 +0200 (Wed, 27 Jun 2018)
Log Message:
-----------
Win32 console windows solved: also tcl script
Modified Paths:
--------------
trunk/Master/tlpkg/installer/install-tl-gui.tcl
Modified: trunk/Master/tlpkg/installer/install-tl-gui.tcl
===================================================================
--- trunk/Master/tlpkg/installer/install-tl-gui.tcl 2018-06-27 16:10:39 UTC (rev 48098)
+++ trunk/Master/tlpkg/installer/install-tl-gui.tcl 2018-06-27 16:13:04 UTC (rev 48099)
@@ -41,6 +41,10 @@
# 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 ::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 @@
# 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 @@
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 @@
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 @@
return $::dialog_ans
}; # select_binaries
+#############################################################
+
### scheme ###
proc select_scheme {} {
create_dlg .tlschm .
@@ -494,6 +494,8 @@
return $::dialog_ans
}; # select_scheme
+#############################################################
+
### collections ###
# toggle collection in treeview widget, but not in underlying data
@@ -610,6 +612,8 @@
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 @@
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 @@
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 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 @@
}
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 @@
}
}
-#file delete "/tmp/dblog"
+file delete $::dblfile
+
main_prog
More information about the tex-live-commits
mailing list