diff options
-rw-r--r-- | doc/jim_tcl.txt | 5 | ||||
-rw-r--r-- | jim-file.c | 21 | ||||
-rw-r--r-- | tclcompat.tcl | 23 |
3 files changed, 49 insertions, 0 deletions
diff --git a/doc/jim_tcl.txt b/doc/jim_tcl.txt index 281817b..a5722ea 100644 --- a/doc/jim_tcl.txt +++ b/doc/jim_tcl.txt @@ -75,6 +75,7 @@ Since v0.61: 13. Allow 'catch' to determine what return codes are caught 14. Allow 'incr' to increment an unset variable by first setting to 0 15. Allow 'args' and optional arguments to the left or required arguments in 'proc' +15. Add 'file copy' TCL INTRODUCTION ----------------- @@ -1843,6 +1844,10 @@ abbreviation for *option* is acceptable. The valid options are: If the file doesn't exist or its access time cannot be queried then an error is generated. ++*file copy ?-force?* 'source target'+:: + Copies file *source* to file *target*. The source file must exist. + The target file must not exist, unless *-force* is specified. + +*file delete* 'name'+:: Deletes file *name*. If the file doesn't exist, nothing happens. If the file can't be deleted, an error is generated. @@ -436,6 +436,20 @@ static int file_cmd_mtime(Jim_Interp *interp, int argc, Jim_Obj *const *argv) return JIM_OK; } +static int file_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *new_argv[4]; + int i; + + new_argv[0] = Jim_NewStringObj(interp, "_file_copy", -1); + for (i = 0; i < argc; i++) { + new_argv[i + 1] = argv[i]; + } + + /* Note that Jim_EvalObjVector() will incr then decr ref count of new_argv[0] */ + return Jim_EvalObjVector(interp, argc + 1, new_argv); +} + static int file_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv) { struct stat sb; @@ -547,6 +561,13 @@ static const jim_subcmd_type command_table[] = { .maxargs = 1, .description = "Last modification time" }, + { .cmd = "copy", + .args = "?-force? source dest", + .function = file_cmd_copy, + .minargs = 2, + .maxargs = 3, + .description = "Copy source file to destination file" + }, { .cmd = "dirname", .args = "name", .function = file_cmd_dirname, 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 |