Posted to tcl by patthoyts at Sat May 24 10:17:44 GMT 2008view raw
- 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;
- }