Remove tclPkg.c changes, instead implement new tcl::build-info command

1 files changed, 47 insertions, 1 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0a4d145..a7f89a4 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -607,6 +607,49 @@ TclFinalizeEvaluation(void)
 /*
  *----------------------------------------------------------------------
  *
+ * buildInfoObjCmd --
+ *
+ *	Implements tcl::build-info command.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+buildInfoObjCmd(
+    void *clientData,
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    if (objc > 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
+	return TCL_ERROR;
+    }
+    if (objc == 2) {
+	const char *arg = Tcl_GetString(objv[1]);
+	const char *p = strstr((char *)clientData, arg);
+	size_t len = strlen(arg);
+	if ((p > (char *)clientData) && p[-1] == '.'
+		&& ((p[len] == '.') || (p[len] == '\0'))) {
+	    Tcl_AppendResult(interp, "1", NULL);
+	} else {
+	    Tcl_AppendResult(interp, "0", NULL);
+	}
+	return TCL_OK;
+    }
+    Tcl_AppendResult(interp, (char *)clientData, NULL);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_CreateInterp --
  *
  *	Create a new TCL command interpreter.
@@ -1179,7 +1222,10 @@ Tcl_CreateInterp(void)
      */
 
     Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
-    Tcl_PkgProvideEx(interp, "tcl", version, &tclStubs);
+    Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);
+    Tcl_CreateObjCommand(interp, "::tcl::build-info",
+	    buildInfoObjCmd, (void *)version, NULL);
+
 
     if (TclTommath_Init(interp) != TCL_OK) {
 	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));