int Sdlmix_Init(Tcl_Interp *interp)
{
if (SDL_Init(SDL_INIT_AUDIO) < 0)
{
return TCL_ERROR;
}
if (Mix_OpenAudio(44100, MIX_DEFAULT_FORMAT, 2, BUFFER) < 0)
{
SDL_Quit();
return TCL_ERROR;
}
// deallocate default channels
Mix_AllocateChannels(0);
Tcl_Namespace *ns = Tcl_FindNamespace(interp, "sdl", NULL, 0);
if (!ns)
{
ns = Tcl_CreateNamespace(interp, "sdl", NULL, NULL);
}
ns = Tcl_CreateNamespace(interp, "sdl::mix", NULL, NULL);
Tcl_Export(interp, ns, "*", 0);
TclData *self = new TclData;
Tcl_CreateObjCommand(interp, "sdl::mix::music", musicCmd, self, destructor);
Tcl_CreateObjCommand(interp, "sdl::mix::channels", chnCmd, self, NULL);
Tcl_CreateObjCommand(interp, "sdl::mix::sound", sndCmd, self, NULL);
return TCL_OK;
}
Tcl_Command
TclInitPrefixCmd(
Tcl_Interp *interp) /* Current interpreter. */
{
static const EnsembleImplMap prefixImplMap[] = {
{"all", PrefixAllObjCmd, NULL, NULL, NULL, 0},
{"longest", PrefixLongestObjCmd, NULL, NULL, NULL, 0},
{"match", PrefixMatchObjCmd, NULL, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
Tcl_Command prefixCmd;
prefixCmd = TclMakeEnsemble(interp, "::tcl::prefix", prefixImplMap);
Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
"prefix", 0);
return prefixCmd;
}
static int
installCommands(Tcl_Interp *interp,struct CommandEntry *table)
{
struct CommandEntry *entry;
char fqn[128];
// регистрация всех команд в таблице
for(entry=table+0;entry->name!=NULL;entry++) {
// регистрация отдельной команды
// должна быть заданна хоть одна процедура
if (entry->objProc==NULL && entry->nreProc==NULL) {
WARN("command %s not fully declared",entry->name);
continue;
}
// полное имя, включая namespace
snprintf(fqn,128,"%s%s",entry->ns,entry->name);
//
if (entry->nreProc!=NULL) {
// регистрация как NRE
entry->token=Tcl_NRCreateCommand(interp,fqn,entry->objProc,entry->nreProc,entry,NULL);
} else {
// регистрация как обычной процедуры
entry->token=Tcl_CreateObjCommand(interp,fqn,entry->objProc,entry,NULL);
}
if (entry->token==NULL) {
ERR("unable to register command %s\n",fqn);
return TCL_ERROR;
}
// создать объект с именем команды
entry->nameObj=Tcl_NewStringObj(fqn,-1);
if (entry->nameObj==NULL) {
return TCL_ERROR; // ENOMEM
}
Tcl_IncrRefCount(entry->nameObj);
// ... возможны дальнейшие проверки ...
// сохранение результата во внешних переменных
if (entry->saveTokenPtr!=NULL) *entry->saveTokenPtr=entry->token;
if (entry->saveNamePtr!=NULL) { *entry->saveNamePtr=entry->nameObj; Tcl_IncrRefCount(entry->nameObj); }
// разрешить/нет экспорт
if (entry->mark) {
if (Tcl_Export(interp,packageNamespace,entry->name,0)!=TCL_OK) {
WARN("unable to export %s : %s",entry->name,Tcl_GetStringResult(interp));
}
}
}
return TCL_OK;
}
int DLLEXPORT
Tclrun_Init(Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
return TCL_ERROR;
if (Tcl_PkgProvide(interp, "run", "0.0.1") == TCL_ERROR)
return TCL_ERROR;
Tcl_CreateObjCommand(interp,
"run::c::c_run", C_Run_Cmd,
NULL, NULL);
Tcl_Namespace* ns =
Tcl_FindNamespace(interp, "run", NULL, 0);
Tcl_Export(interp, ns, "*", 0);
return TCL_OK;
}
void Ttk_StylePkgInit(Tcl_Interp *interp)
{
Tcl_Namespace *nsPtr;
StylePackageData *pkgPtr = ckalloc(sizeof(StylePackageData));
pkgPtr->interp = interp;
Tcl_InitHashTable(&pkgPtr->themeTable, TCL_STRING_KEYS);
Tcl_InitHashTable(&pkgPtr->factoryTable, TCL_STRING_KEYS);
pkgPtr->cleanupList = NULL;
pkgPtr->cache = Ttk_CreateResourceCache(interp);
pkgPtr->themeChangePending = 0;
Tcl_SetAssocData(interp, PKG_ASSOC_KEY, Ttk_StylePkgFree, pkgPtr);
/*
* Create the default system theme:
*
* pkgPtr->defaultTheme must be initialized to 0 before
* calling Ttk_CreateTheme for the first time, since it's used
* as the parent theme.
*/
pkgPtr->defaultTheme = 0;
pkgPtr->defaultTheme = pkgPtr->currentTheme =
Ttk_CreateTheme(interp, "default", NULL);
/*
* Register null element, used as a last-resort fallback:
*/
Ttk_RegisterElement(interp, pkgPtr->defaultTheme, "", &ttkNullElementSpec, 0);
/*
* Register commands:
*/
Tcl_CreateObjCommand(interp, "::ttk::style", StyleObjCmd, pkgPtr, 0);
nsPtr = Tcl_FindNamespace(interp, "::ttk", NULL, TCL_LEAVE_ERR_MSG);
Tcl_Export(interp, nsPtr, "style", 0 /* dontResetList */);
Ttk_RegisterElementFactory(interp, "from", Ttk_CloneElement, 0);
}
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;
}
static int
Initialize (
Tcl_Interp *interp)
{
Tcl_Namespace *nsPtr;
Tcl_Namespace *itclNs;
Tcl_HashEntry *hPtr;
Tcl_Obj *objPtr;
ItclObjectInfo *infoPtr;
const char * ret;
char *res_option;
int opt;
int isNew;
if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
return TCL_ERROR;
}
ret = TclOOInitializeStubs(interp, "1.0");
if (ret == NULL) {
return TCL_ERROR;
}
nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE, NULL, NULL);
if (nsPtr == NULL) {
Tcl_Panic("Itcl: cannot create namespace: \"%s\" \n", ITCL_NAMESPACE);
}
nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE"::methodset",
NULL, NULL);
if (nsPtr == NULL) {
Tcl_Panic("Itcl: cannot create namespace: \"%s::methodset\" \n",
ITCL_NAMESPACE);
}
nsPtr = Tcl_CreateNamespace(interp, ITCL_NAMESPACE"::internal::dicts",
NULL, NULL);
if (nsPtr == NULL) {
Tcl_Panic("Itcl: cannot create namespace: \"%s::internal::dicts\" \n",
ITCL_NAMESPACE);
}
Tcl_CreateObjCommand(interp, ITCL_NAMESPACE"::finish", ItclFinishCmd,
NULL, NULL);
/* for debugging only !!! */
#ifdef OBJ_REF_COUNT_DEBUG
Tcl_CreateObjCommand(interp,
ITCL_NAMESPACE"::dumprefcountinfo",
ItclDumpRefCountInfo, NULL, NULL);
#endif
#ifdef ITCL_PRESERVE_DEBUG
Tcl_CreateObjCommand(interp,
ITCL_NAMESPACE"::dumppreserveinfo",
ItclDumpPreserveInfo, NULL, NULL);
#endif
/* END for debugging only !!! */
Tcl_CreateObjCommand(interp,
ITCL_NAMESPACE"::methodset::callCCommand",
ItclCallCCommand, NULL, NULL);
Tcl_CreateObjCommand(interp,
ITCL_NAMESPACE"::methodset::objectUnknownCommand",
ItclObjectUnknownCommand, NULL, NULL);
/*
* Create the top-level data structure for tracking objects.
* Store this as "associated data" for easy access, but link
* it to the itcl namespace for ownership.
*/
infoPtr = (ItclObjectInfo*)ckalloc(sizeof(ItclObjectInfo));
memset(infoPtr, 0, sizeof(ItclObjectInfo));
infoPtr->interp = interp;
infoPtr->class_meta_type = (Tcl_ObjectMetadataType *)ckalloc(
sizeof(Tcl_ObjectMetadataType));
infoPtr->class_meta_type->version = TCL_OO_METADATA_VERSION_CURRENT;
infoPtr->class_meta_type->name = "ItclClass";
infoPtr->class_meta_type->deleteProc = ItclDeleteClassMetadata;
infoPtr->class_meta_type->cloneProc = NULL;
infoPtr->object_meta_type = (Tcl_ObjectMetadataType *)ckalloc(
sizeof(Tcl_ObjectMetadataType));
infoPtr->object_meta_type->version = TCL_OO_METADATA_VERSION_CURRENT;
infoPtr->object_meta_type->name = "ItclObject";
infoPtr->object_meta_type->deleteProc = ItclDeleteObjectMetadata;
infoPtr->object_meta_type->cloneProc = NULL;
Tcl_InitHashTable(&infoPtr->objects, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&infoPtr->objectCmds, TCL_ONE_WORD_KEYS);
Tcl_InitObjHashTable(&infoPtr->objectNames);
Tcl_InitHashTable(&infoPtr->classes, TCL_ONE_WORD_KEYS);
Tcl_InitObjHashTable(&infoPtr->nameClasses);
Tcl_InitHashTable(&infoPtr->namespaceClasses, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&infoPtr->procMethods, TCL_ONE_WORD_KEYS);
Tcl_InitObjHashTable(&infoPtr->instances);
Tcl_InitHashTable(&infoPtr->objectInstances, TCL_ONE_WORD_KEYS);
Tcl_InitObjHashTable(&infoPtr->classTypes);
infoPtr->ensembleInfo = (EnsembleInfo *)ckalloc(sizeof(EnsembleInfo));
memset(infoPtr->ensembleInfo, 0, sizeof(EnsembleInfo));
Tcl_InitHashTable(&infoPtr->ensembleInfo->ensembles, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(&infoPtr->ensembleInfo->subEnsembles, TCL_ONE_WORD_KEYS);
infoPtr->ensembleInfo->numEnsembles = 0;
infoPtr->protection = ITCL_DEFAULT_PROTECT;
infoPtr->currClassFlags = 0;
infoPtr->buildingWidget = 0;
infoPtr->typeDestructorArgumentPtr = Tcl_NewStringObj("", -1);
Tcl_IncrRefCount(infoPtr->typeDestructorArgumentPtr);
infoPtr->lastIoPtr = NULL;
Tcl_SetVar(interp, ITCL_NAMESPACE"::internal::dicts::classes", "", 0);
Tcl_SetVar(interp, ITCL_NAMESPACE"::internal::dicts::objects", "", 0);
Tcl_SetVar(interp, ITCL_NAMESPACE"::internal::dicts::classOptions", "", 0);
Tcl_SetVar(interp,
ITCL_NAMESPACE"::internal::dicts::classDelegatedOptions", "", 0);
Tcl_SetVar(interp,
ITCL_NAMESPACE"::internal::dicts::classComponents", "", 0);
Tcl_SetVar(interp,
ITCL_NAMESPACE"::internal::dicts::classVariables", "", 0);
Tcl_SetVar(interp,
ITCL_NAMESPACE"::internal::dicts::classFunctions", "", 0);
Tcl_SetVar(interp,
ITCL_NAMESPACE"::internal::dicts::classDelegatedFunctions", "", 0);
hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes,
(char *)Tcl_NewStringObj("class", -1), &isNew);
Tcl_SetHashValue(hPtr, ITCL_CLASS);
hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes,
(char *)Tcl_NewStringObj("type", -1), &isNew);
Tcl_SetHashValue(hPtr, ITCL_TYPE);
hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes,
(char *)Tcl_NewStringObj("widget", -1), &isNew);
Tcl_SetHashValue(hPtr, ITCL_WIDGET);
hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes,
(char *)Tcl_NewStringObj("widgetadaptor", -1), &isNew);
Tcl_SetHashValue(hPtr, ITCL_WIDGETADAPTOR);
hPtr = Tcl_CreateHashEntry(&infoPtr->classTypes,
(char *)Tcl_NewStringObj("extendedclass", -1), &isNew);
Tcl_SetHashValue(hPtr, ITCL_ECLASS);
res_option = getenv("ITCL_USE_OLD_RESOLVERS");
if (res_option == NULL) {
opt = 1;
} else {
opt = atoi(res_option);
}
infoPtr->useOldResolvers = opt;
Itcl_InitStack(&infoPtr->clsStack);
Itcl_InitStack(&infoPtr->contextStack);
Itcl_InitStack(&infoPtr->constructorStack);
Tcl_SetAssocData(interp, ITCL_INTERP_DATA,
(Tcl_InterpDeleteProc*)FreeItclObjectInfo, (ClientData)infoPtr);
Itcl_PreserveData((ClientData)infoPtr);
#ifdef NEW_PROTO_RESOLVER
ItclVarsAndCommandResolveInit(interp);
#endif
/* first create the Itcl base class as root of itcl classes */
if (Tcl_EvalEx(interp, clazzClassScript, -1, 0) != TCL_OK) {
Tcl_Panic("cannot create Itcl root class ::itcl::clazz");
}
objPtr = Tcl_NewStringObj("::itcl::clazz", -1);
infoPtr->clazzObjectPtr = Tcl_GetObjectFromObj(interp, objPtr);
/* work around for SF bug #254 needed because of problem in TclOO 1.0.2 !! */
if (Tcl_PkgPresent(interp, "TclOO", "1.0.2", 1) != NULL) {
Itcl_IncrObjectRefCount(infoPtr->clazzObjectPtr);
}
Tcl_DecrRefCount(objPtr);
if (infoPtr->clazzObjectPtr == NULL) {
Tcl_AppendResult(interp,
"ITCL: cannot get Object for ::itcl::clazz for class \"",
"::itcl::clazz", "\"", NULL);
return TCL_ERROR;
}
infoPtr->clazzClassPtr = Tcl_GetObjectAsClass(infoPtr->clazzObjectPtr);
AddClassUnknowMethod(interp, infoPtr, infoPtr->clazzClassPtr);
/*
* Initialize the ensemble package first, since we need this
* for other parts of [incr Tcl].
*/
if (Itcl_EnsembleInit(interp) != TCL_OK) {
return TCL_ERROR;
}
Itcl_ParseInit(interp, infoPtr);
/*
* Create "itcl::builtin" namespace for commands that
* are automatically built into class definitions.
*/
if (Itcl_BiInit(interp, infoPtr) != TCL_OK) {
return TCL_ERROR;
}
/*
* Export all commands in the "itcl" namespace so that they
* can be imported with something like "namespace import itcl::*"
*/
itclNs = Tcl_FindNamespace(interp, "::itcl", (Tcl_Namespace*)NULL,
TCL_LEAVE_ERR_MSG);
/*
* This was changed from a glob export (itcl::*) to explicit
* command exports, so that the itcl::is command can *not* be
* exported. This is done for concern that the itcl::is command
* imported might be confusing ("is").
*/
if (!itclNs ||
(Tcl_Export(interp, itclNs, "body", /* reset */ 1) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "class", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "code", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "configbody", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "delete", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "delete_helper", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "ensemble", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "filter", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "find", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "forward", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "local", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "mixin", 0) != TCL_OK) ||
(Tcl_Export(interp, itclNs, "scope", 0) != TCL_OK)) {
return TCL_ERROR;
}
Tcl_CreateObjCommand(interp,
ITCL_NAMESPACE"::internal::commands::sethullwindowname",
ItclSetHullWindowName, infoPtr, NULL);
Tcl_CreateObjCommand(interp,
ITCL_NAMESPACE"::internal::commands::checksetitclhull",
ItclCheckSetItclHull, infoPtr, NULL);
/*
* Set up the variables containing version info.
*/
Tcl_SetVar(interp, "::itcl::version", ITCL_VERSION, TCL_NAMESPACE_ONLY);
Tcl_SetVar(interp, "::itcl::patchLevel", ITCL_PATCH_LEVEL,
TCL_NAMESPACE_ONLY);
#ifdef ITCL_DEBUG_C_INTERFACE
RegisterDebugCFunctions(interp);
#endif
/*
* Package is now loaded.
*/
Tcl_PkgProvideEx(interp, "Itcl", ITCL_PATCH_LEVEL, &itclStubs);
return Tcl_PkgProvideEx(interp, "itcl", ITCL_PATCH_LEVEL, &itclStubs);
}
