Remove dependence of jim core on stderr

Remove Jim_PrintErrorMessage() and create Jim_MakeErrorMessage() instead.
Move errorInfo to stdlib since it is now required.

Also move lassign from tclcompat to stdlib as a core command.

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

7 files changed, 48 insertions, 66 deletions

diff --git a/jim-eventloop.c b/jim-eventloop.c
index 9c1bd7c..7192745 100644
--- a/jim-eventloop.c
+++ b/jim-eventloop.c
@@ -116,8 +116,10 @@ int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
             }
             else {
                 /* Report the error to stderr. */
-                fprintf(stderr, "Background error:" JIM_NL);
-                Jim_PrintErrorMessage(interp);
+                Jim_MakeErrorMessage(interp);
+                fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL));
+                /* And reset the result */
+                Jim_SetResultString(interp, "", -1);
             }
         }
         Jim_DecrRefCount(interp, objv[0]);
diff --git a/jim-interactive.c b/jim-interactive.c
index 4aa2923..15b4cba 100644
--- a/jim-interactive.c
+++ b/jim-interactive.c
@@ -53,18 +53,16 @@ int Jim_InteractivePrompt(Jim_Interp *interp)
         }
         retcode = Jim_EvalObj(interp, scriptObjPtr);
         Jim_DecrRefCount(interp, scriptObjPtr);
-        result = Jim_GetString(Jim_GetResult(interp), &reslen);
-        if (retcode == JIM_ERR) {
-            Jim_PrintErrorMessage(interp);
-        }
-        else if (retcode == JIM_EXIT) {
+        if (retcode == JIM_EXIT) {
             Jim_Free(buf);
             exit(Jim_GetExitCode(interp));
         }
-        else {
-            if (reslen) {
-                printf("%s\n", result);
-            }
+        if (retcode == JIM_ERR) {
+            Jim_MakeErrorMessage(interp);
+        }
+        result = Jim_GetString(Jim_GetResult(interp), &reslen);
+        if (reslen) {
+            printf("%s\n", result);
         }
     }
   out:
diff --git a/jim.c b/jim.c
index 2a058d6..d0dc110 100644
--- a/jim.c
+++ b/jim.c
@@ -13437,38 +13437,14 @@ void Jim_RegisterCoreCommands(Jim_Interp *interp)
 /* -----------------------------------------------------------------------------
  * Interactive prompt
  * ---------------------------------------------------------------------------*/
-void Jim_PrintErrorMessage(Jim_Interp *interp)
+void Jim_MakeErrorMessage(Jim_Interp *interp)
 {
-    int len, i;
+    Jim_Obj *argv[2];
 
-    if (*interp->errorFileName) {
-        fprintf(stderr, "%s:%d: Runtime Error: ", interp->errorFileName, interp->errorLine);
-    }
-    fprintf(stderr, "%s" JIM_NL, Jim_GetString(interp->result, NULL));
-    len = Jim_ListLength(interp, interp->stackTrace);
-    for (i = len - 3; i >= 0; i -= 3) {
-        Jim_Obj *objPtr = 0;
-        const char *proc, *file, *line;
+    argv[0] = Jim_NewStringObj(interp, "errorInfo", -1);
+    argv[1] = interp->result;
 
-        Jim_ListIndex(interp, interp->stackTrace, i, &objPtr, JIM_NONE);
-        proc = Jim_GetString(objPtr, NULL);
-        Jim_ListIndex(interp, interp->stackTrace, i + 1, &objPtr, JIM_NONE);
-        file = Jim_GetString(objPtr, NULL);
-        Jim_ListIndex(interp, interp->stackTrace, i + 2, &objPtr, JIM_NONE);
-        line = Jim_GetString(objPtr, NULL);
-        if (*proc) {
-            fprintf(stderr, "in procedure '%s' ", proc);
-            if (*file) {
-                fprintf(stderr, "called ");
-            }
-        }
-        if (*file) {
-            fprintf(stderr, "at file \"%s\", line %s", file, line);
-        }
-        if (*file || *proc) {
-            fprintf(stderr, JIM_NL);
-        }
-    }
+    Jim_EvalObjVector(interp, 2, argv);
 }
 
 static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype,
diff --git a/jim.h b/jim.h
index 6c7a8e8..7325eb2 100644
--- a/jim.h
+++ b/jim.h
@@ -863,7 +863,7 @@ JIM_EXPORT int Jim_PackageRequire (Jim_Interp *interp,
         const char *name, int flags);
 
 /* error messages */
-JIM_EXPORT void Jim_PrintErrorMessage (Jim_Interp *interp);
+JIM_EXPORT void Jim_MakeErrorMessage (Jim_Interp *interp);
 
 /* interactive mode */
 JIM_EXPORT int Jim_InteractivePrompt (Jim_Interp *interp);
diff --git a/jimsh.c b/jimsh.c
index 32f16b7..d5ad678 100644
--- a/jimsh.c
+++ b/jimsh.c
@@ -112,7 +112,8 @@ static int JimLoadJimRc(Jim_Interp *interp)
             fclose(fp);
             retcode = Jim_EvalFile(interp, buf);
             if (retcode == JIM_ERR) {
-                Jim_PrintErrorMessage(interp);
+                Jim_MakeErrorMessage(interp);
+                fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL));
             }
             return retcode;
         }
@@ -147,7 +148,8 @@ int main(int argc, char *const argv[])
 
     /* Register static extensions */
     if (Jim_InitStaticExtensions(interp) != JIM_OK) {
-        Jim_PrintErrorMessage(interp);
+        Jim_MakeErrorMessage(interp);
+        fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL));
     }
 
     /* Append the path where the executed Jim binary is contained
@@ -180,7 +182,8 @@ int main(int argc, char *const argv[])
             retcode = Jim_EvalFile(interp, argv[1]);
         }
         if (retcode == JIM_ERR) {
-            Jim_PrintErrorMessage(interp);
+            Jim_MakeErrorMessage(interp);
+            fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL));
         }
     }
     if (retcode == JIM_OK) {
diff --git a/stdlib.tcl b/stdlib.tcl
index b4a9a69..3f3a6e5 100644
--- a/stdlib.tcl
+++ b/stdlib.tcl
@@ -38,6 +38,14 @@ proc function {value} {
 	return $value
 }
 
+# Tcl 8.5 lassign
+proc lassign {list args} {
+	# in case the list is empty...
+	lappend list {}
+	uplevel 1 [list foreach $args $list break]
+	lrange $list [llength $args] end-1
+}
+
 # Returns a list of proc filename line ...
 # with 3 entries for each stack frame (proc),
 # (deepest level first)
@@ -71,3 +79,20 @@ proc stackdump {stacktrace} {
 	}
 	return $result
 }
+
+# Sort of replacement for $::errorInfo
+# Usage: errorInfo error ?stacktrace?
+proc errorInfo {msg {stacktrace ""}} {
+	if {$stacktrace eq ""} {
+		set stacktrace [info stacktrace]
+	}
+	lassign $stacktrace p f l
+	if {$f ne ""} {
+		set result "$f:$l "
+	}
+	append result "Runtime Error: $msg\n"
+	append result [stackdump $stacktrace]
+
+	# Remove the trailing newline
+	string trim $result
+}
diff --git a/tclcompat.tcl b/tclcompat.tcl
index c632103..398a916 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -36,14 +36,6 @@ proc read {{-nonewline {}} chan} {
 }
 
 
-# Tcl 8.5 lassign
-proc lassign {list args} {
-	# in case the list is empty...
-	lappend list {}
-	uplevel 1 [list foreach $args $list break]
-	lrange $list [llength $args] end-1
-}
-
 # case var ?in? pattern action ?pattern action ...?
 proc case {var args} {
 	# Skip dummy parameter
@@ -109,20 +101,6 @@ proc parray {arrayname {pattern *} {puts puts}} {
 	}
 }
 
-# Sort of replacement for $::errorInfo
-# Usage: errorInfo error ?stacktrace?
-proc errorInfo {error {stacktrace ""}} {
-	if {$stacktrace eq ""} {
-		set stacktrace [info stacktrace]
-	}
-	lassign $stacktrace p f l
-	if {$f ne ""} {
-		set result "$f:$l "
-	}
-	append result "Runtime Error: $error\n"
-	append result [stackdump $stacktrace]
-}
-
 proc {info nameofexecutable} {} {
 	if {[info exists ::jim_argv0]} {
 		if {[string first "/" $::jim_argv0] >= 0} {