Posted to tcl by patthoyts at Wed Apr 29 13:56:40 GMT 2009view pretty

#include <tcl.h>

#define TCL_VERSION_WRONG "8.0"         /* Workaround for #1091431 */

typedef struct DemoData {
    Tcl_Obj *argObj;
} DemoData;

static void
DemoDataCleanup(ClientData clientData)
{
    DemoData *dataPtr = (DemoData *)clientData;
    if (dataPtr->argObj)
        Tcl_DecrRefCount(dataPtr->argObj);
    ckfree((char *)dataPtr);
}

static int
Demo_DataCommand(ClientData clientData, Tcl_Interp *interp,
                 int objc, Tcl_Obj *const objv[])
{
    DemoData *dataPtr = (DemoData *)clientData;
    Tcl_SetObjResult(interp, dataPtr->argObj);
    return TCL_OK;
}

static int
Demo_DemoCommand(ClientData clientData, Tcl_Interp *interp, 
                 int objc, Tcl_Obj *const objv[])
{
    DemoData *dataPtr = NULL;

    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "cmdname junk");
        return TCL_ERROR;
    }
    dataPtr = (DemoData *)ckalloc(sizeof(DemoData));
    dataPtr->argObj = Tcl_DuplicateObj(objv[2]);
    Tcl_IncrRefCount(dataPtr->argObj);
    Tcl_CreateObjCommand(interp, Tcl_GetString(objv[1]), Demo_DataCommand,
                         dataPtr, DemoDataCleanup);
    return TCL_OK;
}

int DLLEXPORT
Tcldemo_Init(Tcl_Interp *interp)
{
#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, TCL_VERSION_WRONG, 0) == NULL) {
        return TCL_ERROR;
    }
#endif

    Tcl_CreateObjCommand(interp, "demo", Demo_DemoCommand, NULL, NULL);
    Tcl_PkgProvide(interp, "tcldemo", "1.0");
    return TCL_OK;
}