コード例 #1
0
ファイル: rechan.c プロジェクト: apnadkarni/kitgen
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");
}
コード例 #2
0
ファイル: tclarc4random.c プロジェクト: aryler/Tclarc4random
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;
}
コード例 #3
0
ファイル: vtables.c プロジェクト: digsrc/windowstoolset
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;
}
コード例 #4
0
ファイル: chantest.c プロジェクト: aosm/tcl
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;
}
コード例 #5
0
/** \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;
}
コード例 #6
0
ファイル: tnmInit.c プロジェクト: flightaware/scotty
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);
}
コード例 #7
0
ファイル: tcl-duktape.c プロジェクト: dbohdan/tcl-duktape
/*
 * 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;
}
コード例 #8
0
ファイル: dhsTcl.c プロジェクト: rlseaman/kdhs_test
/*******************************************************************************
 * 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_);
}
コード例 #9
0
ファイル: pkgua.c プロジェクト: AlexShiLucky/bitkeeper
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;
}
コード例 #10
0
ファイル: TkCximage.cpp プロジェクト: Kjir/amsn
/*
  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;
}
コード例 #11
0
ファイル: bltExtInit.c プロジェクト: Starlink/blt
/*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;
}
コード例 #12
0
ファイル: macports.c プロジェクト: Brucegx/Appstore719
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;
}
コード例 #13
0
ファイル: tclf.c プロジェクト: nektomk/tcl-f
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;
}
コード例 #14
0
ファイル: tcl-python.c プロジェクト: yuhangwang/swift-t
/**
   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;
}
コード例 #15
0
DLLEXPORT int
Pkge_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    static const char script[] = "if 44 {open non_existent}";

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    return Tcl_EvalEx(interp, script, -1, 0);
}
コード例 #16
0
ファイル: tclwinkill.c プロジェクト: LeiYangGH/maxima
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;
}
コード例 #17
0
ファイル: libfac.c プロジェクト: boerge42/Tcl-Magie
/* Erweiterung initialisieren */
int Fac_Init (Tcl_Interp *interp) {

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

	/* factorial-Kommando erzeugen */
	Tcl_CreateObjCommand (interp, "factorial", Fac_cmd, NULL, NULL);
	return TCL_OK;
}
コード例 #18
0
int
Pkge_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    static char script[] = "if 44 {open non_existent}";

    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
	return TCL_ERROR;
    }
    return Tcl_Eval(interp, script);
}
コード例 #19
0
int Vtk_tcl_thread_util_Init(Tcl_Interp *interp) {
	/* initialize the stub table interface */
	if (Tcl_InitStubs(interp,"8.5",0)==NULL) {
		return TCL_ERROR;
	}
	/* Create all of the Tcl commands */
	Tcl_CreateObjCommand(interp,"::vtk_tcl_thread_util::__get_pointer_from_vtk_obj",get_pointer_from_vtk_obj,
			(ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);
	Tcl_CreateObjCommand(interp,"::vtk_tcl_thread_util::__register_vtk_obj",register_vtk_obj,
	                     (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);           
	return TCL_OK;
}
コード例 #20
0
ファイル: tclXtTest.c プロジェクト: afmayer/tcl-tk
int
Tclxttest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
	return TCL_ERROR;
    }
    XtToolkitInitialize();
    InitNotifier();
    Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
	    NULL, NULL);
    return TCL_OK;
}
コード例 #21
0
ファイル: pgtcl.c プロジェクト: BackupTheBerlios/pgtcl-svn
int
Pgtcl_Init(Tcl_Interp *interp)
{
    PgCmd *cmdPtr;

#ifdef WIN32
    WSADATA wsaData;
#endif

#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL)
        return TCL_ERROR;
#endif

#ifdef WIN32
    /*
     * Load the socket DLL and initialize the function table.
     */
    if (WSAStartup(MAKEWORD(1, 1), &wsaData)) {
        /*
         * No really good way to do error handling here, since we
         * don't know how we were loaded
         */
        return FALSE;
    }
#endif

    /*
     * Tcl versions >= 8.1 use UTF-8 for their internal string
     * representation. Therefore PGCLIENTENCODING must be set to UNICODE
     * for these versions.
     */

    Tcl_PutEnv("PGCLIENTENCODING=UNICODE");

    /*
     * register all pgtcl commands
     */

    for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
        Tcl_CreateObjCommand(interp, cmdPtr->name,
            cmdPtr->objProc, (ClientData) "::", NULL);
        Tcl_CreateObjCommand(interp, cmdPtr->altname,
            cmdPtr->objProc, (ClientData) "::pg::", NULL);
    }

    if (Tcl_Eval(interp, "namespace eval ::pg namespace export *") == TCL_ERROR)
        return TCL_ERROR;

    return Tcl_PkgProvide(interp, "Pgtcl", PACKAGE_VERSION);
}
コード例 #22
0
ファイル: iftest.C プロジェクト: m-sonntag/hqp
int
Tcl_AppInit(Tcl_Interp *interp)
{
  if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
    return TCL_ERROR;
  }

  if (Tcl_Init(interp) == TCL_ERROR) {
    return TCL_ERROR;
  }

  theInterp = interp;

  new If_Int("if_int", &if_int);
  new If_Int("if_intCb",
	     new If_GetCb<int, A>(&A::i, &a));

  new If_Bool("if_bool", &if_bool);
  new If_Real("if_real", &if_real);

  if_realVec = v_get(5);
  new If_RealVec("if_realVec", &if_realVec);

  if_realMat = m_get(2,3);
  new If_RealMat("if_realMat", &if_realMat);

  if_intVec = iv_get(3);
  new If_IntVec("if_intVec", &if_intVec);

  new If_IntVec("if_intVecp",
                new If_GetCb<const IVECP, A>(&A::intVecp, &a),
                new If_SetCb<const IVECP, A>(&A::set_intVecp, &a));

  new If_String("if_string", &if_string);
		
  new If_String("if_stringCb",
		new If_GetCb<const char *, A>(&A::string, &a),
		new If_SetCb<const char *, A>(&A::set_string, &a));

  new If_StdString("if_stdString",
		   new If_GetCb<const std::string&, A>(&A::stdString, &a),
		   new If_SetCb<const std::string&, A>(&A::set_stdString, &a));

  new If_Procedure("if_procedure", &if_procedure);

  new If_Method<A>("if_method", &A::if_method, &a);

  Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
  return TCL_OK;
}
コード例 #23
0
ファイル: cvlkdemo.cpp プロジェクト: mikanradojevic/sdkpub
int Tcl_AppInit(Tcl_Interp *pintrp)
{

    if (Tcl_InitStubs(pintrp, TCL_VERSION, 1) == NULL)
        Panic (pintrp,"Tcl stub's initialisation failed!");
        
    if (Tcl_Init(pintrp) == TCL_ERROR)
        Panic (pintrp,"Tcl's initialisation failed!");
    
    if (Tk_Init(pintrp) == TCL_ERROR)
        Panic (pintrp,"Tk's initialisation failed!");

    return TCL_OK;
}
コード例 #24
0
ファイル: base_edf_sched.c プロジェクト: acassis/rtsim
// ################################################################
// 4. Rename the function using the name of the library + _Init
// ################################################################
// example edfnfll_init for edfnfll
int Edfnf_Init(Tcl_Interp *interp)
{
	DBG("\nEdfnf_Init TCL v[%s]", TCL_VERSION);
	
    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
		DBG("\nerror ");
		return TCL_ERROR;
    }
	
	DBG("\nCreating command [%s]\n",COMMAND_NAME);
	//once it receives the command from TCL COMMAND_NAME,is sent the function call SimulatorCmd
    Tcl_CreateObjCommand(interp, COMMAND_NAME, (void*)SimulatorCmd, NULL, NULL);
    Tcl_PkgProvide(interp, COMMAND_NAME, "1.1");

	return TCL_OK;
}
コード例 #25
0
ファイル: tcl-mod.c プロジェクト: OldCoder/BEWorld
/* these are the tcl init/exit routines */
int DLLEXPORT Br_Init(Tcl_Interp *interp)
{

   /* initialize stubs and create the exit handler */
   if( !Tcl_InitStubs(interp, TCL_VERSION, 0) )
     return TCL_ERROR;

   Tcl_CreateExitHandler(Br_Atexit, NULL);


   /* prepare environment and load functions into tcl */
   init_brick();
   load_routines(interp);

   return TCL_OK;
}
コード例 #26
0
ファイル: viewimage_Init.c プロジェクト: sbromle/MvthImage
int Viewimage_Init(Tcl_Interp *interp) {
	/* initialize the stub table interface */
	if (Tcl_InitStubs(interp,"8.1",0)==NULL) {
		return TCL_ERROR;
	}
	if (Tk_InitStubs(interp,"8.1",0)==NULL) {
		return TCL_ERROR;
	}
	if (Tcl_PkgRequire(interp,"Tk","8.1",0)==NULL) {
		return TCL_ERROR;
	}
	if (Tcl_PkgRequire(interp,"mvthimage","1.0",0)==NULL) {
		return TCL_ERROR;
	}
	
	/* initialize the new, alternative image context handling code */
	MvthImageState_Init(interp);

	/* Initialize the Tcl script for viewing images in a Tk window.*/
	char buff[1024];
	snprintf(buff,sizeof(buff),"%s/viewimage.tcl",TCLSCRIPTDIR);
	fprintf(stdout,"viewimage.tcl should be located at: %s\n",buff);
	Tcl_EvalFile(interp,buff);
	Tcl_VarEval(interp,
			"puts stdout {viewimage Copyright (C) 2009 Sam Bromley};",
			"puts stdout {This software comes with ABSOLUTELY NO WARRANTY.};",
			"puts stdout {This is free software, and you are welcome to};",
			"puts stdout {redistribute it under certain conditions.};",
			"puts stdout {For details, see the GNU Lesser Public License V.3 <http://www.gnu.org/licenses>.};",
			NULL);
	Tcl_VarEval(interp,
			"proc miexpand {w} {"
				"foreach {wo ho do bo} [mi size $w] break;"
				"set c [::viewimage::canvasNameFromImg $w];"
				"set wi [winfo width $c];"
				"set hi [winfo height $c];"
				"set wi [expr {$wi-3}];"
				"set hi [expr {$hi-3}];"
				"if {$wi<=0} {set wi 10};"
				"if {$hi<=0} {set hi 10};"
				"mi size $w [list $wi $hi $bo];"
				"xblitimage $w;"
			"}",NULL);
	/* Declare that we provide the buriedtargets package */
	Tcl_PkgProvide(interp,"viewimage","1.0");
	return TCL_OK;
}
コード例 #27
0
ファイル: Hqp_Init.C プロジェクト: omuses/hqp
//--------------------------------------------------------------------------
extern "C" HQP_API int Hqp_Init(Tcl_Interp *interp) 
{
  // provide Tcl package Hqp
  if (Tcl_InitStubs(interp, "8.1", 0) == NULL ||
      Tcl_PkgProvide(interp, "Hqp", (char *)Hqp_Version) != TCL_OK) {
    return TCL_ERROR;
  }

  // initialize global reference to Tcl interpreter
  theInterp = interp;

  // disable Meschach's error counting
  // (otherwise program would exit if counter reaches 100)
  count_errs(0);

  // allocate interface modules
# ifdef IF_CLASS_STATIC
  Hqp_ClassAlloc();
# endif

  // create initial state
  theSqpProgram = NULL;
  theSqpSolver = new Hqp_SqpPowell;

  _ifList.append(new IF_MODULE("prg_name", &theSqpProgram, Hqp_SqpProgram));
  _ifList.append(new IF_MODULE("sqp_solver", &theSqpSolver, Hqp_SqpSolver));
  _ifList.append(new IF_MODULE("mip_solver", &theMipSolver, Hqp_MipSolver));
  _ifList.append(new If_String("hqp_version", &Hqp_Version));
  _ifList.append(new If_Procedure("m_version", &m_version_cmd));

  // evaluate hqp_solve.tcl
  extern char *hqp_solve;
  if (Tcl_Eval(interp, hqp_solve) == TCL_ERROR) {
    fprintf(stderr,
	    "Evaluation of built-in code failed: %s\n", Tcl_GetStringResult(interp));
  }

  // evaluate file ~/.hqprc if it exists
  if (Tcl_Eval(interp, "if {[file exists ~/.hqprc]} {source ~/.hqprc}")
      != TCL_OK) {
    fprintf(stderr,
	    "Evaluation of ~/.hqprc failed: %s\n", Tcl_GetStringResult(interp));
  }

  return TCL_OK;
}
コード例 #28
0
ファイル: pkgd.c プロジェクト: AlexShiLucky/bitkeeper
EXTERN int
Pkgd_SafeInit(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
    return TCL_OK;
}
コード例 #29
0
ファイル: TclLiquid.cpp プロジェクト: 23/openliquid
    /*
     * Load the extension in normal execution mode
     */
    int DLLEXPORT Tclliquid_Init(Tcl_Interp *interp)
    {
        // Initialize the stubs and verify the result
        if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
            return TCL_ERROR;

        // Initialize the package provided by this extension
        if (Tcl_PkgProvide(interp, "liquid", "0.1.0") == TCL_ERROR)
            return TCL_ERROR;

        // Initialize commands
        Tcl_CreateObjCommand(interp, LiquidNamespace"validate", LiquidValidate_Command, NULL, NULL);
        Tcl_CreateObjCommand(interp, LiquidNamespace"render", LiquidRender_Command, NULL, NULL);

        // All set!
        return TCL_OK;
    }
コード例 #30
0
ファイル: bonjour.c プロジェクト: eviltwinskippy/tcl_bonjour
////////////////////////////////////////////////////
// initialize the package
////////////////////////////////////////////////////
int DLLEXPORT Bonjour_Init(
   Tcl_Interp *interp
) {
   // Initialize the stubs library
   if(Tcl_InitStubs(interp, "8.4", 0) == NULL) {
      return(TCL_ERROR);
   }

   // Tell Tcl what package we're providing
   Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);

   // initialize components
   Browse_Init(interp);
   Register_Init(interp);
   Resolve_Init(interp);

   return(TCL_OK);
}