Пример #1
0
	virtual void OnKick(const CNick& OpNick, const CString& sKickedNick, CChan& Channel, const CString& sMessage) {
		CString sOpNick = TclEscape(CString(OpNick.GetNick()));
		CString sNick = TclEscape(sKickedNick);
		CString sOpHost = TclEscape(CString(OpNick.GetIdent() + "@" + OpNick.GetHost()));

		CString sCommand = "Binds::ProcessKick {" + sOpNick + "} {" + sOpHost + "} - {" + Channel.GetName() + "} {" + sNick + "} {" + sMessage + "}";
		i = Tcl_Eval(interp, sCommand.c_str());
		if (i != TCL_OK) {
			PutModule(Tcl_GetStringResult(interp));
		}
	}
Пример #2
0
/*
** This routine is invoked as the 'progress callback' for the database.
*/
static int DbProgressHandler(void *cd){
  SqliteDb *pDb = (SqliteDb*)cd;
  int rc;

  assert( pDb->zProgress );
  rc = Tcl_Eval(pDb->interp, pDb->zProgress);
  if( rc!=TCL_OK || atoi(Tcl_GetStringResult(pDb->interp)) ){
    return 1;
  }
  return 0;
}
Пример #3
0
int ScriptTcl::eval(const char *script, const char **resultPtr) {

#ifdef NAMD_TCL
  int code = Tcl_EvalEx(interp,script,-1,TCL_EVAL_GLOBAL);
  *resultPtr = Tcl_GetStringResult(interp);
  return code;
#else
  NAMD_bug("ScriptTcl::eval called without Tcl.");
  return -1;  // appease compiler
#endif
}
Пример #4
0
static ngx_int_t
ngx_tcl_init(ngx_conf_t *cf)
{
    ngx_tcl_interp_conf_t *iconf;
    int rc;
    int i;

printf("%s\n", __FUNCTION__); fflush(stdout);

    if (interp_confs != NULL) {
        Tcl_FindExecutable(NULL);
    }

    for (iconf = interp_confs; iconf != NULL; iconf = iconf->next) {
        iconf->interp = Tcl_CreateInterp();
        rc = Tcl_Init(iconf->interp);
        if (rc != TCL_OK) {
            ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
                "tcl error: %s", Tcl_GetStringResult(iconf->interp));
            return NGX_ERROR;
        }

        for (i = 0; commands[i].name; ++i) {
            Tcl_CreateObjCommand(iconf->interp, commands[i].name,
                commands[i].cmd, iconf, NULL);
        }

        rc = Tcl_Eval(iconf->interp, (char*)iconf->initscript.data);
        if (rc != TCL_OK) {
            ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
                "tcl error: %s\n%s\n",
                Tcl_GetStringResult(iconf->interp),
                Tcl_GetVar(iconf->interp, "errorInfo", TCL_GLOBAL_ONLY)
            );

            return NGX_ERROR;
        }
    }

    return NGX_OK;
}
Пример #5
0
static void
imfsample_add_imf(Imfsample *imfsample, const char *imfname)
{
    int i;
    ImageFamily *imf = NULL;
    char tclbuf[100];
    int rslt;

    if (strcmp(imfname, "-all") == 0) {
	imfsample->numimages = 0;
	for (i = 0; i < numimages; ++i) {
	    if (imfsample->imfapp) {
		sprintf(tclbuf, 
".closeup.content itemconfigure status -text \"Loading %s\"", 
			images[i]->name);
		rslt = Tcl_Eval(interp, tclbuf);
		if (rslt == TCL_ERROR) {
		    fprintf(stderr, "Error: %s\n", Tcl_GetStringResult(interp));
		}
		sprintf(tclbuf, "update idletasks");
		rslt = Tcl_Eval(interp, tclbuf);
		if (rslt == TCL_ERROR) {
		    fprintf(stderr, "Error: %s\n", Tcl_GetStringResult(interp));
		}
	    }
	    imf = tk_find_imf(images[i]->name);
	    if (imf == NULL) {
		fprintf(stderr, "Missing imf %s\n", imfname);
		return;
	    }
	    imfsample->imf_list[imfsample->numimages++] = images[i];
	}
	return;
    }
    imf = tk_find_imf(imfname);
    if (imf == NULL) {
	fprintf(stderr, "Missing imf %s\n", imfname);
	return;
    }
    imfsample->imf_list[imfsample->numimages++] = imf;
}
Пример #6
0
Файл: If.C Проект: vruge/hqp
//-----------------------------------------------------------------------
extern "C" int If_GetString(const char *name, const char **val)
{
  if (!theInterp)
    return IF_ERROR;

  if (Tcl_Eval(theInterp, (char *)name) != TCL_OK) {
    val = NULL;
    return IF_ERROR;
  }
  *val = Tcl_GetStringResult(theInterp);
  return IF_OK;
}
Пример #7
0
/*
 * plot vertical contigs and deal with diagonal line in dot plot
 */
void
update_contig_comparator(Tcl_Interp *interp,
			 GapIO *io,
			 obj_cs *cs)
{
    int win_wd;
    char cmd[1024];

    Tcl_VarEval(interp, "winfo width ", cs->vert, NULL);
    win_wd = atoi(Tcl_GetStringResult(interp));

    display_contigs(interp, io, cs->vert, cs->line_colour, cs->line_width,
		    cs->tick->line_width, cs->tick->ht, win_wd/2, "vertical");

    scaleSingleCanvas(interp, cs->world, cs->canvas, cs->vert, 'y', "all");

    sprintf(cmd, "DisplayDiagonal %s %s %d", cs->frame, cs->window,
	    *handle_io(io));
    if (TCL_ERROR == Tcl_Eval(interp, cmd))
	printf("update_contig_comparator: %s\n", Tcl_GetStringResult(interp));

}
Пример #8
0
void screen_tcl(ESContext *esContext) {
	static uint8_t startup = 0;
	if (startup == 0) {
		startup = 1;
		char scriptfile[1024];
		sprintf(scriptfile, "%s/scripts/screen_tcl.tcl", BASE_DIR);
		tcl_runFile(scriptfile);
		if (Tcl_Eval(tcl_interp, "init") != TCL_OK) {
			SDL_Log("TCL-ERROR:\n");
			SDL_Log("#######################################################\n");
			SDL_Log("%s\n", Tcl_GetStringResult(tcl_interp));
			SDL_Log("#######################################################\n");
		}
	}
	tcl_update_modeldata();
	if (Tcl_Eval(tcl_interp, "view") != TCL_OK) {
		SDL_Log("TCL-ERROR:\n");
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", Tcl_GetStringResult(tcl_interp));
		SDL_Log("#######################################################\n");
	}
}
Пример #9
0
/* Executes a script in our customized interpreter. Returns 0 on success.
   Returns -1 and prints a message on standard error on failure.

   We'll use this to preload the procedures in the script. The interpreter's
   state is maintained after Tcl_EvalFile. We will NOT call Tcl_EvalFile after
   each frame - that would be hideously slow. */
int LoadGameScript(char *filename)
{
    int status;

    status = Tcl_EvalFile(interp, filename);
    if (status != TCL_OK) {
	fprintf(stderr, "Error executing %s: %s\n", filename,
		Tcl_GetStringResult(interp));
	return -1;
    }

    return 0;
}
Пример #10
0
	virtual EModRet OnChanMsg(CNick& Nick, CChan& Channel, CString& sMessage) {
		CString sMes = TclEscape(sMessage);
		CString sNick = TclEscape(CString(Nick.GetNick()));
		CString sHost = TclEscape(CString(Nick.GetIdent() + "@" + Nick.GetHost()));
		CString sChannel = TclEscape(CString(Channel.GetName()));

		CString sCommand = "Binds::ProcessPubm {" + sNick + "} {" + sHost + "} - {" + sChannel + "} {" + sMes + "}";
		i = Tcl_Eval(interp, sCommand.c_str());
		if (i != TCL_OK) {
			PutModule(Tcl_GetStringResult(interp));
		}
		return CONTINUE;
	}
Пример #11
0
void driver_plot_icon(double x, double y, const char *icon)
{
    char buf[1024];
    int xi, yi;

    G_plot_where_xy(x, y, &xi, &yi);

    sprintf(buf,
	    ".screen.canvas create bitmap %d %d -bitmap @$iconpath/%s.xbm -foreground %s -anchor center",
	    xi, yi, icon, color);
    if (Tcl_Eval(Toolbox, buf) != TCL_OK)
	G_warning("driver_plot_icon: %s", Tcl_GetStringResult(Toolbox));
}
Пример #12
0
void tcl_run(char *script) {
	if (tcl_startup == 0) {
		tcl_init();
	}
	tcl_update_modeldata();
	if (Tcl_Eval(tcl_interp, script) != TCL_OK) {
		SDL_Log("TCL-ERROR:\n");
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", script);
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", Tcl_GetStringResult(tcl_interp));
		SDL_Log("#######################################################\n");
	}
}
Пример #13
0
void registerAlgorithm(mask code, char *shortName, char *longName, 
                void (*updateWeights)(flag)) {
        Algorithm A = (Algorithm) safeMalloc(sizeof(struct algorithm), 
                        "registerAlgorithm:A");
        registerType(shortName, code, ALGORITHM);
        A->code = code;
        A->shortName = copyString(shortName);
        A->longName = copyString(longName);
        A->updateWeights = updateWeights;
        A->next = AlgorithmTable;
        AlgorithmTable = A;
        if (eval(".registerAlgorithm %s \"%s\" %d", shortName, longName, code))
                fatalError(Tcl_GetStringResult(Interp));
}
Пример #14
0
void shell_run(tree_t e, struct tree_rd_ctx *ctx)
{
   const int ndecls = tree_decls(e);
   hash_t *decl_hash = hash_new(ndecls * 2, true);
   for (int i = 0; i < ndecls; i++) {
      tree_t d = tree_decl(e, i);
      hash_put(decl_hash, tree_ident(d), d);
   }

   Tcl_Interp *interp = Tcl_CreateInterp();

   shell_cmd_t shell_cmds[] = {
      CMD(quit,      NULL,       "Exit simulation"),
      CMD(run,       NULL,       "Start or resume simulation"),
      CMD(restart,   e,          "Restart simulation"),
      CMD(show,      decl_hash,  "Display simulation objects"),
      CMD(help,      shell_cmds, "Display this message"),
      CMD(copyright, NULL,       "Display copyright information"),
      CMD(signals,   e,          "Find signal objects in the design"),
      CMD(now,       NULL,       "Display current simulation time"),
      CMD(watch,     decl_hash,  "Trace changes to a signal"),
      CMD(unwatch,   decl_hash,  "Stop tracing signals"),

      { NULL, NULL, NULL, NULL}
   };

   qsort(shell_cmds, ARRAY_LEN(shell_cmds) - 1, sizeof(shell_cmd_t),
         compare_shell_cmd);

   for (shell_cmd_t *c = shell_cmds; c->name != NULL; c++)
      Tcl_CreateObjCommand(interp, c->name, c->fn, c->cd, NULL);

   show_banner();

   char *line;
   while ((line = shell_get_line())) {
      switch (Tcl_Eval(interp, line)) {
      case TCL_OK:
         break;
      case TCL_ERROR:
         errorf("%s", Tcl_GetStringResult(interp));
         break;
      }

      free(line);
   }

   printf("\nBye.\n");
   Tcl_Finalize();
}
Пример #15
0
void TclTextInterp::graph_label_cb(const char *type, const int *ids, int n) {
  Tcl_Obj *itemlist = Tcl_NewListObj(0, NULL);
  for (int i=0; i<n; i++) {
    Tcl_Obj *item = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, item, Tcl_NewStringObj(type, -1));
    Tcl_ListObjAppendElement(interp, item, Tcl_NewIntObj(ids[i]));
    Tcl_ListObjAppendElement(interp, itemlist, item);
  }
  Tcl_Obj *varname = Tcl_NewStringObj("vmd_graph_label", -1);
  if (!Tcl_ObjSetVar2(interp, varname, NULL, itemlist, 
        TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY)) {
    msgErr << "Error graphing labels: " << Tcl_GetStringResult(interp) << sendmsg;
  }
}
Пример #16
0
static void expandPercentsEval(Tcl_Interp * interp,	/* interpreter context */
			       register char *before,	/* Command with percent expressions */
			       char *r,	/* vgpaneHandle string to substitute for "%r" */
			       int npts,	/* number of coordinates */
			       point * ppos	/* Cordinates to substitute for %t */
    )
{
    register char *string;
    Tcl_DString scripts;

    Tcl_DStringInit(&scripts);
    while (1) {
	/*
	 * Find everything up to the next % character and append it to the
	 * result string.
	 */

	for (string = before; (*string != 0) && (*string != '%'); string++) {
	    /* Empty loop body. */
	}
	if (string != before) {
	    Tcl_DStringAppend(&scripts, before, string - before);
	    before = string;
	}
	if (*before == 0) {
	    break;
	}
	/*
	 * There's a percent sequence here.  Process it.
	 */

	switch (before[1]) {
	case 'r':
	    Tcl_DStringAppend(&scripts, r, strlen(r));	/* vgcanvasHandle */
	    break;
	case 't':
	    dgsprintxy(&scripts, npts, ppos);
	    break;
	default:
	    Tcl_DStringAppend(&scripts, before + 1, 1);
	    break;
	}
	before += 2;
    }
    if (Tcl_GlobalEval(interp, Tcl_DStringValue(&scripts)) != TCL_OK)
	fprintf(stderr, "%s while in binding: %s\n\n",
		Tcl_GetStringResult(interp), Tcl_DStringValue(&scripts));
    Tcl_DStringFree(&scripts);
}
Пример #17
0
static void overloadedGlobFunction(
  sqlite3_context *pContext,
  int nArg,
  sqlite3_value **apArg
){
  Tcl_Interp *interp = sqlite3_user_data(pContext);
  Tcl_DString str;
  int i;
  int rc;
  Tcl_DStringInit(&str);
  Tcl_DStringAppendElement(&str, "::echo_glob_overload");
  for(i=0; i<nArg; i++){
    Tcl_DStringAppendElement(&str, (char*)sqlite3_value_text(apArg[i]));
  }
  rc = Tcl_Eval(interp, Tcl_DStringValue(&str));
  Tcl_DStringFree(&str);
  if( rc ){
    sqlite3_result_error(pContext, Tcl_GetStringResult(interp), -1);
  }else{
    sqlite3_result_text(pContext, Tcl_GetStringResult(interp),
                        -1, SQLITE_TRANSIENT);
  }
  Tcl_ResetResult(interp);
}
Пример #18
0
void tcl_runFile(char *file) {
	if (tcl_startup == 0) {
		tcl_init();
		TclUpdateVarString("BASE_DIR", BASE_DIR);
	}
	tcl_update_modeldata();
	if (Tcl_EvalFile(tcl_interp, file) != TCL_OK) {
		SDL_Log("TCL-ERROR:\n");
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", file);
		SDL_Log("#######################################################\n");
		SDL_Log("%s\n", Tcl_GetStringResult(tcl_interp));
		SDL_Log("#######################################################\n");
	}
}
Пример #19
0
static int
NsThread_Init (Tcl_Interp *interp, void *cd)
{
    struct mydata *md = (struct mydata*)cd;
    int ret = Thread_Init(interp);

    if (ret != TCL_OK) {
        Ns_Log(Warning, "can't load module %s: %s", md->modname,
               Tcl_GetStringResult(interp));
        return TCL_ERROR;
    }
    Tcl_SetAssocData(interp, "thread:nsd", NULL, (ClientData)md);

    return TCL_OK;
}
Пример #20
0
void ScriptTcl::load(char *scriptFile) {

#ifdef NAMD_TCL
  int code = Tcl_EvalFile(interp,scriptFile);
  const char *result = Tcl_GetStringResult(interp);
  if (*result != 0) CkPrintf("TCL: %s\n",result);
  if (code != TCL_OK) {
    const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
    NAMD_die(errorInfo);
  }
#else
  NAMD_bug("ScriptTcl::load called without Tcl.");
#endif

}
Пример #21
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;
}
Пример #22
0
int colvarproxy_tcl::tcl_run_colvar_gradient_callback(
                         std::string const &name,
                         std::vector<const colvarvalue *> const &cvc_values,
                         std::vector<cvm::matrix2d<cvm::real> > &gradient)
{
#if defined(COLVARS_TCL)

  Tcl_Interp *const tcl_interp = reinterpret_cast<Tcl_Interp *>(_tcl_interp);
  size_t i;
  std::string cmd = std::string("calc_") + name + "_gradient";
  for (i = 0; i < cvc_values.size(); i++) {
    cmd += std::string(" {") + (*(cvc_values[i])).to_simple_string() +
      std::string("}");
  }
  int err = Tcl_Eval(tcl_interp, cmd.c_str());
  if (err != TCL_OK) {
    return cvm::error(std::string("Error while executing ")
                      + cmd + std::string(":\n") +
                      std::string(Tcl_GetStringResult(tcl_interp)), COLVARS_ERROR);
  }
  Tcl_Obj **list;
  int n;
  Tcl_ListObjGetElements(tcl_interp, Tcl_GetObjResult(tcl_interp),
                         &n, &list);
  if (n != int(gradient.size())) {
    cvm::error("Error parsing list of gradient values from script: found "
               + cvm::to_str(n) + " values instead of " +
               cvm::to_str(gradient.size()));
    return COLVARS_ERROR;
  }
  for (i = 0; i < gradient.size(); i++) {
    std::istringstream is(Tcl_GetString(list[i]));
    if (gradient[i].from_simple_string(is.str()) != COLVARS_OK) {
      cvm::log("Gradient matrix size: " + cvm::to_str(gradient[i].size()));
      cvm::log("Gradient string: " + cvm::to_str(Tcl_GetString(list[i])));
      cvm::error("Error parsing gradient value from script", COLVARS_ERROR);
      return COLVARS_ERROR;
    }
  }

  return cvm::get_error();

#else

  return COLVARS_NOT_IMPLEMENTED;

#endif
}
Пример #23
0
QVariant
TclInterp::execute(const QString& code)
{
    if (code.isEmpty()) return QVariant();

    Tcl_Obj* codeObj = getObject(code);
    int result = Tcl_EvalObjEx(interp, codeObj, TCL_EVAL_DIRECT);
    if (result != TCL_OK && result != TCL_RETURN) {
	QString trace = getVar("errorInfo").toString();
	qWarning("Script error: %s", Tcl_GetStringResult(interp));
	qWarning("Trace: " + trace);
	return QVariant();
    }

    return getValue(Tcl_GetObjResult(interp));
}
Пример #24
0
	virtual void OnNick(const CNick& OldNick, const CString& sNewNick, const vector<CChan*>& vChans) {
		CString sOldNick = TclEscape(CString(OldNick.GetNick()));
		CString sNewNickTmp = TclEscape(sNewNick);
		CString sHost = TclEscape(CString(OldNick.GetIdent() + "@" + OldNick.GetHost()));

		CString sCommand;
		// Nick change is triggered for each common chan so that binds can be chan specific
		unsigned int nLength = vChans.size();
		for (unsigned int n = 0; n < nLength; n++) {
			sCommand = "Binds::ProcessNick {" + sOldNick + "} {" + sHost + "} - {" + vChans[n]->GetName() + "} {" + sNewNickTmp + "}";
			i = Tcl_Eval(interp, sCommand.c_str());
			if (i != TCL_OK) {
				PutModule(Tcl_GetStringResult(interp));
			}
		}
	}
Пример #25
0
CAMLprim value camltk_getvar(value var)
{
  char *s;
  char *stable_var = NULL;
  CheckInit();

  stable_var = string_to_c(var);
  s = (char *)Tcl_GetVar(cltclinterp,stable_var,
                         TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
  stat_free(stable_var);

  if (s == NULL)
    tk_error(Tcl_GetStringResult(cltclinterp));
  else
    return(tcl_string_to_caml(s));
}
Пример #26
0
//
// This procedure is used when paradyn create a process after 
// reading a configuration file (using option -f).
//
void
ParadynTkGUI::ProcessCmd(pdstring *args)
{

  pdstring command;
  command = pdstring("paradyn process ") + (*args);

  if (Tcl_VarEval(interp,command.c_str(),0)==TCL_ERROR) {
    pdstring msg = pdstring("Tcl interpreter failed in routine ProcessCmd: ");
    msg += pdstring(Tcl_GetStringResult(interp));
    msg += pdstring("Was processing: ");
    msg += command;
    uiMgr->showError(83, P_strdup(msg.c_str()));
  }  
  delete args;
}
Пример #27
0
void load_tux()
{
    char cwd[BUFF_LEN];

    if ( tuxLoaded == True ) 
        return;

    tuxLoaded = True;

    registerHierCallbacks( g_game.tcl_interp );
    register_tux_callbacks( g_game.tcl_interp );

    initialize_scene_graph();

    if ( getcwd( cwd, BUFF_LEN ) == NULL ) {
	handle_system_error( 1, "getcwd failed" );
    }

    if ( chdir( getparam_data_dir() ) != 0 ) {
	/* Print a more informative warning since this is a common error */
	handle_system_error( 
	    1, "Can't find the tuxracer data "
	    "directory.  Please check the\nvalue of `data_dir' in "
	    "~/.tuxracer/options and set it to the location where you\n"
	    "installed the TRWC-data files.\n\n"
	    "Couldn't chdir to %s", getparam_data_dir() );
	/*
        handle_system_error( 1, "couldn't chdir to %s", getparam_data_dir() );
	*/
    } 

    if ( Tcl_EvalFile( g_game.tcl_interp, "tux.tcl") == TCL_ERROR ) {
        handle_error( 1, "error evalating %s/tux.tcl: %s\n"
		      "Please check the value of `data_dir' in ~/.tuxracer/options "
		      "and make sure it\npoints to the location of the "
		      "latest version of the TRWC-data files.", 
		      getparam_data_dir(), 
		      Tcl_GetStringResult( g_game.tcl_interp ) );
    } 

    check_assertion( !Tcl_InterpDeleted( g_game.tcl_interp ),
		     "Tcl interpreter deleted" );

    if ( chdir( cwd ) != 0 ) {
	handle_system_error( 1, "couldn't chdir to %s", cwd );
    } 
} 
Пример #28
0
stf_status tpm_call_it(Tcl_Obj **objv, int objc)
{
    int   ret;
    const char *res;

    passert(objc>=4);

    DBG(DBG_CONTROLMORE, DBG_log("TPM call %s %s %s %s %s"
				 , Tcl_GetString(objv[0])
				 , Tcl_GetString(objv[1])
				 , Tcl_GetString(objv[2])
				 , Tcl_GetString(objv[3])
				 , objc>4 ? Tcl_GetString(objv[4]) : ""));
		 
    ret = Tcl_EvalObjv(PlutoInterp, objc, objv, TCL_EVAL_GLOBAL);

    res = Tcl_GetStringResult(PlutoInterp);
    
    DBG(DBG_CONTROL, DBG_log("TPM %s(%s,%s,%s,%s) => %s"
			     , Tcl_GetString(objv[0])
			     , Tcl_GetString(objv[1])
			     , Tcl_GetString(objv[2])
			     , Tcl_GetString(objv[3])
			     , objc>4 ? Tcl_GetString(objv[4]) : ""
			     , res));
		 
    if(strcmp(res, "ignore")==0 || strcmp(res, "nothing")==0 || res[0]=='\0') {
	/* just quietly return */
	return STF_OK;
    }

    libreswan_log("TPM result: %s",res);
    if(ret != TCL_OK) {
	libreswan_log("TPM result failed");
    }

    if(strcmp(res, "stf_stolen")==0) {
	return STF_STOLEN;
    }

    if(strcmp(res, "stf_ignore")==0) {
	return STF_IGNORE;
    }

    return STF_OK;
}
Пример #29
0
int colvarproxy_tcl::tcl_run_force_callback()
{
#if defined(COLVARS_TCL)
  Tcl_Interp *const tcl_interp = reinterpret_cast<Tcl_Interp *>(_tcl_interp);
  std::string cmd = std::string("calc_colvar_forces ")
    + cvm::to_str(cvm::step_absolute());
  int err = Tcl_Eval(tcl_interp, cmd.c_str());
  if (err != TCL_OK) {
    cvm::log(std::string("Error while executing calc_colvar_forces:\n"));
    cvm::error(Tcl_GetStringResult(tcl_interp));
    return COLVARS_ERROR;
  }
  return cvm::get_error();
#else
  return COLVARS_NOT_IMPLEMENTED;
#endif
}
Пример #30
0
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;
}