summaryrefslogtreecommitdiffstats
path: root/src/bltInt.C
diff options
context:
space:
mode:
Diffstat (limited to 'src/bltInt.C')
-rw-r--r--src/bltInt.C56
1 files changed, 56 insertions, 0 deletions
diff --git a/src/bltInt.C b/src/bltInt.C
index 53691fc..f7335d0 100644
--- a/src/bltInt.C
+++ b/src/bltInt.C
@@ -86,4 +86,60 @@ int Tkblt_SafeInit(Tcl_Interp *interp)
return Tkblt_Init(interp);
}
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Blt_InitCmd --
+ *
+ * Given the name of a command, return a pointer to the clientData field
+ * of the command.
+ *
+ * Results:
+ * A standard TCL result. If the command is found, TCL_OK is returned
+ * and clientDataPtr points to the clientData field of the command (if
+ * the clientDataPtr in not NULL).
+ *
+ * Side effects:
+ * If the command is found, clientDataPtr is set to the address of the
+ * clientData of the command. If not found, an error message is left
+ * in interp->result.
+ *
+ *---------------------------------------------------------------------------
+ */
+/*ARGSUSED*/
+int Blt_InitCmd(Tcl_Interp *interp, const char *nsName,
+ Blt_InitCmdSpec *specPtr)
+{
+ const char *cmdPath;
+ Tcl_DString dString;
+ Tcl_Command cmdToken;
+ Tcl_Namespace *nsPtr;
+
+ Tcl_DStringInit(&dString);
+ if (nsName != NULL) {
+ Tcl_DStringAppend(&dString, nsName, -1);
+ }
+ Tcl_DStringAppend(&dString, "::", -1);
+ Tcl_DStringAppend(&dString, specPtr->name, -1);
+
+ cmdPath = Tcl_DStringValue(&dString);
+ cmdToken = Tcl_FindCommand(interp, cmdPath, (Tcl_Namespace *)NULL, 0);
+ if (cmdToken != NULL) {
+ Tcl_DStringFree(&dString);
+ return TCL_OK; /* Assume command was already initialized */
+ }
+ cmdToken = Tcl_CreateObjCommand(interp, cmdPath, specPtr->cmdProc,
+ specPtr->clientData, specPtr->cmdDeleteProc);
+ Tcl_DStringFree(&dString);
+ nsPtr = Tcl_FindNamespace(interp, nsName, (Tcl_Namespace *)NULL,
+ TCL_LEAVE_ERR_MSG);
+ if (nsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_Export(interp, nsPtr, specPtr->name, FALSE) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+