texlive[50725] Master/tlpkg/installer/install-tl-gui.tcl: Symlinks:
commits+siepo at tug.org
commits+siepo at tug.org
Wed Apr 3 21:29:12 CEST 2019
Revision: 50725
http://tug.org/svn/texlive?view=revision&revision=50725
Author: siepo
Date: 2019-04-03 21:29:11 +0200 (Wed, 03 Apr 2019)
Log Message:
-----------
Symlinks: greatgrandparent of target must exist
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 2019-04-03 16:06:28 UTC (rev 50724)
+++ trunk/Master/tlpkg/installer/install-tl-gui.tcl 2019-04-03 19:29:11 UTC (rev 50725)
@@ -56,7 +56,7 @@
set ::perlbin "perl"
if {$::tcl_platform(platform) eq "windows"} {
- set ::perlbin "${::instroot}/tlpkg/tlperl/bin/wperl.exe"
+ set ::perlbin "${::instroot}/tlpkg/tlperl/bin/perl.exe"
}
# menu modes
@@ -265,6 +265,9 @@
-default no]
if {$ans eq "no"} return
catch {chan close $::inst}
+ if {$::tcl_platform(platform) eq "windows"} {
+ catch {exec taskkill /pid $::perlpid /t /f}
+ }
exit
}
ppack .abort -in .bottom -side right
@@ -1001,9 +1004,23 @@
# 'file writable' is only a check of unix permissions
proc dest_ok {d} {
if {$d eq ""} {return 0}
- if {! [file isdirectory $d]} {return 0}
- if {! [file writable $d]} {return 0}
- return 1
+ set its 1
+ while 1 {
+ if [file exists $d] {
+ if {! [file isdirectory $d]} {
+ return 0
+ } elseif {! [file writable $d]} {
+ return 0
+ } else {
+ return 1
+ }
+ } ; # if file exists
+ # try a level up
+ set d [file dirname $d]
+ set its [expr {$its + 1}]
+ if {$its > 3} {return 0}
+ }
+ return 0
}
proc dis_enable_symlink_option {} {
@@ -1147,7 +1164,7 @@
ttk::label .title -text [__ "TeX Live %s Installer" $::release_year] \
-font titlefont
pack .title -pady {10 1} -in .bg
- pack [ttk::label .svn -text "revision $::svn"] -in .bg
+ pack [ttk::label .svn -text "r. $::svn"] -in .bg
pack [ttk::separator .seph0 -orient horizontal] \
-in .bg -pady 3 -fill x
More information about the tex-live-commits
mailing list