diff options
| author | Steve Bennett <steveb@workware.net.au> | 2010-01-27 14:16:37 +1000 |
|---|---|---|
| committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:46 +1000 |
| commit | 8ca4eb0a1561cdd3ccd92d797cc744b6f8b0ea8d (patch) | |
| tree | 85a3de8ee319dbc2b1a4f89d06e4da5c801b9451 /tclcompat.tcl | |
| parent | 88694720353f9c0ad65f8e2ce31d5e1b645474d6 (diff) | |
| download | jimtcl-8ca4eb0a1561cdd3ccd92d797cc744b6f8b0ea8d.zip jimtcl-8ca4eb0a1561cdd3ccd92d797cc744b6f8b0ea8d.tar.gz jimtcl-8ca4eb0a1561cdd3ccd92d797cc744b6f8b0ea8d.tar.bz2 | |
Add support for 'file copy'
Diffstat (limited to 'tclcompat.tcl')
| -rw-r--r-- | tclcompat.tcl | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/tclcompat.tcl b/tclcompat.tcl index 84876c4..266f0d9 100644 --- a/tclcompat.tcl +++ b/tclcompat.tcl @@ -109,4 +109,27 @@ proc info_nameofexecutable {} { return "" } +# Implements 'file copy' - single file mode only +proc _file_copy {{force {}} source target} { + switch -- $force \ + -force {} \ + {} { + if {[file exists $target]} { + error "error copying \"$source\" to \"$target\": file already exists" + } + } \ + default { + error "bad option \"$force\": should be -force" + } + set in [open $source] + set rc [catch { + set out [open $target w] + bio copy $in $out + $out close + } result] + $in close + + return -code $rc $result +} + set ::tcl_platform(platform) unix |