Posted to tcl by emiliano at Thu Oct 31 18:19:08 GMT 2024view raw

  1. #include <tcl.h>
  2. #include <tk.h>
  3.  
  4. typedef int (HashSubCmd)(ClientData, Tcl_Interp *, int, Tcl_Obj *const []);
  5. static HashSubCmd DeleteOp;
  6. static HashSubCmd GetOp;
  7. static HashSubCmd SetOp;
  8. static HashSubCmd StatOp;
  9. static Tk_EventProc hashDestroyHandler;
  10.  
  11. /* wrapper for our data
  12. * this makes easier to deal with Tk event handler on window destroy
  13. */
  14. struct ValueData {
  15. Tcl_Obj *objPtr;
  16. Tk_Window tkwin;
  17. Tcl_HashTable *tablePtr;
  18. };
  19.  
  20. static int
  21. Hash_Cmd(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  22. {
  23. static const struct HashCmds {
  24. char *name;
  25. HashSubCmd *subCmd;
  26. } hashCmds[] = {
  27. {"delete", DeleteOp},
  28. {"get", GetOp},
  29. {"set", SetOp},
  30. {"stat", StatOp},
  31. {NULL, NULL}
  32. };
  33. int index;
  34.  
  35. if (objc < 2) {
  36. Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
  37. return TCL_ERROR;
  38. }
  39.  
  40. if (Tcl_GetIndexFromObjStruct(interp, objv[1], hashCmds,
  41. sizeof(struct HashCmds), "subcommand", 0, &index) != TCL_OK) {
  42. return TCL_ERROR;
  43. }
  44.  
  45. return hashCmds[index].subCmd(clientdata, interp, objc, objv);
  46. }
  47.  
  48. static int
  49. SetOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  50. {
  51. Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
  52. Tk_Window tkwin;
  53. int isNew;
  54. Tcl_Size size;
  55. Tcl_HashEntry *entryPtr;
  56. struct ValueData *data;
  57.  
  58. if (objc != 4) {
  59. Tcl_WrongNumArgs(interp, 2, objv, "window dict");
  60. return TCL_ERROR;
  61. }
  62.  
  63. tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), Tk_MainWindow(interp));
  64. if (! tkwin) {
  65. return TCL_ERROR;
  66. }
  67. /* make sure we have a dict */
  68. if ( Tcl_DictObjSize(interp, objv[3], &size) != TCL_OK) {
  69. return TCL_ERROR;
  70. }
  71.  
  72. entryPtr = Tcl_CreateHashEntry(tablePtr, tkwin, &isNew);
  73. if (! isNew) {
  74. data = Tcl_GetHashValue(entryPtr);
  75. Tcl_DecrRefCount(data->objPtr);
  76. } else {
  77. data = (struct ValueData *)ckalloc(sizeof(struct ValueData));
  78. data->tablePtr = tablePtr;
  79. data->tkwin = tkwin;
  80. Tk_CreateEventHandler(tkwin, StructureNotifyMask, hashDestroyHandler,
  81. data);
  82. }
  83.  
  84. data->objPtr = objv[3];
  85. Tcl_IncrRefCount(data->objPtr);
  86. Tcl_SetHashValue(entryPtr, data);
  87. Tcl_SetObjResult(interp, data->objPtr);
  88. return TCL_OK;
  89. }
  90.  
  91. static int
  92. GetOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  93. {
  94. Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
  95. Tk_Window tkwin;
  96. Tcl_HashEntry *entryPtr;
  97. struct ValueData *data;
  98.  
  99. if (objc != 3) {
  100. Tcl_WrongNumArgs(interp, 2, objv, "window");
  101. return TCL_ERROR;
  102. }
  103.  
  104. tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), Tk_MainWindow(interp));
  105. if (! tkwin) {
  106. return TCL_ERROR;
  107. }
  108.  
  109. entryPtr = Tcl_FindHashEntry(tablePtr, tkwin);
  110. if (! entryPtr) {
  111. Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't find entry for window %s",
  112. Tcl_GetString(objv[2])));
  113. return TCL_ERROR;
  114. }
  115.  
  116. data = Tcl_GetHashValue(entryPtr);
  117. Tcl_SetObjResult(interp, data->objPtr);
  118. return TCL_OK;
  119. }
  120.  
  121. static int
  122. StatOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  123. {
  124. Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
  125. char *stats;
  126.  
  127. if (objc != 2) {
  128. Tcl_WrongNumArgs(interp, 2, objv, NULL);
  129. return TCL_ERROR;
  130. }
  131.  
  132. stats = Tcl_HashStats(tablePtr);
  133. Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
  134. ckfree(stats);
  135. return TCL_OK;
  136. }
  137.  
  138. static int
  139. DeleteOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
  140. {
  141. Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
  142. Tk_Window tkwin;
  143. Tcl_HashEntry *entryPtr;
  144. struct ValueData *data;
  145.  
  146. if (objc != 3) {
  147. Tcl_WrongNumArgs(interp, 2, objv, "window");
  148. return TCL_ERROR;
  149. }
  150.  
  151. tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), Tk_MainWindow(interp));
  152. if (! tkwin) {
  153. return TCL_ERROR;
  154. }
  155.  
  156. entryPtr = Tcl_FindHashEntry(tablePtr, tkwin);
  157. if (! entryPtr) {
  158. Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't find entry for window %s",
  159. Tcl_GetString(objv[2])));
  160. return TCL_ERROR;
  161. }
  162.  
  163. data = Tcl_GetHashValue(entryPtr);
  164. Tk_DeleteEventHandler(data->tkwin, StructureNotifyMask, hashDestroyHandler,
  165. data);
  166. Tcl_DecrRefCount(data->objPtr);
  167. ckfree(data);
  168. Tcl_DeleteHashEntry(entryPtr);
  169. return TCL_OK;
  170. }
  171.  
  172. void
  173. hashDestroyHandler(ClientData clientData, XEvent *eventPtr)
  174. {
  175. struct ValueData *data = (struct ValueData *) clientData;
  176. Tcl_HashEntry *entryPtr;
  177.  
  178. if (eventPtr->type != DestroyNotify) return;
  179.  
  180. entryPtr = Tcl_FindHashEntry(data->tablePtr, data->tkwin);
  181. if (! entryPtr) return;
  182.  
  183. Tcl_DecrRefCount(data->objPtr);
  184. ckfree(data);
  185. Tcl_DeleteHashEntry(entryPtr);
  186. return;
  187. }
  188.  
  189. /*
  190. * Hash_DeleteProc -- Called when Tcl deletes the "hash" command
  191. */
  192. void
  193. Hash_DeleteProc(ClientData clientData)
  194. {
  195. Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
  196. Tcl_HashSearch search;
  197. Tcl_HashEntry *entryPtr;
  198. struct ValueData *data;
  199.  
  200. for (entryPtr = Tcl_FirstHashEntry(tablePtr, &search); entryPtr != NULL;
  201. entryPtr = Tcl_NextHashEntry(&search)) {
  202. data = Tcl_GetHashValue(entryPtr);
  203. Tcl_DecrRefCount(data->objPtr);
  204. ckfree(data);
  205. Tcl_DeleteHashEntry(entryPtr);
  206. }
  207.  
  208. Tcl_DeleteHashTable(tablePtr);
  209. ckfree(tablePtr);
  210. return;
  211. }
  212.  
  213. /*
  214. * Hashsample_Init -- Called when Tcl loads your extension.
  215. */
  216. int DLLEXPORT
  217. Hashsample_Init(Tcl_Interp *interp)
  218. {
  219. Tcl_HashTable *tablePtr;
  220.  
  221. if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
  222. return TCL_ERROR;
  223. }
  224. if (Tk_InitStubs(interp, TCL_VERSION, 0) == NULL) {
  225. return TCL_ERROR;
  226. }
  227. if (Tcl_PkgProvide(interp, "Hashsample", "1.0") == TCL_ERROR) {
  228. return TCL_ERROR;
  229. }
  230.  
  231. tablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
  232. Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);
  233.  
  234. Tcl_CreateObjCommand(interp, "hash", Hash_Cmd, tablePtr, Hash_DeleteProc);
  235. return TCL_OK;
  236. }
  237.  
  238. /*
  239. COMPILED WITH
  240. $ gcc -shared -fPIC -o libhashsample.so -DUSE_TCL_STUBS -DUSE_TK_STUBS \
  241. -I/home/emiliano/tcl9/include hash_sample.c -L/home/emiliano/tcl9/lib \
  242. -ltclstub -ltkstub
  243.  
  244.  
  245. COMMANDS:
  246. load ./libhashsample.so
  247. hash set .foo [dict create foo bar] -> "foo bar"
  248. hash get .foo -> "foo bar"
  249. hash delete .foo -> "" _cleans up .foo entry_
  250. hash stat -> _returns stat info of the hash table_
  251.  
  252. destroy .foo -> _cleans up .foo entry_
  253. */
  254.  

Comments

Posted by emiliano at Thu Oct 31 18:40:59 GMT 2024 [text] [code]

in line 204, before ckfree(data), this line is needed: Tk_DeleteEventHandler(data->tkwin, StructureNotifyMask, hashDestroyHandler, data);