diff options
author | Norbert Preining <norbert@preining.info> | 2020-02-18 03:02:28 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2020-02-18 03:02:28 +0000 |
commit | bb5325dae4202b519b7210a338651301e048998d (patch) | |
tree | 4caa8d8c62275cb193df85d10f8f0e10bab587b3 /systems/texlive/tlnet/tlpkg/tltcl | |
parent | 67394fd2cfa6167f7e2316237629bec93851c1fb (diff) |
CTAN sync 202002180302
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tltcl')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl | 24 |
1 files changed, 23 insertions, 1 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl b/systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl index b0b8d1c19d..11f237b18c 100644 --- a/systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl +++ b/systems/texlive/tlnet/tlpkg/tltcl/tltcl.tcl @@ -1,6 +1,6 @@ #!/usr/bin/env wish -# Copyright 2018 Siep Kroonenberg +# Copyright 2018-2020 Siep Kroonenberg # This file is licensed under the GNU General Public License version 2 # or any later version. @@ -543,6 +543,28 @@ proc native_slashify {s} { return $r } +# test whether a directory is writable. +# 'file writable' merely tests permissions, which may not be good enough +proc dir_writable {d} { + for {set x 0} {$x<100} {incr x} { + set y [expr {int(10000*rand())}] + set newfile [file join $::instroot $y] + if [file exists $newfile] { + continue + } else { + set fid [open $newfile w] + chan close $fid + if [file exists $newfile] { + file delete $newfile + return 1 + } else { + return 0 + } + } + } + return 0 +} + # unix: choose_dir replacing native directory browser if {$::tcl_platform(platform) eq "unix"} { |