Redo TIP #440 alternative again, now using "info runtime".tip_440_alt

1 files changed, 39 insertions, 0 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 739dca9..e5378f0 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -142,6 +142,8 @@ static int		InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
+static int		InfoRuntimeCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
@@ -181,6 +183,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
     {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
     {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
     {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+    {"runtime",		   InfoRuntimeCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
     {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
@@ -2004,6 +2007,42 @@ InfoProcsCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * InfoRuntimeCmd --
+ *
+ *	Called to implement the "info runtime" command that returns the
+ *	runtime. For the Tcl Core implementation, it always returns "core".
+ *  Handles the following syntax:
+ *
+ *	    info runtime
+ *
+ * Results:
+ *	Returns TCL_OK.
+ *
+ * Side effects:
+ *	Returns a result ("core") in the interpreter's result object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoRuntimeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    if (objc != 1) {
+	Tcl_WrongNumArgs(interp, 1, objv, NULL);
+	return TCL_ERROR;
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewStringObj("core", -1));
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * InfoScriptCmd --
  *
  *	Called to implement the "info script" command that returns the script