C++ Tcl_InitStubs函数代码示例

DLLEXPORT int Rechan_Init(Tcl_Interp* interp)
{
  if (!Tcl_InitStubs(interp, "8.4", 0))
    return TCL_ERROR;
  Tcl_CreateObjCommand(interp, "rechan", cmd_rechan, 0, 0);
  return Tcl_PkgProvide(interp, "rechan", "1.0");
}

static int
Ta4r_CommonInit (Tcl_Interp *interp) {
	if (Tcl_InitStubs       (interp, MIN_TCL_VERSION, 0)        == NULL) { return TCL_ERROR; }
	if (Tcl_PkgRequire      (interp, "Tcl", MIN_TCL_VERSION, 0) == NULL) { return TCL_ERROR; }
	if (Tcl_CreateNamespace (interp, Ta4r, NULL, NULL)       == NULL) { return TCL_ERROR; }
	return TCL_OK;
}

int Sqlite_vtable_Init(Tcl_Interp *interp)
{
    VTableInterpContext *vticP;

#ifdef USE_TCL_STUBS
    Tcl_InitStubs(interp, "8.5", 0);
#endif

    /*
     * Initialize the cache of Tcl type pointers (used when converting
     * to sqlite types). It's OK if any of these return NULL.
     */
    gTclBooleanTypeP = Tcl_GetObjType("boolean");
    gTclBooleanStringTypeP = Tcl_GetObjType("booleanString");
    gTclByteArrayTypeP = Tcl_GetObjType("bytearray");
    gTclDoubleTypeP = Tcl_GetObjType("double");
    gTclWideIntTypeP = Tcl_GetObjType("wideInt");
    gTclIntTypeP = Tcl_GetObjType("int");


    vticP = VTICNew(interp);
    VTICRef(vticP, 1); // VTIC is passed to interpreter commands as ClientData

    Tcl_CreateObjCommand(interp, PACKAGE_NAME "::attach_connection",
                         AttachConnectionObjCmd, vticP, 0);

    Tcl_CallWhenDeleted(interp, DetachFromInterp, vticP);


    Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);
    return TCL_OK;
}

EXTERN int
Chantest_Init(Tcl_Interp *interp)
{
    int r = TCL_OK;
    const char *tcl = NULL;
    const char *memchan = NULL;

#ifdef USE_TCL_STUBS
    tcl = Tcl_InitStubs(interp, "8.4", 0);
#endif

#ifdef USE_MEMCHAN_STUBS
    memchan = Memchan_InitStubs(interp, "2.2", 0);
#endif

    if (tcl == NULL || memchan == NULL) {
        Tcl_SetResult(interp, "error loading memchan via stubs", TCL_STATIC);
        r = TCL_ERROR;
    } else {
        Tcl_CreateObjCommand(interp, "chantest", TestObjCmd, 
                             (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
        r = Tcl_PkgProvide(interp, "Chantest", "0.1");
    }
    return r;
}

/** \brief initialize the tclmsgque package
 *
 * The tclmsgque package is created and one new command "msgque"
 * is added to the Tcl interpreter.
 * \param[in] interp the current interpreter
 * \return Tcl error-code
 */
TCLMQ_EXTERN int
Tclmsgque_Init (
  Tcl_Interp * interp
)
{
  // check for the reight tcl
  if (Tcl_InitStubs (interp, "8.5", 0) == NULL) {
    return TCL_ERROR;
  }

  // announce my package
  TclErrorCheck (Tcl_PkgProvide (interp, "TclMsgque", LIBMSGQUE_VERSION));

  // provide "msgque" as only public cammand of the package
  Tcl_CreateObjCommand (interp, "tclmsgque", NS(MsgqueCmd), (ClientData) NULL,
                        (Tcl_CmdDeleteProc *) NULL);

  // init libmsgque global data
  if (MqInitGet() == NULL && Tcl_GetNameOfExecutable() != NULL) {
    struct MqBufferLS * initB = MqInitCreate();

    if (Tcl_Eval(interp, "info script") == TCL_ERROR)
      return TCL_ERROR;

    MqBufferLAppendC(initB, Tcl_GetNameOfExecutable());
    MqBufferLAppendC(initB, Tcl_GetStringResult(interp));
  }

  // create the default-factory
  if (!strcmp(MqFactoryDefaultIdent(),"libmsgque")) {
    MqFactoryDefault("tclmsgque", NS(FactoryCreate), NULL, NULL, NS(FactoryDelete), NULL, NULL);
  }

  return TCL_OK;
}

int
TnmInit(Tcl_Interp *interp, int safe)
{

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
#endif
    
    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
        return TCL_ERROR;
    }

    if (Tcl_PkgProvide(interp, "Tnm", TNM_VERSION) != TCL_OK) {
        return TCL_ERROR;
    }

    Tcl_RegisterObjType(&tnmUnsigned64Type);
    Tcl_RegisterObjType(&tnmUnsigned32Type);
    Tcl_RegisterObjType(&tnmOctetStringType);
    Tcl_RegisterObjType(&tnmIpAddressType);

    InitVars(interp);
    TnmInitDns(interp);
    if (InitCmds(interp, safe) != TCL_OK) {
	return TCL_ERROR;
    }
    if (TnmSmxInit(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    return SourceInitFiles(interp);
}

/*
 * Tclduktape_Init -- Called when Tcl loads the extension.
 */
int DLLEXPORT
Tclduktape_Init(Tcl_Interp *interp)
{
    Tcl_Namespace *nsPtr;
    struct DuktapeData *duktape_data;

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
        return TCL_ERROR;
    }
#endif

    duktape_data = (struct DuktapeData *) ckalloc(sizeof(struct DuktapeData));

    /* Create the namespace. */
    if (Tcl_FindNamespace(interp, NS, NULL, 0) == NULL) {
        nsPtr = Tcl_CreateNamespace(interp, NS, NULL, NULL);
        if (nsPtr == NULL) {
            return TCL_ERROR;
        }
    }

    duktape_data->counter = 0;
    Tcl_InitHashTable(&duktape_data->table, TCL_STRING_KEYS);

    Tcl_CreateObjCommand(interp, NS INIT, Init_Cmd, duktape_data, NULL);
    Tcl_CreateObjCommand(interp, NS CLOSE, Close_Cmd, duktape_data, NULL);
    Tcl_CreateObjCommand(interp, NS EVAL, Eval_Cmd, duktape_data, NULL);
    Tcl_CreateObjCommand(interp, NS CALL_METHOD,
            CallMethod_Cmd, duktape_data, NULL);
    Tcl_CallWhenDeleted(interp, cleanup_interp, duktape_data);
    Tcl_PkgProvide(interp, PACKAGE, VERSION);

    return TCL_OK;
}

/*******************************************************************************
 * dhstcl_Init ( ... )
 *******************************************************************************/
int Dhstcl_Init ( Tcl_Interp *interp ) {
 /* declare local scope variable and initialize them */
 int nc=0;
 /* initialize static variables */
 (void) memset(response,'\0',MAXMSG);
 (void) memset(result,'\0',DHS_RESULT_LEN);
 /* write banner */
 nc = sprintf(result,"\nDHS Package v%s by %s.\n%s\nThis release: %s\n",_dhsTcl_S_,_dhsTcl_A_,_dhsTcl_C_,_dhsTcl_D_);
 (void) Tcl_SetResult(interp,result,TCL_STATIC);
 /* make the wrapper(s) available to Tcl/tk */
 if ( Tcl_InitStubs(interp,TCL_STUB_VERSION,0) == (char *)NULL ) return TCL_ERROR;
 Tcl_CreateCommand(interp,"dhs::help",        (Tcl_CmdProc *)dhsHelpTcl,        (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::version",     (Tcl_CmdProc *)dhsVersionTcl,     (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::SysOpen",     (Tcl_CmdProc *)dhsSysOpenTcl,     (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::SysClose",    (Tcl_CmdProc *)dhsSysCloseTcl,    (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::OpenConnect", (Tcl_CmdProc *)dhsOpenConnectTcl, (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::CloseConnect",(Tcl_CmdProc *)dhsCloseConnectTcl,(ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::OpenExp",     (Tcl_CmdProc *)dhsOpenExpTcl,     (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::CloseExp",    (Tcl_CmdProc *)dhsCloseExpTcl,    (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::IOctl",       (Tcl_CmdProc *)dhsIOctlTcl,       (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::ReadImage",   (Tcl_CmdProc *)dhsReadImageTcl,   (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::PixelData",   (Tcl_CmdProc *)dhsPixelDataTcl,   (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 Tcl_CreateCommand(interp,"dhs::MetaData",    (Tcl_CmdProc *)dhsMetaDataTcl,    (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
 /* provide the package */
 return Tcl_PkgProvide(interp,"dhs",_dhsTcl_S_);
}

EXTERN int
Pkgua_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code, cmdIndex = 0;
    Tcl_Command *cmdTokens;

    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
	return TCL_ERROR;
    }

    /*
     * Initialise our Hash table, where we store the registered command tokens
     * for each interpreter.
     */

    PkguaInitTokensHashTable();

    code = Tcl_PkgProvide(interp, "Pkgua", "1.0");
    if (code != TCL_OK) {
	return code;
    }

    Tcl_SetVar(interp, "::pkgua_loaded", ".", TCL_APPEND_VALUE);

    cmdTokens = PkguaInterpToTokens(interp);
    cmdTokens[cmdIndex++] =
	    Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, NULL,
		    NULL);
    cmdTokens[cmdIndex++] =
	    Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd,
		    NULL, NULL);
    return TCL_OK;
}

/*
  Function : Cximage_Init

  Description :	The Init function that will be called when the extension is loaded to your tk shell

  Arguments   :	Tcl_Interp *interp    :	This is the interpreter from which the load was made and to
  which we'll add the new command


  Return value : TCL_OK in case everything is ok, or TCL_ERROR in case there is an error (Tk version < 8.3)

  Comments     : hummmm... not much, it's simple :)

*/
int Tkcximage_Init (Tcl_Interp *interp ) {

    int i;

    INITLOGS(); //
    LOG("---------------------------------"); //

    //Check Tcl version is 8.3 or higher
    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
        return TCL_ERROR;
    }

    LOG("Tcl stub initialized"); //

    //Check TK version is 8.3 or higher
    if (Tk_InitStubs(interp, TK_VERSION, 1) == NULL) {
        return TCL_ERROR;
    }

    LOG("Tk stub initialized"); //


    LOG("Creating commands"); //

    // Create the wrapping commands in the CxImage namespace linked to custom functions with a NULL clientdata and
    // no deleteproc inside the current interpreter
    Tcl_CreateObjCommand(interp, "::CxImage::Convert", Tk_Convert,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::Resize", Tk_Resize,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::Colorize", Tk_Colorize,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::Thumbnail", Tk_Thumbnail,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::IsAnimated", Tk_IsAnimated,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

#if ANIMATE_GIFS
    Tcl_CreateObjCommand(interp, "::CxImage::StopAnimation", Tk_DisableAnimation,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::StartAnimation", Tk_EnableAnimation,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::NumberOfFrames", Tk_NumberOfFrames,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "::CxImage::JumpToFrame", Tk_JumpToFrame,
                         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
    if (PlaceHook(interp) != TCL_OK) return TCL_ERROR;
#endif

    LOG("Adding format : "); //
    for (i = 0; i < AVAILABLE_FORMATS; i++) {
        Tk_CreatePhotoImageFormat(&cximageFormats[i]);
        APPENDLOG(cximageFormats[i].name); //
    }

    // end of Initialisation
    return TCL_OK;
}

/*LINTLIBRARY*/
int
Blt_x_Init(Tcl_Interp *interp) /* Interpreter to add extra commands */
{
    Tcl_Namespace *nsPtr;
    Tcl_AppInitProc **p;
    const int isExact = 1;

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, TCL_VERSION_LOADED, isExact) == NULL) {
	return TCL_ERROR;
    };
#endif
    if (Tcl_PkgRequire(interp, "blt_core", BLT_VERSION, isExact) == NULL) {
	return TCL_ERROR;
    }

#if (_TCL_VERSION >= _VERSION(8,1,0)) 
#ifdef USE_TK_STUBS
    if (Tk_InitStubs(interp, TK_VERSION_LOADED, isExact) == NULL) {
	return TCL_ERROR;
    };
#endif
    if (Tcl_PkgPresent(interp, "Tk", TK_VERSION_LOADED, isExact) == NULL) {
	return TCL_OK;
    } 
#else
    if (Tcl_PkgRequire(interp, "Tk", TK_VERSION_LOADED, isExact) == NULL) {
	Tcl_ResetResult(interp);
	return TCL_OK;
    } 
#endif
    nsPtr = Tcl_CreateNamespace(interp, "::blt::tk", NULL, NULL);
    if (nsPtr == NULL) {
	return TCL_ERROR;
    }
    nsPtr = Tcl_FindNamespace(interp, "::blt", NULL, TCL_LEAVE_ERR_MSG);
    if (nsPtr == NULL) {
	return TCL_ERROR;
    }
    Blt_RegisterPictureImageType(interp);
    Blt_RegisterEpsCanvasItem();
    Blt_InitXRandrConfig(interp);

    /* Initialize the BLT commands that only use Tk. */
    for (p = cmdProcs; *p != NULL; p++) {
	if ((**p) (interp) != TCL_OK) {
	    Tcl_DeleteNamespace(nsPtr);
	    return TCL_ERROR;
	}
    }
    if (Tcl_PkgProvide(interp, "blt_extra", BLT_VERSION) != TCL_OK) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

int
Macports_Init(Tcl_Interp *interp)
{
	if (Tcl_InitStubs(interp, "8.4", 0) == NULL)
		return TCL_ERROR;
	Tcl_CreateObjCommand(interp, "get_systemconfiguration_proxies", GetSystemConfigurationProxiesCmd, NULL, NULL);
	Tcl_CreateObjCommand(interp, "sysctl", SysctlCmd, NULL, NULL);
	if (Tcl_PkgProvide(interp, "macports", "1.0") != TCL_OK)
		return TCL_ERROR;
	return TCL_OK;
}

int
Tclf_Init(Tcl_Interp *interp)
{	// Инициализация библиотеки
	const char *version;
	if ((version=Tcl_InitStubs(interp,TCL_VERSION,1))==NULL) {
		fprintf(stderr,"Tcl_InitStubs failed for %s\n",TCL_VERSION);
		return TCL_ERROR;		
	}
	// создание namespace
	packageNamespace=Tcl_CreateNamespace(interp,packageNsName,NULL,NULL);
	if (packageNamespace==NULL) {
		ERR("in Tcl_CreateNamespace");
		return TCL_ERROR;
	}
	// создание типов, объектов и констант делается раз и навсегда
	if (nrOfInstances==0) {
		if (initTupleSubsys(interp)!=TCL_OK) {
			ERR("on Tuple init");
			return TCL_ERROR;
		}
		if (initFuncSubsys(interp)!=TCL_OK) {
			ERR("on Func init");
			return TCL_ERROR;
		}
		if (initLazySubsys(interp)!=TCL_OK) {
			ERR("on Lazy init");
			return TCL_ERROR;
		}
		nrOfInstances++;
		if (resolveTypes(interp)!=TCL_OK) {
			ERR("resolve types");
			return TCL_ERROR;
		}
		if (installConsts(interp,constTable)!=TCL_OK) {
			ERR("install consts");
			return TCL_ERROR;
		}
	}
	// а вот команды разные у каждого интерпретатора
	if (resolveCommands(interp,resolveTable)!=TCL_OK) {
		ERR("resolve commands");
		return TCL_ERROR;
	}
	if (installCommands(interp,installTable)!=TCL_OK) {
		ERR("install commands");
		return TCL_ERROR;
	}
	if (initFuncInstance(interp,packageNamespace)!=TCL_OK)
		return TCL_ERROR;
	
	if (initLazyInstance(interp,packageNamespace)!=TCL_OK)
		return TCL_ERROR;
	return TCL_OK;
}

/**
   Called when Tcl loads this extension
 */
int
Tclpython_Init(Tcl_Interp *interp)
{
  if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
    return TCL_ERROR;

  if (Tcl_PkgProvide(interp, "python", "0.1") == TCL_ERROR)
    return TCL_ERROR;

  return TCL_OK;
}

int
Tclwinkill_Init(   Tcl_Interp *interp)
{
    if (!Tcl_InitStubs(interp, "8.0", 0)) {
	return TCL_ERROR;
    }
  if (refcount==0)
    atexit(close_shared_memory1);
  refcount++;
  Tcl_CreateCommand(interp, "winkill" ,Tcl_WinKillCmd ,NULL,close_shared_memory);
  return TCL_OK;
}