static void
get_tcl_version()
{
int major;
int minor;
Tcl_GetVersion(&major, &minor, NULL, NULL);
tcl_version = major + 0.1 * minor;
}
/*--------------------------------------------------------------------------*/
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_GetVersion(char *fname, unsigned long l)
{
static int l1, n1, m1;
int major = 0;
int minor = 0;
int patchLevel = 0;
int type = 0;
char *output = NULL ;
char VersionString[256];
char ReleaseType[256];
CheckRhs(0, 1);
CheckLhs(1, 1);
Tcl_GetVersion(&major, &minor, &patchLevel, &type);
if (Rhs == 0)
{
switch (type)
{
case TCL_ALPHA_RELEASE:
strcpy(ReleaseType, _("Alpha Release"));
break;
case TCL_BETA_RELEASE:
strcpy(ReleaseType, _("Beta Release"));
break;
case TCL_FINAL_RELEASE:
strcpy(ReleaseType, _("Final Release"));
break;
default:
strcpy(ReleaseType, _("Unknown Release"));
break;
}
sprintf(VersionString, "TCL/TK %d.%d.%d %s", major, minor, patchLevel, ReleaseType);
output = strdup(VersionString);
n1 = 1;
m1 = (int)strlen(output);
CreateVarFromPtr(Rhs + 1, STRING_DATATYPE, &m1, &n1, &output);
if (output)
{
FREE(output);
output = NULL;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
if (GetType(1) == sci_strings)
{
char *Param = NULL;
GetRhsVar(1, STRING_DATATYPE, &m1, &n1, &l1);
Param = cstk(l1);
if (strcmp(Param, "numbers") == 0)
{
int *VERSIONMATRIX = NULL;
VERSIONMATRIX = (int *)MALLOC( (4) * sizeof(int) );
VERSIONMATRIX[0] = (int)major;
VERSIONMATRIX[1] = (int)minor;
VERSIONMATRIX[2] = (int)patchLevel;
VERSIONMATRIX[3] = (int)type;
m1 = 1;
n1 = 4;
CreateVarFromPtr(Rhs + 1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1 , &VERSIONMATRIX);
if (VERSIONMATRIX)
{
FREE(VERSIONMATRIX);
VERSIONMATRIX = NULL;
}
LhsVar(1) = Rhs + 1;
PutLhsVar();
}
else
{
Scierror(999, _("%s: Wrong value for input argument #%d: '%s' expected.\n"), fname, 1, "numbers");
}
}
else
{
Scierror(999, _("%s: Wrong type for input argument #%d: String expected.\n"), fname, 1);
}
}
return 0;
}
