Ejemplo n.º 1
0
EXTERN int Pmepot_Init(Tcl_Interp *interp) {

#else

int Pmepot_Init(Tcl_Interp *interp) {

#endif

  int *countptr;
  countptr = (int *)malloc(sizeof(int));
  Tcl_SetAssocData(interp, "Pmepot_count", count_delete_proc, 
				(ClientData)countptr);
  *countptr = 0;

  Tcl_CreateObjCommand(interp,"pmepot_create",tcl_pmepot_create,
	(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"pmepot_add",tcl_pmepot_add,
	(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"pmepot_writedx",tcl_pmepot_writedx,
	(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"pmepot_destroy",tcl_pmepot_destroy,
	(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
 
  Tcl_PkgProvide(interp, "pmepot_core", "1.0.0");

  return TCL_OK;
}
Ejemplo n.º 2
0
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;
}
Ejemplo n.º 3
0
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;
}
Ejemplo n.º 4
0
/*
 * 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;
}
Ejemplo n.º 5
0
int Fftcmds_Init(Tcl_Interp *interp)   

#endif
{
  Tcl_CreateObjCommand(interp,"r2cfft_1d",tcl_rfft_1d,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"c2rfft_1d",tcl_rfft_1d,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftf_1d",tcl_cfft_1d,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftb_1d",tcl_cfft_1d,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftf_2d",tcl_cfft_nd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftb_2d",tcl_cfft_nd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftf_3d",tcl_cfft_nd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftb_3d",tcl_cfft_nd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftf_4d",tcl_cfft_nd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
  Tcl_CreateObjCommand(interp,"cfftb_4d",tcl_cfft_nd,
        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);

  Tcl_PkgProvide(interp, "fftcmds", "1.1");

  check_thread_count(interp,"fftcmds");

  return TCL_OK;
}
Ejemplo n.º 6
0
void ics_tcl_init_commands(struct ics_server *ics)
{
	Tcl_CreateObjCommand(ics->tclinterp, "ics_bind", tcl_ics_bind, ics, NULL);
	Tcl_CreateObjCommand(ics->tclinterp, "irc_interp", tcl_irc_interp, ics, NULL);
/*	Tcl_CreateObjCommand(ics->tclinterp, "get_board" tcl_get_board, ics, NULL);*/
	Tcl_CreateObjCommand(ics->tclinterp, "putics", tcl_putics, ics, NULL);
}
Ejemplo n.º 7
0
void ScriptedMobile::attachTclProcedures() {

	Tcl_CreateObjCommand(&_interp, "seek",seekTcl,
			(ClientData *) _scriptContext, (Tcl_CmdDeleteProc *) NULL);
	Tcl_CreateObjCommand(&_interp, "flee",
			fleeTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "approach",
			approachTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "follow",
			followTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "avoid",
			avoidTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "evade",
			evadeTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "followPath",
			followPathTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "flock",
			flockTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "isViewable",
			isViewableTcl,
			(ClientData *) _scriptContext, NULL);
	Tcl_CreateObjCommand(&_interp, "isTooClose",
			isTooCloseTcl,
			(ClientData *) _scriptContext, NULL);
}
Ejemplo n.º 8
0
int Funtools_Init (void *vinterp)
{
  Tcl_Interp *interp = (Tcl_Interp *)vinterp;

  Tcl_CreateObjCommand(interp, "funcen", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "funcnts", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "fundisp", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "funhead", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "funhist", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "funimage", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "funmerge", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "funtable", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  Tcl_CreateObjCommand(interp, "funcalc", MainLib_Tcl,
    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);

  Tcl_PkgProvide(interp, "funtools", "1.0");
  return(TCL_OK);
}
Ejemplo n.º 9
0
static int ALSProlog_Package_Init(Tcl_Interp *interp, AP_World *w)
{
  if (!Tcl_PkgRequire(interp, (char *)"Tcl", (char *)"8.0", 0)
      || !Tcl_CreateObjCommand(interp, (char *)"prolog", Tcl_ALS_Prolog_ObjCmd, w, NULL)
      || !Tcl_CreateObjCommand(interp, (char *)"dooneevent", Tcl_DoOneEventCmd, w, NULL))
    {
      return TCL_ERROR;
    }
  
  return Tcl_PkgProvide(interp, (char *)"ALSProlog", (char *)VERSION_STRING);
}
Ejemplo n.º 10
0
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 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;
}
Ejemplo n.º 12
0
/*
  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;
}
Ejemplo n.º 13
0
int
Gdbtk_Register_Init (Tcl_Interp *interp)
{
  Tcl_CreateObjCommand (interp, "gdb_reginfo", gdbtk_call_wrapper,
                        gdb_register_info, NULL);
  Tcl_CreateObjCommand (interp, "gdb_reg_arch_changed", gdbtk_call_wrapper,
			setup_architecture_data, NULL);

  /* Register/initialize any architecture specific data */
  setup_architecture_data ();

  return TCL_OK;
}
Ejemplo n.º 14
0
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);
}
Ejemplo n.º 15
0
int
TclObjTest_Init(
    Tcl_Interp *interp)
{
    register int i;

    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	varPtr[i] = NULL;
    }

    Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
	    NULL, NULL);
    return TCL_OK;
}
Ejemplo n.º 16
0
/*
** The main function for threads created with [sqlthread spawn].
*/
static Tcl_ThreadCreateType tclScriptThread(ClientData pSqlThread){
  Tcl_Interp *interp;
  Tcl_Obj *pRes;
  Tcl_Obj *pList;
  int rc;
  SqlThread *p = (SqlThread *)pSqlThread;
  extern int Sqlitetest_mutex_Init(Tcl_Interp*);

  interp = Tcl_CreateInterp();
  Tcl_CreateObjCommand(interp, "clock_seconds", clock_seconds_proc, 0, 0);
  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, pSqlThread, 0);
#if SQLITE_OS_UNIX && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
  Tcl_CreateObjCommand(interp, "sqlite3_blocking_step", blocking_step_proc,0,0);
  Tcl_CreateObjCommand(interp, 
      "sqlite3_blocking_prepare_v2", blocking_prepare_v2_proc, (void *)1, 0);
  Tcl_CreateObjCommand(interp, 
      "sqlite3_nonblocking_prepare_v2", blocking_prepare_v2_proc, 0, 0);
#endif
  Sqlitetest1_Init(interp);
  Sqlitetest_mutex_Init(interp);
  Sqlite3_Init(interp);

  rc = Tcl_Eval(interp, p->zScript);
  pRes = Tcl_GetObjResult(interp);
  pList = Tcl_NewObj();
  Tcl_IncrRefCount(pList);
  Tcl_IncrRefCount(pRes);

  if( rc!=TCL_OK ){
    Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, pList, pRes);
    postToParent(p, pList);
    Tcl_DecrRefCount(pList);
    pList = Tcl_NewObj();
  }

  Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj("set", -1));
  Tcl_ListObjAppendElement(interp, pList, Tcl_NewStringObj(p->zVarname, -1));
  Tcl_ListObjAppendElement(interp, pList, pRes);
  postToParent(p, pList);

  ckfree((void *)p);
  Tcl_DecrRefCount(pList);
  Tcl_DecrRefCount(pRes);
  Tcl_DeleteInterp(interp);
  while( Tcl_DoOneEvent(TCL_ALL_EVENTS|TCL_DONT_WAIT) );
  Tcl_ExitThread(0);
  TCL_THREAD_CREATE_RETURN;
}
Ejemplo n.º 17
0
void tcl_init(void) {
	tcl_startup = 1;
	SDL_Log("Init TCL...\n");
	tcl_interp = Tcl_CreateInterp();
	if (Tcl_Init(tcl_interp) != TCL_OK) {
		SDL_Log("...failed (%s)\n", Tcl_GetStringResult(tcl_interp));
		return;
	}
	Tcl_CreateObjCommand(tcl_interp, "hello", Hello_Cmd, NULL, NULL);
	Tcl_CreateObjCommand(tcl_interp, "ModelData", ModelData_Cmd, NULL, NULL);
	tcl_draw_init(tcl_interp);
	tcl_gl_draw_init(tcl_interp);
	SDL_Log("...done\n");
	return;
}
Ejemplo n.º 18
0
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");
}
Ejemplo n.º 19
0
int
Registry_Init(
    Tcl_Interp *interp)
{
    Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
    return Tcl_PkgProvide(interp, "registry", "1.0");
}
Ejemplo n.º 20
0
int
main()
{
  int mpi_argc = 0;
  char** mpi_argv = NULL;

  MPI_Init(&mpi_argc, &mpi_argv);

  // Create communicator for ADLB
  MPI_Comm comm;
  MPI_Comm_dup(MPI_COMM_WORLD, &comm);

  // Build up arguments
  int argc = 3;
  const char* argv[argc];
  argv[0] = "howdy";
  argv[1] = "ok";
  argv[2] = "bye";

  Tcl_Interp* interp = Tcl_CreateInterp();
  Tcl_Init(interp);

  Tcl_CreateObjCommand(interp, "ptasks_1_c", ptasks_1,
                       NULL, NULL);

  // Run Turbine
  turbine_code rc =
    turbine_run_interp(comm, "tests/ptasks-1.tcl", argc, argv, NULL,
                       interp);
  assert(rc == TURBINE_SUCCESS);

  MPI_Comm_free(&comm);
  MPI_Finalize();
  return 0;
}
Ejemplo n.º 21
0
static int xQueryPhraseCb(
  const Fts5ExtensionApi *pApi, 
  Fts5Context *pFts, 
  void *pCtx
){
  F5tFunction *p = (F5tFunction*)pCtx;
  static sqlite3_int64 iCmd = 0;
  Tcl_Obj *pEval;
  int rc;

  char zCmd[64];
  F5tApi sApi;

  sApi.pApi = pApi;
  sApi.pFts = pFts;
  sprintf(zCmd, "f5t_2_%lld", iCmd++);
  Tcl_CreateObjCommand(p->interp, zCmd, xF5tApi, &sApi, 0);

  pEval = Tcl_DuplicateObj(p->pScript);
  Tcl_IncrRefCount(pEval);
  Tcl_ListObjAppendElement(p->interp, pEval, Tcl_NewStringObj(zCmd, -1));
  rc = Tcl_EvalObjEx(p->interp, pEval, 0);
  Tcl_DecrRefCount(pEval);
  Tcl_DeleteCommand(p->interp, zCmd);

  if( rc==TCL_OK ){
    rc = f5tResultToErrorCode(Tcl_GetStringResult(p->interp));
  }

  return rc;
}
Ejemplo n.º 22
0
Archivo: entry.c Proyecto: zdia/gnocl
/**
\brief
    Function associated with the widget.
*/
int gnoclEntryCmd (
	ClientData data,
	Tcl_Interp *interp,
	int objc,
	Tcl_Obj * const objv[] )
{
#ifdef DEBUG_ENTRY
	printf ( "entry/staticFuncs/gnoclEntryCmd\n" );
#endif

	EntryParams *para;
	int ret;

	if ( gnoclParseOptions ( interp, objc, objv, entryOptions ) != TCL_OK )
	{
		gnoclClearOptions ( entryOptions );
		return TCL_ERROR;
	}

	para = g_new ( EntryParams, 1 );

	para->entry = GTK_ENTRY ( gtk_entry_new( ) );
	para->interp = interp;
	para->variable = NULL;
	para->onChanged = NULL;
	para->inSetVar = 0;

	gtk_entry_set_activates_default ( para->entry, TRUE );


	gtk_widget_show ( GTK_WIDGET ( para->entry ) );

	ret = gnoclSetOptions ( interp, entryOptions, G_OBJECT ( para->entry ), -1 );

	if ( ret == TCL_OK )
	{
		ret = configure ( interp, para, entryOptions );
	}

	gnoclClearOptions ( entryOptions );

	if ( ret != TCL_OK )
	{
		gtk_widget_destroy ( GTK_WIDGET ( para->entry ) );
		g_free ( para );
		return TCL_ERROR;
	}

	para->name = gnoclGetAutoWidgetId();

	g_signal_connect ( G_OBJECT ( para->entry ), "destroy", G_CALLBACK ( destroyFunc ), para );

	gnoclMemNameAndWidget ( para->name, GTK_WIDGET ( para->entry ) );

	Tcl_CreateObjCommand ( interp, para->name, entryFunc, para, NULL );

	Tcl_SetObjResult ( interp, Tcl_NewStringObj ( para->name, -1 ) );

	return TCL_OK;
}
Ejemplo n.º 23
0
Archivo: chantest.c Proyecto: 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;
}
Ejemplo n.º 24
0
/*
** Register commands with the TCL interpreter.
*/
int Sqlitetest3_Init(Tcl_Interp *interp){
  static struct {
     char *zName;
     Tcl_CmdProc *xProc;
  } aCmd[] = {
     { "btree_open",               (Tcl_CmdProc*)btree_open               },
     { "btree_close",              (Tcl_CmdProc*)btree_close              },
     { "btree_begin_transaction",  (Tcl_CmdProc*)btree_begin_transaction  },
     { "btree_pager_stats",        (Tcl_CmdProc*)btree_pager_stats        },
     { "btree_cursor",             (Tcl_CmdProc*)btree_cursor             },
     { "btree_close_cursor",       (Tcl_CmdProc*)btree_close_cursor       },
     { "btree_next",               (Tcl_CmdProc*)btree_next               },
     { "btree_eof",                (Tcl_CmdProc*)btree_eof                },
     { "btree_payload_size",       (Tcl_CmdProc*)btree_payload_size       },
     { "btree_first",              (Tcl_CmdProc*)btree_first              },
     { "btree_varint_test",        (Tcl_CmdProc*)btree_varint_test        },
     { "btree_from_db",            (Tcl_CmdProc*)btree_from_db            },
     { "btree_ismemdb",            (Tcl_CmdProc*)btree_ismemdb            },
     { "btree_set_cache_size",     (Tcl_CmdProc*)btree_set_cache_size     }
  };
  int i;

  for(i=0; i<sizeof(aCmd)/sizeof(aCmd[0]); i++){
    Tcl_CreateCommand(interp, aCmd[i].zName, aCmd[i].xProc, 0, 0);
  }

  Tcl_CreateObjCommand(interp, "btree_insert", btree_insert, 0, 0);

  return TCL_OK;
}
Ejemplo n.º 25
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;
}
Ejemplo n.º 26
0
static int newpvInfo (Tcl_Interp *interp, const char *name, Tcl_Obj *prefix) {
	pvInfo *result=ckalloc(sizeof(pvInfo));
	
	result->interp=interp;
	result->name=ckstrdup(name);
	if (prefix) Tcl_IncrRefCount(prefix);
	result->connectprefix = prefix;
	result->id = 0;
	result->connected = 0;
	result->thrid = Tcl_GetCurrentThread();
	result->monitorid = 0;
	result->monitorprefix = NULL;
	result->nElem = 1;
	result->type = -1;

	/* connect PV */
	int code = ca_create_channel(name, stateHandler, result, 0, &(result->id));
	if (code != ECA_NORMAL) {
		/* raise error */
		freepvInfo(result);
		Tcl_SetObjResult(interp, Tcl_NewStringObj(ca_message(code), -1));
		return TCL_ERROR;
	}	
	
	/* Create handle */
	static int pvcounter = 0;
	char objName[50 + TCL_INTEGER_SPACE];
	sprintf(objName, "::AsynCA::PV%d", ++pvcounter);
	result->cmd = Tcl_CreateObjCommand(interp, objName, InstanceCmd, (ClientData) result, DeleteCmd);
	
	Tcl_SetObjResult(interp, Tcl_NewStringObj(objName, -1));

	return TCL_OK;
}
Ejemplo n.º 27
0
int
TclplatformtestInit(
    Tcl_Interp *interp)		/* Interpreter to add commands to. */
{
    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
        NULL, NULL);
    Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
	    NULL, NULL);
    return TCL_OK;
}
Ejemplo n.º 28
0
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;
}
Ejemplo n.º 29
0
int
elTclHandlersInit(ElTclInterpInfo *iinfo)
{
#ifdef SIGWINCH
   /* we must keep track of that one (for libedit and completion engine) */

   sigset_t set, oset;
   ElTclSignalContext *ctx = malloc(sizeof(*ctx));

   if (ctx != NULL) {
      sigemptyset(&set);
      sigaddset(&set, SIGWINCH);
      sigprocmask(SIG_BLOCK, &set, &oset);

      ctx->iinfo = iinfo;
      ctx->next = sigWinchContext;
      /* XXX this might not be atomic */
      sigWinchContext = ctx;

      signal(SIGWINCH, signalHandler);

      sigprocmask(SIG_SETMASK, &oset, NULL);
   }
#endif


   initSigNames(signalNames);
   Tcl_CreateObjCommand(iinfo->interp, "signal", elTclSignal, iinfo, NULL);
   return TCL_OK;
}
Ejemplo n.º 30
0
int
Tclcurl_MultiInit (Tcl_Interp *interp) {

    Tcl_CreateObjCommand (interp,"::curl::multiinit",curlInitMultiObjCmd,
            (ClientData)NULL,(Tcl_CmdDeleteProc *)NULL);

    return TCL_OK;
}