$e } res] file delete $c if {$code} { append res \n[read [set chan [open $e r]]][close $chan] file delete $e return -code error "Shell \"$shell\" is not executable ($res)" } file delete $e return $res } proc ::platform::shell::TEMP {} { set prefix platform # This code is copied out of Tcllib's fileutil package. # (TempFile/tempfile) set tmpdir [DIR] set chars "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" set nrand_chars 10 set maxtries 10 set access [list RDWR CREAT EXCL TRUNC] set permission 0600 set channel "" set checked_dir_writable 0 set mypid [pid] for {set i 0} {$i < $maxtries} {incr i} { set newname $prefix for {set j 0} {$j < $nrand_chars} {incr j} { append newname [string index $chars \ [expr {int(rand()*62)}]] } set newname [file join $tmpdir $newname] if {[file exists $newname]} { after 1 } else { if {[catch {open $newname $access $permission} channel]} { if {!$checked_dir_writable} { set dirname [file dirname $newname] if {![file writable $dirname]} { return -code error "Directory $dirname is not writable" } set checked_dir_writable 1 } } else { # Success close $channel return [file normalize $newname] } } } if {$channel != ""} { return -code error "Failed to open a temporary file: $channel" } else { return -code error "Failed to find an unused temporary file name" } } proc ::platform::shell::DIR {} { # This code is copied out of Tcllib's fileutil package. # (TempDir/tempdir) global tcl_platform env set attempdirs [list] foreach tmp {TMPDIR TEMP TMP} { if { [info exists env($tmp)] } { lappend attempdirs $env($tmp) } } switch $tcl_platform(platform) { windows { lappend attempdirs "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP" } macintosh { set tmpdir $env(TRASH_FOLDER) ;# a better place? } default { lappend attempdirs \ [file join / tmp] \ [file join / var tmp] \ [file join / usr tmp] } } lappend attempdirs [pwd] foreach tmp $attempdirs { if { [file isdirectory $tmp] && [file writable $tmp] } { return [file normalize $tmp] } } # Fail if nothing worked. return -code error "Unable to determine a proper directory for temporary files" } # ### ### ### ######### ######### ######### ## Ready package provide platform::shell 1.1.4