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

#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);