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