Posted to tcl by patthoyts at Sat May 24 10:17:44 GMT 2008view pretty

The code below makes it easy to create nested ensembles in C. For instance:

static const TkEnsemble choosefontEnsemble[] = {
    { "configure", ChoosefontConfigureCmd, NULL },
    { "show", ChoosefontShowCmd, NULL },
    { "hide", ChoosefontHideCmd, NULL },
};

int
TkChoosefontInit(Tcl_Interp *interp, ClientData clientData)
{
    HookData *hdPtr = NULL;
    hdPtr = (HookData *)ckalloc(sizeof(HookData));
    memset(hdPtr, 0, sizeof(HookData));
    Tcl_SetAssocData(interp, "::tk::choosefont", DeleteHookData, hdPtr);
    TkMakeEnsemble(interp, "::tk", "choosefont", 
	clientData, choosefontEnsemble);
    return TCL_OK;
}

/**************************** below ******************/

/*
 * The following structure is used with TkMakeEnsemble to create
 * ensemble commands and optionally to create sub-ensembles.
 */

typedef struct TkEnsemble {
    const char *name;
    Tcl_ObjCmdProc *proc;
    const struct TkEnsemble *subensemble;
} TkEnsemble;

/*
 *----------------------------------------------------------------------
 *
 * TkMakeEnsemble --
 *
 *	Create an ensemble from a table of implementation commands.
 *	This may be called recursively to create sub-ensembles.
 *
 * Results:
 *	Handle for the ensemble, or NULL if creation of it fails.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TkMakeEnsemble(
    Tcl_Interp *interp,
    const char *namespace,
    const char *name,
    ClientData clientData,
    const TkEnsemble map[])
{
    Tcl_Namespace *namespacePtr = NULL;
    Tcl_Command ensemble = NULL;
    Tcl_Obj *dictObj = NULL;
    Tcl_DString ds;
    int i;

    if (map == NULL) {
	return NULL;
    }

    Tcl_DStringInit(&ds);

    namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0);
    if (namespacePtr == NULL) {
        namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL);
        if (namespacePtr == NULL) {
            Tcl_Panic("failed to create namespace \"%s\"", namespace);
        }
    }

    ensemble = Tcl_FindEnsemble(interp, Tcl_NewStringObj(name,-1), 0);
    if (ensemble == NULL) {
        ensemble = Tcl_CreateEnsemble(interp, name,
	    namespacePtr, TCL_ENSEMBLE_PREFIX);
        if (ensemble == NULL) {
            Tcl_Panic("failed to create ensemble \"%s\"", name);
        }
    }
    
    Tcl_DStringSetLength(&ds, 0);
    Tcl_DStringAppend(&ds, namespace, -1);
    if (!(strlen(namespace) == 2 && namespace[1] == ':')) {
	Tcl_DStringAppend(&ds, "::", -1);
    }
    Tcl_DStringAppend(&ds, name, -1);
	
    dictObj = Tcl_NewObj();
    for (i = 0; map[i].name != NULL ; ++i) {
	Tcl_Obj *nameObj, *fqdnObj;
	
	nameObj = Tcl_NewStringObj(map[i].name, -1);
	fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
	    Tcl_DStringLength(&ds));
	Tcl_AppendStringsToObj(fqdnObj, "::", map[i].name, NULL);
	Tcl_DictObjPut(NULL, dictObj, nameObj, fqdnObj);
	if (map[i].proc) {
	    Tcl_CreateObjCommand(interp, Tcl_GetString(fqdnObj),
		map[i].proc, clientData, NULL);
	} else {
	    TkMakeEnsemble(interp, Tcl_DStringValue(&ds),
		map[i].name, clientData, map[i].subensemble);
	}
    }

    if (ensemble) {
	Tcl_SetEnsembleMappingDict(interp, ensemble, dictObj);
    }

    Tcl_DStringFree(&ds);
    return ensemble;
}