fix tcl freeze when an error occured at initialization
[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 static char *releaseTclInterpOnError(void)
45 {
46     __LockSignal(&InterpReadyLock);
47     __Signal(&InterpReady);
48     __UnLockSignal(&InterpReadyLock);
49     setTkStarted(FALSE);
50 }
51 /*--------------------------------------------------------------------------*/
52 static void *DaemonOpenTCLsci(void* in)
53 /* Checks if tcl/tk has already been initialised and if not */
54 /* initialise it. It must find the tcl script */
55 {
56     char *SciPath           = NULL;
57     char *SciPathShort      = NULL;
58     char *TkScriptpathShort = NULL;
59     BOOL tkStarted          = FALSE;
60     BOOL bOK                = FALSE;
61
62     char TkScriptpath[PATH_MAX];
63     char MyCommand[2048]; /* @TODO: Check for buffer overflow */
64
65
66 #ifndef _MSC_VER
67     DIR *tmpdir = NULL;
68 #endif
69
70     FILE *tmpfile2 = NULL;
71
72     SciPath = GetSciPath();
73
74     /* test SCI validity */
75     if (SciPath == NULL)
76     {
77         sciprint(_("The SCI environment variable is not set.\nTCL initialisation failed !\n"));
78         releaseTclInterpOnError();
79         return (0);
80     }
81
82
83     SciPathShort = getshortpathname(SciPath, &bOK);
84     FREE(SciPath);
85     SciPath = NULL;
86
87 #ifdef TCL_MAJOR_VERSION
88 #ifdef TCL_MINOR_VERSION
89 #if TCL_MAJOR_VERSION >= 8
90 #if TCL_MINOR_VERSION > 0
91     Tcl_FindExecutable(" ");
92 #endif
93 #endif
94 #endif
95 #endif
96
97 #ifdef _MSC_VER
98
99     strcpy(TkScriptpath, SciPathShort);
100     strcat(TkScriptpath, "/modules/tclsci/tcl/TK_Scilab.tcl");
101
102     TkScriptpathShort = getshortpathname(TkScriptpath, &bOK);
103     tmpfile2 = fopen(TkScriptpathShort, "r");
104     if (tmpfile2 == NULL)
105     {
106         sciprint(_("Unable to find Tcl initialisation scripts.\nCheck your SCI environment variable.\nTcl initialisation failed !"));
107         FREE(SciPathShort);
108         SciPathShort = NULL;
109         FREE(TkScriptpathShort);
110         TkScriptpathShort = NULL;
111         return (0);
112     }
113     else
114     {
115         fclose(tmpfile2);
116     }
117 #else
118     tmpdir = opendir(SciPathShort);
119     if (tmpdir == NULL)
120     {
121         sciprint(_("The SCI environment variable is not set.\nTcl initialisation failed !\n"));
122         FREE(SciPathShort);
123         SciPathShort = NULL;
124         FREE(TkScriptpathShort);
125         TkScriptpathShort = NULL;
126         releaseTclInterpOnError();
127         return (0);
128     }
129     else
130     {
131         closedir(tmpdir);
132     }
133     strcpy(TkScriptpath, SciPathShort);
134     strcat(TkScriptpath, "/modules/tclsci/tcl/TK_Scilab.tcl");
135     TkScriptpathShort = getshortpathname(TkScriptpath, &bOK);
136     tmpfile2 = fopen(TkScriptpathShort, "r");
137     if (tmpfile2 == NULL)
138     {
139         sciprint(_("Unable to find Tcl initialisation scripts.\nCheck your SCI environment variable.\nTcl initialisation failed !"));
140         FREE(SciPathShort);
141         SciPathShort = NULL;
142         FREE(TkScriptpathShort);
143         TkScriptpathShort = NULL;
144         releaseTclInterpOnError();
145         return (0);
146     }
147     else
148     {
149         fclose(tmpfile2);
150     }
151 #endif /* _MSC_VER */
152
153     if (getTclInterp() == NULL)
154     {
155         releaseTclInterp();
156         initTclInterp();
157
158 #ifdef _MSC_VER
159         /* Initialize TCL_LIBRARY & TK_LIBRARY variables environment */
160         /* Windows only */
161         SetTclTkEnvironment(SciPathShort);
162 #endif
163
164         if ( getTclInterp() == NULL )
165         {
166             releaseTclInterp();
167             Scierror(999, _("Tcl Error: Unable to create Tcl interpreter (Tcl_CreateInterp).\n"));
168             FREE(SciPathShort);
169             SciPathShort = NULL;
170             FREE(TkScriptpathShort);
171             TkScriptpathShort = NULL;
172             releaseTclInterpOnError();
173             return (0);
174         }
175         releaseTclInterp();
176
177         if ( Tcl_Init(getTclInterp()) == TCL_ERROR)
178         {
179             releaseTclInterp();
180             Scierror(999, _("Tcl Error: Error during the Tcl initialization (Tcl_Init): %s\n"), Tcl_GetStringResult(getTclInterp()));
181             releaseTclInterp();
182             FREE(SciPathShort);
183             SciPathShort = NULL;
184             FREE(TkScriptpathShort);
185             TkScriptpathShort = NULL;
186             releaseTclInterpOnError();
187             return (0);
188         }
189         releaseTclInterp();
190         if (getenv("SCI_DISABLE_TK") == NULL)
191         {
192             /* When SCI_DISABLE_TK is set in the env disable the TK init
193              * process. It is causing issues when Scilab is
194              * used through ssh.  */
195             if ( Tk_Init(getTclInterp()) == TCL_ERROR)
196             {
197                 releaseTclInterp();
198                 releaseTclInterpOnError();
199                 Scierror(999, _("Tcl Error: Error during the TK initialization (Tk_Init): %s\n"), Tcl_GetStringResult(getTclInterp()));
200                 releaseTclInterp();
201                 return (0);
202             }
203             else
204             {
205                 tkStarted = TRUE;
206             }
207             releaseTclInterp();
208         }
209
210
211         sprintf(MyCommand, "set SciPath \"%s\";", SciPathShort);
212
213         if ( Tcl_Eval(getTclInterp(), MyCommand) == TCL_ERROR  )
214         {
215             releaseTclInterp();
216             Scierror(999, _("Tcl Error: Error during the Scilab/Tcl init process. Could not set SciPath: %s\n"), Tcl_GetStringResult(getTclInterp()));
217             releaseTclInterp();
218             FREE(SciPathShort);
219             SciPathShort = NULL;
220             FREE(TkScriptpathShort);
221             TkScriptpathShort = NULL;
222             return (0);
223         }
224
225         releaseTclInterp();
226         Tcl_CreateCommand(getTclInterp(), "ScilabEval", TCL_EvalScilabCmd, (ClientData)1, NULL);
227         releaseTclInterp();
228     }
229     FREE(SciPathShort);
230     SciPathShort = NULL;
231
232     if (TKmainWindow == NULL && tkStarted)
233     {
234         TKmainWindow = Tk_MainWindow(getTclInterp());
235         releaseTclInterp();
236         Tk_GeometryRequest(TKmainWindow, 2, 2);
237         //printf("TkScriptpathShort : |%s|\n", TkScriptpathShort);
238         if ( Tcl_EvalFile(getTclInterp(), TkScriptpathShort) == TCL_ERROR  )
239         {
240             releaseTclInterp();
241             Scierror(999, _("Tcl Error: Error during the Scilab/TK init process. Error while loading %s: %s\n"), TkScriptpathShort, Tcl_GetStringResult(getTclInterp()));
242             releaseTclInterp();
243             FREE(TkScriptpathShort);
244             TkScriptpathShort = NULL;
245             releaseTclInterpOnError();
246             return (0);
247         }
248         releaseTclInterp();
249     }
250
251     FREE(TkScriptpathShort);
252     TkScriptpathShort = NULL;
253
254     // This start a periodic and endless call to "update"
255     // TCL command. This causes any TCL application to start
256     // and run as if it's in the main program thread.
257     startTclLoop();
258     return (0);
259 }
260 /*--------------------------------------------------------------------------*/
261 int OpenTCLsci(void)
262 {
263     __threadKey key;
264     __InitSignalLock(&InterpReadyLock);
265     __InitSignal(&InterpReady);
266     // Open TCL interpreter in a separated thread.
267     // Allows all Tcl application not to freeze nor decrease Scilab speed.
268     // Causes also Scilab let those application live their own lifes.
269
270     __CreateThread(&TclThread, &key, &DaemonOpenTCLsci);
271     // Wait to be sure initialisation is complete.
272     __LockSignal(&InterpReadyLock);
273     __Wait(&InterpReady, &InterpReadyLock);
274     __UnLockSignal(&InterpReadyLock);
275
276     return 0;
277 }
278 /*--------------------------------------------------------------------------*/
279 BOOL CloseTCLsci(void)
280 {
281     if ( getScilabMode() != SCILAB_NWNI )
282     {
283         if (isTkStarted())
284         {
285             setTkStarted(FALSE);
286             __WaitThreadDie(TclThread);
287             deleteTclInterp();
288             TKmainWindow = NULL;
289             return TRUE;
290         }
291     }
292     return FALSE;
293 }
294 /*--------------------------------------------------------------------------*/
295 static char *GetSciPath(void)
296 /* force SciPath to Unix format for compatibility (Windows) */
297 {
298     char *PathUnix = NULL;
299     char *SciPathTmp = NULL;
300     int i = 0;
301     int lenPathUnix = 0;
302
303     SciPathTmp = getSCI();
304
305     if (SciPathTmp)
306     {
307         PathUnix = os_strdup(SciPathTmp);
308         lenPathUnix = (int)strlen(PathUnix);
309         for (i = 0; i < lenPathUnix; i++)
310         {
311             if (PathUnix[i] == '\\')
312             {
313                 PathUnix[i] = '/';
314             }
315         }
316     }
317     if (SciPathTmp)
318     {
319         FREE(SciPathTmp);
320         SciPathTmp = NULL;
321     }
322     return PathUnix;
323 }
324 /*--------------------------------------------------------------------------*/
325 BOOL isTkStarted(void)
326 {
327     return TK_Started;
328 }
329 /*--------------------------------------------------------------------------*/
330 void setTkStarted(BOOL isTkSet)
331 {
332     TK_Started = isTkSet;
333 }
334 /*--------------------------------------------------------------------------*/