A simple hashtable map Tk_Window -> Tcl_DictObj

#include <tcl.h>
#include <tk.h>

typedef int (HashSubCmd)(ClientData, Tcl_Interp *, int, Tcl_Obj *const []);
static HashSubCmd GetOp;
static HashSubCmd SetOp;
static HashSubCmd DeleteOp;

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

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

    if ( Tcl_DictObjSize(interp, objv[3], &size) != TCL_OK) {
	return TCL_ERROR;
    }

    entryPtr = Tcl_CreateHashEntry(tablePtr, tkwin, &isNew);
    if (! isNew) {
	Tcl_DecrRefCount(Tcl_GetHashValue(entryPtr));
    }

    Tcl_IncrRefCount(objv[3]);
    Tcl_SetHashValue(entryPtr, objv[3]);
    Tcl_SetObjResult(interp, objv[3]);
    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;

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

    Tcl_SetObjResult(interp, Tcl_GetHashValue(entryPtr));
    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;

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

    Tcl_DecrRefCount(Tcl_GetHashValue(entryPtr));
    Tcl_DeleteHashEntry(entryPtr);
    return TCL_OK;
}

void
Hash_DeleteProc(ClientData clientData)
{
    Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entryPtr;

    for (entryPtr = Tcl_FirstHashEntry(tablePtr, &search); entryPtr != NULL;
	    entryPtr = Tcl_NextHashEntry(&search)) {
	Tcl_DecrRefCount(Tcl_GetHashValue(entryPtr));
	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;
}

/*

emiliano@LE-PB01:~$ 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

emiliano@LE-PB01:~$ /home/emiliano/tcl9/bin/tclsh9.0
% load ./libhashsample.so
% hash get .
can't find entry for window .
% hash set . foo
missing value to go with key
% hash set . "this is a test"
this is a test
% hash get .
this is a test
% hash delete .
% hash get .
can't find entry for window .

*/