/*--------------------------------------------------------------------------*/
int setenvtcl(char *string, char *value)
{
char MyTclCommand[2048];
sprintf(MyTclCommand, "env(%s)", string);
if (getTclInterp() == NULL)
{
releaseTclInterp();
return FALSE;
}
releaseTclInterp();
if ( !Tcl_SetVar(getTclInterp(), MyTclCommand, value, TCL_GLOBAL_ONLY) )
{
releaseTclInterp();
return FALSE;
}
else
{
releaseTclInterp();
return TRUE;
}
}
/*--------------------------------------------------------------------------*/
int sci_TCL_ExistArray(char *fname,unsigned long l)
{
static int l1,n1,m1;
static int l2,n2,m2;
int ValRet=0;
Tcl_Interp *TCLinterpreter=NULL;
CheckRhs(1,2);
CheckLhs(1,1);
if (GetType(1) == sci_strings)
{
char *VarName=NULL;
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
VarName=cstk(l1);
if (!existsGlobalInterp())
{
Scierror(999,_("%s: Error main TCL interpreter not initialized.\n"),fname);
return 0;
}
if (Rhs==2)
{
/* two arguments given - get a pointer on the slave interpreter */
if (GetType(2) == sci_strings)
{
GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
TCLinterpreter=Tcl_GetSlave(getTclInterp(),cstk(l2));
if (TCLinterpreter==NULL)
{
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, 2);
return 0;
}
}
else
{
/* only one argument given - use the main interpreter */
TCLinterpreter=getTclInterp();
}
ValRet=TCL_ArrayExist(TCLinterpreter,VarName);
releaseTclInterp();
n1=1;
CreateVar(Rhs+1,MATRIX_OF_BOOLEAN_DATATYPE, &n1,&n1,&l1);
if ( ValRet )
{
*istk(l1)=(int)(TRUE);
}
else
{
*istk(l1)=(int)(FALSE);
}
LhsVar(1)=Rhs+1;
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
}
return 0;
}
/*--------------------------------------------------------------------------*/
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;
}
/*--------------------------------------------------------------------------*/
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;
}
/*--------------------------------------------------------------------------*/
static void *DaemonOpenTCLsci(void* in)
/* Checks if tcl/tk has already been initialised and if not */
/* initialise it. It must find the tcl script */
{
char *SciPath = NULL;
char *SciPathShort = NULL;
char *TkScriptpathShort = NULL;
BOOL tkStarted = FALSE;
BOOL bOK = FALSE;
char TkScriptpath[PATH_MAX];
char MyCommand[2048]; /* @TODO: Check for buffer overflow */
#ifndef _MSC_VER
DIR *tmpdir = NULL;
#endif
FILE *tmpfile2 = NULL;
SciPath = GetSciPath();
/* test SCI validity */
if (SciPath == NULL)
{
sciprint(_("The SCI environment variable is not set.\nTCL initialisation failed !\n"));
}
SciPathShort = getshortpathname(SciPath, &bOK);
#ifdef TCL_MAJOR_VERSION
#ifdef TCL_MINOR_VERSION
#if TCL_MAJOR_VERSION >= 8
#if TCL_MINOR_VERSION > 0
Tcl_FindExecutable(" ");
#endif
#endif
#endif
#endif
#ifdef _MSC_VER
strcpy(TkScriptpath, SciPathShort);
strcat(TkScriptpath, "/modules/tclsci/tcl/TK_Scilab.tcl");
TkScriptpathShort = getshortpathname(TkScriptpath, &bOK);
tmpfile2 = fopen(TkScriptpathShort, "r");
if (tmpfile2 == NULL)
{
sciprint(_("Unable to find Tcl initialisation scripts.\nCheck your SCI environment variable.\nTcl initialisation failed !"));
}
else
{
fclose(tmpfile2);
}
#else
tmpdir = opendir(SciPathShort);
if (tmpdir == NULL)
{
sciprint(_("The SCI environment variable is not set.\nTcl initialisation failed !\n"));
}
else
{
closedir(tmpdir);
}
strcpy(TkScriptpath, SciPathShort);
strcat(TkScriptpath, "/modules/tclsci/tcl/TK_Scilab.tcl");
TkScriptpathShort = getshortpathname(TkScriptpath, &bOK);
tmpfile2 = fopen(TkScriptpathShort, "r");
if (tmpfile2 == NULL)
{
sciprint(_("Unable to find Tcl initialisation scripts.\nCheck your SCI environment variable.\nTcl initialisation failed !"));
}
else
{
fclose(tmpfile2);
}
#endif /* _MSC_VER */
if (getTclInterp() == NULL)
{
releaseTclInterp();
initTclInterp();
#ifdef _MSC_VER
/* Initialize TCL_LIBRARY & TK_LIBRARY variables environment */
/* Windows only */
SetTclTkEnvironment(SciPathShort);
#endif
if ( getTclInterp() == NULL )
{
Scierror(999, _("Tcl Error: Unable to create Tcl interpreter (Tcl_CreateInterp).\n"));
}
releaseTclInterp();
if ( Tcl_Init(getTclInterp()) == TCL_ERROR)
{
releaseTclInterp();
Scierror(999, _("Tcl Error: Error during the Tcl initialization (Tcl_Init): %s\n"), Tcl_GetStringResult(getTclInterp()));
}
releaseTclInterp();
if (getenv("SCI_DISABLE_TK") == NULL)
{
/* When SCI_DISABLE_TK is set in the env disable the TK init
* process. It is causing issues when Scilab is
* used through ssh. */
if ( Tk_Init(getTclInterp()) == TCL_ERROR)
{
releaseTclInterp();
Scierror(999, _("Tcl Error: Error during the TK initialization (Tk_Init): %s\n"), Tcl_GetStringResult(getTclInterp()));
}
else
{
tkStarted = TRUE;
}
releaseTclInterp();
}
sprintf(MyCommand, "set SciPath \"%s\";", SciPathShort);
if ( Tcl_Eval(getTclInterp(), MyCommand) == TCL_ERROR )
{
releaseTclInterp();
Scierror(999, _("Tcl Error: Error during the Scilab/Tcl init process. Could not set SciPath: %s\n"), Tcl_GetStringResult(getTclInterp()));
}
releaseTclInterp();
Tcl_CreateCommand(getTclInterp(), "ScilabEval", TCL_EvalScilabCmd, (ClientData)1, NULL);
releaseTclInterp();
}
if (TKmainWindow == NULL && tkStarted)
{
TKmainWindow = Tk_MainWindow(getTclInterp());
releaseTclInterp();
Tk_GeometryRequest(TKmainWindow, 2, 2);
//printf("TkScriptpathShort : |%s|\n", TkScriptpathShort);
if ( Tcl_EvalFile(getTclInterp(), TkScriptpathShort) == TCL_ERROR )
{
releaseTclInterp();
Scierror(999, _("Tcl Error: Error during the Scilab/TK init process. Error while loading %s: %s\n"), TkScriptpathShort, Tcl_GetStringResult(getTclInterp()));
}
releaseTclInterp();
}
if (SciPath)
{
FREE(SciPath);
SciPath = NULL;
}
if (SciPathShort)
{
FREE(SciPathShort);
SciPathShort = NULL;
}
if (TkScriptpathShort)
{
FREE(TkScriptpathShort);
TkScriptpathShort = NULL;
}
// This start a periodic and endless call to "update"
// TCL command. This causes any TCL application to start
// and run as if it's in the main program thread.
startTclLoop();
return(0);
}
/*--------------------------------------------------------------------------*/
BOOL SetTclTkEnvironment(char *DefaultPath)
{
#define TCL_LIBRARY "TCL_LIBRARY"
#define TCL_LIBRARY_FORMAT "%s/modules/tclsci/tcl/tcl%d.%d"
#define TK_LIBRARY "TK_LIBRARY"
#define TK_LIBRARY_FORMAT "%s/modules/tclsci/tcl/tk%d.%d"
#define TCL_DEFAULT_ENCODING_DIR_FORMAT "%s/modules/tclsci/tcl/tcl%d.%d/encoding"
int tcl_major = 8;
int tcl_minor = 4; /* default */
int tcl_patchLevel = 0;
int tcl_type = 0;
BOOL bOK = TRUE;
char TCL_LIBRARY_PATH[PATH_MAX];
char TK_LIBRARY_PATH[PATH_MAX];
char TCL_DEFAULT_ENCODING_DIR[PATH_MAX];
Tcl_DString encodingName;
char ShortPath[PATH_MAX];
char *CopyOfDefaultPath = NULL;
Tcl_Obj *pathPtr = NULL;
Tcl_Obj *objPtr = NULL;
CopyOfDefaultPath = MALLOC(((int)strlen(DefaultPath) + 1) * sizeof(char));
if (CopyOfDefaultPath == NULL)
{
return FALSE;
}
if (getScilabMode() == SCILAB_STD)
{
/* redirect stdout, stderr in console */
freopen("CONOUT$", "wb", stdout); /* redirect stdout --> CONOUT$*/
freopen("CONOUT$", "wb", stderr); /* redirect stderr --> CONOUT$*/
}
Tcl_GetVersion(&tcl_major, &tcl_minor, &tcl_patchLevel, &tcl_type);
GetShortPathName(DefaultPath, ShortPath, PATH_MAX);
AntislashToSlash(ShortPath, CopyOfDefaultPath);
sprintf (TCL_LIBRARY_PATH, TCL_LIBRARY_FORMAT, CopyOfDefaultPath, tcl_major, tcl_minor);
sprintf (TK_LIBRARY_PATH, TK_LIBRARY_FORMAT, CopyOfDefaultPath, tcl_major, tcl_minor);
sprintf (TCL_DEFAULT_ENCODING_DIR,
TCL_DEFAULT_ENCODING_DIR_FORMAT,
CopyOfDefaultPath,
tcl_major,
tcl_minor);
if (CopyOfDefaultPath)
{
FREE(CopyOfDefaultPath);
CopyOfDefaultPath = NULL;
}
/* TCL_LIBRARY initialization */
SetEnvironmentVariable(TCL_LIBRARY, TCL_LIBRARY_PATH);
setenvtcl(TCL_LIBRARY, TCL_LIBRARY_PATH);
if (Tcl_SetVar(getTclInterp(), "tcl_library", TCL_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
{
releaseTclInterp();
fprintf(stderr, _("%s: An error occurred: %s\n"), "tcl_library",
_("Impossible to set environment variable."));
bOK = FALSE;
}
releaseTclInterp();
if (Tcl_SetVar(getTclInterp(), "tclDefaultLibrary", TCL_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
{
releaseTclInterp();
fprintf(stderr, _("%s: An error occurred: %s\n"), "tclDefaultLibrary",
_("Impossible to set environment variable."));
bOK = FALSE;
}
releaseTclInterp();
if (Tcl_SetVar(getTclInterp(), "tcl_pkgPath", TCL_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
{
releaseTclInterp();
fprintf(stderr, _("%s: An error occurred: %s\n"), "tcl_pkgPath",
_("Impossible to set environment variable."));
bOK = FALSE;
}
releaseTclInterp();
pathPtr = Tcl_NewStringObj(TCL_LIBRARY_PATH, -1);
/* TK_LIBRARY initialization */
SetEnvironmentVariable(TK_LIBRARY, TK_LIBRARY_PATH);
setenvtcl(TK_LIBRARY, TK_LIBRARY_PATH);
if (Tcl_SetVar(getTclInterp(), "tk_library", TK_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
{
releaseTclInterp();
fprintf(stderr, _("%s: An error occurred: %s\n"), "tk_library",
_("Impossible to set environment variable."));
bOK = FALSE;
}
releaseTclInterp();
objPtr = Tcl_NewStringObj(TK_LIBRARY_PATH, -1);
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
TclSetLibraryPath(pathPtr);
/* encoding initialization */
Tcl_SetDefaultEncodingDir(TCL_DEFAULT_ENCODING_DIR);
if ( Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)) == TCL_ERROR )
{
fprintf(stderr, _("%s: An error occurred: %s\n"), "Tcl_SetSystemEncoding",
_("Impossible to set system encoding."));
bOK = FALSE;
}
Tcl_DStringFree(&encodingName);
return bOK ;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_UpVar (char *fname,unsigned long l)
{
CheckRhs(2,3);
CheckLhs(0,1);
if ( (GetType(1) == sci_strings) && (GetType(2) == sci_strings) )
{
int m1 = 0, n1 = 0, l1 = 0;
int m2 = 0, n2 = 0, l2 = 0;
Tcl_Interp *TCLinterpreter = NULL;
char *sourceName = NULL, *destName = NULL;
int *paramoutINT = (int*)MALLOC(sizeof(int));
GetRhsVar(1,STRING_DATATYPE,&m1,&n1,&l1);
sourceName = cstk(l1);
GetRhsVar(2,STRING_DATATYPE,&m2,&n2,&l2);
destName = cstk(l2);
if (getTclInterp() == NULL)
{
releaseTclInterp();
Scierror(999,_("%s: Error main TCL interpreter not initialized.\n"),fname);
return 0;
}
releaseTclInterp();
if (Rhs == 3)
{
int m3 = 0, n3 = 0, l3 = 0;
/* three arguments given - get a pointer on the slave interpreter */
if (GetType(3) == sci_strings)
{
GetRhsVar(3,STRING_DATATYPE,&m3,&n3,&l3);
TCLinterpreter = Tcl_GetSlave(getTclInterp() ,cstk(l3));
releaseTclInterp();
if (TCLinterpreter == NULL)
{
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();
releaseTclInterp();
}
if ( Tcl_GetVar(TCLinterpreter, sourceName, TCL_GLOBAL_ONLY) )
{
if ( Tcl_UpVar(TCLinterpreter,"#0", sourceName, destName, TCL_GLOBAL_ONLY) == TCL_ERROR )
{
*paramoutINT = (int)(FALSE);
}
else
{
*paramoutINT = (int)(TRUE);
}
}
else
{
*paramoutINT = (int)(FALSE);
}
n1 = 1;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_BOOLEAN_DATATYPE, &n1, &n1, ¶moutINT);
LhsVar(1) = Rhs+1;
if (paramoutINT) {FREE(paramoutINT); paramoutINT = NULL;}
PutLhsVar();
}
else
{
Scierror(999,_("%s: Wrong type for input argument #%d or #%d: String expected.\n"),fname, 1, 2);
}
return 0;
}
/*--------------------------------------------------------------------------*/
int sci_TCL_DeleteInterp(char *fname, void* pvApiCtx)
{
SciErr sciErr;
int* piAddrl2 = NULL;
char* l2 = NULL;
CheckInputArgument(pvApiCtx, 0, 1);
CheckOutputArgument(pvApiCtx, 1, 1);
if (nbInputArgument(pvApiCtx) == 1)
{
if (!existsGlobalInterp())
{
Scierror(999, _("%s: Error main TCL interpreter not initialized.\n"), fname);
return 0;
}
if (checkInputArgumentType(pvApiCtx, 1, sci_strings))
{
static int n2, m2;
Tcl_Interp *TCLinterpreter = NULL;
sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddrl2);
if (sciErr.iErr)
{
printError(&sciErr, 0);
return 1;
}
// Retrieve a matrix of double at position 1.
if (getAllocatedSingleString(pvApiCtx, piAddrl2, &l2))
{
Scierror(202, _("%s: Wrong type for argument #%d: A string expected.\n"), fname, 1);
return 1;
}
TCLinterpreter = Tcl_GetSlave(getTclInterp(), (l2));
freeAllocatedSingleString(l2);
releaseTclInterp();
if (TCLinterpreter == NULL)
{
Scierror(999, _("%s: No such slave interpreter.\n"), fname);
return 0;
}
else
{
Tcl_DeleteInterp(TCLinterpreter);
TCLinterpreter = NULL;
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
return 0;
}
}
else // nbInputArgument(pvApiCtx) == 0
{
releaseTclInterp();
CloseTCLsci();
InitializeTclTk();
}
AssignOutputVariable(pvApiCtx, 1) = 0;
ReturnArguments(pvApiCtx);
return 0;
}
