diff options
Diffstat (limited to 'src/bltInt.C')
-rw-r--r-- | src/bltInt.C | 56 |
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; +} + |