653e4e8a99d5ab510b3f99790afe1c123fd41d8e
[scilab.git] / scilab / modules / tclsci / src / c / EnvTclTk.c
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2006 - INRIA - Allan CORNET
4 *
5  * Copyright (C) 2012 - 2016 - Scilab Enterprises
6  *
7  * This file is hereby licensed under the terms of the GNU GPL v2.0,
8  * pursuant to article 5.3.4 of the CeCILL v.2.1.
9  * This file was originally licensed under the terms of the CeCILL v2.1,
10  * and continues to be available under such terms.
11  * For more information, see the COPYING file which you should have received
12  * along with this program.
13 *
14 */
15
16 #include <windows.h>
17 #include <stdio.h>
18 #include <tcl.h>
19 #include <tk.h>
20
21 #include "PATH_MAX.h"
22 #include "sci_malloc.h"
23 #include "EnvTclTk.h"
24 #include "setenvtcl.h"
25 #include "GlobalTclInterp.h"
26 #include "localization.h"
27 #include "ConvertSlash.h"
28 #include "configvariable_interface.h"
29 /*--------------------------------------------------------------------------*/
30 extern void     TclSetLibraryPath(Tcl_Obj * pathPtr);
31 /*--------------------------------------------------------------------------*/
32 #if defined(TCL_MAJOR_VERSION) && defined(TCL_MAJOR_VERSION)
33 #if TCL_MAJOR_VERSION == 8
34 #if TCL_MINOR_VERSION == 4
35 static CONST char * Tcl_GetEncodingNameFromEnvironment(Tcl_DString *bufPtr);
36 #endif
37 #endif
38 #endif
39 /*--------------------------------------------------------------------------*/
40 BOOL SetTclTkEnvironment(char *DefaultPath)
41 {
42 #define TCL_LIBRARY "TCL_LIBRARY"
43 #define TCL_LIBRARY_FORMAT "%s/modules/tclsci/tcl/tcl%d.%d"
44
45 #define TK_LIBRARY "TK_LIBRARY"
46 #define TK_LIBRARY_FORMAT "%s/modules/tclsci/tcl/tk%d.%d"
47
48 #define TCL_DEFAULT_ENCODING_DIR_FORMAT "%s/modules/tclsci/tcl/tcl%d.%d/encoding"
49
50     int tcl_major = 8;
51     int tcl_minor = 4; /* default */
52     int tcl_patchLevel = 0;
53     int tcl_type = 0;
54
55     BOOL bOK = TRUE;
56
57     char TCL_LIBRARY_PATH[PATH_MAX];
58     char TK_LIBRARY_PATH[PATH_MAX];
59     char TCL_DEFAULT_ENCODING_DIR[PATH_MAX];
60
61     Tcl_DString encodingName;
62
63     char ShortPath[PATH_MAX];
64     char *CopyOfDefaultPath = NULL;
65
66     Tcl_Obj *pathPtr = NULL;
67     Tcl_Obj *objPtr = NULL;
68
69     CopyOfDefaultPath = MALLOC(((int)strlen(DefaultPath) + 1) * sizeof(char));
70     if (CopyOfDefaultPath == NULL)
71     {
72         return FALSE;
73     }
74
75     if (getScilabMode() == SCILAB_STD)
76     {
77         /* redirect stdout, stderr in console */
78         freopen("CONOUT$", "wb", stdout); /* redirect stdout --> CONOUT$*/
79         freopen("CONOUT$", "wb", stderr); /* redirect stderr --> CONOUT$*/
80     }
81
82     Tcl_GetVersion(&tcl_major, &tcl_minor, &tcl_patchLevel, &tcl_type);
83
84     GetShortPathName(DefaultPath, ShortPath, PATH_MAX);
85     AntislashToSlash(ShortPath, CopyOfDefaultPath);
86     sprintf (TCL_LIBRARY_PATH, TCL_LIBRARY_FORMAT, CopyOfDefaultPath, tcl_major, tcl_minor);
87     sprintf (TK_LIBRARY_PATH, TK_LIBRARY_FORMAT, CopyOfDefaultPath, tcl_major, tcl_minor);
88     sprintf (TCL_DEFAULT_ENCODING_DIR,
89              TCL_DEFAULT_ENCODING_DIR_FORMAT,
90              CopyOfDefaultPath,
91              tcl_major,
92              tcl_minor);
93
94     if (CopyOfDefaultPath)
95     {
96         FREE(CopyOfDefaultPath);
97         CopyOfDefaultPath = NULL;
98     }
99
100     /* TCL_LIBRARY initialization */
101     SetEnvironmentVariable(TCL_LIBRARY, TCL_LIBRARY_PATH);
102     setenvtcl(TCL_LIBRARY, TCL_LIBRARY_PATH);
103     if (Tcl_SetVar(getTclInterp(), "tcl_library", TCL_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
104     {
105         releaseTclInterp();
106         fprintf(stderr, _("%s: An error occurred: %s\n"), "tcl_library",
107                 _("Impossible to set environment variable."));
108         bOK = FALSE;
109     }
110     releaseTclInterp();
111
112     if (Tcl_SetVar(getTclInterp(), "tclDefaultLibrary", TCL_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
113     {
114         releaseTclInterp();
115         fprintf(stderr, _("%s: An error occurred: %s\n"), "tclDefaultLibrary",
116                 _("Impossible to set environment variable."));
117         bOK = FALSE;
118     }
119     releaseTclInterp();
120
121     if (Tcl_SetVar(getTclInterp(), "tcl_pkgPath", TCL_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
122     {
123         releaseTclInterp();
124         fprintf(stderr, _("%s: An error occurred: %s\n"), "tcl_pkgPath",
125                 _("Impossible to set environment variable."));
126         bOK = FALSE;
127     }
128     releaseTclInterp();
129
130     pathPtr = Tcl_NewStringObj(TCL_LIBRARY_PATH, -1);
131
132     /* TK_LIBRARY initialization */
133     SetEnvironmentVariable(TK_LIBRARY, TK_LIBRARY_PATH);
134     setenvtcl(TK_LIBRARY, TK_LIBRARY_PATH);
135     if (Tcl_SetVar(getTclInterp(), "tk_library", TK_LIBRARY_PATH, TCL_GLOBAL_ONLY) == NULL)
136     {
137         releaseTclInterp();
138         fprintf(stderr, _("%s: An error occurred: %s\n"), "tk_library",
139                 _("Impossible to set environment variable."));
140         bOK = FALSE;
141     }
142     releaseTclInterp();
143
144     objPtr = Tcl_NewStringObj(TK_LIBRARY_PATH, -1);
145     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
146     TclSetLibraryPath(pathPtr);
147
148     /* encoding initialization */
149     Tcl_SetDefaultEncodingDir(TCL_DEFAULT_ENCODING_DIR);
150     if ( Tcl_SetSystemEncoding(NULL, Tcl_GetEncodingNameFromEnvironment(&encodingName)) == TCL_ERROR )
151     {
152         fprintf(stderr, _("%s: An error occurred: %s\n"), "Tcl_SetSystemEncoding",
153                 _("Impossible to set system encoding."));
154         bOK = FALSE;
155     }
156     Tcl_DStringFree(&encodingName);
157
158     return bOK ;
159 }
160 /*--------------------------------------------------------------------------*/
161 #if defined(TCL_MAJOR_VERSION) && defined(TCL_MAJOR_VERSION)
162 #if TCL_MAJOR_VERSION == 8
163 #if TCL_MINOR_VERSION == 4
164 static CONST char * Tcl_GetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
165 {
166     Tcl_DStringInit(bufPtr);
167     wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
168     return Tcl_DStringValue(bufPtr);
169 }
170 #endif
171 #endif
172 #endif
173 /*--------------------------------------------------------------------------*/