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

  1. #include <tcl.h>
  2.  
  3. #define TCL_VERSION_WRONG "8.0" /* Workaround for #1091431 */
  4.  
  5. typedef struct DemoData {
  6. Tcl_Obj *argObj;
  7. } DemoData;
  8.  
  9. static void
  10. DemoDataCleanup(ClientData clientData)
  11. {
  12. DemoData *dataPtr = (DemoData *)clientData;
  13. if (dataPtr->argObj)
  14. Tcl_DecrRefCount(dataPtr->argObj);
  15. ckfree((char *)dataPtr);
  16. }
  17.  
  18. static int
  19. Demo_DataCommand(ClientData clientData, Tcl_Interp *interp,
  20. int objc, Tcl_Obj *const objv[])
  21. {
  22. DemoData *dataPtr = (DemoData *)clientData;
  23. Tcl_SetObjResult(interp, dataPtr->argObj);
  24. return TCL_OK;
  25. }
  26.  
  27. static int
  28. Demo_DemoCommand(ClientData clientData, Tcl_Interp *interp,
  29. int objc, Tcl_Obj *const objv[])
  30. {
  31. DemoData *dataPtr = NULL;
  32.  
  33. if (objc != 3) {
  34. Tcl_WrongNumArgs(interp, 1, objv, "cmdname junk");
  35. return TCL_ERROR;
  36. }
  37. dataPtr = (DemoData *)ckalloc(sizeof(DemoData));
  38. dataPtr->argObj = Tcl_DuplicateObj(objv[2]);
  39. Tcl_IncrRefCount(dataPtr->argObj);
  40. Tcl_CreateObjCommand(interp, Tcl_GetString(objv[1]), Demo_DataCommand,
  41. dataPtr, DemoDataCleanup);
  42. return TCL_OK;
  43. }
  44.  
  45. int DLLEXPORT
  46. Tcldemo_Init(Tcl_Interp *interp)
  47. {
  48. #ifdef USE_TCL_STUBS
  49. if (Tcl_InitStubs(interp, TCL_VERSION_WRONG, 0) == NULL) {
  50. return TCL_ERROR;
  51. }
  52. #endif
  53.  
  54. Tcl_CreateObjCommand(interp, "demo", Demo_DemoCommand, NULL, NULL);
  55. Tcl_PkgProvide(interp, "tcldemo", "1.0");
  56. return TCL_OK;
  57. }