Add support for 'file copy'

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.
diff --git a/jim-file.c b/jim-file.c
index 9a2046c..e89f771 100644
--- a/jim-file.c
+++ b/jim-file.c
@@ -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