/*--------------------------------------------------------------------------*/ int TCL_ArraySize(Tcl_Interp *TCLinterpreter, char *VarName) { int ArraySize = 0; if (strcmp(VarName, "TclScilabTmpVar")) { char MyTclCommand[2048]; char *StrArraySize = NULL; sprintf(MyTclCommand, "set TclScilabTmpVar [array size %s];", VarName); if ( Tcl_Eval(TCLinterpreter, MyTclCommand) == TCL_ERROR ) { Scierror(999, _("Tcl Error: %s\n"), Tcl_GetStringResult(TCLinterpreter)); return 0; } StrArraySize = (char *) Tcl_GetVar(TCLinterpreter, "TclScilabTmpVar", TCL_GLOBAL_ONLY); if (StrArraySize) { ArraySize = (int)atoi(StrArraySize); Tcl_UnsetVar(TCLinterpreter, "TclScilabTmpVar", TCL_GLOBAL_ONLY); } } return ArraySize; }
/*--------------------------------------------------------------------------*/ BOOL TCL_ArrayExist(Tcl_Interp *TCLinterpreter,char *VarName) { BOOL bExist = FALSE; if (strcmp(VarName,TCL_VAR_NAME_TMP)) { char MyTclCommand[2048]; char *StrArrayExist=NULL; sprintf(MyTclCommand, "set TclScilabTmpVar [array exists %s];",VarName); if ( Tcl_Eval(TCLinterpreter,MyTclCommand) == TCL_ERROR ) { Scierror(999,_("Tcl Error : %s\n"),Tcl_GetStringResult(TCLinterpreter)); return FALSE; } StrArrayExist = (char *) Tcl_GetVar(TCLinterpreter, TCL_VAR_NAME_TMP,TCL_GLOBAL_ONLY); if (StrArrayExist) { int r = (int)atoi(StrArrayExist); if (r) bExist = TRUE; Tcl_UnsetVar(TCLinterpreter,TCL_VAR_NAME_TMP, TCL_GLOBAL_ONLY); } } return bExist; }
pure_expr *tk_unset(const char *s) { char *result = NULL; if (tk_start(&result)) { int res = Tcl_UnsetVar(interp, s, TCL_GLOBAL_ONLY); if (res == TCL_OK) return pure_tuplel(0); else return 0; } else return tk_error(result); }
static int NS(Main) ( Tcl_Interp * interp, int objc, Tcl_Obj * const objv[] ) { if (3 != objc) { Tcl_WrongNumArgs(interp, 2, objv, "code"); return TCL_ERROR; } if (Tcl_UnsetVar (interp, "MQ_STARTUP_IS_THREAD", TCL_GLOBAL_ONLY) == TCL_ERROR) { TclErrorCheck (Tcl_EvalObjEx (interp, objv[2], TCL_EVAL_GLOBAL)); } return TCL_OK; }
static void ui_message(Tcl_Interp *interp, const char *severity, const char *format, va_list va) { char *tclcmd; char *buf; if (vasprintf(&buf, format, va) < 0) { perror("vasprintf"); return; } if (asprintf(&tclcmd, "ui_%s $warn", severity) < 0) { perror("asprintf"); free(buf); return; } Tcl_SetVar(interp, "warn", buf, 0); if (TCL_OK != Tcl_EvalEx(interp, tclcmd, -1, 0)) { fprintf(stderr, "Error evaluating Tcl statement '%s': %s (message: '%s')\n", tclcmd, Tcl_GetStringResult(interp), buf); } Tcl_UnsetVar(interp, "warn", 0); free(buf); free(tclcmd); }
/* ** This is the callback from a quota-over-limit. */ static void tclQuotaCallback( const char *zFilename, /* Name of file whose size increases */ sqlite3_int64 *piLimit, /* IN/OUT: The current limit */ sqlite3_int64 iSize, /* Total size of all files in the group */ void *pArg /* Client data */ ){ TclQuotaCallback *p; /* Callback script object */ Tcl_Obj *pEval; /* Script to evaluate */ Tcl_Obj *pVarname; /* Name of variable to pass as 2nd arg */ unsigned int rnd; /* Random part of pVarname */ int rc; /* Tcl error code */ p = (TclQuotaCallback *)pArg; if( p==0 ) return; pVarname = Tcl_NewStringObj("::piLimit_", -1); Tcl_IncrRefCount(pVarname); sqlite3_randomness(sizeof(rnd), (void *)&rnd); Tcl_AppendObjToObj(pVarname, Tcl_NewIntObj((int)(rnd&0x7FFFFFFF))); Tcl_ObjSetVar2(p->interp, pVarname, 0, Tcl_NewWideIntObj(*piLimit), 0); pEval = Tcl_DuplicateObj(p->pScript); Tcl_IncrRefCount(pEval); Tcl_ListObjAppendElement(0, pEval, Tcl_NewStringObj(zFilename, -1)); Tcl_ListObjAppendElement(0, pEval, pVarname); Tcl_ListObjAppendElement(0, pEval, Tcl_NewWideIntObj(iSize)); rc = Tcl_EvalObjEx(p->interp, pEval, TCL_EVAL_GLOBAL); if( rc==TCL_OK ){ Tcl_Obj *pLimit = Tcl_ObjGetVar2(p->interp, pVarname, 0, 0); rc = Tcl_GetWideIntFromObj(p->interp, pLimit, piLimit); Tcl_UnsetVar(p->interp, Tcl_GetString(pVarname), 0); } Tcl_DecrRefCount(pEval); Tcl_DecrRefCount(pVarname); if( rc!=TCL_OK ) Tcl_BackgroundError(p->interp); }
/*--------------------------------------------------------------------------*/ int sci_TCL_UnsetVar(char *fname, void* pvApiCtx) { SciErr sciErr; int* piAddrl1 = NULL; int* piAddrl2 = NULL; char* l2 = NULL; static int n1, m1; static int n2, m2; Tcl_Interp *TCLinterpreter = NULL; CheckInputArgument(pvApiCtx, 1, 2); CheckOutputArgument(pvApiCtx, 1, 1); if (checkInputArgumentType(pvApiCtx, 1, sci_strings)) { int paramoutINT = 0; char *VarName = NULL; sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } // Retrieve a matrix of double at position 1. if (getAllocatedSingleString(pvApiCtx, piAddrl1, &VarName)) { Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1); return 1; } if (!existsGlobalInterp()) { freeAllocatedSingleString(VarName); Scierror(999, _("%s: Error main TCL interpreter not initialized.\n"), fname); return 0; } if (nbInputArgument(pvApiCtx) == 2) { // two arguments given - get a pointer on the slave interpreter if (checkInputArgumentType(pvApiCtx, 2, sci_strings)) { sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl2); if (sciErr.iErr) { freeAllocatedSingleString(VarName); printError(&sciErr, 0); return 1; } // Retrieve a matrix of double at position 2. if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2)) { freeAllocatedSingleString(VarName); Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 2); return 1; } TCLinterpreter = Tcl_GetSlave(getTclInterp(), (l2)); freeAllocatedSingleString(l2); releaseTclInterp(); if (TCLinterpreter == NULL) { freeAllocatedSingleString(VarName); Scierror(999, _("%s: No such slave interpreter.\n"), fname); return 0; } } else { freeAllocatedSingleString(VarName); Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 2); return 0; } } else { // only one argument given - use the main interpreter TCLinterpreter = getTclInterp(); } paramoutINT = (int)(Tcl_UnsetVar(TCLinterpreter, VarName, TCL_GLOBAL_ONLY) != TCL_ERROR); freeAllocatedSingleString(VarName); if (createScalarBoolean(pvApiCtx, nbInputArgument(pvApiCtx) + 1, paramoutINT)) { Scierror(999, _("%s: Memory allocation error.\n"), fname); return 1; } AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1; ReturnArguments(pvApiCtx); } else { releaseTclInterp(); Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1); return 0; } releaseTclInterp(); return 0; }
void ParadynTkGUI::chooseMetricsandResources(chooseMandRCBFunc cb, pdvector<metric_focus_pair> * /* pairList */ ) { // store record with unique id and callback function UIMMsgTokenID++; int newptr; Tcl_HashEntry *entryPtr = Tcl_CreateHashEntry (&UIMMsgReplyTbl, (char *)UIMMsgTokenID, &newptr); if (newptr == 0) { showError(21, ""); thr_exit(0); } unsigned requestingThread = getRequestingThread(); // in theory, we can check here whether this (VISI-) thread already // has an outstanding metric request. But for now, we let code in mets.tcl do this... // pdstring commandStr = pdstring("winfo exists .metmenunew") + pdstring(requestingThread); // myTclEval(interp, commandStr); // int result; // assert(TCL_OK == Tcl_GetBoolean(interp, Tcl_GetStringResult(interp), &result)); // if (result) // return; // the window is already up for this thread! UIMReplyRec *reply = new UIMReplyRec; reply->tid = requestingThread; reply->cb = (void *) cb; Tcl_SetHashValue (entryPtr, reply); if (!all_metrics_set_yet) { pdvector<met_name_id> *all_mets = dataMgr->getAvailableMetInfo(true); for (unsigned metlcv=0; metlcv < all_mets->size(); metlcv++) { unsigned id = (*all_mets)[metlcv].id; pdstring &name = (*all_mets)[metlcv].name; all_metric_names[id] = name; pdstring idString(id); bool aflag; aflag=(Tcl_SetVar2(interp, "metricNamesById", const_cast<char*>(idString.c_str()), const_cast<char*>(name.c_str()), TCL_GLOBAL_ONLY) != NULL); assert(aflag); } delete all_mets; all_metrics_set_yet = true; } // Set metIndexes2Id via "temp" (void)Tcl_UnsetVar(interp, "temp", 0); // ignore result; temp may not have existed pdvector<met_name_id> *curr_avail_mets_ptr = dataMgr->getAvailableMetInfo(false); pdvector<met_name_id> &curr_avail_mets = *curr_avail_mets_ptr; unsigned numAvailMets = curr_avail_mets.size(); assert( numAvailMets > 0 ); for (unsigned metlcv=0; metlcv < numAvailMets; metlcv++) { pdstring metricIdStr = pdstring(curr_avail_mets[metlcv].id); bool aflag; aflag = (Tcl_SetVar(interp, "temp", const_cast<char*>(metricIdStr.c_str()), TCL_APPEND_VALUE | TCL_LIST_ELEMENT) != NULL); assert(aflag); } delete curr_avail_mets_ptr; pdstring tcommand("getMetsAndRes "); tcommand += pdstring(UIMMsgTokenID); tcommand += pdstring(" ") + pdstring(requestingThread); tcommand += pdstring(" ") + pdstring(numAvailMets); tcommand += pdstring(" $temp"); int retVal = Tcl_VarEval (interp, tcommand.c_str(), 0); if (retVal == TCL_ERROR) { uiMgr->showError (22, ""); cerr << Tcl_GetStringResult(interp) << endl; thr_exit(0); } }
/*--------------------------------------------------------------------------*/ int sci_TCL_SetVar(char *fname, void* pvApiCtx) { SciErr sciErr; int* piAddrl2 = NULL; char* l2 = NULL; int* piAddrl1 = NULL; int* piAddrStr = NULL; char *VarName = NULL; static int n1, m1; static int n2, m2; int paramoutINT = 0; Tcl_Interp *TCLinterpreter = NULL; CheckInputArgument(pvApiCtx, 2, 3); CheckOutputArgument(pvApiCtx, 0, 1); if (getTclInterp() == NULL) { releaseTclInterp(); Scierror(999, _("%s: Error main TCL interpreter not initialized.\n"), fname); return 0; } releaseTclInterp(); if (nbInputArgument(pvApiCtx) == 3) { // three arguments given - get a pointer on the slave interpreter if (checkInputArgumentType(pvApiCtx, 3, sci_strings)) { sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddrl2); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } // Retrieve a matrix of double at position 3. if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2)) { Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 3); return 1; } TCLinterpreter = Tcl_GetSlave(getTclInterp(), (l2)); freeAllocatedSingleString(l2); if (TCLinterpreter == NULL) { releaseTclInterp(); Scierror(999, _("%s: No such slave interpreter.\n"), fname); return 0; } } else { Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 3); return 0; } } else { // only two arguments given - use the main interpreter TCLinterpreter = getTclInterp(); } if (checkInputArgumentType(pvApiCtx, 1, sci_strings) && checkInputArgumentType(pvApiCtx, 2, sci_strings)) { char **Str = NULL; sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } // Retrieve a matrix of double at position 1. if (getAllocatedSingleString(pvApiCtx, piAddrl1, &VarName)) { Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1); return 1; } sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrStr); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } // Retrieve a matrix of string at position 2. if (getAllocatedMatrixOfString(pvApiCtx, piAddrStr, &m1, &n1, &Str)) { Scierror(202, _("%s: Wrong type for argument #%d: String matrix expected.\n"), fname, 2); return 1; } // Efface valeur precedente Tcl_UnsetVar(TCLinterpreter, VarName, TCL_GLOBAL_ONLY); if ( (m1 == 1) && (n1 == 1) ) { paramoutINT = SetVarAString(TCLinterpreter, VarName, Str); } else { paramoutINT = SetVarStrings(TCLinterpreter, VarName, Str, m1, n1); } freeAllocatedSingleString(VarName); freeAllocatedMatrixOfString(m1, n1, Str); } else if (checkInputArgumentType(pvApiCtx, 1, sci_strings) && checkInputArgumentType(pvApiCtx, 2, sci_matrix)) { #define COMPLEX 1 int *header = NULL; int Cmplx; double* l1 = NULL; sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl1); if (sciErr.iErr) { printError(&sciErr, 0); return 1; } // Retrieve a matrix of double at position 1. if (getAllocatedSingleString(pvApiCtx, piAddrl1, &VarName)) { Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1); return 1; } sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddrl1); if (sciErr.iErr) { printError(&sciErr, 0); freeAllocatedSingleString(VarName); return 1; } if (isVarComplex(pvApiCtx, piAddrl1)) { Scierror(999, _("This function doesn't work with Complex.\n")); freeAllocatedSingleString(VarName); releaseTclInterp(); return 0; } // Retrieve a matrix of double at position 2. sciErr = getMatrixOfDouble(pvApiCtx, piAddrl1, &m1, &n1, &l1); if (sciErr.iErr) { printError(&sciErr, 0); Scierror(202, _("%s: Wrong type for argument %d: A real expected.\n"), fname, 2); freeAllocatedSingleString(VarName); return 1; } if ( (m1 == 0) && (n1 == 0) ) { Scierror(999, _("[] doesn't work with Tcl/Tk.\n")); freeAllocatedSingleString(VarName); releaseTclInterp(); return 0; } if ( (m1 == 1) && (n1 == 1) ) { paramoutINT = SetVarScalar(TCLinterpreter, VarName, *l1); } else { paramoutINT = SetVarMatrix(TCLinterpreter, VarName, l1, m1, n1); } freeAllocatedSingleString(VarName); } else { if ((!checkInputArgumentType(pvApiCtx, 1, sci_strings))) { Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname , 1); } if ((!checkInputArgumentType(pvApiCtx, 2, sci_matrix))) { Scierror(999, _("%s: Wrong type for input argument #%d: Matrix expected.\n"), fname , 2); } releaseTclInterp(); return 0; } if (createScalarBoolean(pvApiCtx, nbInputArgument(pvApiCtx) + 1, paramoutINT)) { Scierror(999, _("%s: Memory allocation error.\n"), fname); return 1; } releaseTclInterp(); AssignOutputVariable(pvApiCtx, 1) = nbInputArgument(pvApiCtx) + 1; ReturnArguments(pvApiCtx); return 0; }