Implement Tcl I/O wrappers in Tcl

This allows 'rename' etc. to work correctly and is smaller, simpler code
Also, read -nonewline is mutually exclusive with 'numChars'

Signed-off-by: Steve Bennett <steveb@workware.net.au>

2 files changed, 48 insertions, 111 deletions

diff --git a/jim-aio.c b/jim-aio.c
index 71e11cc..e606848 100644
--- a/jim-aio.c
+++ b/jim-aio.c
@@ -271,24 +271,21 @@ static int aio_cmd_read(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
     int nonewline = 0;
     int neededLen = -1;         /* -1 is "read as much as possible" */
 
-    if (argc && Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) {
-        nonewline = 1;
-        argv++;
-        argc--;
-    }
-    if (argc == 1) {
-        jim_wide wideValue;
+    if (argc) {
+        if (Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) {
+            nonewline = 1;
+        }
+        else {
+            jim_wide wideValue;
 
-        if (Jim_GetWide(interp, argv[0], &wideValue) != JIM_OK)
-            return JIM_ERR;
-        if (wideValue < 0) {
-            Jim_SetResultString(interp, "invalid parameter: negative len", -1);
-            return JIM_ERR;
+            if (Jim_GetWide(interp, argv[0], &wideValue) != JIM_OK)
+                return JIM_ERR;
+            if (wideValue < 0) {
+                Jim_SetResultString(interp, "invalid parameter: negative len", -1);
+                return JIM_ERR;
+            }
+            neededLen = (int)wideValue;
         }
-        neededLen = (int)wideValue;
-    }
-    else if (argc) {
-        return -1;
     }
     objPtr = Jim_NewStringObj(interp, NULL, 0);
     while (neededLen != 0) {
@@ -580,7 +577,8 @@ static int aio_cmd_seek(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
         else if (Jim_CompareStringImmediate(interp, argv[1], "end"))
             orig = SEEK_END;
         else {
-            return -1;
+            Jim_SetResultFormatted(interp, "bad origin \"%#s\": must be start, current, or end", argv[1]);
+            return JIM_ERR;
         }
     }
     if (Jim_GetLong(interp, argv[0], &offset) != JIM_OK) {
@@ -703,10 +701,10 @@ static int aio_cmd_onexception(Jim_Interp *interp, int argc, Jim_Obj *const *arg
 
 static const jim_subcmd_type aio_command_table[] = {
     {   .cmd = "read",
-        .args = "?-nonewline? ?len?",
+        .args = "?-nonewline|len?",
         .function = aio_cmd_read,
         .minargs = 0,
-        .maxargs = 2,
+        .maxargs = 1,
         .description = "Read and return bytes from the stream. To eof if no len."
     },
     {   .cmd = "gets",
@@ -1188,93 +1186,6 @@ FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command)
     return NULL;
 }
 
-#ifdef JIM_TCL_COMPAT
-static int JimAioTclCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
-{
-    Jim_Obj *newargv[4];
-    int ret;
-    int i;
-    int nonewline = 0;
-
-    if (argc > 1 && Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
-        nonewline = 1;
-    }
-    if (argc < 2 + nonewline || argc > 4) {
-        Jim_WrongNumArgs(interp, 1, argv, "channel");
-        return JIM_ERR;
-    }
-
-    if (nonewline) {
-        /* read -nonewline $f ... => $f read -nonewline ... */
-        newargv[0] = argv[2];
-        newargv[1] = argv[0];
-        newargv[2] = argv[1];
-    }
-    else {
-        /* cmd $f ... => $f cmd ... */
-        newargv[0] = argv[1];
-        newargv[1] = argv[0];
-    }
-
-    for (i = 2 + nonewline; i < argc; i++) {
-        newargv[i] = argv[i];
-    }
-
-    ret = Jim_EvalObjVector(interp, argc, newargv);
-
-    return ret;
-}
-
-static int JimAioPutsCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
-{
-    Jim_Obj *newargv[4];
-    int nonewline = 0;
-
-    int off = 1;
-
-    if (argc > 1 && Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) {
-        nonewline = 1;
-    }
-
-    if (argc < 2 + nonewline || argc > 3 + nonewline) {
-        Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? ?channel? string");
-        return JIM_ERR;
-    }
-
-    /* "puts" */
-    newargv[off++] = argv[0];
-
-    if (nonewline) {
-        newargv[off++] = argv[1];
-        argv++;
-        argc--;
-    }
-
-    if (argc == 2) {
-        /* Missing channel, so use stdout */
-        newargv[0] = Jim_NewStringObj(interp, "stdout", -1);
-        newargv[off++] = argv[1];
-    }
-    else {
-        newargv[0] = argv[1];
-        newargv[off++] = argv[2];
-    }
-
-    return Jim_EvalObjVector(interp, off, newargv);
-}
-
-static void JimAioTclCompat(Jim_Interp *interp)
-{
-    static const char * const tclcmds[] = { "read", "gets", "flush", "close", "eof", "seek", "tell", 0 };
-    int i;
-
-    for (i = 0; tclcmds[i]; i++) {
-        Jim_CreateCommand(interp, tclcmds[i], JimAioTclCmd, NULL, NULL);
-    }
-    Jim_CreateCommand(interp, "puts", JimAioPutsCmd, NULL, NULL);
-}
-#endif
-
 int Jim_aioInit(Jim_Interp *interp)
 {
     if (Jim_PackageProvide(interp, "aio", "1.0", JIM_ERRMSG))
@@ -1288,9 +1199,5 @@ int Jim_aioInit(Jim_Interp *interp)
     /* Takeover stdin, stdout and stderr */
     Jim_EvalGlobal(interp, "open stdin; open stdout; open stderr");
 
-#ifdef JIM_TCL_COMPAT
-    JimAioTclCompat(interp);
-#endif
-
     return JIM_OK;
 }
diff --git a/tclcompat.tcl b/tclcompat.tcl
index 01db0cb..6c981b7 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -1,11 +1,41 @@
 # (c) 2008 Steve Bennett <steveb@workware.net.au>
 #
 # Loads some Tcl-compatible features.
-# case, lassign, parray, errorInfo, ::tcl_platform, ::env
+# I/O commands, case, lassign, parray, errorInfo, ::tcl_platform, ::env
+# try, throw, file copy, info nameofexecutable
 
 # Set up the ::env array
 set env [env]
 
+# Tcl-compatible I/O commands
+foreach p {gets flush close eof seek tell} {
+	proc $p {chan args} {p} {
+		tailcall $chan $p {*}$args
+	}
+}
+unset p
+
+# puts is complicated by -nonewline
+#
+proc puts {{-nonewline {}} {chan stdout} msg} {
+	if {${-nonewline} ni {-nonewline {}}} {
+		tailcall ${-nonewline} puts $msg
+	}
+	tailcall $chan puts {*}${-nonewline} $msg
+}
+
+# read is complicated by -nonewline
+#
+# read chan ?maxchars?
+# read -nonewline chan
+proc read {{-nonewline {}} chan} {
+	if {${-nonewline} ni {-nonewline {}}} {
+		tailcall ${-nonewline} read {*}${chan}
+	}
+	tailcall $chan read {*}${-nonewline}
+}
+
+
 # Tcl 8.5 lassign
 proc lassign {list args} {
 	# in case the list is empty...