/*--------------------------------------------------------------------------*/
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;
}
