Posted to tcl by emiliano at Thu Oct 31 18:19:08 GMT 2024view raw
- #include <tcl.h>
- #include <tk.h>
- typedef int (HashSubCmd)(ClientData, Tcl_Interp *, int, Tcl_Obj *const []);
- static HashSubCmd DeleteOp;
- static HashSubCmd GetOp;
- static HashSubCmd SetOp;
- static HashSubCmd StatOp;
- static Tk_EventProc hashDestroyHandler;
- /* wrapper for our data
- * this makes easier to deal with Tk event handler on window destroy
- */
- struct ValueData {
- Tcl_Obj *objPtr;
- Tk_Window tkwin;
- Tcl_HashTable *tablePtr;
- };
- static int
- Hash_Cmd(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
- {
- static const struct HashCmds {
- char *name;
- HashSubCmd *subCmd;
- } hashCmds[] = {
- {"delete", DeleteOp},
- {"get", GetOp},
- {"set", SetOp},
- {"stat", StatOp},
- {NULL, NULL}
- };
- int index;
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
- return TCL_ERROR;
- }
- if (Tcl_GetIndexFromObjStruct(interp, objv[1], hashCmds,
- sizeof(struct HashCmds), "subcommand", 0, &index) != TCL_OK) {
- return TCL_ERROR;
- }
- return hashCmds[index].subCmd(clientdata, interp, objc, objv);
- }
- static int
- SetOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
- {
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
- Tk_Window tkwin;
- int isNew;
- Tcl_Size size;
- Tcl_HashEntry *entryPtr;
- struct ValueData *data;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 2, objv, "window dict");
- return TCL_ERROR;
- }
- tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), Tk_MainWindow(interp));
- if (! tkwin) {
- return TCL_ERROR;
- }
- /* make sure we have a dict */
- if ( Tcl_DictObjSize(interp, objv[3], &size) != TCL_OK) {
- return TCL_ERROR;
- }
- entryPtr = Tcl_CreateHashEntry(tablePtr, tkwin, &isNew);
- if (! isNew) {
- data = Tcl_GetHashValue(entryPtr);
- Tcl_DecrRefCount(data->objPtr);
- } else {
- data = (struct ValueData *)ckalloc(sizeof(struct ValueData));
- data->tablePtr = tablePtr;
- data->tkwin = tkwin;
- Tk_CreateEventHandler(tkwin, StructureNotifyMask, hashDestroyHandler,
- data);
- }
- data->objPtr = objv[3];
- Tcl_IncrRefCount(data->objPtr);
- Tcl_SetHashValue(entryPtr, data);
- Tcl_SetObjResult(interp, data->objPtr);
- return TCL_OK;
- }
- static int
- GetOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
- {
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
- Tk_Window tkwin;
- Tcl_HashEntry *entryPtr;
- struct ValueData *data;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "window");
- return TCL_ERROR;
- }
- tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), Tk_MainWindow(interp));
- if (! tkwin) {
- return TCL_ERROR;
- }
- entryPtr = Tcl_FindHashEntry(tablePtr, tkwin);
- if (! entryPtr) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't find entry for window %s",
- Tcl_GetString(objv[2])));
- return TCL_ERROR;
- }
- data = Tcl_GetHashValue(entryPtr);
- Tcl_SetObjResult(interp, data->objPtr);
- return TCL_OK;
- }
- static int
- StatOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
- {
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
- char *stats;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 2, objv, NULL);
- return TCL_ERROR;
- }
- stats = Tcl_HashStats(tablePtr);
- Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
- ckfree(stats);
- return TCL_OK;
- }
- static int
- DeleteOp(ClientData clientdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
- {
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientdata;
- Tk_Window tkwin;
- Tcl_HashEntry *entryPtr;
- struct ValueData *data;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "window");
- return TCL_ERROR;
- }
- tkwin = Tk_NameToWindow(interp, Tcl_GetString(objv[2]), Tk_MainWindow(interp));
- if (! tkwin) {
- return TCL_ERROR;
- }
- entryPtr = Tcl_FindHashEntry(tablePtr, tkwin);
- if (! entryPtr) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't find entry for window %s",
- Tcl_GetString(objv[2])));
- return TCL_ERROR;
- }
- data = Tcl_GetHashValue(entryPtr);
- Tk_DeleteEventHandler(data->tkwin, StructureNotifyMask, hashDestroyHandler,
- data);
- Tcl_DecrRefCount(data->objPtr);
- ckfree(data);
- Tcl_DeleteHashEntry(entryPtr);
- return TCL_OK;
- }
- void
- hashDestroyHandler(ClientData clientData, XEvent *eventPtr)
- {
- struct ValueData *data = (struct ValueData *) clientData;
- Tcl_HashEntry *entryPtr;
- if (eventPtr->type != DestroyNotify) return;
- entryPtr = Tcl_FindHashEntry(data->tablePtr, data->tkwin);
- if (! entryPtr) return;
- Tcl_DecrRefCount(data->objPtr);
- ckfree(data);
- Tcl_DeleteHashEntry(entryPtr);
- return;
- }
- /*
- * Hash_DeleteProc -- Called when Tcl deletes the "hash" command
- */
- void
- Hash_DeleteProc(ClientData clientData)
- {
- Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
- Tcl_HashSearch search;
- Tcl_HashEntry *entryPtr;
- struct ValueData *data;
- for (entryPtr = Tcl_FirstHashEntry(tablePtr, &search); entryPtr != NULL;
- entryPtr = Tcl_NextHashEntry(&search)) {
- data = Tcl_GetHashValue(entryPtr);
- Tcl_DecrRefCount(data->objPtr);
- ckfree(data);
- Tcl_DeleteHashEntry(entryPtr);
- }
- Tcl_DeleteHashTable(tablePtr);
- ckfree(tablePtr);
- return;
- }
- /*
- * Hashsample_Init -- Called when Tcl loads your extension.
- */
- int DLLEXPORT
- Hashsample_Init(Tcl_Interp *interp)
- {
- Tcl_HashTable *tablePtr;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
- return TCL_ERROR;
- }
- if (Tk_InitStubs(interp, TCL_VERSION, 0) == NULL) {
- return TCL_ERROR;
- }
- if (Tcl_PkgProvide(interp, "Hashsample", "1.0") == TCL_ERROR) {
- return TCL_ERROR;
- }
- tablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
- Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);
- Tcl_CreateObjCommand(interp, "hash", Hash_Cmd, tablePtr, Hash_DeleteProc);
- return TCL_OK;
- }
- /*
- COMPILED WITH
- $ gcc -shared -fPIC -o libhashsample.so -DUSE_TCL_STUBS -DUSE_TK_STUBS \
- -I/home/emiliano/tcl9/include hash_sample.c -L/home/emiliano/tcl9/lib \
- -ltclstub -ltkstub
- COMMANDS:
- load ./libhashsample.so
- hash set .foo [dict create foo bar] -> "foo bar"
- hash get .foo -> "foo bar"
- hash delete .foo -> "" _cleans up .foo entry_
- hash stat -> _returns stat info of the hash table_
- destroy .foo -> _cleans up .foo entry_
- */
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);