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

  1. The code below makes it easy to create nested ensembles in C. For instance:
  2.  
  3. static const TkEnsemble choosefontEnsemble[] = {
  4. { "configure", ChoosefontConfigureCmd, NULL },
  5. { "show", ChoosefontShowCmd, NULL },
  6. { "hide", ChoosefontHideCmd, NULL },
  7. };
  8.  
  9. int
  10. TkChoosefontInit(Tcl_Interp *interp, ClientData clientData)
  11. {
  12. HookData *hdPtr = NULL;
  13. hdPtr = (HookData *)ckalloc(sizeof(HookData));
  14. memset(hdPtr, 0, sizeof(HookData));
  15. Tcl_SetAssocData(interp, "::tk::choosefont", DeleteHookData, hdPtr);
  16. TkMakeEnsemble(interp, "::tk", "choosefont",
  17. clientData, choosefontEnsemble);
  18. return TCL_OK;
  19. }
  20.  
  21. /**************************** below ******************/
  22.  
  23. /*
  24. * The following structure is used with TkMakeEnsemble to create
  25. * ensemble commands and optionally to create sub-ensembles.
  26. */
  27.  
  28. typedef struct TkEnsemble {
  29. const char *name;
  30. Tcl_ObjCmdProc *proc;
  31. const struct TkEnsemble *subensemble;
  32. } TkEnsemble;
  33.  
  34. /*
  35. *----------------------------------------------------------------------
  36. *
  37. * TkMakeEnsemble --
  38. *
  39. * Create an ensemble from a table of implementation commands.
  40. * This may be called recursively to create sub-ensembles.
  41. *
  42. * Results:
  43. * Handle for the ensemble, or NULL if creation of it fails.
  44. *
  45. *----------------------------------------------------------------------
  46. */
  47.  
  48. Tcl_Command
  49. TkMakeEnsemble(
  50. Tcl_Interp *interp,
  51. const char *namespace,
  52. const char *name,
  53. ClientData clientData,
  54. const TkEnsemble map[])
  55. {
  56. Tcl_Namespace *namespacePtr = NULL;
  57. Tcl_Command ensemble = NULL;
  58. Tcl_Obj *dictObj = NULL;
  59. Tcl_DString ds;
  60. int i;
  61.  
  62. if (map == NULL) {
  63. return NULL;
  64. }
  65.  
  66. Tcl_DStringInit(&ds);
  67.  
  68. namespacePtr = Tcl_FindNamespace(interp, namespace, NULL, 0);
  69. if (namespacePtr == NULL) {
  70. namespacePtr = Tcl_CreateNamespace(interp, namespace, NULL, NULL);
  71. if (namespacePtr == NULL) {
  72. Tcl_Panic("failed to create namespace \"%s\"", namespace);
  73. }
  74. }
  75.  
  76. ensemble = Tcl_FindEnsemble(interp, Tcl_NewStringObj(name,-1), 0);
  77. if (ensemble == NULL) {
  78. ensemble = Tcl_CreateEnsemble(interp, name,
  79. namespacePtr, TCL_ENSEMBLE_PREFIX);
  80. if (ensemble == NULL) {
  81. Tcl_Panic("failed to create ensemble \"%s\"", name);
  82. }
  83. }
  84.  
  85. Tcl_DStringSetLength(&ds, 0);
  86. Tcl_DStringAppend(&ds, namespace, -1);
  87. if (!(strlen(namespace) == 2 && namespace[1] == ':')) {
  88. Tcl_DStringAppend(&ds, "::", -1);
  89. }
  90. Tcl_DStringAppend(&ds, name, -1);
  91.  
  92. dictObj = Tcl_NewObj();
  93. for (i = 0; map[i].name != NULL ; ++i) {
  94. Tcl_Obj *nameObj, *fqdnObj;
  95.  
  96. nameObj = Tcl_NewStringObj(map[i].name, -1);
  97. fqdnObj = Tcl_NewStringObj(Tcl_DStringValue(&ds),
  98. Tcl_DStringLength(&ds));
  99. Tcl_AppendStringsToObj(fqdnObj, "::", map[i].name, NULL);
  100. Tcl_DictObjPut(NULL, dictObj, nameObj, fqdnObj);
  101. if (map[i].proc) {
  102. Tcl_CreateObjCommand(interp, Tcl_GetString(fqdnObj),
  103. map[i].proc, clientData, NULL);
  104. } else {
  105. TkMakeEnsemble(interp, Tcl_DStringValue(&ds),
  106. map[i].name, clientData, map[i].subensemble);
  107. }
  108. }
  109.  
  110. if (ensemble) {
  111. Tcl_SetEnsembleMappingDict(interp, ensemble, dictObj);
  112. }
  113.  
  114. Tcl_DStringFree(&ds);
  115. return ensemble;
  116. }