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; }