add308a3bf514eac0f1eee68e96989894e622d61
[scilab.git] / scilab / modules / tclsci / src / c / InitTclTk.c
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2005-2008 - INRIA - Allan CORNET
4 * Copyright (C) 2007-2008 - INRIA - Bruno JOFRET
5 *
6  * Copyright (C) 2012 - 2016 - Scilab Enterprises
7  *
8  * This file is hereby licensed under the terms of the GNU GPL v2.0,
9  * pursuant to article 5.3.4 of the CeCILL v.2.1.
10  * This file was originally licensed under the terms of the CeCILL v2.1,
11  * and continues to be available under such terms.
12  * For more information, see the COPYING file which you should have received
13  * along with this program.
14 *
15 */
16
17
18 #include <string.h>
19 #ifndef _MSC_VER
20 #include <dirent.h>
21 #include <ctype.h>
22 #else
23 #include <windows.h>
24 #include "EnvTclTk.h"
25 #endif
26 #include "os_string.h"
27 #include "InitTclTk.h"
28 #include "sci_path.h"
29 #include "sciprint.h"
30 #include "Scierror.h"
31 #include "localization.h"
32 #include "configvariable_interface.h"
33 #include "ScilabEval.h"
34 #include "TCL_Command.h"
35 #include "GlobalTclInterp.h"
36 #include "BOOL.h"
37 #include "PATH_MAX.h"
38 #include "getshortpathname.h"
39 /*--------------------------------------------------------------------------*/
40 BOOL TK_Started = FALSE;
41
42 /*--------------------------------------------------------------------------*/
43 static char *GetSciPath(void);
44 /*--------------------------------------------------------------------------*/
45 static void *DaemonOpenTCLsci(void* in)
46 /* Checks if tcl/tk has already been initialised and if not */
47 /* initialise it. It must find the tcl script */
48 {
49     char *SciPath           = NULL;
50     char *SciPathShort      = NULL;
51     char *TkScriptpathShort = NULL;
52     BOOL tkStarted          = FALSE;
53     BOOL bOK                = FALSE;
54
55     char TkScriptpath[PATH_MAX];
56     char MyCommand[2048]; /* @TODO: Check for buffer overflow */
57
58
59 #ifndef _MSC_VER
60     DIR *tmpdir = NULL;
61 #endif
62
63     FILE *tmpfile2 = NULL;
64
65     SciPath = GetSciPath();
66
67     /* test SCI validity */
68     if (SciPath == NULL)
69     {
70         sciprint(_("The SCI environment variable is not set.\nTCL initialisation failed !\n"));
71         return (0);
72     }
73
74
75     SciPathShort = getshortpathname(SciPath, &bOK);
76     FREE(SciPath);
77     SciPath = NULL;
78
79 #ifdef TCL_MAJOR_VERSION
80 #ifdef TCL_MINOR_VERSION
81 #if TCL_MAJOR_VERSION >= 8
82 #if TCL_MINOR_VERSION > 0
83     Tcl_FindExecutable(" ");
84 #endif
85 #endif
86 #endif
87 #endif
88
89 #ifdef _MSC_VER
90
91     strcpy(TkScriptpath, SciPathShort);
92     strcat(TkScriptpath, "/modules/tclsci/tcl/TK_Scilab.tcl");
93
94     TkScriptpathShort = getshortpathname(TkScriptpath, &bOK);
95     tmpfile2 = fopen(TkScriptpathShort, "r");
96     if (tmpfile2 == NULL)
97     {
98         sciprint(_("Unable to find Tcl initialisation scripts.\nCheck your SCI environment variable.\nTcl initialisation failed !"));
99         FREE(SciPathShort);
100         SciPathShort = NULL;
101         FREE(TkScriptpathShort);
102         TkScriptpathShort = NULL;
103         return (0);
104     }
105     else
106     {
107         fclose(tmpfile2);
108     }
109 #else
110     tmpdir = opendir(SciPathShort);
111     if (tmpdir == NULL)
112     {
113         sciprint(_("The SCI environment variable is not set.\nTcl initialisation failed !\n"));
114         FREE(SciPathShort);
115         SciPathShort = NULL;
116         FREE(TkScriptpathShort);
117         TkScriptpathShort = NULL;
118         return (0);
119     }
120     else
121     {
122         closedir(tmpdir);
123     }
124     strcpy(TkScriptpath, SciPathShort);
125     strcat(TkScriptpath, "/modules/tclsci/tcl/TK_Scilab.tcl");
126     TkScriptpathShort = getshortpathname(TkScriptpath, &bOK);
127     tmpfile2 = fopen(TkScriptpathShort, "r");
128     if (tmpfile2 == NULL)
129     {
130         sciprint(_("Unable to find Tcl initialisation scripts.\nCheck your SCI environment variable.\nTcl initialisation failed !"));
131         FREE(SciPathShort);
132         SciPathShort = NULL;
133         FREE(TkScriptpathShort);
134         TkScriptpathShort = NULL;
135         return (0);
136     }
137     else
138     {
139         fclose(tmpfile2);
140     }
141 #endif /* _MSC_VER */
142
143     if (getTclInterp() == NULL)
144     {
145         releaseTclInterp();
146         initTclInterp();
147
148 #ifdef _MSC_VER
149         /* Initialize TCL_LIBRARY & TK_LIBRARY variables environment */
150         /* Windows only */
151         SetTclTkEnvironment(SciPathShort);
152 #endif
153
154         if ( getTclInterp() == NULL )
155         {
156             Scierror(999, _("Tcl Error: Unable to create Tcl interpreter (Tcl_CreateInterp).\n"));
157             FREE(SciPathShort);
158             SciPathShort = NULL;
159             FREE(TkScriptpathShort);
160             TkScriptpathShort = NULL;
161             return (0);
162         }
163         releaseTclInterp();
164
165         if ( Tcl_Init(getTclInterp()) == TCL_ERROR)
166         {
167             releaseTclInterp();
168             Scierror(999, _("Tcl Error: Error during the Tcl initialization (Tcl_Init): %s\n"), Tcl_GetStringResult(getTclInterp()));
169             FREE(SciPathShort);
170             SciPathShort = NULL;
171             FREE(TkScriptpathShort);
172             TkScriptpathShort = NULL;
173             return (0);
174         }
175         releaseTclInterp();
176         if (getenv("SCI_DISABLE_TK") == NULL)
177         {
178             /* When SCI_DISABLE_TK is set in the env disable the TK init
179              * process. It is causing issues when Scilab is
180              * used through ssh.  */
181             if ( Tk_Init(getTclInterp()) == TCL_ERROR)
182             {
183                 releaseTclInterp();
184                 Scierror(999, _("Tcl Error: Error during the TK initialization (Tk_Init): %s\n"), Tcl_GetStringResult(getTclInterp()));
185             }
186             else
187             {
188                 tkStarted = TRUE;
189             }
190             releaseTclInterp();
191         }
192
193
194         sprintf(MyCommand, "set SciPath \"%s\";", SciPathShort);
195
196         if ( Tcl_Eval(getTclInterp(), MyCommand) == TCL_ERROR  )
197         {
198             releaseTclInterp();
199             Scierror(999, _("Tcl Error: Error during the Scilab/Tcl init process. Could not set SciPath: %s\n"), Tcl_GetStringResult(getTclInterp()));
200             FREE(SciPathShort);
201             SciPathShort = NULL;
202             FREE(TkScriptpathShort);
203             TkScriptpathShort = NULL;
204             return (0);
205         }
206
207         releaseTclInterp();
208         Tcl_CreateCommand(getTclInterp(), "ScilabEval", TCL_EvalScilabCmd, (ClientData)1, NULL);
209         releaseTclInterp();
210     }
211     FREE(SciPathShort);
212     SciPathShort = NULL;
213
214     if (TKmainWindow == NULL && tkStarted)
215     {
216         TKmainWindow = Tk_MainWindow(getTclInterp());
217         releaseTclInterp();
218         Tk_GeometryRequest(TKmainWindow, 2, 2);
219         //printf("TkScriptpathShort : |%s|\n", TkScriptpathShort);
220         if ( Tcl_EvalFile(getTclInterp(), TkScriptpathShort) == TCL_ERROR  )
221         {
222             releaseTclInterp();
223             Scierror(999, _("Tcl Error: Error during the Scilab/TK init process. Error while loading %s: %s\n"), TkScriptpathShort, Tcl_GetStringResult(getTclInterp()));
224             FREE(TkScriptpathShort);
225             TkScriptpathShort = NULL;
226             return (0);
227         }
228         releaseTclInterp();
229     }
230
231     FREE(TkScriptpathShort);
232     TkScriptpathShort = NULL;
233
234     // This start a periodic and endless call to "update"
235     // TCL command. This causes any TCL application to start
236     // and run as if it's in the main program thread.
237     startTclLoop();
238     return (0);
239 }
240 /*--------------------------------------------------------------------------*/
241 int OpenTCLsci(void)
242 {
243     __threadKey key;
244     __InitSignalLock(&InterpReadyLock);
245     __InitSignal(&InterpReady);
246     // Open TCL interpreter in a separated thread.
247     // Allows all Tcl application not to freeze nor decrease Scilab speed.
248     // Causes also Scilab let those application live their own lifes.
249
250
251     __CreateThread(&TclThread, &key, &DaemonOpenTCLsci);
252     // Wait to be sure initialisation is complete.
253     __LockSignal(&InterpReadyLock);
254     __Wait(&InterpReady, &InterpReadyLock);
255     __UnLockSignal(&InterpReadyLock);
256
257     return 0;
258 }
259 /*--------------------------------------------------------------------------*/
260 BOOL CloseTCLsci(void)
261 {
262     if ( getScilabMode() != SCILAB_NWNI )
263     {
264         if (isTkStarted())
265         {
266             setTkStarted(FALSE);
267             __WaitThreadDie(TclThread);
268             deleteTclInterp();
269             TKmainWindow = NULL;
270             return TRUE;
271         }
272     }
273     return FALSE;
274 }
275 /*--------------------------------------------------------------------------*/
276 static char *GetSciPath(void)
277 /* force SciPath to Unix format for compatibility (Windows) */
278 {
279     char *PathUnix = NULL;
280     char *SciPathTmp = NULL;
281     int i = 0;
282     int lenPathUnix = 0;
283
284     SciPathTmp = getSCI();
285
286     if (SciPathTmp)
287     {
288         PathUnix = os_strdup(SciPathTmp);
289         lenPathUnix = (int)strlen(PathUnix);
290         for (i = 0; i < lenPathUnix; i++)
291         {
292             if (PathUnix[i] == '\\')
293             {
294                 PathUnix[i] = '/';
295             }
296         }
297     }
298     if (SciPathTmp)
299     {
300         FREE(SciPathTmp);
301         SciPathTmp = NULL;
302     }
303     return PathUnix;
304 }
305 /*--------------------------------------------------------------------------*/
306 BOOL isTkStarted(void)
307 {
308     return TK_Started;
309 }
310 /*--------------------------------------------------------------------------*/
311 void setTkStarted(BOOL isTkSet)
312 {
313     TK_Started = isTkSet;
314 }
315 /*--------------------------------------------------------------------------*/