static int Ta4r_PackageInit (Tcl_Interp *interp) { Tcl_Namespace *ns; Ta4r_Cmd *c; Tcl_Obj *o; Tcl_Obj *m; Tcl_Obj *f; if ((ns = Tcl_FindNamespace(interp, Ta4r, NULL, TCL_LEAVE_ERR_MSG)) == NULL) { return TCL_ERROR; } m = Tcl_NewDictObj(); for (c = &Ta4r_Cmds[0]; c->name != NULL; c++) { /* Put commands into sub-namespace so as not to conflict with ensemble name */ /* This will also create the sub-namespace. Slightly cheap? */ o = Tcl_ObjPrintf("%s::commands::%s", Ta4r, c->name); Tcl_IncrRefCount(o); f = Tcl_ObjPrintf("::tcl::mathfunc::%s", c->name); Tcl_IncrRefCount(f); if (Tcl_CreateObjCommand(interp, Tcl_GetString(o), c->proc, NULL, NULL) == NULL) { Tcl_DecrRefCount(o); Tcl_DecrRefCount(f); return TCL_ERROR; } if (Tcl_CreateAlias(interp, Tcl_GetString(f), interp, Tcl_GetString(o), 0, NULL) != TCL_OK) { Tcl_DecrRefCount(o); Tcl_DecrRefCount(f); return TCL_ERROR; } Tcl_DictObjPut(interp, m, Tcl_NewStringObj(c->name+4, -1), o); Tcl_DecrRefCount(o); Tcl_DecrRefCount(f); } if (Tcl_SetEnsembleMappingDict(interp, Tcl_CreateEnsemble(interp, (Ta4r+2), ns, TCL_ENSEMBLE_PREFIX), m) != TCL_OK) { return TCL_ERROR; }; if (Tcl_Export(interp, ns, (Ta4r+2), 0) != TCL_OK) { return TCL_ERROR; } return TCL_OK; }
extern "C" int DLLEXPORT Perft_Init(Tcl_Interp *interp) { int retval; /* * create namespace for our commands */ Tcl_Namespace *nameSpace = Tcl_CreateNamespace(interp, "perft", NULL, NULL); /* * tell Tcl to grab all subcommands on import */ retval=Tcl_Export(interp, nameSpace, "*", 0); if(retval) { cerr<<"Error exporting commands\n"; return 1; } /* * create the subcommands */ Tcl_CreateObjCommand(interp, "perft::available_events",ListEventsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "perft::init", InitCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "perft::run_file", RunFileCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "perft::run_script", RunScriptCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "perft::select_events", SelectEventsCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "perft::counters", HwInfoCmd, NULL, NULL); /* * create the ensemble */ Tcl_CreateEnsemble(interp, "perft", nameSpace, 0); return TCL_OK; }
/* * ------------------------------------------------------------------------ * Itk_ArchetypeInit() * * Invoked by Itk_Init() whenever a new interpreter is created to * declare the procedures used in the itk::Archetype base class. * ------------------------------------------------------------------------ */ int Itk_ArchetypeInit( Tcl_Interp *interp) /* interpreter to be updated */ { ArchMergeInfo *mergeInfo; Tcl_Namespace *parserNs; Tcl_Namespace *nsPtr; Tcl_Command cmd; int i; /* * Declare all of the C routines that are integrated into * the Archetype base class. */ if (Itcl_RegisterObjC(interp, "Archetype-init", Itk_ArchInitOptsCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK || Itcl_RegisterObjC(interp, "Archetype-delete", Itk_ArchDeleteOptsCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK || Itcl_RegisterObjC(interp, "Archetype-itk_component", Itk_ArchComponentCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK || Itcl_RegisterObjC(interp, "Archetype-itk_option", Itk_ArchOptionCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK || Itcl_RegisterObjC(interp, "Archetype-itk_initialize", Itk_ArchInitCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK || Itcl_RegisterObjC(interp, "Archetype-component", Itk_ArchCompAccessCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK || Itcl_RegisterObjC(interp, "Archetype-configure",Itk_ArchConfigureCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK || Itcl_RegisterObjC(interp, "Archetype-cget",Itk_ArchCgetCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) { return TCL_ERROR; } /* * Build the ensemble used to implement [_archetype]. */ nsPtr = Tcl_CreateNamespace(interp, "::itcl::builtin::Archetype", NULL, NULL); if (nsPtr == NULL) { nsPtr = Tcl_FindNamespace(interp, "::itcl::builtin::Archetype", NULL, 0); } if (nsPtr == NULL) { fprintf(stderr, "error in creating namespace: ::itcl::builtin::Archetype \n"); } cmd = Tcl_CreateEnsemble(interp, nsPtr->fullName, nsPtr, TCL_ENSEMBLE_PREFIX); Tcl_Export(interp, nsPtr, "[a-z]*", 1); for (i=0 ; archetypeCmds[i].name!=NULL ; i++) { Tcl_CreateObjCommand(interp, archetypeCmds[i].name, archetypeCmds[i].proc, NULL, NULL); } /* * Create the namespace containing the option parser commands. */ mergeInfo = (ArchMergeInfo*)ckalloc(sizeof(ArchMergeInfo)); Tcl_InitHashTable(&mergeInfo->usualCode, TCL_STRING_KEYS); mergeInfo->archInfo = NULL; mergeInfo->archComp = NULL; mergeInfo->optionTable = NULL; parserNs = Tcl_CreateNamespace(interp, "::itk::option-parser", (ClientData)mergeInfo, Itcl_ReleaseData); if (!parserNs) { Itk_DelMergeInfo((char*)mergeInfo); Tcl_AddErrorInfo(interp, "\n (while initializing itk)"); return TCL_ERROR; } Itcl_PreserveData((ClientData)mergeInfo); Itcl_EventuallyFree((ClientData)mergeInfo, Itk_DelMergeInfo); Tcl_CreateObjCommand(interp, "::itk::option-parser::keep", Itk_ArchOptKeepCmd, (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL); Tcl_CreateObjCommand(interp, "::itk::option-parser::ignore", Itk_ArchOptIgnoreCmd, (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL); Tcl_CreateObjCommand(interp, "::itk::option-parser::rename", Itk_ArchOptRenameCmd, (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL); Tcl_CreateObjCommand(interp, "::itk::option-parser::usual", Itk_ArchOptUsualCmd, (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL); /* * Add the "itk::usual" command to register option handling code. */ Tcl_CreateObjCommand(interp, "::itk::usual", Itk_UsualCmd, (ClientData)mergeInfo, Itcl_ReleaseData); Itcl_PreserveData((ClientData)mergeInfo); return TCL_OK; }